-;;;; Toplevel for sb-aclrepl
-
(cl:defpackage :sb-aclrepl
- (:use :cl :sb-ext))
+ (:use "COMMON-LISP" "SB-EXT")
+ (:shadowing-import-from "SB-IMPL" "SCRUB-CONTROL-STACK")
+ (:shadowing-import-from "SB-INT" "*REPL-PROMPT-FUN*" "*REPL-READ-FORM-FUN*" "*STEP*" "*STEPPING*")
+ (:export
+ ;; user-level customization of UI
+ "*PROMPT*" "*EXIT-ON-EOF*" "*MAX-HISTORY*"
+ "*USE-SHORT-PACKAGE-NAME*" "*COMMAND-CHAR*"
+ ;; user-level customization of functionality
+ "ALIAS"
+ ;; internalsish, but the documented way to make a new repl "object"
+ ;; such that it inherits the current state of the repl but has its
+ ;; own independent state subsequently.
+ "MAKE-REPL-FUN"))
(cl:in-package :sb-aclrepl)
-(defvar *break-level* 0 "Current break level")
-(defvar *inspect-reason* nil
- "Boolean if break level was started for inspecting.")
-(defvar *continuable-reason* nil
- "Boolean if break level was started by continuable error.")
-(defvar *noprint* nil "Boolean is output should be displayed")
-(defvar *input* nil "Input stream")
-(defvar *output* nil "Output stream")
-
-(defun aclrepl (&key
- (break-level (1+ *break-level*))
- ;; Break level is started to inspect an object
- inspect
- ;; Signals a continuable error
- continuable)
- (let ((*break-level* break-level)
- (*inspect-reason* inspect)
- (*continuable-reason* continuable))
- (loop
- ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
- (sb-impl::scrub-control-stack)
- (unless *noprint*
- (funcall (the function sb-int:*repl-prompt-fun*) *output*)
- (force-output *output*))
- (let* ((form (funcall (the function sb-int:*repl-read-form-fun*)
- *input* *output*))
- (results (multiple-value-list (interactive-eval form))))
- (unless *noprint*
- (dolist (result results)
- (fresh-line *output*)
- (prin1 result *output*)))))))
-
+(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")
-;;; read-eval-print loop for the default system toplevel
-(defun toplevel-aclrepl-fun (noprint)
- (let ((* nil) (** nil) (*** nil)
- (- nil)
- (+ nil) (++ nil) (+++ nil)
- (/// nil) (// nil) (/ nil))
- ;; WITH-SIMPLE-RESTART doesn't actually restart its body as some
- ;; (like WHN for an embarrassingly long time ca. 2001-12-07) might
- ;; think, but instead drops control back out at the end. So when a
- ;; TOPLEVEL or outermost-ABORT restart happens, we need this outer
- ;; LOOP wrapper to grab control and start over again. (And it also
- ;; wraps CATCH 'TOPLEVEL-CATCHER for similar reasons.)
+(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
- ;; There should only be one TOPLEVEL restart, and it's here, so
- ;; restarting at TOPLEVEL always bounces you all the way out here.
- (with-simple-restart (toplevel
- "Restart at toplevel READ/EVAL/PRINT loop.")
- ;; We add a new ABORT restart for every debugger level, so
- ;; restarting at ABORT in a nested debugger gets you out to the
- ;; innermost enclosing debugger, and only when you're in the
- ;; outermost, unnested debugger level does restarting at ABORT
- ;; get you out to here.
- (with-simple-restart
- (abort
- "~@<Reduce debugger level (leaving debugger, returning to toplevel).~@:>")
- (catch 'toplevel-catcher
- #-sunos (sb-unix:unix-sigsetmask 0) ; FIXME: What is this for?
- ;; in the event of a control-stack-exhausted-error, we should
- ;; have unwound enough stack by the time we get here that this
- ;; is now possible
- (sb-kernel::protect-control-stack-guard-page 1)
- (let ((*noprint* noprint)
- (*input* *standard-input*)
- (*output* *standard-output*))
- (aclrepl :break-level 0))
- (sb-impl::critically-unreachable "after REPL")))))))
+ (multiple-value-bind (reason reason-param)
+ (catch 'repl-catcher
+ (loop
+ (unwind-protect
+ (rep-one)
+ ;; reset toplevel step-condition handler
+ (setf *step* nil
+ *stepping* nil))))
+ (declare (ignore reason-param))
+ (cond
+ ((and (eq reason :inspect)
+ (plusp *break-level*))
+ (return-from repl))
+ ((and (eq reason :pop)
+ (plusp *break-level*))
+ (return-from repl)))))))
-#+ignore
-(when (boundp 'sb-impl::*toplevel-repl-fun*)
- (setq sb-impl::*toplevel-repl-fun* #'toplevel-aclrepl-fun))
+(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)
+ ;; FIXME: Calling fresh-line before a result ensures the result starts
+ ;; on a newline, but it usually generates an empty line.
+ ;; One solution would be to have the newline's entered on the
+ ;; input stream inform the output stream that the column should be
+ ;; reset to the beginning of the line.
+ (fresh-line *standard-output*)
+ (prin1 result *standard-output*)))))
projects / sbcl.git / blobdiff