From f5409662d478093ebb79fdb308538be7bf42f701 Mon Sep 17 00:00:00 2001 From: Mike Vink Date: Sun, 23 Apr 2023 22:23:23 +0200 Subject: fixup --- shared/data-directed-programming.rkt | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) (limited to 'shared') diff --git a/shared/data-directed-programming.rkt b/shared/data-directed-programming.rkt index 6cecaf1..7566e30 100644 --- a/shared/data-directed-programming.rkt +++ b/shared/data-directed-programming.rkt @@ -15,15 +15,21 @@ ;; Type tagged data (define (attach-tag type-tag contents) - (cons type-tag contents)) + (cond ((number? contents) contents) + ((symbol? contents) contents) + (else (cons type-tag contents)))) (define (type-tag datum) - (if (pair? datum) - (car datum) - (error "Bad tagged datum -- TYPE-TAG" datum))) + (cond + ((pair? datum) (car datum)) + ((number? datum) 'scheme-number) + ((symbol? datum) 'symbol) + (else (error "Bad tagged datum -- TYPE-TAG" datum)))) (define (contents datum) - (if (pair? datum) - (cdr datum) - (error "Bad tagged datum -- CONTENTS" datum))) + (cond + ((pair? datum) (cdr datum)) + ((number? datum) datum) + ((symbol? datum) datum) + (else (error "Bad tagged datum -- CONTENTS" datum)))) (define (find-type type seq) (define (rec items) @@ -39,7 +45,7 @@ (define dispatch-table '()) (define (printer) (newline) - (display dispatch-table)) + (println dispatch-table)) (define (get op types) (let ((op-datum (find-type op dispatch-table))) (if op-datum -- cgit v1.2.3