From b79fc0e07dc40c8c0f7b59e0fa6006042986758a Mon Sep 17 00:00:00 2001
From: Kevin Rosenberg <kevin@rosenberg.net>
Date: Sun, 27 Apr 2003 17:02:13 +0000
Subject: [PATCH] 0.pre8.112:       - toplevel.lisp: implements toplevel of
 recursive repl.

---
 contrib/sb-aclrepl/toplevel.lisp |   65 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)
 create mode 100644 contrib/sb-aclrepl/toplevel.lisp

diff --git a/contrib/sb-aclrepl/toplevel.lisp b/contrib/sb-aclrepl/toplevel.lisp
new file mode 100644
index 0000000..41d871c
--- /dev/null
+++ b/contrib/sb-aclrepl/toplevel.lisp
@@ -0,0 +1,65 @@
+(cl:defpackage :sb-aclrepl
+  (:use :cl :sb-ext))
+
+(cl:in-package :sb-aclrepl)
+
+(defvar *noprint* nil "boolean: T if don't print prompt and output")
+(defvar *break-level* 0 "current break level")
+(defvar *inspect-break* nil "boolean: T if break caused by inspect")
+(defvar *continuable-break* nil "boolean: T if break caused by continuable error")
+
+(shadowing-import '(sb-impl::scrub-control-stack
+		    sb-int:*repl-prompt-fun* sb-int:*repl-read-form-fun*)
+		  :sb-aclrepl)
+	  
+
+(defun repl (&key
+	     (break-level (1+ *break-level*))
+	     (noprint *noprint*)
+	     (inspect nil)
+	     (continuable nil))
+  (let ((*noprint* noprint)
+	(*break-level* break-level)
+	(*inspect-break* inspect)
+	(*continuable-break* continuable))
+    (sb-int:/show0 "entering REPL")
+    (loop
+     (multiple-value-bind (reason reason-param)
+	 (catch 'repl-catcher
+	   (loop
+	    (rep-one)))
+       (cond
+	 ((and (eq reason :inspect)
+	       (plusp *break-level*))
+	  (return-from repl))
+	 ((and (eq reason :pop)
+	       (plusp *break-level*))
+	  (return-from repl)))))))
+
+(defun rep-one ()
+  "Read-Eval-Print one form"
+  ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
+  (scrub-control-stack)
+  (unless *noprint*
+    (funcall *repl-prompt-fun* *standard-output*)
+    ;; (Should *REPL-PROMPT-FUN* be responsible for doing its own
+    ;; FORCE-OUTPUT? I can't imagine a valid reason for it not to
+    ;; be done here, so leaving it up to *REPL-PROMPT-FUN* seems
+    ;; odd. But maybe there *is* a valid reason in some
+    ;; circumstances? perhaps some deadlock issue when being driven
+    ;; by another process or something...)
+    (force-output *standard-output*))
+  (let* ((form (funcall *repl-read-form-fun*
+			*standard-input*
+			*standard-output*))
+	 (results (multiple-value-list (sb-impl::interactive-eval form))))
+    (unless *noprint*
+      (dolist (result results)
+	(fresh-line)
+	(prin1 result)))))
+
+(defun repl-fun (noprint)
+  (repl :noprint noprint :break-level 0))
+
+(when (boundp 'sb-impl::*repl-fun*)
+  (setq sb-impl::*repl-fun* #'repl-fun))
-- 
1.7.10.4