From 8dc7fa7eda8ad0429728c04e4e3f1868648a2c27 Mon Sep 17 00:00:00 2001 From: Mike Vink Date: Wed, 26 Apr 2023 21:55:59 +0200 Subject: 82 is not tested but meh --- shared/data-directed-programming.rkt | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'shared') 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))))))) + -- cgit v1.2.3