diff options
Diffstat (limited to 'shared/data-directed-programming.rkt')
| -rw-r--r-- | shared/data-directed-programming.rkt | 15 |
1 files changed, 7 insertions, 8 deletions
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))) |