diff options
| author | Mike Vink <mike1994vink@gmail.com> | 2023-04-26 21:55:59 +0200 |
|---|---|---|
| committer | Mike Vink <mike1994vink@gmail.com> | 2023-04-26 21:55:59 +0200 |
| commit | 8dc7fa7eda8ad0429728c04e4e3f1868648a2c27 (patch) | |
| tree | b88ae865447740832b60b60e155897e9c0b9b0e2 /shared | |
| parent | f5409662d478093ebb79fdb308538be7bf42f701 (diff) | |
82 is not tested but meh
Diffstat (limited to 'shared')
| -rw-r--r-- | shared/data-directed-programming.rkt | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/shared/data-directed-programming.rkt b/shared/data-directed-programming.rkt index 7566e30..603d4d7 100644 --- a/shared/data-directed-programming.rkt +++ b/shared/data-directed-programming.rkt @@ -1,5 +1,6 @@ #lang racket (provide + make-apply-with-coercion make-apply make-dispatch-table printer @@ -11,6 +12,15 @@ find-type) (require "./lists.rkt") +(define (make-apply-with-coercion get get-coercion) + (lambda (op . args) + (let ((type-tags (map type-tag args))) + (let ((proc (get op type-tags))) + (if proc + (apply proc (map contents args)) + (error + "No method for these types -- APPLY-GENERIC" + (list op type-tags))))))) ;; Type tagged data @@ -86,8 +96,9 @@ (define (printer t) (cadddr t)) -(define (make-apply put get) +(define (make-apply get) (lambda (op . args) + (display args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc @@ -95,3 +106,4 @@ (error "No method for these types -- APPLY-GENERIC" (list op type-tags))))))) + |