contrib/sb-aclrepl/toplevel.lisp

   1 (cl:defpackage :sb-aclrepl
   2   (:use "COMMON-LISP" "SB-EXT")
   3   (:shadowing-import-from "SB-IMPL" "SCRUB-CONTROL-STACK")
   4   (:shadowing-import-from "SB-INT" "*REPL-PROMPT-FUN*" "*REPL-READ-FORM-FUN*")
   5   (:export
   6    ;; user-level customization of UI
   7    "*PROMPT*" "*EXIT-ON-EOF*" "*MAX-HISTORY*"
   8    "*USE-SHORT-PACKAGE-NAME*" "*COMMAND-CHAR*"
   9    ;; user-level customization of functionality
  10    "ALIAS"
  11    ;; internalsish, but the documented way to make a new repl "object"
  12    ;; such that it inherits the current state of the repl but has its
  13    ;; own independent state subsequently.
  14    "MAKE-REPL-FUN"))
  15
  16 (cl:in-package :sb-aclrepl)
  17
  18 (defvar *noprint* nil
  19   "boolean: T if don't print prompt and output")
  20 (defvar *break-level* 0
  21   "current break level")
  22 (defvar *inspect-break* nil
  23   "boolean: T if break caused by inspect")
  24 (defvar *continuable-break* nil
  25   "boolean: T if break caused by continuable error")
  26
  27 (defun repl (&key
  28              (break-level (1+ *break-level*))
  29              (noprint *noprint*)
  30              (inspect nil)
  31              (continuable nil))
  32   (let ((*noprint* noprint)
  33         (*break-level* break-level)
  34         (*inspect-break* inspect)
  35         (*continuable-break* continuable))
  36     (loop
  37      (multiple-value-bind (reason reason-param)
  38          (catch 'repl-catcher
  39            (loop
  40             (unwind-protect
  41                  (rep-one)
  42               ;; if we started stepping in the debugger, now is the
  43               ;; time to stop
  44               (sb-impl::disable-stepping))))
  45        (declare (ignore reason-param))
  46        (cond
  47          ((and (eq reason :inspect)
  48                (plusp *break-level*))
  49           (return-from repl))
  50          ((and (eq reason :pop)
  51                (plusp *break-level*))
  52           (return-from repl)))))))
  53
  54 (defun rep-one ()
  55   "Read-Eval-Print one form"
  56   ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
  57   (scrub-control-stack)
  58   (unless *noprint*
  59     (funcall *repl-prompt-fun* *standard-output*)
  60     ;; (Should *REPL-PROMPT-FUN* be responsible for doing its own
  61     ;; FORCE-OUTPUT? I can't imagine a valid reason for it not to
  62     ;; be done here, so leaving it up to *REPL-PROMPT-FUN* seems
  63     ;; odd. But maybe there *is* a valid reason in some
  64     ;; circumstances? perhaps some deadlock issue when being driven
  65     ;; by another process or something...)
  66     (force-output *standard-output*))
  67   (let* ((form (funcall *repl-read-form-fun*
  68                         *standard-input*
  69                         *standard-output*))
  70          (results (multiple-value-list (sb-impl::interactive-eval form))))
  71     (unless *noprint*
  72       (dolist (result results)
  73         ;; FIXME: Calling fresh-line before a result ensures the result starts
  74         ;; on a newline, but it usually generates an empty line.
  75         ;; One solution would be to have the newline's entered on the
  76         ;; input stream inform the output stream that the column should be
  77         ;; reset to the beginning of the line.
  78         (fresh-line *standard-output*)
  79         (prin1 result *standard-output*)))))