Change references to LOCAL-ASSIGNMENT and LEXICAL-* to instead use

procedures in the environment abstraction.

diff --git a/v7/src/compiler/etc/disload.scm b/v7/src/compiler/etc/disload.scm
index 20f167f9c642ed840c8a77f10d939bcff3712772..ca325fde6cdeec3f94ab496ee07d7ef50a5d091f 100644 (file)
--- a/v7/src/compiler/etc/disload.scm
+++ b/v7/src/compiler/etc/disload.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: disload.scm,v 1.9 2001/08/09 03:06:55 cph Exp $
+$Id: disload.scm,v 1.10 2001/12/19 01:49:45 cph Exp $
 
 Copyright (c) 1993, 1999, 2001 Massachusetts Institute of Technology
 
@@ -50,7 +50,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
            (link-variables disenv name compinfo name))
 
          (if (not (environment-bound? parenv 'addressing-granularity))
-             (local-assignment
+             (environment-define
               parenv
               'addressing-granularity
               (if (default-object? addressing-granularity)

diff --git a/v7/src/edwin/autold.scm b/v7/src/edwin/autold.scm
index 20a114e8654b9d645791719500b7ba8498a65332..e93d216f79bae8d1b374ad73dfafca683721f033 100644 (file)
--- a/v7/src/edwin/autold.scm
+++ b/v7/src/edwin/autold.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;$Id: autold.scm,v 1.60 2001/12/18 22:17:19 cph Exp $
+;;;$Id: autold.scm,v 1.61 2001/12/19 01:45:49 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
@@ -47,11 +47,11 @@
 
 (define (define-autoload-procedure name package library-name)
   (let ((environment (->environment package)))
-    (local-assignment environment
-                     name
-                     (make-autoloading-procedure
-                      library-name
-                      (lambda () (lexical-reference environment name))))))
+    (environment-define environment
+                       name
+                       (make-autoloading-procedure
+                        library-name
+                        (lambda () (environment-lookup environment name))))))
 
 (define (define-autoload-major-mode name super-mode-name display-name
          library-name description)
@@ -62,9 +62,9 @@
               (make-autoloading-procedure library-name
                                           (lambda ()
                                             (mode-initialization mode)))))
-  (local-assignment (->environment '(EDWIN))
-                   (mode-name->scheme-name name)
-                   mode)
+  (environment-define (->environment '(EDWIN))
+                     (mode-name->scheme-name name)
+                     mode)
   name)
 
 (define (define-autoload-minor-mode name display-name library-name description)
@@ -73,9 +73,9 @@
               (make-autoloading-procedure library-name
                                           (lambda ()
                                             (mode-initialization mode)))))
-  (local-assignment (->environment '(EDWIN))
-                   (mode-name->scheme-name name)
-                   mode)
+  (environment-define (->environment '(EDWIN))
+                     (mode-name->scheme-name name)
+                     mode)
   name)
 
 (define (autoloading-mode? mode)
@@ -87,9 +87,9 @@
                  (make-autoloading-procedure library-name
                                              (lambda ()
                                                (command-procedure command)))))
-  (local-assignment (->environment '(EDWIN))
-                   (command-name->scheme-name name)
-                   command)
+  (environment-define (->environment '(EDWIN))
+                     (command-name->scheme-name name)
+                     command)
   name)
 
 (define (autoloading-command? command)

diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm
index c8662ee13b61236cc60df8d467bc06e0d598b611..7d8eafff369f1a5ec40777fd39ad61b04b60399f 100644 (file)
--- a/v7/src/edwin/debug.scm
+++ b/v7/src/edwin/debug.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: debug.scm,v 1.56 2001/03/21 19:25:22 cph Exp $
+;;; $Id: debug.scm,v 1.57 2001/12/19 01:45:58 cph Exp $
 ;;;
 ;;; Copyright (c) 1992-2001 Massachusetts Institute of Technology
 ;;;
@@ -1630,15 +1630,13 @@ once it has been renamed, it will not be deleted automatically.")
           (debugger-newline port)
           (for-each (lambda (name)
                       (myprint-binding name
-                                       (environment-lookup environment name)
+                                       (safe-lookup environment name)
                                        port))
             names))))
     (cond ((null? names)
           (write-string " has no bindings" port))
          ((and package
-               (let ((limit
-                      (ref-variable
-                       environment-package-limit)))
+               (let ((limit (ref-variable environment-package-limit)))
                  (and limit
                       (let ((n (length names)))
                         (and (>= n limit)
@@ -1658,6 +1656,11 @@ once it has been renamed, it will not be deleted automatically.")
   (write-string
    "---------------------------------------------------------------------"
    port))
+
+(define (safe-lookup environment name)
+  (if (environment-assigned? environment name)
+      (environment-lookup environment name)
+      (make-unassigned-reference-trap)))
 \f
 ;;;This does some stuff who's end product is to pp the bindings
 (define (myprint-binding name value port)
@@ -1765,7 +1768,7 @@ once it has been renamed, it will not be deleted automatically.")
                           (if (environment-bound? env name)
                               (print-binding-with-ind
                                name
-                               (environment-lookup env name)
+                               (safe-lookup env name)
                                "  "
                                port)
                               (loop (environment-parent env)))))
@@ -1825,7 +1828,7 @@ once it has been renamed, it will not be deleted automatically.")
             (for-each (lambda (name)
                         (print-binding-with-ind
                          name
-                         (environment-lookup environment name)
+                         (safe-lookup environment name)
                          ind
                          port))
                       names))))

diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index 1ac9ad8cd2e47c2c7a9ba6bd9ca4f72a0773aa49..8652439f334f2ebf9acd8f13a5c60a3c2d0cc1c6 100644 (file)
--- a/v7/src/edwin/evlcom.scm
+++ b/v7/src/edwin/evlcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: evlcom.scm,v 1.63 2000/03/23 03:19:09 cph Exp $
+;;; $Id: evlcom.scm,v 1.64 2001/12/19 01:46:03 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-2001 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
@@ -16,7 +16,8 @@
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; Evaluation Commands
 ;;; Package: (edwin)
@@ -393,14 +394,15 @@ Has no effect if evaluate-in-inferior-repl is false."
          ((syntax-table? syntax-table)
           syntax-table)
          ((symbol? syntax-table)
-          (or (and (not (lexical-unreferenceable? environment syntax-table))
+          (or (and (environment-bound? environment syntax-table)
+                   (environment-assigned? environment syntax-table)
                    (let ((syntax-table
-                          (lexical-reference environment syntax-table)))
+                          (environment-lookup environment syntax-table)))
                      (and (syntax-table? syntax-table)
                           syntax-table)))
-              (editor-error "Undefined syntax table: " syntax-table)))
+              (editor-error "Undefined syntax table" syntax-table)))
          (else
-          (editor-error "Illegal syntax table: " syntax-table)))))
+          (editor-error "Illegal syntax table" syntax-table)))))
 \f
 (define-variable run-light
   "Scheme run light.  Not intended to be modified by users.

diff --git a/v7/src/edwin/macros.scm b/v7/src/edwin/macros.scm
index bb92fa91f6c4930e1b0cb3f3e1f2fd53aa4c97f0..e89ecc6b5f8abff70811740bedfac5ad6e180642 100644 (file)
--- a/v7/src/edwin/macros.scm
+++ b/v7/src/edwin/macros.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: macros.scm,v 1.66 2001/12/18 21:35:11 cph Exp $
+;;; $Id: macros.scm,v 1.67 2001/12/19 01:46:08 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -65,10 +65,9 @@
 (syntax-table/define edwin-environment 'COMMAND-DEFINED?
   (lambda (name)
     (let ((variable-name (command-name->scheme-name (canonicalize-name name))))
-      `(let ((env (->environment '(EDWIN))))
-        (and (environment-bound? env ',variable-name)
-             (not (lexical-unassigned? env
-                                       ',variable-name)))))))
+      `(LET ((_ENV (->ENVIRONMENT '(EDWIN))))
+        (AND (ENVIRONMENT-BOUND? _ENV ',variable-name)
+             (ENVIRONMENT-ASSIGNED? _ENV ',variable-name))))))
 
 (define (command-name->scheme-name name)
   (symbol-append 'EDWIN-COMMAND$ name))

diff --git a/v7/src/swat/scheme/load.scm b/v7/src/swat/scheme/load.scm
index 155442d1626ceca8ff6240d5662b0383e8a0a11b..25f48f42a5805e91a9641fe4d59a92b4748459ef 100644 (file)
--- a/v7/src/swat/scheme/load.scm
+++ b/v7/src/swat/scheme/load.scm
@@ -27,7 +27,7 @@
   (package/add-child!  (find-package '())  'SWAT  swat-env)
 
   (for-each (lambda (export)
-             (local-assignment swat-env export 'UNASSIGNED)
+             (environment-define swat-env export 'UNASSIGNED)
              (link-variables (package/environment (find-package '())) export
                              swat-env export))
     ;; All of SWAT's exported names.  This list need pruning

diff --git a/v7/src/xml/compile.scm b/v7/src/xml/compile.scm
index 562108853e534a4d254034fb9dd9b6c0ed3f956e..b9e8217a4d77ff1196ebf1bcf667bae680438e3a 100644 (file)
--- a/v7/src/xml/compile.scm
+++ b/v7/src/xml/compile.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: compile.scm,v 1.7 2001/11/09 21:37:10 cph Exp $
+;;; $Id: compile.scm,v 1.8 2001/12/19 01:48:38 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -24,9 +24,9 @@
 (load-option 'SOS)
 
 (if (not (environment-bound? system-global-environment 'XML-PARSER-MACROS))
-    (local-assignment system-global-environment
-                     'XML-PARSER-MACROS
-                     (make-parser-macros #f)))
+    (environment-define system-global-environment
+                       'XML-PARSER-MACROS
+                       (make-parser-macros #f)))
 
 (with-working-directory-pathname (directory-pathname (current-load-pathname))
   (lambda ()