Fix bug in macro expansion for define-bundle-interface.
authorChris Hanson <org/chris-hanson/cph>
Fri, 19 Jan 2018 02:25:54 +0000 (18:25 -0800)
committerChris Hanson <org/chris-hanson/cph>
Fri, 19 Jan 2018 02:25:54 +0000 (18:25 -0800)
src/runtime/mit-macros.scm

index 74bc320cb5f1c1d6074d2e89719d9cb2d65dc698..2a6160e9b3d7e79e9ffeae6ab193ef8754920c8c 100644 (file)
@@ -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))))