Eliminate non-hygienic macros.

diff --git a/v7/src/compiler/back/asmmac.scm b/v7/src/compiler/back/asmmac.scm
index dde56c135d9aed2275a7230a83e320390cc73b14..9a5e068caec65bcf9129e8b75aef71a8770d79bc 100644 (file)
--- 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 353f251c7bfbbe4207bf2eebbd8cf08e0e77589b..f70b5ad3157668776eba2d17ce5f6ecf908e0d40 100644 (file)
--- 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 162b712490a210854f1923ae7d804754115949c3..33e413ce502505b13fe9ec7ab3dee51e4bf1d5df 100644 (file)
--- 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 28be51fdde1196910c8794c58161f8f7655e676a..0b3dbccd2ed91dd3fc1cc2e0b86dcbb4988dde16 100644 (file)
--- 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)