Don't close the identifier of a definition.

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index 86507f718050b1ad951cd811d645e3410b0ce4b9..97275ce0351183a4658edb97e048b68f2c98485b 100644 (file)
--- 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 9e83474e876fb635b44bfb10eb0d55e09e8f5f3d..8ffe3249aff6311f108393e6136cf216b2207147 100644 (file)
--- 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 43c6e714e585aa215177cd9fa18d66572ba3c082..8d0d823e6586dd600999f7b4052185087c4d11fa 100644 (file)
--- 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 3e7fb6c1985819fb686e10039a6ff8a406677d1e..fae1a521eab5d391c3f2264c2ba2780971159d5a 100644 (file)
--- 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 f741fc6ab5afe6a988d0edc3e584c56d0d286c15..f1081e1f8a21f5b7e40f85ee59820234ae3d652d 100644 (file)
--- 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 21f26fb6b5edf4882655eab1933f5da8a495b7a9..8cbf2fcd30077e62b763d82b61c8cd8df4f95f95 100644 (file)
--- 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 aa52cd6c15e6300714be14ee80eaef6261349baa..25532b17cbfdb90da40c26767e1ec5587c87bcd4 100644 (file)
--- 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 9af6ceca3d1fcc36b03c67359298eeeb3e9e84e0..4b0ce303621e7772bff33b46972f3031a0173329 100644 (file)
--- 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 209df3ad764fbb11a6177ded5175a3f495d5c5b3..902639f9dcb9eb912774a4add063ab6adfe21fe3 100644 (file)
--- 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)