85

3 files changed, 42 insertions, 7 deletions

diff --git a/coding-exercises/2/78/install-complex-package.rkt b/coding-exercises/2/78/install-complex-package.rkt
index a656495..fa39328 100644
--- a/coding-exercises/2/78/install-complex-package.rkt
+++ b/coding-exercises/2/78/install-complex-package.rkt
@@ -39,8 +39,8 @@
 
   ;; predicates (...) -> bool
   (define (equ? z1 z2)
-    (and (equal? (real-part z1) (real-part z2))
-         (equal? (imag-part z1) (imag-part z2))))
+    (and (= (real-part z1) (real-part z2))
+         (= (imag-part z1) (imag-part z2))))
   (define (=zero? z)
     (and (= (real-part z)) (= (imag-part z))))
 
diff --git a/coding-exercises/2/83.rkt b/coding-exercises/2/83.rkt
index 26a8ea8..c6f7b68 100644
--- a/coding-exercises/2/83.rkt
+++ b/coding-exercises/2/83.rkt
@@ -64,8 +64,8 @@
     (make-rat (* (numer x) (denom y))
               (* (denom x) (numer y))))
   (define (equ? x y)
-    (and (equal? (numer x) (numer y))
-         (equal? (denom x) (denom y))))
+    (and (= (numer x) (numer y))
+         (= (denom x) (denom y))))
   (define (=zero? x)
     (equal? (numer x) 0))
 
@@ -95,6 +95,8 @@
   (put 'div '(rational rational)
        (lambda (x y) (tagme (div-rat x y))))
   (put 'raise '(rational) raiseme)
+  (put 'project '(rational) (lambda (rat)
+                              ((get 'make 'integer) (/ (numer rat) (denom rat)))))
 
   ;; predicates
   (put 'equ? '(rational rational)
@@ -120,6 +122,8 @@
   (put 'mul '(real real) (lambda (x y) (tagme (make (* x y)))))
   (put 'div '(real real) (lambda (x y) (tagme (make (/ x y)))))
   (put 'raise '(real) raiseme)
+  (put 'project '(real) (lambda (n)
+                          ((get 'make 'rational) (round n) 1)))
   ;; predicates
   (put 'equ? '(real real) (lambda (x y) (= x y)))
   (put '=zero? '(real) (lambda (x) (= 0 x)))
@@ -131,6 +135,8 @@
 (install-real put get)
 ;; use from previous exercise
 (install-complex-package apply-generic get put)
+(put 'project '(complex) (lambda (z)
+                           ((get 'make 'real) (apply-generic 'real-part z))))
 
 ;; test running
 ;; integer
@@ -141,7 +147,7 @@
 ;; rational
 (define (make-rat n d)
   ((get 'make 'rational) n d))
-(define test-rat (make-rat 1 2))
+(define test-rat (make-rat 5 2))
 
 ;; real
 (define (make-real n)
@@ -240,4 +246,34 @@
 ;; 85
 ;; lowerable?
 (define (project datum)
-  datum)
+  (apply-generic 'project datum))
+(project test-complex)
+(project 1.5)
+(project test-rat)
+(define (equ? d1 d2)
+  (apply-generic 'equ? d1 d2))
+
+(define (can-drop? datum)
+  (equ? (raisetower (project datum))
+        datum))
+(define (towerdrop datum)
+  (cond ((and (get 'project (list (type-tag datum)))
+              (can-drop? datum))
+         (towerdrop (project datum)))
+        (else datum)))
+(towerdrop (make-complex 1 1))
+
+(define (make-apply-with-raising-and-drop apply-generic get)
+  (lambda (op . args)
+    (let ((result (apply apply-generic (cons op args))))
+      (if result
+        (towerdrop result)
+        (let ((raised-args (raise-until-type-match apply-generic (highest-type apply-generic args) args)))
+          (let ((raised-result (apply apply-generic (cons op raised-args))))
+            (if raised-result
+               (towerdrop raised-result)
+               (error "Could not apply --" (list op args raised-args)))))))))
+(define apply-and-drop (make-apply-with-raising-and-drop (make-apply-pred get) get))
+(apply-and-drop 'add
+                1.0
+                (make-complex 1 0))
diff --git a/shared/data-directed-programming.rkt b/shared/data-directed-programming.rkt
index 2edf4d5..7b9655a 100644
--- a/shared/data-directed-programming.rkt
+++ b/shared/data-directed-programming.rkt
@@ -92,7 +92,6 @@
 
 (define (make-apply get)
   (lambda (op . args)
-     (display args)
      (let ((type-tags (map type-tag args)))
        (let ((proc (get op type-tags)))
          (if proc