From bfba1c01022e1d16321c19cd2f256ef3952df398 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@Gmail.com>
Date: Tue, 23 Jul 2013 19:58:20 +0800
Subject: [PATCH] c2_78

---
 src/c2_78.scm    |  9 +++++++++
 src/lib/base.scm | 16 +++++++++-------
 2 files changed, 18 insertions(+), 7 deletions(-)
 create mode 100644 src/c2_78.scm

diff --git a/src/c2_78.scm b/src/c2_78.scm
new file mode 100644
index 0000000..982e0f9
--- /dev/null
+++ b/src/c2_78.scm
@@ -0,0 +1,9 @@
+(import (rnrs)
+        (base)
+        (init)
+        (generic-arithmetic))
+
+(init)
+(display (make-scheme-number 3))(newline)
+(display (add (make-scheme-number 3)
+              (make-scheme-number 4)))(newline)
diff --git a/src/lib/base.scm b/src/lib/base.scm
index d03fc06..3a24897 100644
--- a/src/lib/base.scm
+++ b/src/lib/base.scm
@@ -10,15 +10,17 @@
   (define get (operation-table 'lookup-proc))
   (define put (operation-table 'insert-proc!))
   (define (attach-tag type-tag contents)
-    (cons type-tag contents))
+    (if (number? contents)
+      contents
+      (cons type-tag contents)))
   (define (type-tag datum)
-    (if (pair? datum)
-      (car datum)
-      (error 'type-tag "Bad tagged datum" datum)))
+    (cond ((number? datum) 'scheme-number)
+          ((pair?  datum) (car datum))
+          (else (error 'type-tag "Bad tagged datum" datum))))
   (define (contents datum)
-    (if (pair? datum)
-      (cdr datum)
-      (error 'contents "Bad tagged datum" datum)))
+    (cond ((number? datum) datum)
+          ((pair? datum) (cdr datum))
+          (else (error 'contents "Bad tagged datum" datum))))
   (define (square x)
     (* x x))
   (define (apply-generic op . args)