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

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

diff --git a/v7/src/6001/arith.scm b/v7/src/6001/arith.scm
index 7516535f1..7acbf54f7 100644
--- a/v7/src/6001/arith.scm
+++ b/v7/src/6001/arith.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: arith.scm,v 1.9 2002/02/03 03:38:53 cph Exp $
+$Id: arith.scm,v 1.10 2002/02/09 05:56:43 cph Exp $
 
 Copyright (c) 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -48,7 +48,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)))))))
@@ -82,7 +82,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	(lambda (form environment)
 	  (let ((flo:op (close-syntax (list-ref form 2) environment))
 		(int: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)
@@ -197,7 +197,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:->FLONUM
 		   (,operator ,(flo->int 'N)
@@ -229,7 +229,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/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 55efaeb5c..efc143af6 100644
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: buffer.scm,v 1.185 2002/02/03 03:38:53 cph Exp $
+;;; $Id: buffer.scm,v 1.186 2002/02/09 05:55:05 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2002 Massachusetts Institute of Technology
 ;;;
@@ -49,8 +49,7 @@
       (sc-macro-transformer
        (lambda (form environment)
 	 (let ((slot-name (cadr form)))
-	   `(DEFINE-INTEGRABLE
-	      ,(close-syntax (symbol-append 'BUFFER- slot-name) environment)
+	   `(DEFINE-INTEGRABLE ,(symbol-append 'BUFFER- slot-name)
 	      ,(close-syntax (symbol-append 'BUFFER-% slot-name)
 			     environment)))))))
   (rename name)
diff --git a/v7/src/edwin/calias.scm b/v7/src/edwin/calias.scm
index 1d12c7159..b30510802 100644
--- a/v7/src/edwin/calias.scm
+++ b/v7/src/edwin/calias.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: calias.scm,v 1.24 2002/02/03 03:38:54 cph Exp $
+;;; $Id: calias.scm,v 1.25 2002/02/09 05:55:09 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2002 Massachusetts Institute of Technology
 ;;;
@@ -258,9 +258,9 @@
 (let-syntax ((make-key
 	      (sc-macro-transformer
 	       (lambda (form environment)
-		 (let ((name (close-syntax (cadr form) environment)))
-		   `(DEFINE ,name
-		      (INTERN-SPECIAL-KEY ',name 0)))))))
+		 environment
+		 `(DEFINE ,(cadr form)
+		    (INTERN-SPECIAL-KEY ',(cadr form) 0))))))
   (make-key backspace)
   (make-key stop)
   (make-key f1)
diff --git a/v7/src/edwin/dosproc.scm b/v7/src/edwin/dosproc.scm
index 69dfff0f4..e823f6fdd 100644
--- a/v7/src/edwin/dosproc.scm
+++ b/v7/src/edwin/dosproc.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: dosproc.scm,v 1.8 2002/02/03 03:38:54 cph Exp $
+;;; $Id: dosproc.scm,v 1.9 2002/02/09 05:55:12 cph Exp $
 ;;;
 ;;; Copyright (c) 1992-2002 Massachusetts Institute of Technology
 ;;;
@@ -45,8 +45,8 @@
 (let-syntax ((define-process-operation
 	      (sc-macro-transformer
 	       (lambda (form environment)
-		 (let ((name (close-syntax (cadr form) environment)))
-		   `(DEFINE ,name (PROCESS-OPERATION ',name)))))))
+		 environment
+		 `(DEFINE ,(cadr form) (PROCESS-OPERATION ',(cadr form)))))))
   (define-process-operation delete-process))
 
 (define (process-status-changes?)
diff --git a/v7/src/edwin/macros.scm b/v7/src/edwin/macros.scm
index 0384697e2..94407483e 100644
--- a/v7/src/edwin/macros.scm
+++ b/v7/src/edwin/macros.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: macros.scm,v 1.71 2002/02/03 03:38:54 cph Exp $
+;;; $Id: macros.scm,v 1.72 2002/02/09 05:55:16 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 ;;;
@@ -27,38 +27,32 @@
 (define edwin-syntax-table (->environment '(EDWIN)))
 
 (define-syntax define-command
-  (sc-macro-transformer
+  (rsc-macro-transformer
    (lambda (form environment)
      (capture-syntactic-environment
-      (lambda (closing-environment)
+      (lambda (instance-environment)
 	(if (syntax-match? '(SYMBOL EXPRESSION EXPRESSION EXPRESSION)
 			   (cdr form))
 	    (let ((name (list-ref form 1))
-		  (description (close-syntax (list-ref form 2) environment))
+		  (description (list-ref form 2))
 		  (interactive (list-ref form 3))
 		  (procedure (list-ref form 4)))
-	      (let ((scheme-name
-		     (close-syntax (command-name->scheme-name name)
-				   environment)))
-		`(DEFINE ,scheme-name
-		   (MAKE-COMMAND ',name
-				 ,description
-				 ,(if (null? interactive)
-				      `'()
-				      (close-syntax interactive environment))
-				 ,(close-syntax
-				   (if (and (pair? procedure)
-					    (identifier=? environment
-							  (car procedure)
-							  closing-environment
-							  'LAMBDA)
-					    (pair? (cdr procedure)))
-				       `(,(close-syntax 'NAMED-LAMBDA
-							closing-environment)
-					 (,scheme-name ,@(cadr procedure))
-					 ,@(cddr procedure))
-				       procedure)
-				   environment)))))
+	      (let ((scheme-name (command-name->scheme-name name)))
+		`(,(close-syntax 'DEFINE environment)
+		  ,scheme-name
+		   (,(close-syntax 'MAKE-COMMAND environment)
+		    ',name
+		    ,description
+		    ,interactive
+		    ,(if (and (pair? procedure)
+			      (identifier=?
+			       instance-environment (car procedure)
+			       environment 'LAMBDA)
+			      (pair? (cdr procedure)))
+			 `(,(close-syntax 'NAMED-LAMBDA environment)
+			   (,scheme-name ,@(cadr procedure))
+			   ,@(cddr procedure))
+			 procedure)))))
 	    (ill-formed-syntax form)))))))
 
 (define-syntax ref-command-object
@@ -91,32 +85,27 @@
 	 (ill-formed-syntax form)))))
 
 (define-syntax define-variable
-  (sc-macro-transformer
+  (rsc-macro-transformer
    (lambda (form environment)
      (expand-variable-definition form environment `#F))))
 
 (define-syntax define-variable-per-buffer
-  (sc-macro-transformer
+  (rsc-macro-transformer
    (lambda (form environment)
      (expand-variable-definition form environment `#T))))
 
 (define (expand-variable-definition form environment buffer-local?)
   (if (and (syntax-match? '(SYMBOL + EXPRESSION) (cdr form))
 	   (<= (length form) 6))
-      `(DEFINE ,(close-syntax (variable-name->scheme-name (list-ref form 1))
-			      environment)
-	 (MAKE-VARIABLE ',(list-ref form 1)
-			,(close-syntax (list-ref form 2) environment)
-			,(if (> (length form) 3)
-			     (close-syntax (list-ref form 3) environment)
-			     '#F)
-			,buffer-local?
-			,(if (> (length form) 4)
-			     (close-syntax (list-ref form 4) environment)
-			     '#F)
-			,(if (> (length form) 5)
-			     (close-syntax (list-ref form 5) environment)
-			     '#F)))
+      `(,(close-syntax 'DEFINE environment)
+	,(variable-name->scheme-name (list-ref form 1))
+	(,(close-syntax 'MAKE-VARIABLE environment)
+	 ',(list-ref form 1)
+	 ,(list-ref form 2)
+	 ,(if (> (length form) 3) (list-ref form 3) '#F)
+	 ,buffer-local?
+	 ,(if (> (length form) 4) (list-ref form 4) '#F)
+	 ,(if (> (length form) 5) (list-ref form 5) '#F)))
       (ill-formed-syntax form)))
 
 (define-syntax ref-variable-object
@@ -180,8 +169,7 @@
        (if (syntax-match? pattern (cdr form))
 	   (let ((name (list-ref form 1))
 		 (super-mode-name (list-ref form 2)))
-	     (let ((scheme-name
-		    (close-syntax (mode-name->scheme-name name) environment)))
+	     (let ((scheme-name (mode-name->scheme-name name)))
 	       `(DEFINE ,scheme-name
 		  (MAKE-MODE ',name
 			     #T
@@ -200,7 +188,9 @@
 				(if super-mode-name
 				    `(LAMBDA (BUFFER)
 				       ((MODE-INITIALIZATION
-					 (MODE-SUPER-MODE ,scheme-name))
+					 (MODE-SUPER-MODE
+					  ,(close-syntax scheme-name
+							 environment)))
 					BUFFER)
 				       ,@(if initialization
 					     `((,initialization BUFFER))
@@ -220,7 +210,7 @@
      (lambda (form environment)
        (if (syntax-match? pattern (cdr form))
 	   (let ((name (list-ref form 1)))
-	     `(DEFINE ,(close-syntax (mode-name->scheme-name name) environment)
+	     `(DEFINE ,(mode-name->scheme-name name)
 		(MAKE-MODE ',name
 			   #F
 			   ',(or (list-ref form 2)
diff --git a/v7/src/edwin/search.scm b/v7/src/edwin/search.scm
index 314ddfb7c..967afe09f 100644
--- a/v7/src/edwin/search.scm
+++ b/v7/src/edwin/search.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;$Id: search.scm,v 1.154 2002/02/03 03:38:54 cph Exp $
+;;;$Id: search.scm,v 1.155 2002/02/09 05:55:20 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 ;;;
@@ -27,7 +27,7 @@
     ((define-search
        (sc-macro-transformer
 	(lambda (form environment)
-	  (let ((name (close-syntax (cadr form) environment))
+	  (let ((name (cadr form))
 		(find-next (close-syntax (caddr form) environment)))
 	    `(DEFINE (,name GROUP START END CHAR)
 	       ;; Assume (FIX:<= START END)
@@ -65,7 +65,7 @@
     ((define-search
        (sc-macro-transformer
 	(lambda (form environment)
-	  (let ((name (close-syntax (cadr form) environment))
+	  (let ((name (cadr form))
 		(find-previous (close-syntax (caddr form) environment)))
 	    `(DEFINE (,name GROUP START END CHAR)
 	       ;; Assume (FIX:<= START END)
diff --git a/v7/src/edwin/tterm.scm b/v7/src/edwin/tterm.scm
index 7136eca55..f7908f770 100644
--- a/v7/src/edwin/tterm.scm
+++ b/v7/src/edwin/tterm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: tterm.scm,v 1.33 2002/02/03 03:38:54 cph Exp $
+$Id: tterm.scm,v 1.34 2002/02/09 05:55:25 cph Exp $
 
 Copyright (c) 1990-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -445,10 +445,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	      (sc-macro-transformer
 	       (lambda (form environment)
 		 (let ((name (cadr form)))
-		   `(DEFINE-INTEGRABLE
-		      (,(close-syntax (symbol-append 'SCREEN- name)
-				      environment)
-		       SCREEN)
+		   `(DEFINE-INTEGRABLE (,(symbol-append 'SCREEN- name) SCREEN)
 		      (,(close-syntax (symbol-append 'TERMINAL-STATE/ name)
 				      environment)
 		       (SCREEN-STATE SCREEN)))))))
@@ -458,10 +455,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 		 (let ((name (cadr form)))
 		   (let ((param (make-synthetic-identifier name)))
 		     `(DEFINE-INTEGRABLE
-			(,(close-syntax (symbol-append 'SET-SCREEN- name '!)
-					environment)
-			 SCREEN
-			 ,param)
+			(,(symbol-append 'SET-SCREEN- name '!) SCREEN ,param)
 			(,(close-syntax
 			   (symbol-append 'SET-TERMINAL-STATE/ name '!)
 			   environment)
diff --git a/v7/src/edwin/xcom.scm b/v7/src/edwin/xcom.scm
index 0a5b31d12..32b891185 100644
--- a/v7/src/edwin/xcom.scm
+++ b/v7/src/edwin/xcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: xcom.scm,v 1.20 2002/02/03 03:38:55 cph Exp $
+;;; $Id: xcom.scm,v 1.21 2002/02/09 05:55:29 cph Exp $
 ;;;
 ;;; Copyright (c) 1989-2002 Massachusetts Institute of Technology
 ;;;
@@ -313,9 +313,7 @@ When called interactively, completion is available on the input."
       (sc-macro-transformer
        (lambda (form environment)
 	 (let ((name (cadr form)))
-	   `(DEFINE
-	      ,(close-syntax (symbol-append 'EDWIN-COMMAND$X- name)
-			     environment)
+	   `(DEFINE ,(symbol-append 'EDWIN-COMMAND$X- name)
 	      ,(close-syntax (symbol-append 'EDWIN-COMMAND$ name)
 			     environment)))))))
   (copy set-foreground-color)
@@ -347,9 +345,7 @@ When called interactively, completion is available on the input."
       (sc-macro-transformer
        (lambda (form environment)
 	 (let ((name (cadr form)))
-	   `(DEFINE
-	      ,(close-syntax (symbol-append 'EDWIN-VARIABLE$X-SCREEN- name)
-			     environment)
+	   `(DEFINE ,(symbol-append 'EDWIN-VARIABLE$X-SCREEN- name)
 	      ,(close-syntax (symbol-append 'EDWIN-VARIABLE$FRAME- name)
 			     environment)))))))
   (copy icon-name-format)