]> birchwood-abbey.net Git - mit-scheme.git/commitdiff
Fix bug #63503.
authorChris Hanson <org/chris-hanson/cph>
Sun, 11 Dec 2022 07:54:13 +0000 (23:54 -0800)
committerChris Hanson <org/chris-hanson/cph>
Sun, 11 Dec 2022 07:55:10 +0000 (23:55 -0800)
Screwed up literal identifier matching during rewrite.

src/runtime/syntax-rules.scm
tests/runtime/test-syntax.scm

index bd133f5fbde58c64fd9f550137ce77f5da65fc2f..9a50080f56685d859c59c58dd6d04904ab6a3159 100644 (file)
@@ -83,9 +83,8 @@ USA.
         `(,(rename 'er-macro-transformer)
           (,(rename 'lambda)
            (,r-form ,r-rename ,r-compare)
-           (,(rename 'declare) (ignore ,r-compare))
            ,@(if (null? clauses)
-                 `((,(rename 'declare) (ignore ,r-rename)))
+                 `((,(rename 'declare) (ignore ,r-rename ,r-compare)))
                  '())
            ,(let loop
                 ((clauses
@@ -98,7 +97,9 @@ USA.
                     `(let ((,r-dict
                             (,(rename 'syntax-rules:match-datum)
                              ,(syntax-quote pattern)
-                             (cdr ,r-form))))
+                             (cdr ,r-form)
+                            ,r-rename
+                            ,r-compare)))
                        (if ,r-dict
                            (,(rename 'syntax-rules:expand-template)
                             ,(syntax-quote template)
@@ -265,7 +266,7 @@ USA.
                (syntax-error "Mixed segments in template:"
                              (map car pvs**))))))))
 \f
-(define (syntax-rules:match-datum pattern datum)
+(define (syntax-rules:match-datum pattern datum rename compare)
 
   (define (match-datum pat datum dict k)
 
@@ -288,7 +289,11 @@ USA.
           (lambda (pats datum dict)
             (match-datum (car pats) datum dict k))))
        ((literal)
-        (and (equal? (car x) datum)
+        (and (let ((literal (car x)))
+               (if (identifier? literal)
+                   (and (identifier? datum)
+                        (compare (rename literal) datum))
+                   (equal? literal datum)))
              (k dict)))
        ((var) (k (dict-add (car x) datum dict)))
        ((anon-var) (k dict))
index f8697494b7a0f9dc1c30f3962717fa72f151ec97..e1ad647c72a1032ce826ff68bf8ca5dda4ee2f03 100644 (file)
@@ -364,4 +364,15 @@ USA.
        ((_ a b ... . c)
         (quote (a (b ...) c)))))
     (assert-equal (bar 1 2 3 4) '(1 (2 3 4) ()))
-    (assert-equal (bar 1 2 3 . 4) '(1 (2 3) 4))))
\ No newline at end of file
+    (assert-equal (bar 1 2 3 . 4) '(1 (2 3) 4))))
+
+(define-test 'bug-63503
+  (lambda ()
+    (define-syntax foo
+      (syntax-rules (keyword)
+       ((foo keyword x) x)))
+    (define-syntax bar
+      (syntax-rules ()
+       ((bar x)
+        (foo keyword x))))
+    (assert-equal (bar 123) 123)))
\ No newline at end of file