make raising and dropping more robust

4 files changed, 30 insertions, 38 deletions

diff --git a/coding-exercises/2/83/install-rational.rkt b/coding-exercises/2/83/install-rational.rkt
index 334f802..92531ec 100644
--- a/coding-exercises/2/83/install-rational.rkt
+++ b/coding-exercises/2/83/install-rational.rkt
@@ -70,15 +70,11 @@
       (cons (sign (/ n g)) (abs (/ d g)))))
 
   (define (dropme rat)
-    (display (list (numer rat) (denom rat)))
-    (display (list (integer? (numer rat)) (integer? (denom rat))))
     (if (and (integer? (numer rat))
              (integer? (denom rat)))
       ((get 'make 'integer) (/ (numer rat) (denom rat)))
       (list 'undefined)))
   (define (raiseme rat)
-    (display (list (numer rat) (denom rat)))
-    (display (list (integer? (numer rat)) (integer? (denom rat))))
     (if (and (integer? (numer rat))
              (integer? (denom rat)))
       ((get 'make 'real) (/ (numer rat) (denom rat)))
diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt
index fcaff0b..25f2152 100644
--- a/coding-exercises/2/83/install.rkt
+++ b/coding-exercises/2/83/install.rkt
@@ -11,14 +11,14 @@
          make-complex-rect
          test-complex-rect
          make-complex-polar
-         ;test-complex-polar
+         test-complex-polar
          term
          dense-termlist
          sparse-termlist
          make-polynomial
-         ; test-poly1
-         ; test-poly2
-         ; test-poly3
+         test-poly1
+         test-poly2
+         test-poly3
          =zero?
          equ?
          add
@@ -82,8 +82,7 @@
   ((get 'make-from-mag-ang 'complex) x y))
 (define test-complex (make-complex 1 2))
 (define test-complex-rect (make-complex-rect 1 2))
-(display (apply-fn 'magnitude test-complex))
-;; (define test-complex-polar (make-complex-polar (apply-fn 'magnitude test-complex) (apply-fn 'angle test-complex)))
+(define test-complex-polar (make-complex-polar (apply-fn 'magnitude test-complex) (apply-fn 'angle test-complex)))
 
 ;; polynomial
 (define (term order coeff)
@@ -94,16 +93,16 @@
   ((get 'make-from-terms 'dense-termlist) terms))
 (define (make-polynomial var terms)
   ((get 'make 'polynomial) var terms))
-; (define test-poly1 (make-polynomial 'x (sparse-termlist
-;                                          (term 1 test-integer)))
-; (define test-poly2 (make-polynomial 'x (sparse-termlist
-;                                          (term 100 test-complex)
-;                                          (term 2 test-real)
-;                                          (term 1 test-rat)
-;                                          (term 0 test-integer))))
-; (define test-poly3 (make-polynomial 'x (sparse-termlist
-;                                          (term 50 test-rat)
-;                                          (term 0 2))))
+(define test-poly1 (make-polynomial 'x (sparse-termlist
+                                         (term 1 test-integer))))
+(define test-poly2 (make-polynomial 'x (sparse-termlist
+                                         (term 100 test-complex)
+                                         (term 2 test-real)
+                                         (term 1 test-rat)
+                                         (term 0 test-integer))))
+(define test-poly3 (make-polynomial 'x (sparse-termlist
+                                         (term 50 test-rat)
+                                         (term 0 2))))
 
 ;; generic methods
 (define (equ? a1 a2)
diff --git a/coding-exercises/2/93.rkt b/coding-exercises/2/93.rkt
index a4067d1..4fe754e 100644
--- a/coding-exercises/2/93.rkt
+++ b/coding-exercises/2/93.rkt
@@ -8,15 +8,13 @@
 (define apply-fn (caddr get-put-apply))
 
 ;; something
-;; (define p1 (make-polynomial 'x (sparse-termlist
-;;                                  (term 2 1) (term 0 1)))
-;; (define p2 (make-polynomial 'x (sparse-termlist
-;;                                  (term 3 1) (term 0 1))))
-;; (define rf (make-rat p2 p1))
+(define p1 (make-polynomial 'x (sparse-termlist
+                                 (term 2 1) (term 0 1))))
+(define p2 (make-polynomial 'x (sparse-termlist
+                                 (term 3 1) (term 0 1))))
+(define rf (make-rat p2 p1))
 ((lambda ()
    (newline)
-   (display (add 1 (make-rat 2 1)))))
-   ;; (newline)
-   ;; (display rf)
-   ;; (newline)
-   ;; (display (add rf rf))))
+   (display rf)
+   (newline)
+   (display (add rf rf))))
diff --git a/shared/data-directed-programming.rkt b/shared/data-directed-programming.rkt
index decdf0f..3e555ee 100644
--- a/shared/data-directed-programming.rkt
+++ b/shared/data-directed-programming.rkt
@@ -121,7 +121,6 @@
 (define (make-apply-with-coercion get get-coercion)
   (define (make-apply get)
     (lambda (op . args)
-       ;; (display args)
        (let ((type-tags (map type-tag args)))
          (let ((proc (get op type-tags)))
            (if proc
@@ -153,7 +152,6 @@
     (iter type-tags))
 
   (lambda (op . args)
-     ;; (display args)
      (let ((type-tags (map type-tag args)))
        (let ((proc (get op type-tags)))
          (if proc
@@ -229,11 +227,15 @@
   (define (equ? d1 d2)
     (local-apply 'equ? d1 d2))
 
+  (define (raisable? datum)
+    (get 'raise (list (type-tag datum))))
   (define (can-drop? datum)
     (let ((dropped (project datum)))
-      (let ((raised (raisetower dropped)))
-        (and (get 'equ? (list (type-tag raised) (type-tag datum)))
-             (equ? raised datum)))))
+      (if (raisable? dropped)
+        (let ((raised (raisetower dropped)))
+          (and (get 'equ? (list (type-tag raised) (type-tag datum)))
+               (equ? raised datum)))
+        false)))
 
   (define (projectable? datum)
     (get 'project (list (type-tag datum))))
@@ -249,9 +251,6 @@
       (if proc
         (towerdrop (apply proc (map contents args)))
         (let ((raised-args (raise-until-type-match get (highest-type get args) args)))
-          (newline)
-          (display (list "RAISED -- " raised-args))
-          (newline)
           (let ((raised-proc (get op (map type-tag raised-args))))
             (if raised-proc
                (towerdrop (apply raised-proc (map contents raised-args)))