From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 20 Jan 2018 03:58:48 +0000 (-0800)
Subject: Rewrite define-bundle-interface to do renaming manually.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~337
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7e20d0747c5d33e97cd3bd6f94f7d5d3d6acddc2;p=mit-scheme.git

Rewrite define-bundle-interface to do renaming manually.

Automatic renamer was clumsy and error-prone.
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 2a6160e9b..2c319cc65 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -779,54 +779,40 @@ USA.
 			    (cddddr form)))))
 
 (define (make-interface-helper rename interface capturer predicate elements)
-  (rename-generated-expression
-   rename
-   `(begin
-      (define ,interface
-	(make-bundle-interface
+  (let ((rlist (rename 'list)))
+    `(,(rename 'begin)
+      (,(rename 'define)
+       ,interface
+	(,(rename 'make-bundle-interface)
 	 ',(strip-angle-brackets interface)
-	 (list ,@(map (lambda (element)
-			(if (symbol? element)
-			    `(list ',element)
-			    `(list ',(car element)
-				   ,@(map (lambda (p)
-					    `(list ',(car p)
-						   ,@(cdr p)))
-					  (cdr element)))))
-		      elements))))
-      (define ,predicate
-	(dispatch-tag->predicate ,interface))
-      (define-syntax ,capturer
-	(sc-macro-transformer
-	 (lambda (form use-environment)
-	   (if (not (null? (cdr form)))
-	       (syntax-error "Ill-formed special form:" form))
-	   (list 'capture-bundle
+	 (,rlist ,@(map (lambda (element)
+			  (if (symbol? element)
+			      `(,rlist ',element)
+			      `(,rlist ',(car element)
+				       ,@(map (lambda (p)
+						`(,rlist ',(car p) ,@(cdr p)))
+					      (cdr element)))))
+			elements))))
+      (,(rename 'define)
+       ,predicate
+	(,(rename 'dispatch-tag->predicate) ,interface))
+      (,(rename 'define-syntax)
+       ,capturer
+       (,(rename 'sc-macro-transformer)
+	(,(rename 'lambda)
+	 (form use-env)
+	 (if (,(rename 'not) (,(rename 'null?) (,(rename 'cdr) form)))
+	     (,(rename 'syntax-error) "Ill-formed special form:" form))
+	 (,rlist 'capture-bundle
 		 ',interface
 		 ,@(map (lambda (element)
-			  `(close-syntax ',(if (symbol? element)
-					       element
-					       (car element))
-					 use-environment))
+			  `(,(rename 'close-syntax)
+			    ',(if (symbol? element)
+				  element
+				  (car element))
+			    use-env))
 			elements))))))))
 
-(define (rename-generated-expression rename expr)
-  (let loop ((expr expr))
-    (cond ((identifier? expr)
-	   (rename expr))
-	  ((and (pair? expr)
-		(list? (cdr expr)))
-	   (cons (rename (car expr))
-		 (let ((rest (cdr expr)))
-		   (case (car expr)
-		     ((quote dispatch-tag->predicate)
-		      rest)
-		     ((define define-syntax)
-		      (cons (car rest) (map loop (cdr rest))))
-		     (else
-		      (map loop rest))))))
-	  (else expr))))
-
 (define-syntax :capture-bundle
   (syntax-rules ()
     ((_ interface name ...)