From 86c23a6886f87329ccc7694c928e1621385147f1 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 6 Jan 1989 22:25:08 +0000
Subject: [PATCH] Extend V and Z commands to allow lookup of symbols in
 compiled code environments.

---
 v7/src/runtime/debug.scm | 78 +++++++++++++++++++++-------------------
 1 file changed, 41 insertions(+), 37 deletions(-)

diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm
index accf8e19e..ce2e9e824 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.8 1989/01/06 20:59:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.9 1989/01/06 22:25:08 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -163,8 +163,7 @@ MIT in each case. |#
 	 (if (stack-frame/compiled-code? current-subproblem)
 	     "Compiled code expression"
 	     "Expression"))
-	(if (or (debugging-info/undefined-expression? current-expression)
-		(debugging-info/compiled-code? current-expression))
+	(if (invalid-expression? current-expression)
 	    (write-string " unknown")
 	    (begin
 	      (write-string " (from stack):")
@@ -476,14 +475,12 @@ MIT in each case. |#
 	 (show-current-frame-1 true))))
 
 (define (enter-read-eval-print-loop)
-  (with-rep-environment
-   (lambda (environment)
-     (debug/read-eval-print environment
-			    "You are now in the desired environment"
-			    "Eval-in-env-->"))))
+  (debug/read-eval-print (get-evaluation-environment interpreter-environment?)
+			 "You are now in the desired environment"
+			 "Eval-in-env-->"))
 
 (define (eval-in-current-environment)
-  (with-rep-environment debug/read-eval-print-1))
+  (with-current-environment debug/read-eval-print-1))
 
 (define (enter-where-command)
   (with-current-environment debug/where))
@@ -528,37 +525,40 @@ MIT in each case. |#
 (define (return-command)
   (let ((next (stack-frame/next-subproblem current-subproblem)))
     (if next
-	(with-rep-environment
-	 (lambda (environment)
-	   (let ((value
-		  (debug/eval
-		   (let ((expression
-			  (prompt-for-expression
-			   "Expression to EVALUATE and CONTINUE with ($ to retry): ")))
-		     (if (eq? expression '$)
-			 (unsyntax current-expression)
-			 expression))
-		   environment)))
-	     (if print-return-values?
-		 (begin
-		   (newline)
-		   (write-string "That evaluates to:")
-		   (newline)
-		   (write value)
-		   (if (prompt-for-confirmation "Confirm: ") (next value)))
-		 (next value)))))
+	(let ((invalid-expression? (invalid-expression? current-expression))
+	      (environment (get-evaluation-environment environment?)))
+	  (let ((value
+		 (debug/eval
+		  (let ((expression
+			 (prompt-for-expression
+			  (string-append
+			   "Expression to EVALUATE and CONTINUE with"
+			   (if invalid-expression?
+			       ""
+			       " ($ to retry)")
+			   ": "))))
+		    (if (and (not invalid-expression?)
+			     (eq? expression '$))
+			(unsyntax current-expression)
+			expression))
+		  environment)))
+	    (if print-return-values?
+		(begin
+		  (newline)
+		  (write-string "That evaluates to:")
+		  (newline)
+		  (write value)
+		  (if (prompt-for-confirmation "Confirm: ") (next value)))
+		(next value))))
 	(begin
 	  (beep)
 	  (newline)
 	  (write-string "Can't continue!!!")))))
 
 (define (internal-command)
-  (debug/read-eval-print user-debug-environment
+  (debug/read-eval-print (->environment '(runtime debugger))
 			 "You are now in the debugger environment"
-			 "Debugger-->"))
-(define user-debug-environment
-  (the-environment))
-
+			 "Debugger-->"))
 ;;;; Reduction and subproblem motion low-level
 
 (define (set-current-subproblem! stack-frame previous-frames
@@ -619,21 +619,25 @@ MIT in each case. |#
   (eq? (list-tail reductions (dotted-list-length reductions))
        reduction-wrap-around-tag))
 
+(define (invalid-expression? expression)
+  (or (debugging-info/undefined-expression? expression)
+      (debugging-info/compiled-code? expression)))
+
 (define (with-current-environment receiver)
   (if (pair? environment-list)
       (receiver (car environment-list))
       (print-undefined-environment)))
 
-(define (with-rep-environment receiver)
+(define (get-evaluation-environment predicate)
   (if (and (pair? environment-list)
-	   (interpreter-environment? (car environment-list)))
-      (receiver (car environment-list))
+	   (predicate (car environment-list)))      (car environment-list)
       (begin
 	(newline)
 	(write-string "Cannot evaluate in current environment")
 	(newline)
 	(write-string "Using the read-eval-print environment instead")
-	(receiver (nearest-repl/environment)))))
+	(newline)
+	(nearest-repl/environment))))
 
 (define (print-undefined-environment)
   (beep)
-- 
2.25.1