From: Chris Hanson Date: Wed, 19 Dec 2001 05:25:43 +0000 (+0000) Subject: Excise syntax tables from the REPL. X-Git-Tag: 20090517-FFI~2358 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=786a2c20c4ecd659377445ff2ec8c14377023ff9;p=mit-scheme.git Excise syntax tables from the REPL. --- diff --git a/v7/src/6001/nodefs.scm b/v7/src/6001/nodefs.scm index 90b78f18c..e2e19ff96 100644 --- a/v7/src/6001/nodefs.scm +++ b/v7/src/6001/nodefs.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: nodefs.scm,v 1.11 1999/01/02 06:06:43 cph Exp $ +$Id: nodefs.scm,v 1.12 2001/12/19 05:23:50 cph Exp $ -Copyright (c) 1991-1999 Massachusetts Institute of Technology +Copyright (c) 1991-1999, 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 published by @@ -16,7 +16,8 @@ General Public License for more details. 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. |# ;;;; SCode rewriting for 6.001 @@ -28,10 +29,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (set! hook/repl-eval student/repl-eval) unspecific) -(define (student/repl-eval repl s-expression environment syntax-table) +(define (student/repl-eval repl s-expression environment) (repl-scode-eval repl - (rewrite-scode (syntax s-expression syntax-table) + (rewrite-scode (syntax s-expression environment) (and repl (let ((port (cmdl/port repl))) (let ((operation diff --git a/v7/src/edwin/artdebug.scm b/v7/src/edwin/artdebug.scm index 6588b8891..4e69560f3 100644 --- a/v7/src/edwin/artdebug.scm +++ b/v7/src/edwin/artdebug.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: artdebug.scm,v 1.28 1999/02/24 21:35:54 cph Exp $ +;;; $Id: artdebug.scm,v 1.29 2001/12/19 05:25:08 cph Exp $ ;;; -;;; Copyright (c) 1989-1999 Massachusetts Institute of Technology +;;; Copyright (c) 1989-1999, 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. ;;;; Continuation Browser @@ -520,7 +521,7 @@ The evaluation occurs in the dynamic state of the current frame." (fluid-let ((in-debugger-evaluation? #t) (hook/repl-eval - (lambda (expression environment syntax-table) + (lambda (expression environment) (let ((unique (cons 'unique 'id))) (let ((result (call-with-current-continuation @@ -534,8 +535,7 @@ The evaluation occurs in the dynamic state of the current frame." (lambda () (continuation* (repl-eval expression - environment - syntax-table)))))))))) + environment)))))))))) (if (and (pair? result) (eq? unique (car result))) (error (cdr result)) diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm index 42eccac7c..98e4a70da 100644 --- a/v7/src/edwin/comred.scm +++ b/v7/src/edwin/comred.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: comred.scm,v 1.122 2001/07/21 05:49:36 cph Exp $ +;;; $Id: comred.scm,v 1.123 2001/12/19 05:25:12 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology ;;; @@ -446,7 +446,7 @@ (apply (command-procedure (name->command (car entry))) (map (let ((environment (->environment '(EDWIN)))) (lambda (expression) - (eval-with-history (current-buffer) expression environment))) + (eval-with-history expression environment))) (cdr entry)))) (define (interactive-argument key prompt) diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm index 7d8eafff3..de33e7037 100644 --- a/v7/src/edwin/debug.scm +++ b/v7/src/edwin/debug.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: debug.scm,v 1.57 2001/12/19 01:45:58 cph Exp $ +;;; $Id: debug.scm,v 1.58 2001/12/19 05:25:21 cph Exp $ ;;; ;;; Copyright (c) 1992-2001 Massachusetts Institute of Technology ;;; @@ -348,11 +348,7 @@ (buffer-end buffer)) (buffer-not-modified! buffer) (if env-exists? - (start-inferior-repl! - buffer - environment - (evaluation-syntax-table buffer environment) - #f)) + (start-inferior-repl! buffer environment #f)) buffer)))))))) (define evaluation-line-marker @@ -471,8 +467,7 @@ (prompt-for-expression prompt) (if (default-object? environment) (nearest-repl/environment) - environment) - (nearest-repl/syntax-table)))))) + environment)))))) (hook/invoke-restart (lambda (continuation arguments) (invoke-continuation continuation diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm index aacba616e..6e8923a41 100644 --- a/v7/src/edwin/editor.scm +++ b/v7/src/edwin/editor.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: editor.scm,v 1.252 2001/07/21 05:49:45 cph Exp $ +;;; $Id: editor.scm,v 1.253 2001/12/19 05:25:25 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology ;;; @@ -176,7 +176,6 @@ (start-inferior-repl! buffer (nearest-repl/environment) - (nearest-repl/syntax-table) (and (not (ref-variable inhibit-startup-message)) (cmdl-message/append (cmdl-message/active diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm index 8652439f3..7613d906a 100644 --- a/v7/src/edwin/evlcom.scm +++ b/v7/src/edwin/evlcom.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: evlcom.scm,v 1.64 2001/12/19 01:46:03 cph Exp $ +;;; $Id: evlcom.scm,v 1.65 2001/12/19 05:25:29 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology ;;; @@ -44,36 +44,23 @@ If 'DEFAULT, use the default (REP loop) environment." (->environment object)))))))) (define-variable scheme-syntax-table - "The syntax table used by the evaluation commands, or #F. -If #F, use the default (REP loop) syntax-table." - #f - (lambda (object) - (or (not object) - (symbol? object) - (syntax-table? object)))) - -(let ((daemon - (lambda (buffer variable) - variable - (if buffer (normal-buffer-evaluation-mode buffer))))) - (add-variable-assignment-daemon! (ref-variable-object scheme-environment) - daemon) - (add-variable-assignment-daemon! (ref-variable-object scheme-syntax-table) - daemon)) + "This variable is obsolete and its value is ignored." + #f) + +(add-variable-assignment-daemon! (ref-variable-object scheme-environment) + (lambda (buffer variable) + variable + (if buffer (normal-buffer-evaluation-mode buffer)))) (define (normal-buffer-evaluation-mode buffer) (let ((environment (ref-variable-object scheme-environment)) - (syntax-table (ref-variable-object scheme-syntax-table)) (evaluate-inferior (ref-variable-object evaluate-in-inferior-repl)) (run-light (ref-variable-object run-light))) (if (and (not (repl-buffer? buffer)) (not (variable-local-value? buffer evaluate-inferior)) - (or (and (variable-local-value? buffer environment) - (not (eq? 'DEFAULT - (variable-local-value buffer environment)))) - (and (variable-local-value? buffer syntax-table) - (not (memq (variable-local-value buffer syntax-table) - '(#F DEFAULT)))))) + (and (variable-local-value? buffer environment) + (not (eq? 'DEFAULT + (variable-local-value buffer environment))))) (begin (define-variable-local-value! buffer evaluate-inferior #f) (if (not (variable-local-value? buffer run-light)) @@ -233,12 +220,6 @@ Has no effect if evaluate-in-inferior-repl is false." (lambda (environment) (local-set-variable! scheme-environment environment))) -(define-command set-syntax-table - "Make SYNTAX-TABLE the current syntax table." - "XSet syntax table" - (lambda (syntax-table) - (local-set-variable! scheme-syntax-table syntax-table))) - (define-command set-default-environment "Make ENVIRONMENT the default evaluation environment." "XSet default environment" @@ -246,25 +227,12 @@ Has no effect if evaluate-in-inferior-repl is false." (set-variable-default-value! (ref-variable-object scheme-environment) environment))) -(define-command set-default-syntax-table - "Make SYNTAX-TABLE the default syntax table." - "XSet default syntax table" - (lambda (syntax-table) - (set-variable-default-value! (ref-variable-object scheme-syntax-table) - syntax-table))) - (define-command set-repl-environment "Make ENVIRONMENT the environment of the nearest REP loop." "XSet REPL environment" (lambda (environment) (set-repl/environment! (nearest-repl) (->environment environment)))) -(define-command set-repl-syntax-table - "Make SYNTAX-TABLE the syntax table of the nearest REP loop." - "XSet REPL syntax table" - (lambda (syntax-table) - (set-repl/syntax-table! (nearest-repl) syntax-table))) - (define-command select-transcript-buffer "Select the transcript buffer." () @@ -275,8 +243,7 @@ Has no effect if evaluate-in-inferior-repl is false." (define (prompt-for-expression-value prompt #!optional default . options) (let ((buffer (current-buffer))) - (eval-with-history buffer - (apply prompt-for-expression + (eval-with-history (apply prompt-for-expression prompt (cond ((default-object? default) default-object-kludge) @@ -386,23 +353,6 @@ Has no effect if evaluate-in-inferior-repl is false." (non-default environment))) (nearest-repl/environment))) (non-default environment))))) - -(define (evaluation-syntax-table buffer environment) - (let ((syntax-table (ref-variable scheme-syntax-table buffer))) - (cond ((or (not syntax-table) (eq? 'DEFAULT syntax-table)) - (environment-syntax-table environment)) - ((syntax-table? syntax-table) - syntax-table) - ((symbol? syntax-table) - (or (and (environment-bound? environment syntax-table) - (environment-assigned? environment syntax-table) - (let ((syntax-table - (environment-lookup environment syntax-table))) - (and (syntax-table? syntax-table) - syntax-table))) - (editor-error "Undefined syntax table" syntax-table))) - (else - (editor-error "Illegal syntax table" syntax-table))))) (define-variable run-light "Scheme run light. Not intended to be modified by users. @@ -424,8 +374,7 @@ Set by Scheme evaluation code to update the mode line." (let ((output-string (with-output-to-string (lambda () - (set! value - (eval-with-history buffer sexp environment)) + (set! value (eval-with-history sexp environment)) unspecific)))) (let ((evaluation-output-receiver (ref-variable evaluation-output-receiver buffer))) @@ -460,12 +409,11 @@ Set by Scheme evaluation code to update the mode line." (update-screens! #f)))) (core)))) -(define (eval-with-history buffer expression environment) - (let ((syntax-table (evaluation-syntax-table buffer environment))) - (bind-condition-handler (list condition-type:error) - evaluation-error-handler - (lambda () - (hook/repl-eval #f expression environment syntax-table))))) +(define (eval-with-history expression environment) + (bind-condition-handler (list condition-type:error) + evaluation-error-handler + (lambda () + (hook/repl-eval #f expression environment)))) (define (evaluation-error-handler condition) (maybe-debug-scheme-error (ref-variable-object debug-on-evaluation-error) diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm index cbf767963..9237a8195 100644 --- a/v7/src/edwin/filcom.scm +++ b/v7/src/edwin/filcom.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: filcom.scm,v 1.222 2001/12/18 21:35:06 cph Exp $ +;;; $Id: filcom.scm,v 1.223 2001/12/19 05:25:33 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology ;;; @@ -242,17 +242,8 @@ procedures are called." (local-set-variable! scheme-environment (cadr entry) buffer) (if (and (eq? 'DEFAULT (ref-variable scheme-environment buffer)) (not (eq? 'DEFAULT (cadr entry)))) - (begin - (message "Ignoring bad evaluation environment: " - (cadr entry)) - (local-set-variable! scheme-syntax-table - 'DEFAULT - buffer)) - (local-set-variable! scheme-syntax-table - (if (pair? (cddr entry)) - (caddr entry) - 'DEFAULT) - buffer))))))) + (message "Ignoring bad evaluation environment: " + (cadr entry)))))))) (define (find-file-revert buffer) (if (verify-visited-file-modification-time? buffer) diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm index 941b8c5e2..89774d19d 100644 --- a/v7/src/edwin/intmod.scm +++ b/v7/src/edwin/intmod.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: intmod.scm,v 1.114 2001/12/18 20:50:51 cph Exp $ +;;; $Id: intmod.scm,v 1.115 2001/12/19 05:25:39 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology ;;; @@ -73,10 +73,7 @@ With two C-u's, creates a new REPL buffer with a new evaluation environment. (let ((make-new (lambda (environment) (let ((repl-buffer (new-buffer initial-buffer-name))) - (start-inferior-repl! repl-buffer - environment - (environment-syntax-table environment) - #f) + (start-inferior-repl! repl-buffer environment #f) repl-buffer)))) (if (>= argument 16) (make-new @@ -106,7 +103,7 @@ evaluated in the specified inferior REPL buffer." (lambda (repl-buffer) (set-local-repl-buffer! (current-buffer) repl-buffer))) -(define (start-inferior-repl! buffer environment syntax-table message) +(define (start-inferior-repl! buffer environment message) (set-buffer-major-mode! buffer (ref-mode-object inferior-repl)) (if (ref-variable repl-mode-locked) (buffer-put! buffer 'MAJOR-MODE-LOCKED #t)) @@ -128,7 +125,6 @@ evaluated in the specified inferior REPL buffer." (repl/start (make-repl #f port environment - syntax-table #f `((ERROR-DECISION ,error-decision)) user-initial-prompt) @@ -1116,14 +1112,6 @@ If this is an error, the debugger examines the error condition." (mark-buffer mark))) #t))) -(define (operation/set-default-syntax-table port syntax-table) - (enqueue-output-operation! port - (lambda (mark transcript?) - (if (not transcript?) - (local-set-variable! scheme-syntax-table syntax-table - (mark-buffer mark))) - #t))) - (define interface-port-type (make-port-type `((WRITE-CHAR ,operation/write-char) @@ -1140,7 +1128,6 @@ If this is an error, the debugger examines the error condition." (PROMPT-FOR-COMMAND-CHAR ,operation/prompt-for-command-char) (SET-DEFAULT-DIRECTORY ,operation/set-default-directory) (SET-DEFAULT-ENVIRONMENT ,operation/set-default-environment) - (SET-DEFAULT-SYNTAX-TABLE ,operation/set-default-syntax-table) (PEEK-CHAR ,operation/peek-char) (READ-CHAR ,operation/read-char) (READ ,operation/read) diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm index 5846e461e..7c50d7196 100644 --- a/v7/src/edwin/schmod.scm +++ b/v7/src/edwin/schmod.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: schmod.scm,v 1.54 2001/12/18 22:12:27 cph Exp $ +;;; $Id: schmod.scm,v 1.55 2001/12/19 05:25:43 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology ;;; @@ -197,7 +197,6 @@ The following commands evaluate Scheme expressions: (LIST-TRANSFORM-NEGATIVE . 1) (LIST-SEARCH-POSITIVE . 1) (LIST-SEARCH-NEGATIVE . 1) - (SYNTAX-TABLE-DEFINE . 2) (FOR-ALL? . 1) (THERE-EXISTS? . 1))) @@ -302,7 +301,7 @@ Otherwise, it is shown in the echo area." (let ((environment (evaluation-environment buffer))) (extended-scode-eval (syntax (with-input-from-region (make-region start end) read) - (evaluation-syntax-table buffer environment)) + environment) environment)))) (if (procedure? procedure) (let ((argl (procedure-argl procedure))) diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm index a8d800990..ee599ae60 100644 --- a/v7/src/runtime/error.scm +++ b/v7/src/runtime/error.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: error.scm,v 14.51 2000/01/10 03:48:33 cph Exp $ +$Id: error.scm,v 14.52 2001/12/19 05:21:37 cph Exp $ -Copyright (c) 1988-2000 Massachusetts Institute of Technology +Copyright (c) 1988-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 published by @@ -16,7 +16,8 @@ General Public License for more details. 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. |# ;;;; Error System @@ -35,12 +36,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (lambda (type port) (write-char #\space port) (write-string (%condition-type/name type) port))))) - (name false read-only true) + (name #f read-only #t) generalizations - (field-indexes false read-only true) - (number-of-fields false read-only true) - (reporter false read-only true) - (properties (make-1d-table) read-only true)) + (field-indexes #f read-only #t) + (number-of-fields #f read-only #t) + (reporter #f read-only #t) + (properties (make-1d-table) read-only #t)) (define (make-condition-type name generalization field-names reporter) (if generalization @@ -54,7 +55,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (%make-condition-type (cond ((string? name) (string-copy name)) ((symbol? name) (symbol->string name)) - ((false? name) "(anonymous)") + ((not name) "(anonymous)") (else (error:wrong-type-argument name "condition-type name" 'MAKE-CONDITION-TYPE))) @@ -66,7 +67,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (write-string reporter port))) ((procedure-of-arity? reporter 2) reporter) - ((false? reporter) + ((not reporter) (if generalization (%condition-type/reporter generalization) (lambda (condition port) @@ -97,18 +98,18 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ((field-names field-names) (index old-n-fields) (indexes (let loop ((old-indexes old-indexes) (indexes '())) - (if (null? old-indexes) - indexes + (if (pair? old-indexes) (loop (cdr old-indexes) (let ((entry (car old-indexes))) (if (memq (car entry) field-names) indexes - (cons entry indexes)))))))) - (if (null? field-names) - (values index (reverse! indexes)) + (cons entry indexes)))) + indexes)))) + (if (pair? field-names) (loop (cdr field-names) (+ index 1) - (cons (cons (car field-names) index) indexes))))))) + (cons (cons (car field-names) index) indexes)) + (values index (reverse! indexes))))))) (define (%condition-type/field-index type field-name operator) (let ((association (assq field-name (%condition-type/field-indexes type)))) @@ -132,7 +133,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (1d-table/put! (condition-type/properties type) key datum)) (define (condition-type/get type key) - (1d-table/get (condition-type/properties type) key false)) + (1d-table/get (condition-type/properties type) key #f)) ;;;; Condition Instances @@ -146,12 +147,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (write-string (%condition-type/name (%condition/type condition)) port))))) - (type false read-only true) - (continuation false read-only true) - (restarts false read-only true) - (field-values (make-vector (%condition-type/number-of-fields type) false) - read-only true) - (properties (make-1d-table) read-only true)) + (type #f read-only #t) + (continuation #f read-only #t) + (restarts #f read-only #t) + (field-values (make-vector (%condition-type/number-of-fields type) #f) + read-only #t) + (properties (make-1d-table) read-only #t)) (define (make-condition type continuation restarts field-alist) (guarantee-condition-type type 'MAKE-CONDITION) @@ -163,7 +164,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (%restarts-argument restarts 'MAKE-CONDITION)))) (let ((field-values (%condition/field-values condition))) (do ((alist field-alist (cddr alist))) - ((null? alist)) + ((not (pair? alist))) (vector-set! field-values (%condition-type/field-index type (car alist) 'MAKE-CONDITION) @@ -190,8 +191,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((values (%condition/field-values condition))) (do ((i indexes (cdr i)) (v field-values (cdr v))) - ((or (null? i) (null? v)) - (if (not (and (null? i) (null? v))) + ((or (not (pair? i)) + (not (pair? v))) + (if (or (pair? i) (pair? v)) (error:wrong-number-of-arguments constructor (+ (length indexes) 1) @@ -256,7 +258,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (1d-table/put! (condition/properties condition) key datum)) (define (condition/get condition key) - (1d-table/get (condition/properties condition) key false)) + (1d-table/get (condition/properties condition) key #f)) (define (write-condition-report condition port) (guarantee-condition condition 'WRITE-CONDITION-REPORT) @@ -287,11 +289,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if name (write name port) (write-string "(anonymous)" port))))))) - (name false read-only true) - (reporter false read-only true) - (effector false read-only true) - (interactor false) - (properties (make-1d-table) read-only true)) + (name #f read-only #t) + (reporter #f read-only #t) + (effector #f read-only #t) + (interactor #f) + (properties (make-1d-table) read-only #t)) (define (with-restart name reporter effector interactor thunk) (if name (guarantee-symbol name 'WITH-RESTART)) @@ -339,7 +341,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (restart/get restart key) (if (eq? key 'INTERACTIVE) (restart/interactor restart) - (1d-table/get (restart/properties restart) key false))) + (1d-table/get (restart/properties restart) key #f))) (define (restart/put! restart key datum) (if (eq? key 'INTERACTIVE) @@ -381,7 +383,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (continue-from-derived-thread-error condition) (let loop ((restarts (bound-restarts))) - (if (not (null? restarts)) + (if (pair? restarts) (if (and (eq? 'CONTINUE (restart/name (car restarts))) (eq? condition (restart/get (car restarts) 'ASSOCIATED-CONDITION))) @@ -392,19 +394,19 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (bound-restarts) (let loop ((restarts *bound-restarts*)) - (if (null? restarts) - '() - (cons (car restarts) (loop (cdr restarts)))))) + (if (pair? restarts) + (cons (car restarts) (loop (cdr restarts))) + '()))) (define (first-bound-restart) (let ((restarts *bound-restarts*)) - (if (null? restarts) + (if (not (pair? restarts)) (error:no-such-restart #f)) (car restarts))) (define (%find-restart name restarts) (let loop ((restarts restarts)) - (and (not (null? restarts)) + (and (pair? restarts) (if (eq? name (%restart/name (car restarts))) (car restarts) (loop (cdr restarts)))))) @@ -508,29 +510,29 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (lambda (types) (let outer ((type (car types)) (types (cdr types))) (let inner ((generalizations generalizations)) - (if (null? generalizations) - (and (not (null? types)) - (outer (car types) (cdr types))) + (if (pair? generalizations) (or (eq? type (car generalizations)) - (inner (cdr generalizations))))))))) + (inner (cdr generalizations))) + (and (pair? types) + (outer (car types) (cdr types))))))))) (if (let ((types break-on-signals-types)) - (and (not (null? types)) + (and (pair? types) (intersect-generalizations? types))) (fluid-let ((break-on-signals-types '())) (breakpoint-procedure 'INHERIT "BKPT entered because of BREAK-ON-SIGNALS:" condition))) (do ((frames dynamic-handler-frames (cdr frames))) - ((null? frames)) + ((not (pair? frames))) (if (let ((types (caar frames))) - (or (null? types) + (or (not (pair? types)) (intersect-generalizations? types))) (fluid-let ((dynamic-handler-frames (cdr frames))) (hook/invoke-condition-handler (cdar frames) condition)))) (do ((frames static-handler-frames (cdr frames))) - ((null? frames)) + ((not (pair? frames))) (if (let ((types (caar frames))) - (or (null? types) + (or (not (pair? types)) (intersect-generalizations? types))) (fluid-let ((static-handler-frames (cdr frames)) (dynamic-handler-frames '())) @@ -572,14 +574,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (standard-error-handler condition) (let ((hook standard-error-hook)) (if hook - (fluid-let ((standard-error-hook false)) + (fluid-let ((standard-error-hook #f)) (hook condition)))) - (repl/start (push-repl 'INHERIT 'INHERIT condition '() "error>"))) + (repl/start (push-repl 'INHERIT condition '() "error>"))) (define (standard-warning-handler condition) (let ((hook standard-warning-hook)) (if hook - (fluid-let ((standard-warning-hook false)) + (fluid-let ((standard-warning-hook #f)) (hook condition)) (let ((port (notification-output-port))) (fresh-line port) @@ -587,8 +589,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (write-condition-report condition port) (newline port))))) -(define standard-error-hook false) -(define standard-warning-hook false) +(define standard-error-hook #f) +(define standard-warning-hook #f) (define (condition-signaller type field-names default-handler) (guarantee-condition-handler default-handler 'CONDITION-SIGNALLER) @@ -727,13 +729,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (lambda (effector arguments) (apply effector arguments))) (set! condition-type:serious-condition - (make-condition-type 'SERIOUS-CONDITION false '() false)) + (make-condition-type 'SERIOUS-CONDITION #f '() #f)) (set! condition-type:warning - (make-condition-type 'WARNING false '() false)) + (make-condition-type 'WARNING #f '() #f)) (set! condition-type:error - (make-condition-type 'ERROR condition-type:serious-condition '() - false)) + (make-condition-type 'ERROR condition-type:serious-condition '() #f)) (let ((reporter/simple-condition (lambda (condition port) @@ -741,7 +742,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (access-condition condition 'IRRITANTS) port)))) (set! condition-type:simple-condition - (make-condition-type 'SIMPLE-CONDITION false '(MESSAGE IRRITANTS) + (make-condition-type 'SIMPLE-CONDITION #f '(MESSAGE IRRITANTS) reporter/simple-condition)) (set! condition-type:simple-error (make-condition-type 'SIMPLE-ERROR condition-type:error @@ -775,9 +776,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((type (access-condition condition 'TYPE))) (if (string? type) (begin - (if (and (not (string-null? type)) - (not (or (string-prefix-ci? "a " type) - (string-prefix-ci? "an " type)))) + (if (not (or (string-null? type) + (string-prefix-ci? "a " type) + (string-prefix-ci? "an " type))) (write-string (if (char-set-member? char-set:vowels (string-ref type 0)) @@ -1186,7 +1187,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (list-of-symbols? object) (and (list? object) (let loop ((field-names object)) - (or (null? field-names) + (or (not (pair? field-names)) (and (symbol? (car field-names)) (not (memq (car field-names) (cdr field-names))) (loop (cdr field-names))))))) @@ -1198,10 +1199,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (keyword-association-list? object) (and (list? object) (let loop ((l object) (symbols '())) - (or (null? l) + (or (not (pair? l)) (and (symbol? (car l)) (not (memq (car l) symbols)) - (not (null? (cdr l))) + (pair? (cdr l)) (loop (cddr l) (cons (car l) symbols))))))) (define-integrable (procedure-of-arity? object arity) diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm index 7ef0aea3a..93d36ffd6 100644 --- a/v7/src/runtime/load.scm +++ b/v7/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 14.59 2001/12/18 22:17:06 cph Exp $ +$Id: load.scm,v 14.60 2001/12/19 05:21:42 cph Exp $ Copyright (c) 1988-2001 Massachusetts Institute of Technology @@ -65,18 +65,13 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;;; before opening the input file. (define (load filename/s #!optional environment syntax-table purify?) + syntax-table ;ignored (let ((environment ;; Kludge until optional defaulting fixed. (if (or (default-object? environment) (eq? environment default-object)) default-object (->environment environment))) - (syntax-table - (if (or (default-object? syntax-table) - (eq? syntax-table default-object) - (eq? syntax-table 'DEFAULT)) - default-object - (guarantee-syntax-table syntax-table 'LOAD))) (purify? (if (or (default-object? purify?) (eq? purify? default-object)) #f @@ -93,7 +88,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (lambda () (loader pathname environment - syntax-table purify? load-noisily?)))) (cond (last-file? (load-it)) @@ -140,13 +134,14 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (list 'DEFAULT-OBJECT)) (define (load-noisily filename #!optional environment syntax-table purify?) + syntax-table ;ignored (fluid-let ((load-noisily? #t)) (load filename ;; This defaulting is a kludge until we get the optional ;; defaulting fixed. Right now it must match the defaulting ;; of `load'. (if (default-object? environment) default-object environment) - (if (default-object? syntax-table) default-object syntax-table) + 'DEFAULT (if (default-object? purify?) default-object purify?)))) (define (load-latest . args) @@ -218,7 +213,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (loop (cdr types) pathname (cadar types) time) (skip))))))) -(define (load/internal pathname environment syntax-table purify? load-noisily?) +(define (load/internal pathname environment purify? load-noisily?) (let* ((port (open-input-file pathname)) (fasl-marker (peek-char port))) (if (and (not (eof-object? fasl-marker)) @@ -231,7 +226,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA purify?)) (let ((value-stream (lambda () - (eval-stream (read-stream port) environment syntax-table)))) + (eval-stream (read-stream port) environment)))) (if load-noisily? (write-stream (value-stream) (lambda (exp&value) @@ -251,9 +246,8 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (fasload/update-debugging-info! value pathname) value)) -(define (load-object-file pathname environment - syntax-table purify? load-noisily?) - syntax-table load-noisily? ; ignored +(define (load-object-file pathname environment purify? load-noisily?) + load-noisily? ; ignored (loading-message load/suppress-loading-message? pathname (lambda () @@ -359,24 +353,16 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (close-input-port port) #t))))) -(define (eval-stream stream environment syntax-table) +(define (eval-stream stream environment) (stream-map stream (let ((repl (nearest-repl))) (let* ((environment (if (eq? environment default-object) (repl/environment repl) - environment)) - (syntax-table - (make-syntax-table - (if (eq? syntax-table default-object) - (environment-syntax-table environment) - syntax-table)))) + environment))) (lambda (s-expression) (cons s-expression - (hook/repl-eval #f - s-expression - environment - syntax-table))))))) + (hook/repl-eval #f s-expression environment))))))) (define (write-stream stream write) (if (stream-pair? stream) @@ -564,17 +550,13 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (fluid-let ((load (lambda (fname #!optional env syntax-table purify?) + syntax-table ;ignored (let ((env (if (default-object? env) default-object env)) (purify? (if (default-object? purify?) default-object purify?))) (let ((place (find-filename fname alist))) (if (not place) - (real-load fname - env - (if (default-object? syntax-table) - default-object - syntax-table) - purify?) + (real-load fname env 'DEFAULT purify?) (handle-load-hooks (lambda () (let ((scode (caddr place))) diff --git a/v7/src/runtime/packag.scm b/v7/src/runtime/packag.scm index aaa794ace..e341f434c 100644 --- a/v7/src/runtime/packag.scm +++ b/v7/src/runtime/packag.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: packag.scm,v 14.38 2001/12/18 20:42:50 cph Exp $ +$Id: packag.scm,v 14.39 2001/12/19 05:21:46 cph Exp $ Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology @@ -184,15 +184,14 @@ USA. (let ((alternate-loader (lookup-option 'ALTERNATE-PACKAGE-LOADER options)) (load-component - (let ((syntax-table (nearest-repl/syntax-table))) - (lambda (component environment) - (let ((value - (filename->compiled-object filename component))) - (if value - (begin - (purify (load/purification-root value)) - (scode-eval value environment)) - (load component environment syntax-table #t))))))) + (lambda (component environment) + (let ((value + (filename->compiled-object filename component))) + (if value + (begin + (purify (load/purification-root value)) + (scode-eval value environment)) + (load component environment 'DEFAULT #t)))))) (if alternate-loader (alternate-loader load-component options) (begin diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm index f717c6f4f..a50f57e3c 100644 --- a/v7/src/runtime/rep.scm +++ b/v7/src/runtime/rep.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rep.scm,v 14.56 2001/02/27 17:21:01 cph Exp $ +$Id: rep.scm,v 14.57 2001/12/19 05:21:51 cph Exp $ Copyright (c) 1988-2001 Massachusetts Institute of Technology @@ -16,7 +16,8 @@ General Public License for more details. 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. |# ;;;; Read-Eval-Print Loop @@ -24,15 +25,15 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (declare (usual-integrations)) -(define repl:allow-restart-notifications? true) -(define repl:write-result-hash-numbers? true) +(define repl:allow-restart-notifications? #t) +(define repl:write-result-hash-numbers? #t) (define (initialize-package!) - (set! *nearest-cmdl* false) + (set! *nearest-cmdl* #f) (set! hook/repl-eval default/repl-eval) (set! hook/repl-write default/repl-write) (set! hook/set-default-environment default/set-default-environment) - (set! hook/error-decision false) + (set! hook/error-decision #f) (initialize-breakpoint-condition!) unspecific) @@ -40,11 +41,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (call-with-current-continuation (lambda (continuation) (set! root-continuation continuation) - (repl/start (make-repl false + (repl/start (make-repl #f console-i/o-port user-initial-environment - user-initial-syntax-table - false + #f `((SET-DEFAULT-DIRECTORY ,top-level-repl/set-default-directory)) user-initial-prompt) @@ -80,7 +80,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. cmdl-rtd '(LEVEL PARENT PORT DRIVER STATE OPERATIONS PROPERTIES)))) (lambda (parent port driver state operations) - (if (not (or (false? parent) (cmdl? parent))) + (if (not (or (not parent) (cmdl? parent))) (error:wrong-type-argument parent "cmdl" 'MAKE-CMDL)) (if (not (or parent port)) (error:bad-range-argument port 'MAKE-CMDL)) @@ -255,15 +255,15 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (cmdl/operation-names cmdl) (let cmdl-loop ((cmdl cmdl) (names '())) (let loop ((bindings (cmdl/operations cmdl)) (names names)) - (if (null? bindings) - (let ((parent (cmdl/parent cmdl))) - (if parent - (cmdl-loop parent names) - names)) + (if (pair? bindings) (loop (cdr bindings) (if (memq (caar bindings) names) names - (cons (caar bindings) names))))))) + (cons (caar bindings) names))) + (let ((parent (cmdl/parent cmdl))) + (if parent + (cmdl-loop parent names) + names)))))) ;;;; Messages @@ -290,23 +290,22 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (cmdl-message/append . messages) (do ((messages messages (cdr messages))) - ((null? messages)) + ((not (pair? messages))) (set-car! messages (->cmdl-message (car messages)))) (let ((messages (delq! %cmdl-message/null messages))) - (cond ((null? messages) - (cmdl-message/null)) - ((null? (cdr messages)) - (car messages)) - (else - (lambda (cmdl) - (for-each (lambda (message) (message cmdl)) messages)))))) + (if (pair? messages) + (if (pair? (cdr messages)) + (lambda (cmdl) + (for-each (lambda (message) (message cmdl)) messages)) + (car messages)) + (cmdl-message/null)))) (define-integrable (cmdl-message/null) %cmdl-message/null) (define (%cmdl-message/null cmdl) cmdl - false) + #f) ;;;; Interrupts @@ -336,22 +335,22 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (abort->previous #!optional message) (invoke-abort (let ((restarts (find-restarts 'ABORT (bound-restarts)))) (let ((next (find-restarts 'ABORT (cdr restarts)))) - (cond ((not (null? next)) (car next)) - ((not (null? restarts)) (car restarts)) + (cond ((pair? next) (car next)) + ((pair? restarts) (car restarts)) (else (error:no-such-restart 'ABORT))))) (if (default-object? message) "Up!" message))) (define (abort->top-level #!optional message) (invoke-abort (let loop ((restarts (find-restarts 'ABORT (bound-restarts)))) (let ((next (find-restarts 'ABORT (cdr restarts)))) - (cond ((not (null? next)) (loop next)) - ((not (null? restarts)) (car restarts)) + (cond ((pair? next) (loop next)) + ((pair? restarts) (car restarts)) (else (error:no-such-restart 'ABORT))))) (if (default-object? message) "Quit!" message))) (define (find-restarts name restarts) (let loop ((restarts restarts)) - (if (or (null? restarts) + (if (or (not (pair? restarts)) (eq? name (restart/name (car restarts)))) restarts (loop (cdr restarts))))) @@ -367,7 +366,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;;; REP Loops -(define (make-repl parent port environment syntax-table +(define (make-repl parent port environment #!optional condition operations prompt) (make-cmdl parent port @@ -396,10 +395,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. repl/environment 'ENVIRONMENT ->environment) - (inherit syntax-table - repl/syntax-table - 'SYNTAX-TABLE - guarantee-syntax-table) (if (default-object? condition) #f condition))) (append (if (default-object? operations) '() operations) default-repl-operations))) @@ -413,14 +408,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (error:derived-thread thread condition) (error "Non-owner thread can't start REPL:" thread))))))) -(define (push-repl environment syntax-table +(define (push-repl environment #!optional condition operations prompt) (let ((parent (nearest-cmdl))) (make-repl parent #f environment - syntax-table - (if (default-object? condition) false condition) + (if (default-object? condition) #f condition) (if (default-object? operations) '() operations) (if (default-object? prompt) 'INHERIT prompt)))) @@ -435,23 +429,19 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((reader-history (repl/reader-history repl)) (printer-history (repl/printer-history repl))) (port/set-default-environment (cmdl/port repl) (repl/environment repl)) - (port/set-default-syntax-table (cmdl/port repl) (repl/syntax-table repl)) - (do () (false) + (do () (#f) (let ((s-expression (prompt-for-command-expression (cons 'STANDARD (repl/prompt repl)) (cmdl/port repl)))) (repl-history/record! reader-history s-expression) (let ((value - (hook/repl-eval repl - s-expression - (repl/environment repl) - (repl/syntax-table repl)))) + (hook/repl-eval repl s-expression (repl/environment repl)))) (repl-history/record! printer-history value) (hook/repl-write repl s-expression value)))))) (define hook/repl-eval) -(define (default/repl-eval repl s-expression environment syntax-table) - (let ((scode (syntax s-expression syntax-table))) +(define (default/repl-eval repl s-expression environment) + (let ((scode (syntax s-expression environment))) (with-repl-eval-boundary repl (lambda () (extended-scode-eval scode environment))))) @@ -482,7 +472,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (cmdl/start repl (make-repl-message repl (if (default-object? message) - false + #f message)))) (define (make-repl-message repl message) @@ -586,7 +576,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (newline port) (do ((restarts restarts (cdr restarts)) (index (length restarts) (- index 1))) - ((null? restarts)) + ((not (pair? restarts))) (write-index index port) (write-string " " port) (write-restart-report (car restarts) port) @@ -594,15 +584,15 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (filter-restarts restarts) (let loop ((restarts restarts)) - (if (null? restarts) - '() + (if (pair? restarts) (let ((rest (if (cmdl-abort-restart? (car restarts)) (list-transform-positive (cdr restarts) cmdl-abort-restart?) (loop (cdr restarts))))) (if (restart/interactor (car restarts)) (cons (car restarts) rest) - rest))))) + rest)) + '()))) (define (condition-restarts-message condition) (cmdl-message/active @@ -618,11 +608,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define-structure (repl-state (conc-name repl-state/) (constructor make-repl-state - (prompt environment syntax-table condition))) + (prompt environment condition))) prompt environment - syntax-table - (condition false read-only true) + (condition #f read-only #t) (reader-history (make-repl-history repl-reader-history-size)) (printer-history (make-repl-history repl-printer-history-size))) @@ -644,13 +633,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (repl/set-default-environment repl) (port/set-default-environment (cmdl/port repl) environment)) -(define-integrable (repl/syntax-table repl) - (repl-state/syntax-table (cmdl/state repl))) - -(define (set-repl/syntax-table! repl syntax-table) - (set-repl-state/syntax-table! (cmdl/state repl) syntax-table) - (port/set-default-syntax-table (cmdl/port repl) syntax-table)) - (define-integrable (repl/condition repl) (repl-state/condition (cmdl/state repl))) @@ -688,9 +670,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (nearest-repl/environment) (repl/environment (nearest-repl))) -(define (nearest-repl/syntax-table) - (repl/syntax-table (nearest-repl))) - (define (nearest-repl/condition) (repl/condition (nearest-repl))) @@ -701,7 +680,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define-structure (repl-history (constructor %make-repl-history) (conc-name repl-history/)) - (size false read-only true) + (size #f read-only #t) elements) (define (make-repl-history size) @@ -709,14 +688,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (repl-history/record! history object) (let ((elements (repl-history/elements history))) - (if (not (null? elements)) + (if (pair? elements) (begin (set-car! elements object) (set-repl-history/elements! history (cdr elements)))))) (define (repl-history/replace-current! history object) (let ((elements (repl-history/elements history))) - (if (not (null? elements)) + (if (pair? elements) (set-car! (list-tail elements (- (repl-history/size history) 1)) object)))) @@ -755,17 +734,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((package-name (cond ((symbol? object) (list object)) ((list? object) object) - (else false)))) + (else #f)))) (and package-name (name->package package-name))))) (if (not package) (error:wrong-type-argument object "environment" procedure)) (package/environment package)))))) -(define (gst syntax-table) - (guarantee-syntax-table syntax-table 'GST) - (set-repl/syntax-table! (nearest-repl) syntax-table)) - (define (re #!optional index) (let ((repl (nearest-repl))) (hook/repl-eval repl @@ -777,8 +752,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. index)))) (repl-history/replace-current! history s-expression) s-expression)) - (repl/environment repl) - (repl/syntax-table repl)))) + (repl/environment repl)))) (define (in #!optional index) (repl-history/read (repl/reader-history (nearest-repl)) @@ -789,10 +763,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (- (if (default-object? index) 1 index) 1))) (define (read-eval-print environment message prompt) - (repl/start (push-repl environment 'INHERIT false '() prompt) message)) + (repl/start (push-repl environment #f '() prompt) message)) (define (ve environment) - (read-eval-print (->environment environment 'VE) false 'INHERIT)) + (read-eval-print (->environment environment 'VE) #f 'INHERIT)) (define (proceed #!optional value) (if (default-object? value) @@ -915,7 +889,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (fluid-let ((standard-breakpoint-hook #f)) (hook condition)))) (repl/start (push-repl (breakpoint/environment condition) - 'INHERIT condition '() (breakpoint/prompt condition)) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 06f6e1f34..e36bb01a4 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.389 2001/12/19 04:11:02 cph Exp $ +$Id: runtime.pkg,v 14.390 2001/12/19 05:22:04 cph Exp $ Copyright (c) 1988-2001 Massachusetts Institute of Technology @@ -2706,7 +2706,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA condition-type:breakpoint condition/breakpoint? ge - gst in initial-top-level-repl make-cmdl @@ -2719,7 +2718,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA nearest-repl nearest-repl/condition nearest-repl/environment - nearest-repl/syntax-table out pe proceed @@ -2741,7 +2739,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA repl/prompt repl/reader-history repl/start - repl/syntax-table repl:allow-restart-notifications? repl:write-result-hash-numbers? repl? @@ -2751,7 +2748,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA set-repl/printer-history! set-repl/prompt! set-repl/reader-history! - set-repl/syntax-table! signal-breakpoint standard-breakpoint-handler standard-breakpoint-hook @@ -3770,8 +3766,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA syntax-closure/expression syntax-closure? syntax/top-level? - system-global-syntax-table - user-initial-syntax-table) + system-global-syntax-table) (export (runtime defstruct) parse-lambda-list) (initialization (initialize-package!))) @@ -3900,7 +3895,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA prompt-for-expression) (export (runtime rep) port/set-default-environment - port/set-default-syntax-table port/write-result) (export (runtime rep) port/set-default-directory) diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm index 1d87204b7..acf0136f2 100644 --- a/v7/src/runtime/syntax.scm +++ b/v7/src/runtime/syntax.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: syntax.scm,v 14.38 2001/12/19 04:12:03 cph Exp $ +$Id: syntax.scm,v 14.39 2001/12/19 05:22:09 cph Exp $ Copyright (c) 1988-2001 Massachusetts Institute of Technology @@ -33,16 +33,13 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (set! system-global-syntax-table (make-system-global-syntax-table)) (set-environment-syntax-table! system-global-environment system-global-syntax-table) - (set! user-initial-syntax-table - (make-syntax-table system-global-syntax-table)) (set-environment-syntax-table! user-initial-environment - user-initial-syntax-table) + (make-syntax-table system-global-environment)) (set! syntaxer/default-environment (extend-interpreter-environment system-global-environment)) unspecific) (define system-global-syntax-table) -(define user-initial-syntax-table) (define *syntax-table*) (define *current-keyword* #f) (define *syntax-top-level?*) @@ -104,7 +101,8 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (fluid-let ((*syntax-table* (if (eq? table 'DEFAULT) (if (unassigned? *syntax-table*) - (nearest-repl/syntax-table) + (environment-syntax-table + (nearest-repl/environment)) *syntax-table*) (guarantee-syntax-table table name))) (*current-keyword* #f)) diff --git a/v7/src/runtime/usrint.scm b/v7/src/runtime/usrint.scm index 1e02a753f..e1f8fa65a 100644 --- a/v7/src/runtime/usrint.scm +++ b/v7/src/runtime/usrint.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: usrint.scm,v 1.16 1999/01/02 06:19:10 cph Exp $ +$Id: usrint.scm,v 1.17 2001/12/19 05:22:13 cph Exp $ -Copyright (c) 1991-1999 Massachusetts Institute of Technology +Copyright (c) 1991-1999, 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 published by @@ -16,7 +16,8 @@ General Public License for more details. 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. |# ;;;; User Interface @@ -99,8 +100,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. port)) (if (default-object? environment) (nearest-repl/environment) - environment) - (nearest-repl/syntax-table))) + environment))) (define (prompt-for-command-char prompt #!optional port) (let ((prompt (canonicalize-command-prompt prompt)) @@ -242,11 +242,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if operation (operation port environment)))) -(define (port/set-default-syntax-table port syntax-table) - (let ((operation (port/operation port 'SET-DEFAULT-SYNTAX-TABLE))) - (if operation - (operation port syntax-table)))) - (define (port/gc-start port) (let ((operation (port/operation port 'GC-START))) (if (and operation (not *within-restore-window?*))