From 369d09cdfab4ea50d4e5189b80db561a9eb53e00 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 5 Dec 2018 23:41:37 -0800
Subject: [PATCH] In er-macro-transformer, guarantee that two renames of a
 symbol are eq?.

---
 src/runtime/mit-syntax.scm | 11 +++++------
 src/runtime/runtime.pkg    |  1 +
 src/runtime/syntax-low.scm | 11 +++++++++--
 src/runtime/syntax.scm     | 10 ++++++++++
 tests/unit-testing.scm     |  2 +-
 5 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index 0a3955819..6ac2d8741 100644
--- 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 909df86bc..d55ad2447 100644
--- 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 95c05fae0..150e8a797 100644
--- 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 e6641a6b4..cd191b70d 100644
--- 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 05eeac6e3..5cf497745 100644
--- 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")))
-- 
2.25.1