Completed up to 2.84

2_78.rkt

@@ -68,23 +68,30 @@
 ;;            "No method for these types -- APPLY-GENERIC"
 ;;            (list op type-tags))))))
 
-(define (accumulate op initial sequence)
-  (if (null? sequence)
-      initial
-      (op (car sequence)
-          (accumulate op initial (cdr sequence)))))
-
-(define (flatmap proc seq)
-  (accumulate append nil (map proc seq)))
+;; 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-iter tower)
+    (cond ((null? tower)
+           (error "Not in tower" (list t1 t2)))
+          ((eq? (car tower) t1) #t)
+          ((eq? (car tower) t2) #f)
+          (else (tower-iter (cdr tower)))))
+  (if (eq? t1 t2)
+      #f
+      (tower-iter tower)))
 
 (define (apply-generic op . args)
   (define (coerce-to t)
-    (lambda (arg)
-      (let* ((type (type-tag arg))
-             (type->t (get-coercion type t)))
-        (cond ((eq? type t) arg)
-              (type->t (type->t arg))
-              (else '())))))
+    (letrec ((coerce (lambda (arg)
+                       (cond ((eq? (type-tag arg) t) arg)
+                             ((lower-in-tower?
+                               (type-tag arg)
+                               t)
+                              (coerce (raise arg)))
+                             (else '())))))
+      coerce))
   (define (any-empty-list l)
     (cond ((null? l) #f)
           ((eq? (car l) '()) #t)
@@ -110,14 +117,6 @@
               (error "Too few args"))))))
 
 
-;; map coerce-to onto all arguments for the type of each argument.
-;; The first one that returns all non empty arguments is the coercion
-;; that is used.
-;; How to determine if any of the results are ()?  Maybe use accumulate?
-      
-        
-  
-
 ;; Scheme numbers
 
 (define (install-scheme-number-package)
@@ -354,6 +353,7 @@
 ;; Generic operators
 
 (define (add x y) (apply-generic 'add x y))
+(define (add3 x y z) (apply-generic 'add3 x y z))
 (define (sub x y) (apply-generic 'sub x y))
 (define (mul x y) (apply-generic 'mul x y))
 (define (div x y) (apply-generic 'div x y))