c2_78

Author: seckcoder

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)

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)