loops.
#| -*-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
(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 ()
#| -*-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
(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))
(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))))
(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")
#| -*-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
(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)))
#| -*-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
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))
(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)
(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))
#| -*-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
(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
#| -*-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
(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)))
projects / mit-scheme.git / commitdiff