From 747578f337f7cdb96ec7d9b85b43255876f20939 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 20 Dec 2001 03:46:57 +0000
Subject: [PATCH] Fix problem caused by SCode-manipulating macro being closed
in compiler environment.
---
v7/src/compiler/base/macros.scm | 65 ++++++++++++++++-----------------
1 file changed, 32 insertions(+), 33 deletions(-)
diff --git a/v7/src/compiler/base/macros.scm b/v7/src/compiler/base/macros.scm
index a165f471e..42335b302 100644
--- a/v7/src/compiler/base/macros.scm
+++ b/v7/src/compiler/base/macros.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: macros.scm,v 4.17 2001/12/19 21:39:29 cph Exp $
+$Id: macros.scm,v 4.18 2001/12/20 03:46:57 cph Exp $
Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
@@ -62,7 +62,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
transform/define-rule)))
(define transform/last-reference
- (macro (name)
+ (lambda (name)
(let ((x (generate-uninterned-symbol)))
`(IF COMPILER:PRESERVE-DATA-STRUCTURES?
,name
@@ -72,27 +72,26 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
(define (transform/package names . body)
(make-syntax-closure
- (make-sequence
+ (scode/make-sequence
`(,@(map (lambda (name)
(make-definition name (make-unassigned-reference-trap)))
names)
- ,(make-combination
+ ,(scode/make-combination
(let ((block (syntax* (append body (list unspecific)))))
- (if (open-block? block)
- (open-block-components block
+ (if (scode/open-block? block)
+ (scode/open-block-components block
(lambda (names* declarations body)
- (make-lambda lambda-tag:let '() '() false
- (list-transform-negative names*
- (lambda (name)
- (memq name names)))
- declarations
- body)))
- (make-lambda lambda-tag:let '() '() false '()
- '() block)))
+ (scode/make-lambda lambda-tag:let '() '() #f
+ (list-transform-negative names*
+ (lambda (name)
+ (memq name names)))
+ declarations
+ body)))
+ (scode/make-lambda lambda-tag:let '() '() #f '() '() block)))
'())))))
(define transform/define-export
- (macro (pattern . body)
+ (lambda (pattern . body)
(parse-define-syntax pattern body
(lambda (name body)
name
@@ -102,7 +101,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
(NAMED-LAMBDA ,pattern ,@body))))))
(define transform/define-vector-slots
- (macro (class index . slots)
+ (lambda (class index . slots)
(define (loop slots n)
(if (null? slots)
'()
@@ -124,7 +123,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
`(BEGIN ,@(loop slots index)))))
(define transform/define-root-type
- (macro (type . slots)
+ (lambda (type . slots)
(let ((tag-name (symbol-append type '-TAG)))
`(BEGIN (DEFINE ,tag-name
(MAKE-VECTOR-TAG FALSE ',type FALSE))
@@ -137,7 +136,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
(DESCRIPTOR-LIST ,type ,@slots)))))))
(define transform/descriptor-list
- (macro (type . slots)
+ (lambda (type . slots)
(let ((ref-name (lambda (slot) (symbol-append type '- slot))))
`(LIST ,@(map (lambda (slot)
(if (pair? slot)
@@ -149,10 +148,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
(let-syntax
((define-type-definition
- (macro (name reserved enumeration)
+ (lambda (name reserved enumeration)
(let ((parent (symbol-append name '-TAG)))
`(DEFINE ,(symbol-append 'TRANSFORM/DEFINE- name)
- (macro (type . slots)
+ (lambda (type . slots)
(let ((tag-name (symbol-append type '-TAG)))
`(BEGIN (DEFINE ,tag-name
(MAKE-VECTOR-TAG ,',parent ',type ,',enumeration))
@@ -173,22 +172,22 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;;; Kludge to make these compile efficiently.
(define transform/make-snode
- (macro (tag . extra)
+ (lambda (tag . extra)
`((ACCESS VECTOR ,system-global-environment)
,tag FALSE '() '() FALSE ,@extra)))
(define transform/make-pnode
- (macro (tag . extra)
+ (lambda (tag . extra)
`((ACCESS VECTOR ,system-global-environment)
,tag FALSE '() '() FALSE FALSE ,@extra)))
(define transform/make-rvalue
- (macro (tag . extra)
+ (lambda (tag . extra)
`((ACCESS VECTOR ,system-global-environment)
,tag FALSE ,@extra)))
(define transform/make-lvalue
- (macro (tag . extra)
+ (lambda (tag . extra)
(let ((result (generate-uninterned-symbol)))
`(let ((,result
((ACCESS VECTOR ,system-global-environment)
@@ -230,25 +229,25 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
(* ref-index 2)
(* set-index 2))))))))))
(set! transform/define-rtl-expression
- (macro (type prefix . components)
+ (lambda (type prefix . components)
(rtl-common type prefix components
identity-procedure
'RTL:EXPRESSION-TYPES)))
(set! transform/define-rtl-statement
- (macro (type prefix . components)
+ (lambda (type prefix . components)
(rtl-common type prefix components
(lambda (expression) `(STATEMENT->SRTL ,expression))
'RTL:STATEMENT-TYPES)))
(set! transform/define-rtl-predicate
- (macro (type prefix . components)
+ (lambda (type prefix . components)
(rtl-common type prefix components
(lambda (expression) `(PREDICATE->PRTL ,expression))
'RTL:PREDICATE-TYPES))))
(define transform/define-rule
- (macro (type pattern . body)
+ (lambda (type pattern . body)
(parse-rule pattern body
(lambda (pattern variables qualifier actions)
`(,(case type
@@ -263,15 +262,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;;;; Lap instruction sequences.
(define transform/lap
- (macro some-instructions
+ (lambda some-instructions
(list 'QUASIQUOTE some-instructions)))
(define transform/inst-ea
- (macro (ea)
+ (lambda (ea)
(list 'QUASIQUOTE ea)))
(define transform/define-enumeration
- (macro (name elements)
+ (lambda (name elements)
(let ((enumeration (symbol-append name 'S)))
`(BEGIN (DEFINE ,enumeration
(MAKE-ENUMERATION ',elements))
@@ -307,7 +306,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
body)))))
(define transform/enumeration-case
- (macro (name expression . clauses)
+ (lambda (name expression . clauses)
(macros/case-macro expression
clauses
(lambda (expression element)
@@ -317,7 +316,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
'()))))
(define transform/cfg-node-case
- (macro (expression . clauses)
+ (lambda (expression . clauses)
(macros/case-macro expression
clauses
(lambda (expression element)
--
2.25.1