From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 19 Jan 2018 02:25:54 +0000 (-0800)
Subject: Fix bug in macro expansion for define-bundle-interface.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~341
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fdc3e01ae31e6b33703a8dd87fa0c377229c47ca;p=mit-scheme.git

Fix bug in macro expansion for define-bundle-interface.
---

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))))