From 39139f4863f764ee99e95b9ecf09af0e3cf0aabd Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 14 Jul 1988 07:41:03 +0000 Subject: [PATCH] Change the names of the `standard-repl-{environment,syntax-table}' operations to `nearest-repl/{environment,syntax-table}'. Add new operations `{input,output}-port/operation'. --- v7/src/runtime/debug.scm | 4 +- v7/src/runtime/error.scm | 4 +- v7/src/runtime/input.scm | 87 +++++++++++++++++++++++--------------- v7/src/runtime/load.scm | 4 +- v7/src/runtime/output.scm | 46 +++++++++++--------- v7/src/runtime/packag.scm | 4 +- v7/src/runtime/rep.scm | 10 ++--- v7/src/runtime/runtime.pkg | 8 ++-- v7/src/runtime/version.scm | 4 +- v7/src/runtime/where.scm | 4 +- v8/src/runtime/load.scm | 4 +- v8/src/runtime/runtime.pkg | 8 ++-- 12 files changed, 108 insertions(+), 79 deletions(-) diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm index 54772b6e8..0c3359366 100644 --- a/v7/src/runtime/debug.scm +++ b/v7/src/runtime/debug.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.2 1988/06/21 05:48:48 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.3 1988/07/14 07:39:50 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -532,7 +532,7 @@ MIT in each case. |# (print-undefined-environment) (newline) (write-string "Using the read-eval-print environment instead!") - (receiver (standard-repl-environment))) + (receiver (nearest-repl/environment))) (receiver environment))) (define (if-valid-environment environment receiver) diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm index 9010d6625..7157632b9 100644 --- a/v7/src/runtime/error.scm +++ b/v7/src/runtime/error.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.3 1988/06/21 05:53:08 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.4 1988/07/14 07:40:00 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -115,7 +115,7 @@ MIT in each case. |# (1d-table/put! (condition/properties condition) environment-tag (if (eq? environment repl-environment) - (cons (standard-repl-environment) true) + (cons (nearest-repl/environment) true) (cons environment false))) condition)) diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm index 563c98672..9276831eb 100644 --- a/v7/src/runtime/input.scm +++ b/v7/src/runtime/input.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 14.2 1988/07/11 23:50:59 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 14.3 1988/07/14 07:40:08 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -69,45 +69,32 @@ MIT in each case. |# (if (not (input-port? port)) (error "Bad input port" port)) port) -(define (input-port/custom-operation port name) - (let ((entry (assq name (input-port/custom-operations port)))) - (and entry - (cdr entry)))) - (define (input-port/copy port state) (let ((result (%input-port/copy port))) (set-input-port/state! result state) result)) -(define (input-port/char-ready? port interval) - ((input-port/operation/char-ready? port) port interval)) - -(define (input-port/peek-char port) - ((input-port/operation/peek-char port) port)) - -(define (input-port/read-char port) - ((input-port/operation/read-char port) port)) - -(define (input-port/peek-char-immediate port) - ((input-port/operation/peek-char-immediate port) port)) - -(define (input-port/read-char-immediate port) - ((input-port/operation/read-char-immediate port) port)) - -(define (input-port/discard-char port) - ((input-port/operation/discard-char port) port)) - -(define (input-port/read-string port delimiters) - ((input-port/operation/read-string port) port delimiters)) - -(define (input-port/discard-chars port delimiters) - ((input-port/operation/discard-chars port) port delimiters)) - -(define (input-port/read-start! port) - ((input-port/operation/read-start! port) port)) +(define (input-port/custom-operation port name) + (let ((entry (assq name (input-port/custom-operations port)))) + (and entry + (cdr entry)))) -(define (input-port/read-finish! port) - ((input-port/operation/read-finish! port) port)) +(define (input-port/operation port name) + (or (input-port/custom-operation port name) + (case name + ((OPERATION/CHAR-READY?) (input-port/operation/char-ready? port)) + ((OPERATION/PEEK-CHAR) (input-port/operation/peek-char port)) + ((OPERATION/READ-CHAR) (input-port/operation/read-char port)) + ((OPERATION/PEEK-CHAR-IMMEDIATE) + (input-port/operation/peek-char-immediate port)) + ((OPERATION/READ-CHAR-IMMEDIATE) + (input-port/operation/read-char-immediate port)) + ((OPERATION/DISCARD-CHAR) (input-port/operation/discard-char port)) + ((OPERATION/READ-STRING) (input-port/operation/read-string port)) + ((OPERATION/DISCARD-CHARS) (input-port/operation/discard-chars port)) + ((OPERATION/READ-START!) (input-port/operation/read-start! port)) + ((OPERATION/READ-FINISH!) (input-port/operation/read-finish! port)) + (else false)))) (define (make-input-port operations state) (let ((operations @@ -148,7 +135,7 @@ MIT in each case. |# read-start! read-finish! operations)))))) - + (define (default-operation/read-string port delimiters) (list->string (let ((peek-char (input-port/operation/peek-char port)) @@ -175,6 +162,36 @@ MIT in each case. |# port false) +(define (input-port/char-ready? port interval) + ((input-port/operation/char-ready? port) port interval)) + +(define (input-port/peek-char port) + ((input-port/operation/peek-char port) port)) + +(define (input-port/read-char port) + ((input-port/operation/read-char port) port)) + +(define (input-port/peek-char-immediate port) + ((input-port/operation/peek-char-immediate port) port)) + +(define (input-port/read-char-immediate port) + ((input-port/operation/read-char-immediate port) port)) + +(define (input-port/discard-char port) + ((input-port/operation/discard-char port) port)) + +(define (input-port/read-string port delimiters) + ((input-port/operation/read-string port) port delimiters)) + +(define (input-port/discard-chars port delimiters) + ((input-port/operation/discard-chars port) port delimiters)) + +(define (input-port/read-start! port) + ((input-port/operation/read-start! port) port)) + +(define (input-port/read-finish! port) + ((input-port/operation/read-finish! port) port)) + (define eof-object "EOF Object") diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm index c6ee50379..94820fbf9 100644 --- a/v7/src/runtime/load.scm +++ b/v7/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.2 1988/06/13 11:47:32 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.3 1988/07/14 07:40:16 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -136,7 +136,7 @@ MIT in each case. |# (if purify? (purify scode)) scode) (if (eq? environment default-object) - (standard-repl-environment) + (nearest-repl/environment) environment))) (write-stream (eval-stream (read-stream port) environment syntax-table) (if load-noisily? diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm index 0afc5e749..4feb28fba 100644 --- a/v7/src/runtime/output.scm +++ b/v7/src/runtime/output.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/output.scm,v 14.1 1988/06/13 11:48:42 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/output.scm,v 14.2 1988/07/14 07:40:24 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -64,31 +64,24 @@ MIT in each case. |# (if (not (output-port? port)) (error "Bad output port" port)) port) -(define (output-port/custom-operation port name) - (let ((entry (assq name (output-port/custom-operations port)))) - (and entry - (cdr entry)))) - (define (output-port/copy port state) (let ((result (%output-port/copy port))) (set-output-port/state! result state) result)) -(define (output-port/write-char port char) - ((output-port/operation/write-char port) port char)) - -(define (output-port/write-string port string) - ((output-port/operation/write-string port) port string)) +(define (output-port/custom-operation port name) + (let ((entry (assq name (output-port/custom-operations port)))) + (and entry + (cdr entry)))) -(define (output-port/flush-output port) - ((output-port/operation/flush-output port) port)) +(define (output-port/operation port name) + (or (output-port/custom-operation port name) + (case name + ((WRITE-CHAR) (output-port/operation/write-char port)) + ((WRITE-STRING) (output-port/operation/write-string port)) + ((FLUSH-OUTPUT) (output-port/operation/flush-output port)) + (else false)))) -(define (output-port/x-size port) - (or (let ((operation (output-port/custom-operation port 'X-SIZE))) - (and operation - (operation port))) - 79)) - (define (make-output-port operations state) (let ((operations (map (lambda (entry) @@ -125,6 +118,21 @@ MIT in each case. |# port false) +(define (output-port/write-char port char) + ((output-port/operation/write-char port) port char)) + +(define (output-port/write-string port string) + ((output-port/operation/write-string port) port string)) + +(define (output-port/flush-output port) + ((output-port/operation/flush-output port) port)) + +(define (output-port/x-size port) + (or (let ((operation (output-port/custom-operation port 'X-SIZE))) + (and operation + (operation port))) + 79)) + (define *current-output-port*) (define-integrable (current-output-port) diff --git a/v7/src/runtime/packag.scm b/v7/src/runtime/packag.scm index 2647663dc..d423d4b53 100644 --- a/v7/src/runtime/packag.scm +++ b/v7/src/runtime/packag.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/packag.scm,v 14.2 1988/06/13 11:48:57 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/packag.scm,v 14.3 1988/07/14 07:40:31 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -102,7 +102,7 @@ MIT in each case. |# load/default-types))) (load (pathname-new-type pathname "bcon") system-global-environment) ((load (pathname-new-type pathname "bldr") system-global-environment) - (let ((syntax-table (standard-repl-syntax-table))) + (let ((syntax-table (nearest-repl/syntax-table))) (lambda (filename environment) (load filename environment syntax-table true))) options))))) diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm index 6658d962c..161251c45 100644 --- a/v7/src/runtime/rep.scm +++ b/v7/src/runtime/rep.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.3 1988/07/11 18:53:25 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.4 1988/07/14 07:40:37 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -216,7 +216,7 @@ MIT in each case. |# (with-standard-proceed-point (lambda () (breakpoint (cmdl-message/standard "^B interrupt") - (standard-repl-environment))))) + (nearest-repl/environment))))) ;;;; Proceed @@ -330,13 +330,13 @@ MIT in each case. |# (repl/base parent) repl))) -(define (standard-repl-environment) +(define (nearest-repl/environment) (let ((repl (nearest-repl))) (if repl (repl/environment repl) user-initial-environment))) -(define (standard-repl-syntax-table) +(define (nearest-repl/syntax-table) (let ((repl (nearest-repl))) (if repl (repl/syntax-table repl) @@ -346,7 +346,7 @@ MIT in each case. |# (let ((parent (nearest-cmdl))) (make-repl parent environment - (standard-repl-syntax-table) + (nearest-repl/syntax-table) prompt (cmdl/input-port parent) (cmdl/output-port parent) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 958e11ad2..d5066ba4a 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.11 1988/07/13 18:41:50 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.12 1988/07/14 07:40:46 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -615,6 +615,7 @@ MIT in each case. |# input-port/custom-operation input-port/discard-char input-port/discard-chars + input-port/operation input-port/operation/char-ready? input-port/operation/discard-char input-port/operation/discard-chars @@ -965,6 +966,7 @@ MIT in each case. |# output-port/copy output-port/custom-operation output-port/flush-output + output-port/operation output-port/operation/flush-output output-port/operation/write-char output-port/operation/write-string @@ -1195,6 +1197,8 @@ MIT in each case. |# make-repl nearest-cmdl nearest-repl + nearest-repl/environment + nearest-repl/syntax-table out proceed prompt-for-command-char @@ -1224,8 +1228,6 @@ MIT in each case. |# set-repl/prompt! set-repl/reader-history! set-repl/syntax-table! - standard-repl-environment - standard-repl-syntax-table ve vst with-proceed-point diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index 188e02ae8..05a646293 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.10 1988/07/13 18:42:10 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.11 1988/07/14 07:40:57 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -45,7 +45,7 @@ MIT in each case. |# '())) (add-system! microcode-system) (add-event-receiver! event:after-restore snarf-microcode-version!) - (add-identification! "Runtime" 14 10)) + (add-identification! "Runtime" 14 11)) (define microcode-system) diff --git a/v7/src/runtime/where.scm b/v7/src/runtime/where.scm index 88a2bb2f9..a0fc7a2ab 100644 --- a/v7/src/runtime/where.scm +++ b/v7/src/runtime/where.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/where.scm,v 14.1 1988/06/13 12:00:44 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/where.scm,v 14.2 1988/07/14 07:41:03 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -72,7 +72,7 @@ MIT in each case. |# (define (where #!optional environment) (let ((environment (if (default-object? environment) - (standard-repl-environment) + (nearest-repl/environment) (->environment environment)))) (hook/repl-environment (nearest-repl) environment) (fluid-let ((env environment) diff --git a/v8/src/runtime/load.scm b/v8/src/runtime/load.scm index 26adf1235..21cddeddb 100644 --- a/v8/src/runtime/load.scm +++ b/v8/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.2 1988/06/13 11:47:32 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.3 1988/07/14 07:40:16 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -136,7 +136,7 @@ MIT in each case. |# (if purify? (purify scode)) scode) (if (eq? environment default-object) - (standard-repl-environment) + (nearest-repl/environment) environment))) (write-stream (eval-stream (read-stream port) environment syntax-table) (if load-noisily? diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 1d6990d1e..d8af7f64c 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.11 1988/07/13 18:41:50 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.12 1988/07/14 07:40:46 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -615,6 +615,7 @@ MIT in each case. |# input-port/custom-operation input-port/discard-char input-port/discard-chars + input-port/operation input-port/operation/char-ready? input-port/operation/discard-char input-port/operation/discard-chars @@ -965,6 +966,7 @@ MIT in each case. |# output-port/copy output-port/custom-operation output-port/flush-output + output-port/operation output-port/operation/flush-output output-port/operation/write-char output-port/operation/write-string @@ -1195,6 +1197,8 @@ MIT in each case. |# make-repl nearest-cmdl nearest-repl + nearest-repl/environment + nearest-repl/syntax-table out proceed prompt-for-command-char @@ -1224,8 +1228,6 @@ MIT in each case. |# set-repl/prompt! set-repl/reader-history! set-repl/syntax-table! - standard-repl-environment - standard-repl-syntax-table ve vst with-proceed-point -- 2.25.1