From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 8 Feb 2002 03:55:01 +0000 (+0000)
Subject: Eliminate non-hygienic macros.
X-Git-Tag: 20090517-FFI~2264
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a3b8092945319d0841564f6c29f9a30412fd0877;p=mit-scheme.git

Eliminate non-hygienic macros.
---

diff --git a/v7/src/compiler/back/asmmac.scm b/v7/src/compiler/back/asmmac.scm
index dde56c135..9a5e068ca 100644
--- a/v7/src/compiler/back/asmmac.scm
+++ b/v7/src/compiler/back/asmmac.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: asmmac.scm,v 1.12 2002/02/08 03:06:16 cph Exp $
+$Id: asmmac.scm,v 1.13 2002/02/08 03:54:10 cph Exp $
 
 Copyright (c) 1988, 1990, 1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -27,6 +27,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (define-syntax define-instruction
   (sc-macro-transformer
    (lambda (form environment)
+     environment
      (if (syntax-match? '(SYMBOL * (DATUM + DATUM)) (cdr form))
 	 `(ADD-INSTRUCTION!
 	   ',(cadr form)
diff --git a/v7/src/compiler/base/macros.scm b/v7/src/compiler/base/macros.scm
index 353f251c7..f70b5ad31 100644
--- a/v7/src/compiler/base/macros.scm
+++ b/v7/src/compiler/base/macros.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: macros.scm,v 4.24 2002/02/08 03:07:04 cph Exp $
+$Id: macros.scm,v 4.25 2002/02/08 03:55:01 cph Exp $
 
 Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -143,25 +143,30 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 					   (and (pair? x)
 						(list-of-type? x symbol?)))))))
 		    (lambda (form environment)
-		      (let ((type (cadr form))
-			    (slots (cddr form)))
-			(let ((tag-name (symbol-append type '-TAG)))
-			  (let ((tag-ref (close-syntax tag-name environment)))
-			    `(BEGIN
-			       (DEFINE ,tag-name
-				 (MAKE-VECTOR-TAG ,',parent ',type
-						  ,',enumeration))
-			       (DEFINE ,(symbol-append type '?)
-				 (TAGGED-VECTOR/PREDICATE ,tag-name))
-			       (DEFINE-VECTOR-SLOTS ,type ,,reserved ,@slots)
-			       (SET-VECTOR-TAG-DESCRIPTION!
-				,tag-name
-				(LAMBDA (OBJECT)
-				  (APPEND!
-				   ((VECTOR-TAG-DESCRIPTION ,',parent) OBJECT)
-				   (DESCRIPTOR-LIST OBJECT
-						    ,type
-						    ,@slots))))))))))))))))))
+		      (if (syntax-match? pattern (cdr form))
+			  (let ((type (cadr form))
+				(slots (cddr form)))
+			    (let ((tag-name (symbol-append type '-TAG)))
+			      (let ((tag-ref
+				     (close-syntax tag-name environment)))
+				`(BEGIN
+				   (DEFINE ,tag-name
+				     (MAKE-VECTOR-TAG ,',parent ',type
+						      ,',enumeration))
+				   (DEFINE ,(symbol-append type '?)
+				     (TAGGED-VECTOR/PREDICATE ,tag-ref))
+				   (DEFINE-VECTOR-SLOTS ,type ,,reserved
+				     ,@slots)
+				   (SET-VECTOR-TAG-DESCRIPTION!
+				    ,tag-name
+				    (LAMBDA (OBJECT)
+				      (APPEND!
+				       ((VECTOR-TAG-DESCRIPTION ,',parent)
+					OBJECT)
+				       (DESCRIPTOR-LIST OBJECT
+							,type
+							,@slots))))))))
+			  (ill-formed-syntax form))))))))))))
   (define-type-definition snode 5 #f)
   (define-type-definition pnode 6 #f)
   (define-type-definition rvalue 2 rvalue-types)
@@ -251,25 +256,28 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (define-syntax define-rtl-expression
   (sc-macro-transformer
    (lambda (form environment)
-     (define-rtl-common form environment
+     environment
+     (define-rtl-common form
        (lambda (expression) expression)
        'RTL:EXPRESSION-TYPES))))
 
 (define-syntax define-rtl-statement
   (sc-macro-transformer
    (lambda (form environment)
-     (define-rtl-common form environment
+     environment
+     (define-rtl-common form
        (lambda (expression) `(STATEMENT->SRTL ,expression))
        'RTL:STATEMENT-TYPES))))
 
 (define-syntax define-rtl-predicate
   (sc-macro-transformer
    (lambda (form environment)
-     (define-rtl-common form environment
+     environment
+     (define-rtl-common form
        (lambda (expression) `(PREDICATE->PRTL ,expression))
        'RTL:PREDICATE-TYPES))))
 
-(define (define-rtl-common form environment wrap-constructor types)
+(define (define-rtl-common form wrap-constructor types)
   (if (syntax-match? '(SYMBOL SYMBOL * SYMBOL) (cdr form))
       (let ((type (cadr form))
 	    (prefix (caddr form))
@@ -320,12 +328,12 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   (rsc-macro-transformer
    (lambda (form environment)
      (if (syntax-match? '(* DATUM) (cdr form))
-	 `(,(close-syntax 'QUASIQUOTE environment) ,@(cdr form))
+	 `(,(close-syntax 'QUASIQUOTE environment) ,(cdr form))
 	 (ill-formed-syntax form)))))
 
 (define-syntax inst-ea
   (rsc-macro-transformer
-   (lambda (ea)
+   (lambda (form environment)
      (if (syntax-match? '(DATUM) (cdr form))
 	 `(,(close-syntax 'QUASIQUOTE environment) ,(cadr form))
 	 (ill-formed-syntax form)))))
@@ -333,9 +341,9 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (define-syntax define-enumeration
   (sc-macro-transformer
    (lambda (form environment)
-     (if (syntax-match '(SYMBOL * SYMBOL) (cdr form))
+     (if (syntax-match? '(SYMBOL (* SYMBOL)) (cdr form))
 	 (let ((name (cadr form))
-	       (elements (cddr form)))
+	       (elements (caddr form)))
 	   (let ((enumeration (symbol-append name 'S)))
 	     (let ((enum-ref (close-syntax enumeration environment)))
 	       `(BEGIN
@@ -359,7 +367,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (define-syntax cfg-node-case
   (sc-macro-transformer
-   (lambda (expression . clauses)
+   (lambda (form environment)
      (if (syntax-match? '(EXPRESSION * (DATUM * EXPRESSION)) (cdr form))
 	 (enumeration-case-1 (cadr form) (cddr form) environment
 			     (lambda (element) (symbol-append element '-TAG))
@@ -402,4 +410,4 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (if (identifier? expression)
 	   (generate-body expression)
 	   `(LET ((TEMP ,expression))
-	      (generate-body 'TEMP)))))))
\ No newline at end of file
+	      ,(generate-body 'TEMP)))))))
\ No newline at end of file
diff --git a/v7/src/compiler/fggen/canon.scm b/v7/src/compiler/fggen/canon.scm
index 162b71249..33e413ce5 100644
--- a/v7/src/compiler/fggen/canon.scm
+++ b/v7/src/compiler/fggen/canon.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: canon.scm,v 1.21 2002/02/08 03:08:00 cph Exp $
+$Id: canon.scm,v 1.22 2002/02/08 03:54:25 cph Exp $
 
 Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -799,7 +799,7 @@ ARBITRARY:	The expression may be executed more than once.  It
   (let ((dispatch-vector
 	 (make-vector (microcode-type/code-limit) canonicalize/constant)))
 
-    (let-syntax
+    (letrec-syntax
 	((dispatch-entry
 	  (sc-macro-transformer
 	   (lambda (form environment)
@@ -807,7 +807,7 @@ ARBITRARY:	The expression may be executed more than once.  It
 			   ,(close-syntax (caddr form) environment)))))
 
 	 (dispatch-entries
-	  (c-macro-transformer
+	  (sc-macro-transformer
 	   (lambda (form environment)
 	     (let ((handler (close-syntax (caddr form) environment)))
 	       `(BEGIN
diff --git a/v7/src/compiler/fggen/fggen.scm b/v7/src/compiler/fggen/fggen.scm
index 28be51fdd..0b3dbccd2 100644
--- a/v7/src/compiler/fggen/fggen.scm
+++ b/v7/src/compiler/fggen/fggen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fggen.scm,v 4.36 2002/02/08 03:08:11 cph Exp $
+$Id: fggen.scm,v 4.37 2002/02/08 03:54:36 cph Exp $
 
 Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -952,7 +952,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 		 (else
 		  (generate/constant block continuation
 				     context expression))))))
-    (let-syntax
+    (letrec-syntax
 	((dispatch-entry
 	  (sc-macro-transformer
 	   (lambda (form environment)