Eliminate non-hygienic macros.

diff --git a/v7/src/compiler/back/asmmac.scm b/v7/src/compiler/back/asmmac.scm
index 84175aa7b263baf4f00cf20140c6ddb744070ce7..dde56c135d9aed2275a7230a83e320390cc73b14 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.11 2002/02/07 05:57:44 cph Exp $
+$Id: asmmac.scm,v 1.12 2002/02/08 03:06:16 cph Exp $
 
 Copyright (c) 1988, 1990, 1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (define-syntax define-instruction
   (sc-macro-transformer
    (lambda (form environment)
-     (if (syntax-match? '(SYMBOL * DATUM) (cdr form))
+     (if (syntax-match? '(SYMBOL * (DATUM + DATUM)) (cdr form))
         `(ADD-INSTRUCTION!
           ',(cadr form)
           ,(compile-database (cddr form)

diff --git a/v7/src/compiler/base/cfg1.scm b/v7/src/compiler/base/cfg1.scm
index 3d8df9f48808f83b18aa20ca67d3ee96049a891a..1af4bb28fd2a538948d73adbbe94d5fac8f51c09 100644 (file)
--- a/v7/src/compiler/base/cfg1.scm
+++ b/v7/src/compiler/base/cfg1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: cfg1.scm,v 4.5 1999/01/02 06:06:43 cph Exp $
+$Id: cfg1.scm,v 4.6 2002/02/08 03:07:00 cph Exp $
 
-Copyright (c) 1987, 1989, 1999 Massachusetts Institute of Technology
+Copyright (c) 1987, 1989, 1999, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -32,7 +32,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (set-vector-tag-description!
  cfg-node-tag
  (lambda (node)
-   (descriptor-list node generation alist previous-edges)))
+   (descriptor-list node node generation alist previous-edges)))
 
 (define snode-tag (make-vector-tag cfg-node-tag 'SNODE false))
 (define snode? (tagged-vector/subclass-predicate snode-tag))
@@ -46,7 +46,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  snode-tag
  (lambda (snode)
    (append! ((vector-tag-description (vector-tag-parent snode-tag)) snode)
-           (descriptor-list snode next-edge))))
+           (descriptor-list snode snode next-edge))))
 
 (define pnode-tag (make-vector-tag cfg-node-tag 'PNODE false))
 (define pnode? (tagged-vector/subclass-predicate pnode-tag))
@@ -60,7 +60,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  pnode-tag
  (lambda (pnode)
    (append! ((vector-tag-description (vector-tag-parent pnode-tag)) pnode)
-           (descriptor-list pnode consequent-edge alternative-edge))))
+           (descriptor-list pnode pnode consequent-edge alternative-edge))))
 
 (define (add-node-previous-edge! node edge)
   (set-node-previous-edges! node (cons edge (node-previous-edges node))))

diff --git a/v7/src/compiler/base/macros.scm b/v7/src/compiler/base/macros.scm
index d102eab3e7be6c50e8985046f2d61d4f435aa3cc..353f251c7bfbbe4207bf2eebbd8cf08e0e77589b 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.23 2002/02/03 03:38:53 cph Exp $
+$Id: macros.scm,v 4.24 2002/02/08 03:07:04 cph Exp $
 
 Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -26,29 +26,31 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (declare (usual-integrations))
 \f
 (define-syntax last-reference
-  (non-hygienic-macro-transformer
-   (lambda (name)
-     (let ((x (generate-uninterned-symbol)))
-       `(IF COMPILER:PRESERVE-DATA-STRUCTURES?
-           ,name
-           (LET ((,x ,name))
-             (SET! ,name)
-             ,x))))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(IDENTIFIER) (cdr form))
+        (let ((name (close-syntax (cadr form) environment)))
+          `(IF COMPILER:PRESERVE-DATA-STRUCTURES?
+               ,name
+               (LET ((TEMP ,name))
+                 (SET! ,name)
+                 TEMP)))
+        (ill-formed-syntax form)))))
 
 (define-syntax package
   (rsc-macro-transformer
    (lambda (form environment)
-     (if (not (syntax-match? '((* IDENTIFIER) * EXPRESSION) (cdr form)))
-        (error "Ill-formed special form:" form))
-     (let ((names (cadr form))
-          (body (cddr form)))
-       `(,(make-syntactic-closure environment '() 'BEGIN)
-        ,@(map (let ((r-define
-                      (make-syntactic-closure environment '() 'DEFINE)))
-                 (lambda (name)
-                   `(,r-define ,name)))
-               names)
-        (,(make-syntactic-closure environment '() 'LET) () ,@body))))))
+     (if (syntax-match? '((* IDENTIFIER) * EXPRESSION) (cdr form))
+        (let ((names (cadr form))
+              (body (cddr form)))
+          `(,(make-syntactic-closure environment '() 'BEGIN)
+            ,@(map (let ((r-define
+                          (make-syntactic-closure environment '() 'DEFINE)))
+                     (lambda (name)
+                       `(,r-define ,name)))
+                   names)
+            (,(make-syntactic-closure environment '() 'LET) () ,@body)))
+        (ill-formed-syntax form)))))
 
 (define-syntax define-export
   (rsc-macro-transformer
@@ -62,245 +64,342 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
              (,(make-syntactic-closure environment '() 'NAMED-LAMBDA)
               ,@(cdr form))))
           (else
-           (error "Ill-formed special form:" form))))))
+           (ill-formed-syntax form))))))
 \f
 (define-syntax define-vector-slots
-  (non-hygienic-macro-transformer
-   (lambda (class index . slots)
-     (define (loop slots n)
-       (if (pair? slots)
-          (let ((make-defs
-                 (lambda (slot)
-                   (let ((ref-name (symbol-append class '- slot)))
-                     `(BEGIN
-                        (DEFINE-INTEGRABLE (,ref-name ,class)
-                          (VECTOR-REF ,class ,n))
-                        (DEFINE-INTEGRABLE (,(symbol-append 'SET- ref-name '!)
-                                            ,class ,slot)
-                          (VECTOR-SET! ,class ,n ,slot))))))
-                (rest (loop (cdr slots) (1+ n))))
-            (if (pair? (car slots))
-                (map* rest make-defs (car slots))
-                (cons (make-defs (car slots)) rest)))
-          '()))
-     (if (pair? slots)
-        `(BEGIN ,@(loop slots index))
-        'UNSPECIFIC))))
+  (sc-macro-transformer
+   (let ((pattern
+         `(SYMBOL ,exact-nonnegative-integer?
+                  * ,(lambda (x)
+                       (or (symbol? x)
+                           (and (pair? x)
+                                (list-of-type? x symbol?)))))))
+     (lambda (form environment)
+       environment
+       (if (syntax-match? pattern (cdr form))
+          (let ((class (cadr form))
+                (index (caddr form))
+                (slots (cdddr form)))
+            (let ((make-defs
+                   (lambda (slot index)
+                     (let ((ref-name (symbol-append class '- slot)))
+                       `((DEFINE-INTEGRABLE (,ref-name V)
+                           (VECTOR-REF V ,index))
+                         (DEFINE-INTEGRABLE
+                           (,(symbol-append 'SET- ref-name '!) V OBJECT)
+                           (VECTOR-SET! V ,index OBJECT)))))))
+              (if (pair? slots)
+                  `(BEGIN
+                     ,@(let loop ((slots slots) (index index))
+                         (if (pair? slots)
+                             (append (if (pair? (car slots))
+                                         (append-map (lambda (slot)
+                                                       (make-defs slot index))
+                                                     (car slots))
+                                         (make-defs (car slots) index))
+                                     (loop (cdr slots) (+ index 1)))
+                             '())))
+                  'UNSPECIFIC)))
+          (ill-formed-syntax form))))))
 
 (define-syntax define-root-type
-  (non-hygienic-macro-transformer
-   (lambda (type . slots)
-     (let ((tag-name (symbol-append type '-TAG)))
-       `(BEGIN (DEFINE ,tag-name
-                (MAKE-VECTOR-TAG #F ',type #F))
-              (DEFINE ,(symbol-append type '?)
-                (TAGGED-VECTOR/SUBCLASS-PREDICATE ,tag-name))
-              (DEFINE-VECTOR-SLOTS ,type 1 ,@slots)
-              (SET-VECTOR-TAG-DESCRIPTION!
-               ,tag-name
-               (LAMBDA (,type)
-                 (DESCRIPTOR-LIST ,type ,@slots))))))))
-
-(define-syntax descriptor-list
-  (non-hygienic-macro-transformer
-   (lambda (type . slots)
-     (let ((ref-name (lambda (slot) (symbol-append type '- slot))))
-       `(LIST ,@(map (lambda (slot)
-                      (if (pair? slot)
-                          (let ((ref-names (map ref-name slot)))
-                            ``(,',ref-names ,(,(car ref-names) ,type)))
-                          (let ((ref-name (ref-name slot)))
-                            ``(,',ref-name ,(,ref-name ,type)))))
-                    slots))))))
+  (sc-macro-transformer
+   (let ((pattern
+         `(SYMBOL * ,(lambda (x)
+                       (or (symbol? x)
+                           (and (pair? x)
+                                (list-of-type? x symbol?)))))))
+     (lambda (form environment)
+       (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 #F ',type #F))
+                   (DEFINE ,(symbol-append type '?)
+                     (TAGGED-VECTOR/SUBCLASS-PREDICATE ,tag-ref))
+                   (DEFINE-VECTOR-SLOTS ,type 1 ,@slots)
+                   (SET-VECTOR-TAG-DESCRIPTION! ,tag-ref
+                     (LAMBDA (OBJECT)
+                       (DESCRIPTOR-LIST OBJECT ,type ,@slots)))))))
+          (ill-formed-syntax form))))))
 \f
 (let-syntax
     ((define-type-definition
-       (non-hygienic-macro-transformer
-       (lambda (name reserved enumeration)
-         (let ((parent (symbol-append name '-TAG)))
-           `(define-syntax ,(symbol-append 'DEFINE- name)
-              (non-hygienic-macro-transformer
-               (lambda (type . slots)
-                 (let ((tag-name (symbol-append type '-TAG)))
-                   `(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 (,type)
-                         (APPEND!
-                          ((VECTOR-TAG-DESCRIPTION ,',parent) ,type)
-                          (DESCRIPTOR-LIST ,type ,@slots))))))))))))))
+       (sc-macro-transformer
+       (lambda (form environment)
+         (let ((name (cadr form))
+               (reserved (caddr form))
+               (enumeration (close-syntax (cadddr form) environment)))
+           (let ((parent
+                  (close-syntax (symbol-append name '-TAG) environment)))
+             `(define-syntax ,(symbol-append 'DEFINE- name)
+                (sc-macro-transformer
+                 (let ((pattern
+                        `(SYMBOL * ,(lambda (x)
+                                      (or (symbol? x)
+                                          (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))))))))))))))))))
   (define-type-definition snode 5 #f)
   (define-type-definition pnode 6 #f)
   (define-type-definition rvalue 2 rvalue-types)
   (define-type-definition lvalue 14 #f))
 
+(define-syntax descriptor-list
+  (sc-macro-transformer
+   (let ((pattern
+         `(IDENTIFIER SYMBOL
+                      * ,(lambda (x)
+                           (or (symbol? x)
+                               (and (pair? x)
+                                    (list-of-type? x symbol?)))))))
+     (lambda (form environment)
+       (if (syntax-match? pattern (cdr form))
+          (let ((object (close-syntax (cadr form) environment))
+                (type (caddr form))
+                (slots (cdddr form)))
+            (let ((ref-name
+                   (lambda (slot)
+                     (close-syntax (symbol-append type '- slot)
+                                   environment))))
+              `(LIST
+                ,@(map (lambda (slot)
+                         (if (pair? slot)
+                             (let ((names (map ref-name slot)))
+                               ``(,',names ,(,(car names) ,object)))
+                             (let ((name (ref-name slot)))
+                               ``(,',name ,(,name ,object)))))
+                       slots))))
+          (ill-formed-syntax form))))))
+\f
 ;;; Kludge to make these compile efficiently.
 
 (define-syntax make-snode
-  (non-hygienic-macro-transformer
-   (lambda (tag . extra)
-     `((ACCESS VECTOR ,system-global-environment)
-       ,tag #F '() '() #F ,@extra))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(+ EXPRESSION) (cdr form))
+        (let ((tag (close-syntax (cadr form) environment))
+              (extra
+               (map (lambda (form) (close-syntax form environment))
+                    (cddr form))))
+          `((ACCESS VECTOR ,system-global-environment)
+            ,tag #F '() '() #F ,@extra))
+        (ill-formed-syntax form)))))
 
 (define-syntax make-pnode
-  (non-hygienic-macro-transformer
-   (lambda (tag . extra)
-     `((ACCESS VECTOR ,system-global-environment)
-       ,tag #F '() '() #F #F ,@extra))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(+ EXPRESSION) (cdr form))
+        (let ((tag (close-syntax (cadr form) environment))
+              (extra
+               (map (lambda (form) (close-syntax form environment))
+                    (cddr form))))
+          `((ACCESS VECTOR ,system-global-environment)
+            ,tag #F '() '() #F #F ,@extra))
+        (ill-formed-syntax form)))))
 
 (define-syntax make-rvalue
-  (non-hygienic-macro-transformer
-   (lambda (tag . extra)
-     `((ACCESS VECTOR ,system-global-environment)
-       ,tag #F ,@extra))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(+ EXPRESSION) (cdr form))
+        (let ((tag (close-syntax (cadr form) environment))
+              (extra
+               (map (lambda (form) (close-syntax form environment))
+                    (cddr form))))
+          `((ACCESS VECTOR ,system-global-environment)
+            ,tag #F ,@extra))
+        (ill-formed-syntax form)))))
 
 (define-syntax make-lvalue
-  (non-hygienic-macro-transformer
-   (lambda (tag . extra)
-     (let ((result (generate-uninterned-symbol)))
-       `(let ((,result
-              ((ACCESS VECTOR ,system-global-environment)
-               ,tag #F '() '() '() '() '() '() 'NOT-CACHED
-               #F '() #F #F '() ,@extra)))
-         (SET! *LVALUES* (CONS ,result *LVALUES*))
-         ,result)))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(+ EXPRESSION) (cdr form))
+        (let ((tag (close-syntax (cadr form) environment))
+              (extra
+               (map (lambda (form) (close-syntax form environment))
+                    (cddr form))))
+          `(LET ((LVALUE
+                  ((ACCESS VECTOR ,system-global-environment)
+                   ,tag #F '() '() '() '() '() '() 'NOT-CACHED
+                   #F '() #F #F '() ,@extra)))
+             (SET! *LVALUES* (CONS LVALUE *LVALUES*))
+             LVALUE))
+        (ill-formed-syntax form)))))
 \f
 (define-syntax define-rtl-expression
-  (non-hygienic-macro-transformer
-   (lambda (type prefix . components)
-     (rtl-common type prefix components
-                identity-procedure
-                'RTL:EXPRESSION-TYPES))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (define-rtl-common form environment
+       (lambda (expression) expression)
+       'RTL:EXPRESSION-TYPES))))
 
 (define-syntax define-rtl-statement
-  (non-hygienic-macro-transformer
-   (lambda (type prefix . components)
-     (rtl-common type prefix components
-                (lambda (expression) `(STATEMENT->SRTL ,expression))
-                'RTL:STATEMENT-TYPES))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (define-rtl-common form environment
+       (lambda (expression) `(STATEMENT->SRTL ,expression))
+       'RTL:STATEMENT-TYPES))))
 
 (define-syntax define-rtl-predicate
-  (non-hygienic-macro-transformer
-   (lambda (type prefix . components)
-     (rtl-common type prefix components
-                (lambda (expression) `(PREDICATE->PRTL ,expression))
-                'RTL:PREDICATE-TYPES))))
-
-(define (rtl-common type prefix components wrap-constructor types)
-  `(BEGIN
-     (SET! ,types (CONS ',type ,types))
-     (DEFINE-INTEGRABLE
-       (,(symbol-append prefix 'MAKE- type) ,@components)
-       ,(wrap-constructor `(LIST ',type ,@components)))
-     (DEFINE-INTEGRABLE (,(symbol-append 'RTL: type '?) EXPRESSION)
-       (EQ? (CAR EXPRESSION) ',type))
-     ,@(let loop ((components components)
-                 (ref-index 6)
-                 (set-index 2))
-        (if (pair? components)
-            (let* ((slot (car components))
-                   (name (symbol-append type '- slot)))
-              `((DEFINE-INTEGRABLE (,(symbol-append 'RTL: name) ,type)
-                  (GENERAL-CAR-CDR ,type ,ref-index))
-                ,(let ((slot (if (eq? slot type)
-                                 (symbol-append slot '-VALUE)
-                                 slot)))
-                   `(DEFINE-INTEGRABLE
-                      (,(symbol-append 'RTL:SET- name '!)
-                       ,type ,slot)
-                      (SET-CAR! (GENERAL-CAR-CDR ,type ,set-index)
-                                ,slot)))
-                ,@(loop (cdr components)
-                        (* ref-index 2)
-                        (* set-index 2))))
-            '()))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (define-rtl-common form environment
+       (lambda (expression) `(PREDICATE->PRTL ,expression))
+       'RTL:PREDICATE-TYPES))))
 
-(define-syntax define-rule
-  (non-hygienic-macro-transformer
-   (lambda (type pattern . body)
-     (parse-rule pattern body
-       (lambda (pattern variables qualifier actions)
-        `(,(case type
-             ((STATEMENT) 'ADD-STATEMENT-RULE!)
-             ((PREDICATE) 'ADD-STATEMENT-RULE!)
-             ((REWRITING) 'ADD-REWRITING-RULE!)
-             (else type))
-          ',pattern
-          ,(rule-result-expression variables qualifier
-                                   `(BEGIN ,@actions))))))))
+(define (define-rtl-common form environment wrap-constructor types)
+  (if (syntax-match? '(SYMBOL SYMBOL * SYMBOL) (cdr form))
+      (let ((type (cadr form))
+           (prefix (caddr form))
+           (components (cdddr form)))
+       `(BEGIN
+          (SET! ,types (CONS ',type ,types))
+          ,(let ((parameters (map make-synthetic-identifier components)))
+             `(DEFINE-INTEGRABLE
+                (,(symbol-append prefix 'MAKE- type) ,@parameters)
+                ,(wrap-constructor `(LIST ',type ,@parameters))))
+          (DEFINE-INTEGRABLE (,(symbol-append 'RTL: type '?) EXPRESSION)
+            (EQ? (CAR EXPRESSION) ',type))
+          ,@(let loop ((components components) (ref-index 6) (set-index 2))
+              (if (pair? components)
+                  (let ((name (symbol-append type '- (car components))))
+                    `((DEFINE-INTEGRABLE
+                        (,(symbol-append 'RTL: name) OBJECT)
+                        (GENERAL-CAR-CDR OBJECT ,ref-index))
+                      (DEFINE-INTEGRABLE
+                        (,(symbol-append 'RTL:SET- name '!) OBJECT V)
+                        (SET-CAR! (GENERAL-CAR-CDR OBJECT ,set-index) V))
+                      ,@(loop (cdr components)
+                              (* ref-index 2)
+                              (* set-index 2))))
+                  '()))))
+      (ill-formed-syntax form)))
 \f
-;;;; LAP instruction sequences.
+(define-syntax define-rule
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(IDENTIFIER DATUM + DATUM) (cdr form))
+        (let ((type (cadr form))
+              (pattern (caddr form))
+              (body (cdddr form)))
+          (parse-rule pattern body
+            (lambda (pattern variables qualifier actions)
+              `(,(case type
+                   ((STATEMENT) 'ADD-STATEMENT-RULE!)
+                   ((PREDICATE) 'ADD-STATEMENT-RULE!)
+                   ((REWRITING) 'ADD-REWRITING-RULE!)
+                   (else (close-syntax type environment)))
+                ',pattern
+                ,(rule-result-expression variables qualifier
+                                         `(BEGIN ,@actions))))))
+        (ill-formed-syntax form)))))
 
 (define-syntax lap
-  (non-hygienic-macro-transformer
-   (lambda some-instructions
-     (list 'QUASIQUOTE some-instructions))))
+  (rsc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(* DATUM) (cdr form))
+        `(,(close-syntax 'QUASIQUOTE environment) ,@(cdr form))
+        (ill-formed-syntax form)))))
 
 (define-syntax inst-ea
-  (non-hygienic-macro-transformer
+  (rsc-macro-transformer
    (lambda (ea)
-     (list 'QUASIQUOTE ea))))
-
+     (if (syntax-match? '(DATUM) (cdr form))
+        `(,(close-syntax 'QUASIQUOTE environment) ,(cadr form))
+        (ill-formed-syntax form)))))
+\f
 (define-syntax define-enumeration
-  (non-hygienic-macro-transformer
-   (lambda (name elements)
-     (let ((enumeration (symbol-append name 'S)))
-       `(BEGIN (DEFINE ,enumeration
-                (MAKE-ENUMERATION ',elements))
-              ,@(map (lambda (element)
-                       `(DEFINE ,(symbol-append name '/ element)
-                          (ENUMERATION/NAME->INDEX ,enumeration ',element)))
-                     elements))))))
-
-(define (macros/case-macro expression clauses predicate default)
-  (let ((need-temp? (not (symbol? expression))))
-    (let ((expression*
-          (if need-temp?
-              (generate-uninterned-symbol)
-              expression)))
-      (let ((body
-            `(COND
-              ,@(let loop ((clauses clauses))
-                  (cond ((not (pair? clauses))
-                         (default expression*))
-                        ((eq? (caar clauses) 'ELSE)
-                         (if (pair? (cdr clauses))
-                             (error "ELSE clause not last" clauses))
-                         clauses)
-                        (else
-                         `(((OR ,@(map (lambda (element)
-                                         (predicate expression* element))
-                                       (caar clauses)))
-                            ,@(cdar clauses))
-                           ,@(loop (cdr clauses)))))))))
-       (if need-temp?
-           `(LET ((,expression* ,expression))
-              ,body)
-           body)))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match '(SYMBOL * SYMBOL) (cdr form))
+        (let ((name (cadr form))
+              (elements (cddr form)))
+          (let ((enumeration (symbol-append name 'S)))
+            (let ((enum-ref (close-syntax enumeration environment)))
+              `(BEGIN
+                 (DEFINE ,enumeration
+                   (MAKE-ENUMERATION ',elements))
+                 ,@(map (lambda (element)
+                          `(DEFINE ,(symbol-append name '/ element)
+                             (ENUMERATION/NAME->INDEX ,enum-ref ',element)))
+                        elements)))))
+        (ill-formed-syntax form)))))
 
 (define-syntax enumeration-case
-  (non-hygienic-macro-transformer
-   (lambda (name expression . clauses)
-     (macros/case-macro expression
-                       clauses
-                       (lambda (expression element)
-                         `(EQ? ,expression ,(symbol-append name '/ element)))
-                       (lambda (expression)
-                         expression
-                         '())))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(SYMBOL EXPRESSION * (DATUM * EXPRESSION)) (cdr form))
+        (enumeration-case-1 (caddr form) (cdddr form) environment
+                            (lambda (element)
+                              (symbol-append (cadr form) '/ element))
+                            (lambda (expression) expression '()))
+        (ill-formed-syntax form)))))
 
 (define-syntax cfg-node-case
-  (non-hygienic-macro-transformer
+  (sc-macro-transformer
    (lambda (expression . clauses)
-     (macros/case-macro expression
-                       clauses
-                       (lambda (expression element)
-                         `(EQ? ,expression ,(symbol-append element '-TAG)))
-                       (lambda (expression)
-                         `((ELSE
-                            (ERROR "Unknown node type" ,expression))))))))
\ No newline at end of file
+     (if (syntax-match? '(EXPRESSION * (DATUM * EXPRESSION)) (cdr form))
+        (enumeration-case-1 (cadr form) (cddr form) environment
+                            (lambda (element) (symbol-append element '-TAG))
+                            (lambda (expression)
+                              `((ELSE
+                                 (ERROR "Unknown node type:" ,expression)))))
+        (ill-formed-syntax form)))))
+
+(define (enumeration-case-1 expression clauses environment map-element default)
+  (capture-syntactic-environment
+   (lambda (closing-environment)
+     (let ((expression (close-syntax expression environment))
+          (generate-body
+           (lambda (expression)
+             `(COND
+               ,@(let loop ((clauses clauses))
+                   (if (pair? clauses)
+                       (if (and (identifier? (caar clauses))
+                                (identifier=? environment (caar clauses)
+                                              closing-environment 'ELSE))
+                           (begin
+                             (if (pair? (cdr clauses))
+                                 (error "ELSE clause not last:" clauses))
+                             `((ELSE
+                                ,@(map (lambda (expression)
+                                         (close-syntax expression
+                                                       environment))
+                                       (cdar clauses)))))
+                           `(((OR ,@(map (lambda (element)
+                                           `(EQ? ,expression
+                                                 ,(close-syntax
+                                                   (map-element element)
+                                                   environment)))
+                                         (caar clauses)))
+                              ,@(map (lambda (expression)
+                                       (close-syntax expression environment))
+                                     (cdar clauses)))
+                             ,@(loop (cdr clauses))))
+                       (default expression)))))))
+       (if (identifier? expression)
+          (generate-body expression)
+          `(LET ((TEMP ,expression))
+             (generate-body 'TEMP)))))))
\ No newline at end of file

diff --git a/v7/src/compiler/base/scode.scm b/v7/src/compiler/base/scode.scm
index 7ec7c092f1966c1ae416d34566942f1d3b3000c4..0c0aafff7bf42c63b3476f2a9ce10028e78675cb 100644 (file)
--- a/v7/src/compiler/base/scode.scm
+++ b/v7/src/compiler/base/scode.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: scode.scm,v 4.13 2001/12/23 17:20:57 cph Exp $
+$Id: scode.scm,v 4.14 2002/02/08 03:07:07 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -24,48 +24,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (declare (usual-integrations))
 \f
-(let-syntax ((define-scode-operators
-             (non-hygienic-macro-transformer
-              (lambda names
-                `(BEGIN ,@(map (lambda (name)
-                                 `(DEFINE ,(symbol-append 'SCODE/ name)
-                                    (ACCESS ,name SYSTEM-GLOBAL-ENVIRONMENT)))
-                               names))))))
-  (define-scode-operators
-    make-access access? access-components
-    access-environment access-name
-    make-assignment assignment? assignment-components
-    assignment-name assignment-value
-    make-combination combination? combination-components
-    combination-operator combination-operands
-    make-comment comment? comment-components
-    comment-expression comment-text
-    make-conditional conditional? conditional-components
-    conditional-predicate conditional-consequent conditional-alternative
-    make-declaration declaration? declaration-components
-    declaration-expression declaration-text
-    make-definition definition? definition-components
-    definition-name definition-value
-    make-delay delay? delay-components
-    delay-expression
-    make-disjunction disjunction? disjunction-components
-    disjunction-predicate disjunction-alternative
-    make-lambda lambda? lambda-components
-    make-open-block open-block? open-block-components
-    primitive-procedure? procedure?
-    make-quotation quotation? quotation-expression
-    make-sequence sequence? sequence-actions sequence-components
-    symbol?
-    make-the-environment the-environment?
-    make-unassigned? unassigned?? unassigned?-name
-    make-variable variable? variable-components variable-name
-    ))
-
-(define-integrable (scode/make-constant value) value)
-(define-integrable (scode/constant-value constant) constant)
-(define scode/constant? (access scode-constant? system-global-environment))
-
-(define-integrable (scode/quotation-components quot recvr)
+(define (scode/make-constant value) value)
+(define (scode/constant-value constant) constant)
+
+(define (scode/quotation-components quot recvr)
   (recvr (scode/quotation-expression quot)))
 
 (define comment-tag:directive
@@ -100,27 +62,27 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 ;;;; Absolute variables and combinations
 
-(define-integrable (scode/make-absolute-reference variable-name)
-  (scode/make-access '() variable-name))
+(define (scode/make-absolute-reference variable-name)
+  (scode/make-access system-global-environment variable-name))
 
 (define (scode/absolute-reference? object)
   (and (scode/access? object)
-       (null? (scode/access-environment object))))
+       (eq? (scode/access-environment object) system-global-environment)))
 
-(define-integrable (scode/absolute-reference-name reference)
+(define (scode/absolute-reference-name reference)
   (scode/access-name reference))
 
-(define-integrable (scode/make-absolute-combination name operands)
+(define (scode/make-absolute-combination name operands)
   (scode/make-combination (scode/make-absolute-reference name) operands))
 
 (define (scode/absolute-combination? object)
   (and (scode/combination? object)
        (scode/absolute-reference? (scode/combination-operator object))))
 
-(define-integrable (scode/absolute-combination-name combination)
+(define (scode/absolute-combination-name combination)
   (scode/absolute-reference-name (scode/combination-operator combination)))
 
-(define-integrable (scode/absolute-combination-operands combination)
+(define (scode/absolute-combination-operands combination)
   (scode/combination-operands combination))
 
 (define (scode/absolute-combination-components combination receiver)

diff --git a/v7/src/compiler/base/utils.scm b/v7/src/compiler/base/utils.scm
index 6d202fd81d8af103a0cee1b7faf92477d9382d1e..4f341cddf0ed909105d4392de7e82f3b589ed2ec 100644 (file)
--- a/v7/src/compiler/base/utils.scm
+++ b/v7/src/compiler/base/utils.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: utils.scm,v 4.23 2001/12/23 17:20:57 cph Exp $
+$Id: utils.scm,v 4.24 2002/02/08 03:07:11 cph Exp $
 
-Copyright (c) 1987-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1987-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -137,11 +137,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;;;; Type Codes
 
 (let-syntax ((define-type-code
-             (non-hygienic-macro-transformer
-              (lambda (var-name #!optional type-name)
-                (if (default-object? type-name) (set! type-name var-name))
-                `(DEFINE-INTEGRABLE ,(symbol-append 'TYPE-CODE: var-name)
-                   ',(microcode-type type-name))))))
+              (sc-macro-transformer
+               (lambda (form environment)
+                 environment
+                 `(DEFINE-INTEGRABLE ,(symbol-append 'TYPE-CODE: (cadr form))
+                    ',(microcode-type (cadr form)))))))
   (define-type-code lambda)
   (define-type-code extended-lambda)
   (define-type-code procedure)

diff --git a/v7/src/compiler/etc/comcmp.scm b/v7/src/compiler/etc/comcmp.scm
index 232f70a4604249856f7b3f77a23f2c83ec417914..51ca22893f8c51c6704099f682ff3538251532fb 100644 (file)
--- a/v7/src/compiler/etc/comcmp.scm
+++ b/v7/src/compiler/etc/comcmp.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: comcmp.scm,v 1.10 2001/12/24 04:15:36 cph Exp $
+$Id: comcmp.scm,v 1.11 2002/02/08 03:07:42 cph Exp $
 
-Copyright (c) 1989-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -25,9 +25,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (declare (usual-integrations))
 \f
 (define-syntax ucode-type
-  (non-hygienic-macro-transformer
-   (lambda (name)
-     (microcode-type name))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     environment
+     (apply microcode-type (cdr form)))))
 
 (define comcmp:ignore-debugging-info? #t)
 (define comcmp:show-differing-blocks? #f)

diff --git a/v7/src/compiler/fggen/canon.scm b/v7/src/compiler/fggen/canon.scm
index bd4c38e6eaa8dc480aba74e13c9fd1f3467f7f95..162b712490a210854f1923ae7d804754115949c3 100644 (file)
--- a/v7/src/compiler/fggen/canon.scm
+++ b/v7/src/compiler/fggen/canon.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: canon.scm,v 1.20 2001/12/23 17:20:57 cph Exp $
+$Id: canon.scm,v 1.21 2002/02/08 03:08:00 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -503,13 +503,15 @@ ARBITRARY:        The expression may be executed more than once.  It
 \f
 ;;;; Hairier expressions
 
-(let-syntax ((is-operator?
-             (non-hygienic-macro-transformer
-              (lambda (value name)
-                `(or (eq? ,value (ucode-primitive ,name))
-                     (and (scode/absolute-reference? ,value)
-                          (eq? (scode/absolute-reference-name ,value)
-                               ',name)))))))
+(let-syntax
+    ((is-operator?
+      (sc-macro-transformer
+       (lambda (form environment)
+        (let ((value (close-syntax (cadr form) environment))
+              (name (caddr form)))
+          `(OR (EQ? ,value (UCODE-PRIMITIVE ,name))
+               (AND (SCODE/ABSOLUTE-REFERENCE? ,value)
+                    (EQ? (SCODE/ABSOLUTE-REFERENCE-NAME ,value) ',name))))))))
 
   (define (canonicalize/combination expr bound context)
     (scode/combination-components
@@ -517,11 +519,11 @@ ARBITRARY:        The expression may be executed more than once.  It
      (lambda (operator operands)
        (cond ((lambda? operator)
              (canonicalize/let operator operands bound context))
-            ((and (is-operator? operator LEXICAL-UNASSIGNED?)
+            ((and (is-operator? operator lexical-unassigned?)
                   (scode/the-environment? (car operands))
                   (symbol? (cadr operands)))
              (canonicalize/unassigned? (cadr operands) expr bound context))
-            ((and (is-operator? operator ERROR-PROCEDURE)
+            ((and (is-operator? operator error-procedure)
                   (scode/the-environment? (caddr operands)))
              (canonicalize/error operator operands bound context))
             (else
@@ -799,33 +801,45 @@ ARBITRARY:        The expression may be executed more than once.  It
 
     (let-syntax
        ((dispatch-entry
-         (non-hygienic-macro-transformer
-          (lambda (type handler)
-            `(VECTOR-SET! DISPATCH-VECTOR ,(microcode-type type) ,handler))))
+         (sc-macro-transformer
+          (lambda (form environment)
+            `(VECTOR-SET! DISPATCH-VECTOR ,(microcode-type (cadr form))
+                          ,(close-syntax (caddr form) environment)))))
 
         (dispatch-entries
-         (non-hygienic-macro-transformer
-          (lambda (types handler)
-            `(BEGIN ,@(map (lambda (type)
-                             `(DISPATCH-ENTRY ,type ,handler))
-                           types)))))
+         (c-macro-transformer
+          (lambda (form environment)
+            (let ((handler (close-syntax (caddr form) environment)))
+              `(BEGIN
+                 ,@(map (lambda (type)
+                          `(DISPATCH-ENTRY ,type ,handler))
+                        (cadr form)))))))
         (standard-entry
-         (non-hygienic-macro-transformer
-          (lambda (name)
-            `(DISPATCH-ENTRY ,name ,(symbol-append 'CANONICALIZE/ name)))))
+         (sc-macro-transformer
+          (lambda (form environment)
+            (let ((name (cadr form)))
+              `(DISPATCH-ENTRY ,name
+                               ,(close-syntax (symbol-append 'CANONICALIZE/
+                                                             name)
+                                              environment))))))
 
         (nary-entry
-         (non-hygienic-macro-transformer
-          (lambda (nary name)
-            `(DISPATCH-ENTRY ,name
-                             (,(symbol-append 'CANONICALIZE/ nary)
-                              ,(symbol-append 'SCODE/ name '-COMPONENTS)
-                              ,(symbol-append 'SCODE/MAKE- name))))))
+         (sc-macro-transformer
+          (lambda (form environment)
+            (let ((nary (cadr form))
+                  (name (caddr form)))
+              `(DISPATCH-ENTRY ,name
+                               ,(close-syntax
+                                 `(,(symbol-append 'CANONICALIZE/ nary)
+                                   ,(symbol-append 'SCODE/ name '-COMPONENTS)
+                                   ,(symbol-append 'SCODE/MAKE- name))
+                                 environment))))))
 
         (binary-entry
-         (non-hygienic-macro-transformer
-          (lambda (name)
-            `(NARY-ENTRY binary ,name)))))
+         (sc-macro-transformer
+          (lambda (form environment)
+            environment
+            `(NARY-ENTRY BINARY ,(cadr form))))))
 
       ;; quotations are treated as constants.
       (binary-entry access)

diff --git a/v7/src/compiler/fggen/fggen.scm b/v7/src/compiler/fggen/fggen.scm
index 27fb4ce8e6978b8a36cf7f9d20dd404311026792..28be51fdde1196910c8794c58161f8f7655e676a 100644 (file)
--- a/v7/src/compiler/fggen/fggen.scm
+++ b/v7/src/compiler/fggen/fggen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: fggen.scm,v 4.35 2001/12/23 17:20:57 cph Exp $
+$Id: fggen.scm,v 4.36 2002/02/08 03:08:11 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -952,22 +952,28 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
                 (else
                  (generate/constant block continuation
                                     context expression))))))
-\f
     (let-syntax
        ((dispatch-entry
-         (non-hygienic-macro-transformer
-          (lambda (type handler)
-            `(VECTOR-SET! DISPATCH-VECTOR ,(microcode-type type) ,handler))))
+         (sc-macro-transformer
+          (lambda (form environment)
+            `(VECTOR-SET! DISPATCH-VECTOR
+                          ,(microcode-type (cadr form))
+                          ,(close-syntax (caddr form) environment)))))
         (dispatch-entries
-         (non-hygienic-macro-transformer
-          (lambda (types handler)
-            `(BEGIN ,@(map (lambda (type)
-                             `(DISPATCH-ENTRY ,type ,handler))
-                           types)))))
+         (sc-macro-transformer
+          (lambda (form environment)
+            (let ((handler (close-syntax (caddr form) environment)))
+              `(BEGIN
+                 ,@(map (lambda (type)
+                          `(DISPATCH-ENTRY ,type ,handler))
+                        (cadr form)))))))
         (standard-entry
-         (non-hygienic-macro-transformer
-          (lambda (name)
-            `(DISPATCH-ENTRY ,name ,(symbol-append 'GENERATE/ name))))))
+         (sc-macro-transformer
+          (lambda (form environment)
+            (let ((name (cadr form)))
+              `(DISPATCH-ENTRY ,name
+                               ,(close-syntax (symbol-append 'GENERATE/ name)
+                                              environment)))))))
       (standard-entry access)
       (standard-entry assignment)
       (standard-entry conditional)

diff --git a/v7/src/compiler/machines/C/compiler.pkg b/v7/src/compiler/machines/C/compiler.pkg
index c01faf13dc16ef185446c7b78cd9aae98a3d5c9d..800bf4d87380e82d84f747504c31046239b3b301 100644 (file)
--- a/v7/src/compiler/machines/C/compiler.pkg
+++ b/v7/src/compiler/machines/C/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.12 2001/12/20 03:04:02 cph Exp $
+$Id: compiler.pkg,v 1.13 2002/02/08 03:10:37 cph Exp $
 
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -89,7 +89,79 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          compiler:show-procedures?
          compiler:show-subphases?
          compiler:show-time-reports?
-         compiler:use-multiclosures?))
+         compiler:use-multiclosures?)
+  (import ()
+         (scode/access-components access-components)
+         (scode/access-environment access-environment)
+         (scode/access-name access-name)
+         (scode/access? access?)
+         (scode/assignment-components assignment-components)
+         (scode/assignment-name assignment-name)
+         (scode/assignment-value assignment-value)
+         (scode/assignment? assignment?)
+         (scode/combination-components combination-components)
+         (scode/combination-operands combination-operands)
+         (scode/combination-operator combination-operator)
+         (scode/combination? combination?)
+         (scode/comment-components comment-components)
+         (scode/comment-expression comment-expression)
+         (scode/comment-text comment-text)
+         (scode/comment? comment?)
+         (scode/conditional-alternative conditional-alternative)
+         (scode/conditional-components conditional-components)
+         (scode/conditional-consequent conditional-consequent)
+         (scode/conditional-predicate conditional-predicate)
+         (scode/conditional? conditional?)
+         (scode/constant? scode-constant?)
+         (scode/declaration-components declaration-components)
+         (scode/declaration-expression declaration-expression)
+         (scode/declaration-text declaration-text)
+         (scode/declaration? declaration?)
+         (scode/definition-components definition-components)
+         (scode/definition-name definition-name)
+         (scode/definition-value definition-value)
+         (scode/definition? definition?)
+         (scode/delay-components delay-components)
+         (scode/delay-expression delay-expression)
+         (scode/delay? delay?)
+         (scode/disjunction-alternative disjunction-alternative)
+         (scode/disjunction-components disjunction-components)
+         (scode/disjunction-predicate disjunction-predicate)
+         (scode/disjunction? disjunction?)
+         (scode/lambda-components lambda-components)
+         (scode/lambda? lambda?)
+         (scode/make-access make-access)
+         (scode/make-assignment make-assignment)
+         (scode/make-combination make-combination)
+         (scode/make-comment make-comment)
+         (scode/make-conditional make-conditional)
+         (scode/make-declaration make-declaration)
+         (scode/make-definition make-definition)
+         (scode/make-delay make-delay)
+         (scode/make-disjunction make-disjunction)
+         (scode/make-lambda make-lambda)
+         (scode/make-open-block make-open-block)
+         (scode/make-quotation make-quotation)
+         (scode/make-sequence make-sequence)
+         (scode/make-the-environment make-the-environment)
+         (scode/make-unassigned? make-unassigned?)
+         (scode/make-variable make-variable)
+         (scode/open-block-components open-block-components)
+         (scode/open-block? open-block?)
+         (scode/primitive-procedure? primitive-procedure?)
+         (scode/procedure? procedure?)
+         (scode/quotation-expression quotation-expression)
+         (scode/quotation? quotation?)
+         (scode/sequence-actions sequence-actions)
+         (scode/sequence-components sequence-components)
+         (scode/sequence? sequence?)
+         (scode/symbol? symbol?)
+         (scode/the-environment? the-environment?)
+         (scode/unassigned?-name unassigned?-name)
+         (scode/unassigned?? unassigned??)
+         (scode/variable-components variable-components)
+         (scode/variable-name variable-name)
+         (scode/variable? variable?)))
 \f
 (define-package (compiler reference-contexts)
   (files "base/refctx")

diff --git a/v7/src/compiler/machines/alpha/compiler.pkg b/v7/src/compiler/machines/alpha/compiler.pkg
index d48aea70ab48ccdd20946243cc5f3dbee811e9f4..793c7b62f6e1bb999c5270da16bfaa6adac573d9 100644 (file)
--- a/v7/src/compiler/machines/alpha/compiler.pkg
+++ b/v7/src/compiler/machines/alpha/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.15 2001/12/20 03:04:02 cph Exp $
+$Id: compiler.pkg,v 1.16 2002/02/08 03:10:57 cph Exp $
 
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -88,7 +88,79 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          compiler:show-procedures?
          compiler:show-subphases?
          compiler:show-time-reports?
-         compiler:use-multiclosures?))
+         compiler:use-multiclosures?)
+  (import ()
+         (scode/access-components access-components)
+         (scode/access-environment access-environment)
+         (scode/access-name access-name)
+         (scode/access? access?)
+         (scode/assignment-components assignment-components)
+         (scode/assignment-name assignment-name)
+         (scode/assignment-value assignment-value)
+         (scode/assignment? assignment?)
+         (scode/combination-components combination-components)
+         (scode/combination-operands combination-operands)
+         (scode/combination-operator combination-operator)
+         (scode/combination? combination?)
+         (scode/comment-components comment-components)
+         (scode/comment-expression comment-expression)
+         (scode/comment-text comment-text)
+         (scode/comment? comment?)
+         (scode/conditional-alternative conditional-alternative)
+         (scode/conditional-components conditional-components)
+         (scode/conditional-consequent conditional-consequent)
+         (scode/conditional-predicate conditional-predicate)
+         (scode/conditional? conditional?)
+         (scode/constant? scode-constant?)
+         (scode/declaration-components declaration-components)
+         (scode/declaration-expression declaration-expression)
+         (scode/declaration-text declaration-text)
+         (scode/declaration? declaration?)
+         (scode/definition-components definition-components)
+         (scode/definition-name definition-name)
+         (scode/definition-value definition-value)
+         (scode/definition? definition?)
+         (scode/delay-components delay-components)
+         (scode/delay-expression delay-expression)
+         (scode/delay? delay?)
+         (scode/disjunction-alternative disjunction-alternative)
+         (scode/disjunction-components disjunction-components)
+         (scode/disjunction-predicate disjunction-predicate)
+         (scode/disjunction? disjunction?)
+         (scode/lambda-components lambda-components)
+         (scode/lambda? lambda?)
+         (scode/make-access make-access)
+         (scode/make-assignment make-assignment)
+         (scode/make-combination make-combination)
+         (scode/make-comment make-comment)
+         (scode/make-conditional make-conditional)
+         (scode/make-declaration make-declaration)
+         (scode/make-definition make-definition)
+         (scode/make-delay make-delay)
+         (scode/make-disjunction make-disjunction)
+         (scode/make-lambda make-lambda)
+         (scode/make-open-block make-open-block)
+         (scode/make-quotation make-quotation)
+         (scode/make-sequence make-sequence)
+         (scode/make-the-environment make-the-environment)
+         (scode/make-unassigned? make-unassigned?)
+         (scode/make-variable make-variable)
+         (scode/open-block-components open-block-components)
+         (scode/open-block? open-block?)
+         (scode/primitive-procedure? primitive-procedure?)
+         (scode/procedure? procedure?)
+         (scode/quotation-expression quotation-expression)
+         (scode/quotation? quotation?)
+         (scode/sequence-actions sequence-actions)
+         (scode/sequence-components sequence-components)
+         (scode/sequence? sequence?)
+         (scode/symbol? symbol?)
+         (scode/the-environment? the-environment?)
+         (scode/unassigned?-name unassigned?-name)
+         (scode/unassigned?? unassigned??)
+         (scode/variable-components variable-components)
+         (scode/variable-name variable-name)
+         (scode/variable? variable?)))
 \f
 (define-package (compiler reference-contexts)
   (files "base/refctx")

diff --git a/v7/src/compiler/machines/bobcat/compiler.pkg b/v7/src/compiler/machines/bobcat/compiler.pkg
index 9f3fb6a1a5f6a05ed1049d8daa2ef9fd3f8e5979..7971896118d8bd737c2d0d853f7cd147d1dce401 100644 (file)
--- a/v7/src/compiler/machines/bobcat/compiler.pkg
+++ b/v7/src/compiler/machines/bobcat/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.52 2001/12/20 03:04:02 cph Exp $
+$Id: compiler.pkg,v 1.53 2002/02/08 03:11:18 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -89,7 +89,79 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          compiler:show-procedures?
          compiler:show-subphases?
          compiler:show-time-reports?
-         compiler:use-multiclosures?))
+         compiler:use-multiclosures?)
+  (import ()
+         (scode/access-components access-components)
+         (scode/access-environment access-environment)
+         (scode/access-name access-name)
+         (scode/access? access?)
+         (scode/assignment-components assignment-components)
+         (scode/assignment-name assignment-name)
+         (scode/assignment-value assignment-value)
+         (scode/assignment? assignment?)
+         (scode/combination-components combination-components)
+         (scode/combination-operands combination-operands)
+         (scode/combination-operator combination-operator)
+         (scode/combination? combination?)
+         (scode/comment-components comment-components)
+         (scode/comment-expression comment-expression)
+         (scode/comment-text comment-text)
+         (scode/comment? comment?)
+         (scode/conditional-alternative conditional-alternative)
+         (scode/conditional-components conditional-components)
+         (scode/conditional-consequent conditional-consequent)
+         (scode/conditional-predicate conditional-predicate)
+         (scode/conditional? conditional?)
+         (scode/constant? scode-constant?)
+         (scode/declaration-components declaration-components)
+         (scode/declaration-expression declaration-expression)
+         (scode/declaration-text declaration-text)
+         (scode/declaration? declaration?)
+         (scode/definition-components definition-components)
+         (scode/definition-name definition-name)
+         (scode/definition-value definition-value)
+         (scode/definition? definition?)
+         (scode/delay-components delay-components)
+         (scode/delay-expression delay-expression)
+         (scode/delay? delay?)
+         (scode/disjunction-alternative disjunction-alternative)
+         (scode/disjunction-components disjunction-components)
+         (scode/disjunction-predicate disjunction-predicate)
+         (scode/disjunction? disjunction?)
+         (scode/lambda-components lambda-components)
+         (scode/lambda? lambda?)
+         (scode/make-access make-access)
+         (scode/make-assignment make-assignment)
+         (scode/make-combination make-combination)
+         (scode/make-comment make-comment)
+         (scode/make-conditional make-conditional)
+         (scode/make-declaration make-declaration)
+         (scode/make-definition make-definition)
+         (scode/make-delay make-delay)
+         (scode/make-disjunction make-disjunction)
+         (scode/make-lambda make-lambda)
+         (scode/make-open-block make-open-block)
+         (scode/make-quotation make-quotation)
+         (scode/make-sequence make-sequence)
+         (scode/make-the-environment make-the-environment)
+         (scode/make-unassigned? make-unassigned?)
+         (scode/make-variable make-variable)
+         (scode/open-block-components open-block-components)
+         (scode/open-block? open-block?)
+         (scode/primitive-procedure? primitive-procedure?)
+         (scode/procedure? procedure?)
+         (scode/quotation-expression quotation-expression)
+         (scode/quotation? quotation?)
+         (scode/sequence-actions sequence-actions)
+         (scode/sequence-components sequence-components)
+         (scode/sequence? sequence?)
+         (scode/symbol? symbol?)
+         (scode/the-environment? the-environment?)
+         (scode/unassigned?-name unassigned?-name)
+         (scode/unassigned?? unassigned??)
+         (scode/variable-components variable-components)
+         (scode/variable-name variable-name)
+         (scode/variable? variable?)))
 \f
 (define-package (compiler reference-contexts)
   (files "base/refctx")

diff --git a/v7/src/compiler/machines/i386/compiler.pkg b/v7/src/compiler/machines/i386/compiler.pkg
index 343d3bcdcd014bd946257c919df1f8e7548376cd..1d477d30e16e1a98dffd39c98285eedb3135107d 100644 (file)
--- a/v7/src/compiler/machines/i386/compiler.pkg
+++ b/v7/src/compiler/machines/i386/compiler.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.28 2002/02/03 03:38:53 cph Exp $
+$Id: compiler.pkg,v 1.29 2002/02/08 03:09:41 cph Exp $
 
 Copyright (c) 1992-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -93,7 +93,79 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          compiler:use-multiclosures?)
   (import (runtime system-macros)
          ucode-primitive
-         ucode-type))
+         ucode-type)
+  (import ()
+         (scode/access-components access-components)
+         (scode/access-environment access-environment)
+         (scode/access-name access-name)
+         (scode/access? access?)
+         (scode/assignment-components assignment-components)
+         (scode/assignment-name assignment-name)
+         (scode/assignment-value assignment-value)
+         (scode/assignment? assignment?)
+         (scode/combination-components combination-components)
+         (scode/combination-operands combination-operands)
+         (scode/combination-operator combination-operator)
+         (scode/combination? combination?)
+         (scode/comment-components comment-components)
+         (scode/comment-expression comment-expression)
+         (scode/comment-text comment-text)
+         (scode/comment? comment?)
+         (scode/conditional-alternative conditional-alternative)
+         (scode/conditional-components conditional-components)
+         (scode/conditional-consequent conditional-consequent)
+         (scode/conditional-predicate conditional-predicate)
+         (scode/conditional? conditional?)
+         (scode/constant? scode-constant?)
+         (scode/declaration-components declaration-components)
+         (scode/declaration-expression declaration-expression)
+         (scode/declaration-text declaration-text)
+         (scode/declaration? declaration?)
+         (scode/definition-components definition-components)
+         (scode/definition-name definition-name)
+         (scode/definition-value definition-value)
+         (scode/definition? definition?)
+         (scode/delay-components delay-components)
+         (scode/delay-expression delay-expression)
+         (scode/delay? delay?)
+         (scode/disjunction-alternative disjunction-alternative)
+         (scode/disjunction-components disjunction-components)
+         (scode/disjunction-predicate disjunction-predicate)
+         (scode/disjunction? disjunction?)
+         (scode/lambda-components lambda-components)
+         (scode/lambda? lambda?)
+         (scode/make-access make-access)
+         (scode/make-assignment make-assignment)
+         (scode/make-combination make-combination)
+         (scode/make-comment make-comment)
+         (scode/make-conditional make-conditional)
+         (scode/make-declaration make-declaration)
+         (scode/make-definition make-definition)
+         (scode/make-delay make-delay)
+         (scode/make-disjunction make-disjunction)
+         (scode/make-lambda make-lambda)
+         (scode/make-open-block make-open-block)
+         (scode/make-quotation make-quotation)
+         (scode/make-sequence make-sequence)
+         (scode/make-the-environment make-the-environment)
+         (scode/make-unassigned? make-unassigned?)
+         (scode/make-variable make-variable)
+         (scode/open-block-components open-block-components)
+         (scode/open-block? open-block?)
+         (scode/primitive-procedure? primitive-procedure?)
+         (scode/procedure? procedure?)
+         (scode/quotation-expression quotation-expression)
+         (scode/quotation? quotation?)
+         (scode/sequence-actions sequence-actions)
+         (scode/sequence-components sequence-components)
+         (scode/sequence? sequence?)
+         (scode/symbol? symbol?)
+         (scode/the-environment? the-environment?)
+         (scode/unassigned?-name unassigned?-name)
+         (scode/unassigned?? unassigned??)
+         (scode/variable-components variable-components)
+         (scode/variable-name variable-name)
+         (scode/variable? variable?)))
 \f
 (define-package (compiler reference-contexts)
   (files "base/refctx")

diff --git a/v7/src/compiler/machines/mips/compiler.pkg b/v7/src/compiler/machines/mips/compiler.pkg
index 93760101c53b414800f5ccda2cb73ab8179c2346..9f060a458b524a2575f143de148999f933e02211 100644 (file)
--- a/v7/src/compiler/machines/mips/compiler.pkg
+++ b/v7/src/compiler/machines/mips/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.22 2001/12/20 03:04:02 cph Exp $
+$Id: compiler.pkg,v 1.23 2002/02/08 03:11:37 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -89,7 +89,79 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          compiler:show-procedures?
          compiler:show-subphases?
          compiler:show-time-reports?
-         compiler:use-multiclosures?))
+         compiler:use-multiclosures?)
+  (import ()
+         (scode/access-components access-components)
+         (scode/access-environment access-environment)
+         (scode/access-name access-name)
+         (scode/access? access?)
+         (scode/assignment-components assignment-components)
+         (scode/assignment-name assignment-name)
+         (scode/assignment-value assignment-value)
+         (scode/assignment? assignment?)
+         (scode/combination-components combination-components)
+         (scode/combination-operands combination-operands)
+         (scode/combination-operator combination-operator)
+         (scode/combination? combination?)
+         (scode/comment-components comment-components)
+         (scode/comment-expression comment-expression)
+         (scode/comment-text comment-text)
+         (scode/comment? comment?)
+         (scode/conditional-alternative conditional-alternative)
+         (scode/conditional-components conditional-components)
+         (scode/conditional-consequent conditional-consequent)
+         (scode/conditional-predicate conditional-predicate)
+         (scode/conditional? conditional?)
+         (scode/constant? scode-constant?)
+         (scode/declaration-components declaration-components)
+         (scode/declaration-expression declaration-expression)
+         (scode/declaration-text declaration-text)
+         (scode/declaration? declaration?)
+         (scode/definition-components definition-components)
+         (scode/definition-name definition-name)
+         (scode/definition-value definition-value)
+         (scode/definition? definition?)
+         (scode/delay-components delay-components)
+         (scode/delay-expression delay-expression)
+         (scode/delay? delay?)
+         (scode/disjunction-alternative disjunction-alternative)
+         (scode/disjunction-components disjunction-components)
+         (scode/disjunction-predicate disjunction-predicate)
+         (scode/disjunction? disjunction?)
+         (scode/lambda-components lambda-components)
+         (scode/lambda? lambda?)
+         (scode/make-access make-access)
+         (scode/make-assignment make-assignment)
+         (scode/make-combination make-combination)
+         (scode/make-comment make-comment)
+         (scode/make-conditional make-conditional)
+         (scode/make-declaration make-declaration)
+         (scode/make-definition make-definition)
+         (scode/make-delay make-delay)
+         (scode/make-disjunction make-disjunction)
+         (scode/make-lambda make-lambda)
+         (scode/make-open-block make-open-block)
+         (scode/make-quotation make-quotation)
+         (scode/make-sequence make-sequence)
+         (scode/make-the-environment make-the-environment)
+         (scode/make-unassigned? make-unassigned?)
+         (scode/make-variable make-variable)
+         (scode/open-block-components open-block-components)
+         (scode/open-block? open-block?)
+         (scode/primitive-procedure? primitive-procedure?)
+         (scode/procedure? procedure?)
+         (scode/quotation-expression quotation-expression)
+         (scode/quotation? quotation?)
+         (scode/sequence-actions sequence-actions)
+         (scode/sequence-components sequence-components)
+         (scode/sequence? sequence?)
+         (scode/symbol? symbol?)
+         (scode/the-environment? the-environment?)
+         (scode/unassigned?-name unassigned?-name)
+         (scode/unassigned?? unassigned??)
+         (scode/variable-components variable-components)
+         (scode/variable-name variable-name)
+         (scode/variable? variable?)))
 \f
 (define-package (compiler reference-contexts)
   (files "base/refctx")

diff --git a/v7/src/compiler/machines/spectrum/compiler.pkg b/v7/src/compiler/machines/spectrum/compiler.pkg
index 867f633460ccd6a724482c63cadf559f97b4061f..5594407bc3d267afa8a2b73b5a07de0a5cdcadea 100644 (file)
--- a/v7/src/compiler/machines/spectrum/compiler.pkg
+++ b/v7/src/compiler/machines/spectrum/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.52 2001/12/20 03:04:02 cph Exp $
+$Id: compiler.pkg,v 1.53 2002/02/08 03:12:45 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -89,7 +89,79 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          compiler:show-procedures?
          compiler:show-subphases?
          compiler:show-time-reports?
-         compiler:use-multiclosures?))
+         compiler:use-multiclosures?)
+  (import ()
+         (scode/access-components access-components)
+         (scode/access-environment access-environment)
+         (scode/access-name access-name)
+         (scode/access? access?)
+         (scode/assignment-components assignment-components)
+         (scode/assignment-name assignment-name)
+         (scode/assignment-value assignment-value)
+         (scode/assignment? assignment?)
+         (scode/combination-components combination-components)
+         (scode/combination-operands combination-operands)
+         (scode/combination-operator combination-operator)
+         (scode/combination? combination?)
+         (scode/comment-components comment-components)
+         (scode/comment-expression comment-expression)
+         (scode/comment-text comment-text)
+         (scode/comment? comment?)
+         (scode/conditional-alternative conditional-alternative)
+         (scode/conditional-components conditional-components)
+         (scode/conditional-consequent conditional-consequent)
+         (scode/conditional-predicate conditional-predicate)
+         (scode/conditional? conditional?)
+         (scode/constant? scode-constant?)
+         (scode/declaration-components declaration-components)
+         (scode/declaration-expression declaration-expression)
+         (scode/declaration-text declaration-text)
+         (scode/declaration? declaration?)
+         (scode/definition-components definition-components)
+         (scode/definition-name definition-name)
+         (scode/definition-value definition-value)
+         (scode/definition? definition?)
+         (scode/delay-components delay-components)
+         (scode/delay-expression delay-expression)
+         (scode/delay? delay?)
+         (scode/disjunction-alternative disjunction-alternative)
+         (scode/disjunction-components disjunction-components)
+         (scode/disjunction-predicate disjunction-predicate)
+         (scode/disjunction? disjunction?)
+         (scode/lambda-components lambda-components)
+         (scode/lambda? lambda?)
+         (scode/make-access make-access)
+         (scode/make-assignment make-assignment)
+         (scode/make-combination make-combination)
+         (scode/make-comment make-comment)
+         (scode/make-conditional make-conditional)
+         (scode/make-declaration make-declaration)
+         (scode/make-definition make-definition)
+         (scode/make-delay make-delay)
+         (scode/make-disjunction make-disjunction)
+         (scode/make-lambda make-lambda)
+         (scode/make-open-block make-open-block)
+         (scode/make-quotation make-quotation)
+         (scode/make-sequence make-sequence)
+         (scode/make-the-environment make-the-environment)
+         (scode/make-unassigned? make-unassigned?)
+         (scode/make-variable make-variable)
+         (scode/open-block-components open-block-components)
+         (scode/open-block? open-block?)
+         (scode/primitive-procedure? primitive-procedure?)
+         (scode/procedure? procedure?)
+         (scode/quotation-expression quotation-expression)
+         (scode/quotation? quotation?)
+         (scode/sequence-actions sequence-actions)
+         (scode/sequence-components sequence-components)
+         (scode/sequence? sequence?)
+         (scode/symbol? symbol?)
+         (scode/the-environment? the-environment?)
+         (scode/unassigned?-name unassigned?-name)
+         (scode/unassigned?? unassigned??)
+         (scode/variable-components variable-components)
+         (scode/variable-name variable-name)
+         (scode/variable? variable?)))
 \f
 (define-package (compiler reference-contexts)
   (files "base/refctx")

diff --git a/v7/src/compiler/machines/vax/compiler.pkg b/v7/src/compiler/machines/vax/compiler.pkg
index 4c8a32069a0571636054b4c30f415eebd598b3cd..37168e538bb86606e759c20b74f4568f87bf8cd0 100644 (file)
--- a/v7/src/compiler/machines/vax/compiler.pkg
+++ b/v7/src/compiler/machines/vax/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.24 2001/12/20 03:04:02 cph Exp $
+$Id: compiler.pkg,v 1.25 2002/02/08 03:13:05 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -89,7 +89,79 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          compiler:show-procedures?
          compiler:show-subphases?
          compiler:show-time-reports?
-         compiler:use-multiclosures?))
+         compiler:use-multiclosures?)
+  (import ()
+         (scode/access-components access-components)
+         (scode/access-environment access-environment)
+         (scode/access-name access-name)
+         (scode/access? access?)
+         (scode/assignment-components assignment-components)
+         (scode/assignment-name assignment-name)
+         (scode/assignment-value assignment-value)
+         (scode/assignment? assignment?)
+         (scode/combination-components combination-components)
+         (scode/combination-operands combination-operands)
+         (scode/combination-operator combination-operator)
+         (scode/combination? combination?)
+         (scode/comment-components comment-components)
+         (scode/comment-expression comment-expression)
+         (scode/comment-text comment-text)
+         (scode/comment? comment?)
+         (scode/conditional-alternative conditional-alternative)
+         (scode/conditional-components conditional-components)
+         (scode/conditional-consequent conditional-consequent)
+         (scode/conditional-predicate conditional-predicate)
+         (scode/conditional? conditional?)
+         (scode/constant? scode-constant?)
+         (scode/declaration-components declaration-components)
+         (scode/declaration-expression declaration-expression)
+         (scode/declaration-text declaration-text)
+         (scode/declaration? declaration?)
+         (scode/definition-components definition-components)
+         (scode/definition-name definition-name)
+         (scode/definition-value definition-value)
+         (scode/definition? definition?)
+         (scode/delay-components delay-components)
+         (scode/delay-expression delay-expression)
+         (scode/delay? delay?)
+         (scode/disjunction-alternative disjunction-alternative)
+         (scode/disjunction-components disjunction-components)
+         (scode/disjunction-predicate disjunction-predicate)
+         (scode/disjunction? disjunction?)
+         (scode/lambda-components lambda-components)
+         (scode/lambda? lambda?)
+         (scode/make-access make-access)
+         (scode/make-assignment make-assignment)
+         (scode/make-combination make-combination)
+         (scode/make-comment make-comment)
+         (scode/make-conditional make-conditional)
+         (scode/make-declaration make-declaration)
+         (scode/make-definition make-definition)
+         (scode/make-delay make-delay)
+         (scode/make-disjunction make-disjunction)
+         (scode/make-lambda make-lambda)
+         (scode/make-open-block make-open-block)
+         (scode/make-quotation make-quotation)
+         (scode/make-sequence make-sequence)
+         (scode/make-the-environment make-the-environment)
+         (scode/make-unassigned? make-unassigned?)
+         (scode/make-variable make-variable)
+         (scode/open-block-components open-block-components)
+         (scode/open-block? open-block?)
+         (scode/primitive-procedure? primitive-procedure?)
+         (scode/procedure? procedure?)
+         (scode/quotation-expression quotation-expression)
+         (scode/quotation? quotation?)
+         (scode/sequence-actions sequence-actions)
+         (scode/sequence-components sequence-components)
+         (scode/sequence? sequence?)
+         (scode/symbol? symbol?)
+         (scode/the-environment? the-environment?)
+         (scode/unassigned?-name unassigned?-name)
+         (scode/unassigned?? unassigned??)
+         (scode/variable-components variable-components)
+         (scode/variable-name variable-name)
+         (scode/variable? variable?)))
 \f
 (define-package (compiler reference-contexts)
   (files "base/refctx")

diff --git a/v7/src/compiler/rtlbase/rtlcfg.scm b/v7/src/compiler/rtlbase/rtlcfg.scm
index ca79788bdb3aca5c3a8c7be2978f76cb8f186537..d9c64790c839c8103b32c9c39841874d5bf59a8f 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlcfg.scm
+++ b/v7/src/compiler/rtlbase/rtlcfg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rtlcfg.scm,v 4.9 1999/01/02 06:06:43 cph Exp $
+$Id: rtlcfg.scm,v 4.10 2002/02/08 03:08:36 cph Exp $
 
-Copyright (c) 1987, 1988, 1989, 1999 Massachusetts Institute of Technology
+Copyright (c) 1987-1989, 1999, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -56,6 +56,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (let ((bblock-describe
        (lambda (bblock)
         (descriptor-list bblock
+                         bblock
                          instructions
                          live-at-entry
                          live-at-exit
@@ -68,6 +69,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (append! ((vector-tag-description snode-tag) sblock)
              (bblock-describe sblock)
              (descriptor-list sblock
+                              sblock
                               continuation))))
   (set-vector-tag-description!
    pblock-tag
@@ -75,6 +77,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (append! ((vector-tag-description pnode-tag) pblock)
              (bblock-describe pblock)
              (descriptor-list pblock
+                              pblock
                               consequent-lap-generator
                               alternative-lap-generator)))))
 \f

diff --git a/v7/src/compiler/rtlbase/rtlreg.scm b/v7/src/compiler/rtlbase/rtlreg.scm
index 850383254e805153021d1f48e536ffa53e88546b..1e8b97ae75b9ca0bd1e4fd96fac0abd14a3f2406 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlreg.scm
+++ b/v7/src/compiler/rtlbase/rtlreg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rtlreg.scm,v 4.8 2001/12/23 17:20:58 cph Exp $
+$Id: rtlreg.scm,v 4.9 2002/02/08 03:08:47 cph Exp $
 
-Copyright (c) 1987, 1988, 1990, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1990, 1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -67,15 +67,20 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (let-syntax
     ((define-register-references
-      (non-hygienic-macro-transformer
-       (lambda (slot)
-        (let ((name (symbol-append 'REGISTER- slot)))
-          (let ((vector `(,(symbol-append 'RGRAPH- name) *CURRENT-RGRAPH*)))
-            `(BEGIN (DEFINE-INTEGRABLE (,name REGISTER)
-                      (VECTOR-REF ,vector REGISTER))
-                    (DEFINE-INTEGRABLE
-                      (,(symbol-append 'SET- name '!) REGISTER VALUE)
-                      (VECTOR-SET! ,vector REGISTER VALUE)))))))))
+       (sc-macro-transformer
+       (lambda (form environment)
+         (let ((slot (cadr form)))
+           (let ((name (symbol-append 'REGISTER- slot)))
+             (let ((vector
+                    `(,(close-syntax (symbol-append 'RGRAPH- name)
+                                     environment)
+                      *CURRENT-RGRAPH*)))
+               `(BEGIN
+                  (DEFINE-INTEGRABLE (,name REGISTER)
+                    (VECTOR-REF ,vector REGISTER))
+                  (DEFINE-INTEGRABLE
+                    (,(symbol-append 'SET- name '!) REGISTER VALUE)
+                    (VECTOR-SET! ,vector REGISTER VALUE))))))))))
   (define-register-references bblock)
   (define-register-references n-refs)
   (define-register-references n-deaths)

diff --git a/v7/src/compiler/rtlbase/valclass.scm b/v7/src/compiler/rtlbase/valclass.scm
index c70a017f35042334401fbb932465fd74637d0018..05fe6398fbc269c877f7e6d809804afd03d03d0e 100644 (file)
--- a/v7/src/compiler/rtlbase/valclass.scm
+++ b/v7/src/compiler/rtlbase/valclass.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: valclass.scm,v 1.4 2001/12/23 17:20:58 cph Exp $
+$Id: valclass.scm,v 1.5 2002/02/08 03:08:55 cph Exp $
 
-Copyright (c) 1989, 1990, 1999 Massachusetts Institute of Technology
+Copyright (c) 1989, 1990, 1999, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -75,34 +75,37 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 \f
 (let-syntax
     ((define-value-class
-      (non-hygienic-macro-transformer
-       (lambda (name parent-name)
-        (let* ((name->variable
-                (lambda (name) (symbol-append 'VALUE-CLASS= name)))
-               (variable (name->variable name)))
-          `(BEGIN
-             (DEFINE ,variable
-               (MAKE-VALUE-CLASS ',name
-                                 ,(if parent-name
-                                      (name->variable parent-name)
-                                      `#F)))
-             (DEFINE (,(symbol-append variable '?) CLASS)
-               (VALUE-CLASS/ANCESTOR-OR-SELF? CLASS ,variable))
-             (DEFINE
-               (,(symbol-append 'REGISTER- variable '?) REGISTER)
-               (VALUE-CLASS/ANCESTOR-OR-SELF? (REGISTER-VALUE-CLASS REGISTER)
-                                              ,variable))))))))
-
-(define-value-class value #f)
-(define-value-class float value)
-(define-value-class word value)
-(define-value-class object word)
-(define-value-class unboxed word)
-(define-value-class address unboxed)
-(define-value-class immediate unboxed)
-(define-value-class ascii immediate)
-(define-value-class datum immediate)
-(define-value-class fixnum immediate)
-(define-value-class type immediate)
-
-)
\ No newline at end of file
+       (sc-macro-transformer
+       (lambda (form environment)
+         (let ((name (cadr form))
+               (parent-name (caddr form)))
+           (let* ((name->variable
+                   (lambda (name)
+                     (symbol-append 'VALUE-CLASS= name)))
+                  (variable (name->variable name))
+                  (var-ref (close-syntax variable environment)))
+             `(BEGIN
+                (DEFINE ,variable
+                  (MAKE-VALUE-CLASS
+                   ',name
+                   ,(if parent-name
+                        (close-syntax (name->variable parent-name)
+                                      environment)
+                        `#F)))
+                (DEFINE (,(symbol-append variable '?) CLASS)
+                  (VALUE-CLASS/ANCESTOR-OR-SELF? CLASS ,variable))
+                (DEFINE (,(symbol-append 'REGISTER- variable '?) REGISTER)
+                  (VALUE-CLASS/ANCESTOR-OR-SELF?
+                   (REGISTER-VALUE-CLASS REGISTER)
+                   ,variable)))))))))
+  (define-value-class value #f)
+  (define-value-class float value)
+  (define-value-class word value)
+  (define-value-class object word)
+  (define-value-class unboxed word)
+  (define-value-class address unboxed)
+  (define-value-class immediate unboxed)
+  (define-value-class ascii immediate)
+  (define-value-class datum immediate)
+  (define-value-class fixnum immediate)
+  (define-value-class type immediate))
\ No newline at end of file