In er-macro-transformer, guarantee that two renames of a symbol are eq?.

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index 0a3955819f77fa36dcf41ab5e16bab1af1400205..6ac2d8741d71bd9693ea603dfc748693961532f9 100644 (file)
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -178,11 +178,7 @@ USA.
    (delay
      (spar-call-with-values
         (lambda (ctx id item)
-          (receive (id senv)
-              (if (closed-identifier? id)
-                  (values (syntactic-closure-form id)
-                          (syntactic-closure-senv id))
-                  (values id (serror-ctx-senv ctx)))
+          (let ((senv (serror-ctx-senv ctx)))
             (bind-keyword id senv item)
             ;; User-defined macros at top level are preserved in the output.
             (if (and (keyword-item-has-expr? item)
@@ -191,7 +187,10 @@ USA.
                 (seq-item ctx '()))))
        (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-push-subform-if identifier? spar-arg:form)
+       (spar-subform
+        (spar-match identifier? spar-arg:form)
+        (spar-funcall reserve-identifier spar-arg:form spar-arg:senv)
+        (spar-push spar-arg:form))
        (spar-subform
         spar-push-classified
         (spar-or (spar-match keyword-item? spar-arg:value)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 909df86bce2862460826bdeac84d238185a682a5..d55ad24472631fa3213be4cae2bd206bc2344075 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4604,6 +4604,7 @@ USA.
          subform-select)
   (export (runtime syntax low)
          reclassify
+         rename-id
          with-error-context)
   (export (runtime syntax parser)
          with-error-context))

diff --git a/src/runtime/syntax-low.scm b/src/runtime/syntax-low.scm
index 95c05fae0680139d6a163c1da10adede9ecad343..150e8a7979bcf5bcd9653a94599685ef00aabd93 100644 (file)
--- a/src/runtime/syntax-low.scm
+++ b/src/runtime/syntax-low.scm
@@ -85,8 +85,15 @@ USA.
                hist)))
 
 (define (make-er-rename closing-senv)
-  (lambda (identifier)
-    (close-syntax identifier closing-senv)))
+  (let ((renames '()))
+    (lambda (id)
+      (guarantee identifier? id)
+      (let ((p (assq id renames)))
+       (if p
+           (cdr p)
+           (let ((rename (rename-id id closing-senv)))
+             (set! renames (cons (cons id rename) renames))
+             rename))))))
 
 (define (make-er-compare use-senv)
   (lambda (x y)

diff --git a/src/runtime/syntax.scm b/src/runtime/syntax.scm
index e6641a6b469fcc5f00ed201f91fbe027258cecfa..cd191b70df5f49415573d2a048977ab25d941708 100644 (file)
--- a/src/runtime/syntax.scm
+++ b/src/runtime/syntax.scm
@@ -133,6 +133,11 @@ USA.
           (pair? form)
           (identifier? form))))
 
+;; Renaming for er-macro-transformer.
+;; Required for uniqueness and proper lookup.
+(define (rename-id id senv)
+  (%make-syntactic-closure senv '() id))
+
 (define-record-type <syntactic-closure>
     (%make-syntactic-closure senv free form)
     syntactic-closure?
@@ -140,6 +145,11 @@ USA.
   (free syntactic-closure-free)
   (form syntactic-closure-form))
 
+(define-print-method syntactic-closure?
+  (standard-print-method 'syntactic-closure
+    (lambda (closure)
+      (list (syntactic-closure-form closure)))))
+
 (define (strip-syntactic-closures object)
   (if (let loop ((object object))
        (if (pair? object)

diff --git a/tests/unit-testing.scm b/tests/unit-testing.scm
index 05eeac6e3547fc98fac861741df59adda0a94ab6..5cf497745df7e0f14e79601bdd626e5d0307448e 100644 (file)
--- a/tests/unit-testing.scm
+++ b/tests/unit-testing.scm
@@ -649,4 +649,4 @@ USA.
                          (if+ "the same elements as" "different elements from")
                          (marker)
                          "comparing elements with" (name-of comparator)
-                         "in any order")))
\ No newline at end of file
+                         "in any order")))\f