From: Chris Hanson Date: Thu, 3 Aug 1989 23:03:58 +0000 (+0000) Subject: Allow compiled-code environments to be used in evaluation and REP X-Git-Tag: 20090517-FFI~11895 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dfcd864b6ecb04c1477986df71986dc3fd207b4b;p=mit-scheme.git Allow compiled-code environments to be used in evaluation and REP loops. --- diff --git a/v7/src/runtime/dbgcmd.scm b/v7/src/runtime/dbgcmd.scm index 55ed351e8..eddca8479 100644 --- a/v7/src/runtime/dbgcmd.scm +++ b/v7/src/runtime/dbgcmd.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dbgcmd.scm,v 14.4 1989/01/06 22:24:05 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dbgcmd.scm,v 14.5 1989/08/03 23:03:34 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -115,25 +115,8 @@ MIT in each case. |# (read-eval-print environment (cmdl-message/standard message) prompt)))) (define (debug/eval expression environment) - (if (interpreter-environment? environment) - (leaving-command-loop (lambda () (eval expression environment))) - (begin - (if (not (symbol? expression)) - (error "Can only lookup symbols in compiled code environments" - expression)) - (let loop ((environment environment)) - (if (environment-bound? environment expression) - (let ((value (environment-lookup environment expression))) - (if (unassigned-reference-trap? value) - (error "Unassigned variable" expression)) - value) - (begin - (if (not (environment-has-parent? environment)) - (error "Unbound variable" expression)) - (let ((parent (environment-parent environment))) - (if (interpreter-environment? parent) - (lexical-reference parent expression) - (loop parent))))))))) + (leaving-command-loop (lambda () (eval expression environment)))) + (define (debug/where environment) (leaving-command-loop (lambda () diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm index 8385bad6c..69e1be904 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.13 1989/07/13 18:38:31 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.14 1989/08/03 23:02:11 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -518,13 +518,12 @@ MIT in each case. |# (show-current-frame-1 true)))) (define (enter-read-eval-print-loop) - (debug/read-eval-print (get-evaluation-environment interpreter-environment?) + (debug/read-eval-print (get-evaluation-environment) "You are now in the desired environment" "Eval-in-env-->")) (define (eval-in-current-environment) - (debug/read-eval-print-1 - (get-evaluation-environment interpreter-environment?))) + (debug/read-eval-print-1 (get-evaluation-environment))) (define (enter-where-command) (with-current-environment debug/where)) @@ -570,7 +569,7 @@ MIT in each case. |# (let ((next (stack-frame/next-subproblem current-subproblem))) (if next (let ((invalid-expression? (invalid-expression? current-expression)) - (environment (get-evaluation-environment environment?)) + (environment (get-evaluation-environment)) (return (lambda (value) ((stack-frame->continuation next) value)))) @@ -682,9 +681,10 @@ MIT in each case. |# (receiver (car environment-list)) (print-undefined-environment))) -(define (get-evaluation-environment predicate) +(define (get-evaluation-environment) (if (and (pair? environment-list) - (predicate (car environment-list))) (car environment-list) + (environment? (car environment-list))) + (car environment-list) (begin (newline) (write-string "Cannot evaluate in current environment") diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm index cc9e6a34c..f744c1b21 100644 --- a/v7/src/runtime/global.scm +++ b/v7/src/runtime/global.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.9 1989/06/09 16:51:27 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.10 1989/08/03 23:03:58 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -99,7 +99,9 @@ MIT in each case. |# (loop (car rest-elements) (cdr rest-elements)))))))) (define (eval expression environment) - (scode-eval (syntax expression system-global-syntax-table) environment)) + (extended-scode-eval (syntax expression system-global-syntax-table) + environment)) + (define-integrable (system-hunk3-cons type cxr0 cxr1 cxr2) (object-new-type type (hunk3-cons cxr0 cxr1 cxr2))) diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm index abd0b97d5..4eb089455 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.9 1989/03/06 19:59:42 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.10 1989/08/03 23:03:04 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -272,7 +272,11 @@ MIT in each case. |# syntax-table (make-repl-history reader-history-size) (make-repl-history printer-history-size)) - message)) + (cmdl-message/append + message + (cmdl-message/active + (lambda () + (hook/repl-environment (nearest-repl) environment)))))) (define (repl-driver repl) (fluid-let ((hook/error-handler default/error-handler)) @@ -383,12 +387,20 @@ MIT in each case. |# (define hook/repl-write) (define (default/repl-environment repl environment) - (let ((package (environment->package environment)) - (port (cmdl/output-port repl))) - (if package + (let ((port (cmdl/output-port repl))) + (if (not (interpreter-environment? environment)) (begin - (write-string "\n;Package: " port) - (write (package/name package) port)))) + (write-string + "\n;Warning! this environment is a compiled-code environment:") + (write-string + "\n; Assignments to most compiled-code bindings are prohibited,") + (write-string + "\n; as are certain other environment operations."))) + (let ((package (environment->package environment))) + (if package + (begin + (write-string "\n;Package: " port) + (write (package/name package) port))))) unspecific) (define (default/repl-read repl) @@ -399,7 +411,8 @@ MIT in each case. |# (define (default/repl-eval repl s-expression environment syntax-table) repl ;ignore (let ((scode (syntax s-expression syntax-table))) - (with-new-history (lambda () (scode-eval scode environment))))) + (with-new-history (lambda () (extended-scode-eval scode environment))))) + (define ((cmdl-message/value value) repl) (hook/repl-write repl value)) diff --git a/v7/src/runtime/where.scm b/v7/src/runtime/where.scm index 5ae0acb97..d05699d48 100644 --- a/v7/src/runtime/where.scm +++ b/v7/src/runtime/where.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/where.scm,v 14.5 1988/12/30 06:44:04 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/where.scm,v 14.6 1989/08/03 23:02:37 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -114,25 +114,14 @@ MIT in each case. |# (print-user-friendly-name (car frame-list))) (define (recursive-where) - (if-interpreter-environment (car frame-list) - (lambda (environment) - (let ((inp (prompt-for-expression "Object to eval and examine-> "))) - (write-string "New where!") - (debug/where (debug/eval inp environment)))))) + (let ((inp (prompt-for-expression "Object to eval and examine-> "))) + (write-string "New where!") + (debug/where (debug/eval inp (car frame-list))))) (define (enter) - (if-interpreter-environment (car frame-list) - (lambda (environment) - (debug/read-eval-print environment - "You are now in the desired environment" - "Eval-in-env-->")))) + (debug/read-eval-print (car frame-list) + "You are now in the desired environment" + "Eval-in-env-->")) (define (show-object) - (if-interpreter-environment (car frame-list) debug/read-eval-print-1)) - -(define (if-interpreter-environment environment receiver) - (if (interpreter-environment? environment) - (receiver environment) - (begin - (newline) - (write-string "This frame is not an interpreter environment")))) \ No newline at end of file + (debug/read-eval-print-1 (car frame-list))) \ No newline at end of file diff --git a/v8/src/runtime/global.scm b/v8/src/runtime/global.scm index 339f848a9..28ad02cd3 100644 --- a/v8/src/runtime/global.scm +++ b/v8/src/runtime/global.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.9 1989/06/09 16:51:27 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.10 1989/08/03 23:03:58 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -99,7 +99,9 @@ MIT in each case. |# (loop (car rest-elements) (cdr rest-elements)))))))) (define (eval expression environment) - (scode-eval (syntax expression system-global-syntax-table) environment)) + (extended-scode-eval (syntax expression system-global-syntax-table) + environment)) + (define-integrable (system-hunk3-cons type cxr0 cxr1 cxr2) (object-new-type type (hunk3-cons cxr0 cxr1 cxr2)))