From fdc3e01ae31e6b33703a8dd87fa0c377229c47ca Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 18 Jan 2018 18:25:54 -0800 Subject: [PATCH] Fix bug in macro expansion for define-bundle-interface. --- src/runtime/mit-macros.scm | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm index 74bc320cb..2a6160e9b 100644 --- a/src/runtime/mit-macros.scm +++ b/src/runtime/mit-macros.scm @@ -784,7 +784,7 @@ USA. `(begin (define ,interface (make-bundle-interface - ',(string->symbol (strip-angle-brackets (symbol->string interface))) + ',(strip-angle-brackets interface) (list ,@(map (lambda (element) (if (symbol? element) `(list ',element) @@ -795,7 +795,7 @@ USA. (cdr element))))) elements)))) (define ,predicate - (bundle-interface-predicate ,interface)) + (dispatch-tag->predicate ,interface)) (define-syntax ,capturer (sc-macro-transformer (lambda (form use-environment) @@ -814,21 +814,15 @@ USA. (let loop ((expr expr)) (cond ((identifier? expr) (rename expr)) - ((and (pair? expr) - (eq? 'quote (car expr)) - (pair? (cdr expr)) - (null? (cddr expr))) - (list (rename 'quote) - (cadr expr))) ((and (pair? expr) (list? (cdr expr))) (cons (rename (car expr)) (let ((rest (cdr expr))) (case (car expr) - ((quote) + ((quote dispatch-tag->predicate) rest) ((define define-syntax) - (cons (car rest) (loop (cdr rest)))) + (cons (car rest) (map loop (cdr rest)))) (else (map loop rest)))))) (else expr)))) -- 2.25.1