From 69e3daac96a8ff8902378e8b140766c6209712c3 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 19 Dec 2001 01:49:45 +0000 Subject: [PATCH] Change references to LOCAL-ASSIGNMENT and LEXICAL-* to instead use procedures in the environment abstraction. --- v7/src/compiler/etc/disload.scm | 4 ++-- v7/src/edwin/autold.scm | 30 +++++++++++++++--------------- v7/src/edwin/debug.scm | 17 ++++++++++------- v7/src/edwin/evlcom.scm | 16 +++++++++------- v7/src/edwin/macros.scm | 9 ++++----- v7/src/swat/scheme/load.scm | 2 +- v7/src/xml/compile.scm | 8 ++++---- 7 files changed, 45 insertions(+), 41 deletions(-) diff --git a/v7/src/compiler/etc/disload.scm b/v7/src/compiler/etc/disload.scm index 20f167f9c..ca325fde6 100644 --- 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 20a114e86..e93d216f7 100644 --- 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 c8662ee13..7d8eafff3 100644 --- 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))) ;;;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 1ac9ad8cd..8652439f3 100644 --- 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))))) (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 bb92fa91f..e89ecc6b5 100644 --- 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 155442d16..25f48f42a 100644 --- 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 562108853..b9e8217a4 100644 --- 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 () -- 2.25.1