Replace reals with scheme-numbers

2_78.rkt

@@ -68,7 +68,7 @@
 ;; Number tower.  Ignores possibility of one of the arguments
 ;; not being in the tower.  Maybe fix later.
 (define (lower-in-tower? t1 t2)
-  (define tower '(integer rational real complex))
+  (define tower '(integer rational scheme-number complex))
   (define (tower-iter tower)
     (cond ((null? tower)
            (error "Not in tower" (list t1 t2)))
@@ -170,10 +170,26 @@
   (put 'div '(scheme-number scheme-number)
        (lambda (x y) (tag (/ x y))))
   (put 'negate '(scheme-number)
-       (lambda (x) (* -1 x)))
+       (lambda (x) (tag (* -1 x))))
+  (put 'sine '(scheme-number)
+       (lambda (x) (tag (sin x))))
+  (put 'cosine '(scheme-number)
+       (lambda (x) (tag (cos x))))
+  (put 'square-root '(scheme-number)
+       (lambda (x) (tag (sqrt x))))
   (put 'equ? '(scheme-number scheme-number) =)
   (put '=zero? '(scheme-number)
        (lambda (x) (= x 0)))
+  (put 'raise '(scheme-number)
+       (lambda (x)
+         (make-complex-from-real-imag
+          (tag x)
+          (tag 0))))
+  (put 'project '(scheme-number)
+       (lambda (x)
+         (make-rational
+          (round (* x 1000))
+          1000)))
   (put 'exp '(scheme-number scheme-number)
        (lambda (x y) (tag (expt x y))))
   (put 'make 'scheme-number
@@ -221,48 +237,6 @@
        (lambda (x) (tag (round x))))
   'done)
 
-;; Reals
-
-(define (install-real-package)
-  (define (tag x)
-    (attach-tag 'real x))
-
-  (put 'add '(real real)
-       (lambda (x y)
-         (make-real (+ x y))))
-  (put 'sub '(real real)
-       (lambda (x y)
-         (make-real (- x y))))
-  (put 'mul '(real real)
-       (lambda (x y)
-         (make-real (* x y))))
-  (put 'div '(real real)
-       (lambda (x y)
-         (make-real (/ x y))))
-  (put 'negate '(real)
-       (lambda (x)
-         (make-real (* -1 x))))
-  (put 'sine '(real)
-       (lambda (x) (make-real (sin x))))
-  (put 'cosine '(real)
-       (lambda (x) (make-real (cos x))))
-  (put 'square-root '(real)
-       (lambda (x) (make-real (sqrt x))))
-  (put 'arctan '(real real)
-       (lambda (x y) (make-real (atan x y))))
-  (put 'equ? '(real real)
-       (lambda (x y)
-         (= x y)))
-  (put 'raise '(real)
-       (lambda (x) (make-complex-from-real-imag (make-real x) (make-real 0))))
-  (put 'project '(real)
-       (lambda (x) (make-rational
-                    (round (* x 1000))
-                    1000)))
-  (put 'make 'real
-       (lambda (x) (tag x)))
-  'done)
-
 ;; Rationals
 
 (define (install-rational-package)
@@ -290,7 +264,7 @@
     (and (= (numer x) (numer y))
          (= (denom x) (denom y))))
   (define (raise-rat x)
-    (make-real (/ (numer x) (denom x))))
+    (make-scheme-number (/ (numer x) (denom x))))
   ;; interface to rest of the system
   (define (tag x) (attach-tag 'rational x))
   (put 'add '(rational rational)
@@ -348,8 +322,8 @@
           (mul r (sine a))))
   (define (negate z)
     (make-from-real-imag
-     (mul (make-real -1) (real-part z))
-     (mul (make-real -1) (imag-part z))))
+     (mul (make-scheme-number -1) (real-part z))
+     (mul (make-scheme-number -1) (imag-part z))))
 
   ;; interface to the rest of the system
   (define (tag x) (attach-tag 'rectangular x))
@@ -379,7 +353,7 @@
   (define (make-from-real-imag x y) 
     (cons (square-root (add (square x) (square y)))
           (arctan y x)))
-  (define pi (make-real (* 2 (asin 1)))) 
+  (define pi (make-scheme-number (* 2 (asin 1)))) 
   (define (negate z)
     (make-from-mag-ang
      (magnitude z)
@@ -439,15 +413,15 @@
          (and (equ? (real-part z1) (real-part z2))
               (equ? (imag-part z1) (imag-part z2)))))
   (put '=zero? '(complex)
-       (lambda (z) (equ? (magnitude z) (make-real 0))))
+       (lambda (z) (equ? (magnitude z) (make-scheme-number 0))))
   ;;(put 'negate '(complex)
        ;;(lambda (z) (tag (negate z))))
   (put 'negate '(complex)
        (lambda (z)
          (tag
           (make-from-real-imag
-           (mul (real-part z) (make-real -1))
-           (mul (imag-part z) (make-real -1))))))
+           (mul (real-part z) (make-scheme-number -1))
+           (mul (imag-part z) (make-scheme-number -1))))))
          
   (put 'make-from-real-imag 'complex
        (lambda (x y) (tag (make-from-real-imag x y))))
@@ -572,9 +546,6 @@
 (define (make-rational n d)
   ((get 'make 'rational) n d))
 
-(define (make-real x)
-  ((get 'make 'real) x))
-
 (define (make-complex-from-real-imag x y)
   ((get 'make-from-real-imag 'complex) x y))
 
@@ -644,7 +615,6 @@
 (install-scheme-number-package)
 (install-integer-package)
 (install-rational-package)
-(install-real-package)
 (install-polar-package)
 (install-rectangular-package)
 (install-complex-package)