From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 9 Feb 2002 06:10:11 +0000 (+0000)
Subject: Don't close the identifier of a definition.
X-Git-Tag: 20090517-FFI~2260
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dd0acaa099257ebaea8fc527925847a268c8f571;p=mit-scheme.git

Don't close the identifier of a definition.
---

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index 86507f718..97275ce03 100644
--- a/v7/src/runtime/arith.scm
+++ b/v7/src/runtime/arith.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: arith.scm,v 1.49 2002/02/03 03:38:55 cph Exp $
+$Id: arith.scm,v 1.50 2002/02/09 06:09:39 cph Exp $
 
 Copyright (c) 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -149,7 +149,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	 (lambda (form environment)
 	   (let ((name (list-ref form 1))
 		 (identity (close-syntax (list-ref form 3) environment)))
-	     `(SET! ,name
+	     `(SET! ,(close-syntax name environment)
 		    (MAKE-ENTITY
 		     (NAMED-LAMBDA (,name SELF . ZS)
 		       SELF		; ignored
@@ -174,7 +174,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	(sc-macro-transformer
 	 (lambda (form environment)
 	   (let ((name (list-ref form 1)))
-	     `(SET! ,name
+	     `(SET! ,(close-syntax name environment)
 		    (MAKE-ENTITY
 		     (NAMED-LAMBDA (,name SELF Z1 . ZS)
 		       SELF		; ignored
@@ -198,7 +198,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	 (lambda (form environment)
 	   (let ((name (list-ref form 1))
 		 (type (list-ref form 4)))
-	     `(SET! ,name
+	     `(SET! ,(close-syntax name environment)
 		    (MAKE-ENTITY
 		     (NAMED-LAMBDA (,name SELF . ZS)
 		       SELF		; ignored
@@ -232,7 +232,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	 (lambda (form environment)
 	   (let ((name (list-ref form 1))
 		 (generic-binary (close-syntax (list-ref form 2) environment)))
-	     `(SET! ,name
+	     `(SET! ,(close-syntax name environment)
 		    (MAKE-ENTITY
 		     (NAMED-LAMBDA (,name SELF X . XS)
 		       SELF		; ignored
@@ -537,7 +537,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
     ((define-addition-operator
        (sc-macro-transformer
 	(lambda (form environment)
-	  (let ((name (close-syntax (list-ref form 1) environment))
+	  (let ((name (list-ref form 1))
 		(int:op (close-syntax (list-ref form 2) environment)))
 	    `(DEFINE (,name U/U* V/V*)
 	       (RAT:BINARY-OPERATOR U/U* V/V*
@@ -700,7 +700,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
     ((define-integer-coercion
        (sc-macro-transformer
 	(lambda (form environment)
-	  `(DEFINE (,(close-syntax (list-ref form 1) environment) Q)
+	  `(DEFINE (,(list-ref form 1) Q)
 	     (COND ((RATNUM? Q)
 		    (,(close-syntax (list-ref form 3) environment)
 		     (RATNUM-NUMERATOR Q)
@@ -956,7 +956,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
     ((define-standard-unary
        (sc-macro-transformer
 	(lambda (form environment)
-	  `(DEFINE (,(close-syntax (list-ref form 1) environment) X)
+	  `(DEFINE (,(list-ref form 1) X)
 	     (IF (FLONUM? X)
 		 (,(close-syntax (list-ref form 2) environment) X)
 		 (,(close-syntax (list-ref form 3) environment) X)))))))
@@ -987,7 +987,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	(lambda (form environment)
 	  (let ((flo:op (close-syntax (list-ref form 2) environment))
 		(rat:op (close-syntax (list-ref form 3) environment)))
-	    `(DEFINE (,(close-syntax (list-ref form 1) environment) X Y)
+	    `(DEFINE (,(list-ref form 1) X Y)
 	       (IF (FLONUM? X)
 		   (IF (FLONUM? Y)
 		       (,flo:op X Y)
@@ -1079,7 +1079,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 		       (FLO:->INTEGER ,n)
 		       (ERROR:WRONG-TYPE-ARGUMENT ,n "integer"
 						  ',(list-ref form 2))))))
-	   `(DEFINE (,(close-syntax (list-ref form 1) environment) N M)
+	   `(DEFINE (,(list-ref form 1) N M)
 	      (IF (FLONUM? N)
 		  (INT:->INEXACT
 		   (,operator ,(flo->int 'N)
@@ -1104,7 +1104,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
       (sc-macro-transformer
        (lambda (form environment)
 	 (let ((operator (close-syntax (list-ref form 2) environment)))
-	   `(DEFINE (,(close-syntax (list-ref form 1) environment) Q)
+	   `(DEFINE (,(list-ref form 1) Q)
 	      (IF (FLONUM? Q)
 		  (RAT:->INEXACT (,operator (FLO:->RATIONAL Q)))
 		  (,operator Q))))))))
@@ -1115,7 +1115,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
     ((define-transcendental-unary
       (sc-macro-transformer
        (lambda (form environment)
-	 `(DEFINE (,(close-syntax (list-ref form 1) environment) X)
+	 `(DEFINE (,(list-ref form 1) X)
 	    (IF (,(close-syntax (list-ref form 2) environment) X)
 		,(close-syntax (list-ref form 3) environment)
 		(,(close-syntax (list-ref form 4) environment)
diff --git a/v7/src/runtime/graphics.scm b/v7/src/runtime/graphics.scm
index 9e83474e8..8ffe3249a 100644
--- a/v7/src/runtime/graphics.scm
+++ b/v7/src/runtime/graphics.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: graphics.scm,v 1.20 2002/02/03 03:38:55 cph Exp $
+$Id: graphics.scm,v 1.21 2002/02/09 06:09:43 cph Exp $
 
 Copyright (c) 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -257,9 +257,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (lambda (form environment)
 	 (let ((name (cadr form)))
 	   `(DEFINE-INTEGRABLE
-	      (,(close-syntax (symbol-append 'GRAPHICS-DEVICE/OPERATION/ name)
-			      environment)
-	       DEVICE)
+	      (,(symbol-append 'GRAPHICS-DEVICE/OPERATION/ name) DEVICE)
 	      (,(close-syntax (symbol-append 'GRAPHICS-DEVICE-TYPE/OPERATION/
 					     name)
 			      environment)
diff --git a/v7/src/runtime/infstr.scm b/v7/src/runtime/infstr.scm
index 43c6e714e..8d0d823e6 100644
--- a/v7/src/runtime/infstr.scm
+++ b/v7/src/runtime/infstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: infstr.scm,v 1.14 2002/02/03 03:38:55 cph Exp $
+$Id: infstr.scm,v 1.15 2002/02/09 06:09:47 cph Exp $
 
 Copyright (c) 1988-2002 Massachusetts Institute of Technology
 
@@ -155,7 +155,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
       (sc-macro-transformer
        (lambda (form environment)
 	 (let ((symbol (symbol-append 'DBG-BLOCK-NAME/ (cadr form))))
-	   `(DEFINE-INTEGRABLE ,(close-syntax symbol environment)
+	   `(DEFINE-INTEGRABLE ,symbol
 	      ',((ucode-primitive string->symbol)
 		 (string-append "#[(runtime compiler-info)"
 				(string-downcase (symbol-name symbol))
diff --git a/v7/src/runtime/parse.scm b/v7/src/runtime/parse.scm
index 3e7fb6c19..fae1a521e 100644
--- a/v7/src/runtime/parse.scm
+++ b/v7/src/runtime/parse.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: parse.scm,v 14.36 2002/02/03 03:38:56 cph Exp $
+$Id: parse.scm,v 14.37 2002/02/09 06:09:51 cph Exp $
 
 Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -281,13 +281,13 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
      (let ((offset (cadr form))
 	   (param-list (caddr form))
 	   (body (cdddr form)))
-       `(DEFINE ,(map (lambda (name)
-			(close-syntax name environment))
-		      param-list)
+       `(DEFINE ,param-list
 	  (LET ((CORE
 		 (LAMBDA ()
 		   ,@(map (lambda (expression)
-			    (close-syntax expression environment))
+			    (make-syntactic-closure environment
+				(cdr param-list)
+			      expression))
 			  body))))
 	    (IF *PARSER-ASSOCIATE-POSITIONS?*
 		(RECORDING-OBJECT-POSITION ,offset CORE)
diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index f741fc6ab..f1081e1f8 100644
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.22 2002/02/03 03:38:56 cph Exp $
+$Id: port.scm,v 1.23 2002/02/09 06:09:55 cph Exp $
 
 Copyright (c) 1991-2002 Massachusetts Institute of Technology
 
@@ -194,9 +194,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	(lambda (form environment)
 	  (let ((dir (cadr form))
 		(name (caddr form)))
-	    `(DEFINE (,(close-syntax (symbol-append dir '-PORT/OPERATION/ name)
-				     environment)
-		      PORT)
+	    `(DEFINE (,(symbol-append dir '-PORT/OPERATION/ name) PORT)
 	       (,(close-syntax (symbol-append 'PORT-TYPE/ name) environment)
 		(PORT/TYPE PORT))))))))
   (define-port-operation input char-ready?)
diff --git a/v7/src/runtime/rgxcmp.scm b/v7/src/runtime/rgxcmp.scm
index 21f26fb6b..8cbf2fcd3 100644
--- a/v7/src/runtime/rgxcmp.scm
+++ b/v7/src/runtime/rgxcmp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rgxcmp.scm,v 1.119 2002/02/03 03:38:56 cph Exp $
+;;; $Id: rgxcmp.scm,v 1.120 2002/02/09 06:09:59 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2002 Massachusetts Institute of Technology
 ;;;
@@ -36,8 +36,7 @@
 	  ,@(let loop ((n 0) (suffixes suffixes))
 	      (if (pair? suffixes)
 		  (cons `(DEFINE-INTEGRABLE
-			   ,(close-syntax (symbol-append prefix (car suffixes))
-					  environment)
+			   ,(symbol-append prefix (car suffixes))
 			   ,n)
 			(loop (+ n 1) (cdr suffixes)))
 		  '()))
diff --git a/v7/src/runtime/starbase.scm b/v7/src/runtime/starbase.scm
index aa52cd6c1..25532b17c 100644
--- a/v7/src/runtime/starbase.scm
+++ b/v7/src/runtime/starbase.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: starbase.scm,v 1.16 2002/02/03 03:38:56 cph Exp $
+$Id: starbase.scm,v 1.17 2002/02/09 06:10:03 cph Exp $
 
 Copyright (c) 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -110,17 +110,13 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (lambda (form environment)
 	 (let ((name (cadr form)))
 	   `(BEGIN
-	      (DEFINE (,(close-syntax (symbol-append 'STARBASE-DEVICE/ name)
-				      environment)
-		       DEVICE)
+	      (DEFINE (,(symbol-append 'STARBASE-DEVICE/ name) DEVICE)
 		(,(close-syntax
 		   (symbol-append 'STARBASE-GRAPHICS-DESCRIPTOR/ name)
 		   environment)
 		 (GRAPHICS-DEVICE/DESCRIPTOR DEVICE)))
-	      (DEFINE (,(close-syntax
-			 (symbol-append 'SET-STARBASE-DEVICE/ name '!)
-			 environment)
-		       DEVICE VALUE)
+	      (DEFINE
+		(,(symbol-append 'SET-STARBASE-DEVICE/ name '!) DEVICE VALUE)
 		(,(close-syntax
 		   (symbol-append 'SET-STARBASE-GRAPHICS-DESCRIPTOR/ name '!)
 		   environment)
diff --git a/v7/src/runtime/sysmac.scm b/v7/src/runtime/sysmac.scm
index 9af6ceca3..4b0ce3036 100644
--- a/v7/src/runtime/sysmac.scm
+++ b/v7/src/runtime/sysmac.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: sysmac.scm,v 14.8 2002/02/03 03:38:57 cph Exp $
+$Id: sysmac.scm,v 14.9 2002/02/09 06:10:07 cph Exp $
 
 Copyright (c) 1988, 1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -30,7 +30,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
    (lambda (form environment)
      (let ((primitive-definition
 	    (lambda (variable-name primitive-args)
-	      `(DEFINE-INTEGRABLE ,(close-syntax variable-name environment)
+	      `(DEFINE-INTEGRABLE ,variable-name
 		 ,(apply make-primitive-procedure primitive-args)))))
        `(BEGIN ,@(map (lambda (name)
 			(cond ((not (pair? name))
diff --git a/v7/src/runtime/vector.scm b/v7/src/runtime/vector.scm
index 209df3ad7..902639f9d 100644
--- a/v7/src/runtime/vector.scm
+++ b/v7/src/runtime/vector.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: vector.scm,v 14.20 2002/02/03 03:38:57 cph Exp $
+$Id: vector.scm,v 14.21 2002/02/09 06:10:11 cph Exp $
 
 Copyright (c) 1988-2002 Massachusetts Institute of Technology
 
@@ -206,7 +206,7 @@ USA.
     ((iref
       (sc-macro-transformer
        (lambda (form environment)
-	 `(DEFINE-INTEGRABLE (,(close-syntax (cadr form) environment) VECTOR)
+	 `(DEFINE-INTEGRABLE (,(cadr form) VECTOR)
 	    (GUARANTEE-VECTOR VECTOR 'SAFE-VECTOR-REF)
 	    (VECTOR-REF VECTOR ,(caddr form)))))))
   (iref vector-first 0)