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)