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     (sb-int:/show0 "entering REPL")
  37     (loop
  38      (multiple-value-bind (reason reason-param)
  39          (catch 'repl-catcher
  40            (loop
  41             (rep-one)))
  42        (declare (ignore reason-param))
  43        (cond
  44          ((and (eq reason :inspect)
  45                (plusp *break-level*))
  46           (return-from repl))
  47          ((and (eq reason :pop)
  48                (plusp *break-level*))
  49           (return-from repl)))))))
  50
  51 (defun rep-one ()
  52   "Read-Eval-Print one form"
  53   ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
  54   (scrub-control-stack)
  55   (unless *noprint*
  56     (funcall *repl-prompt-fun* *standard-output*)
  57     ;; (Should *REPL-PROMPT-FUN* be responsible for doing its own
  58     ;; FORCE-OUTPUT? I can't imagine a valid reason for it not to
  59     ;; be done here, so leaving it up to *REPL-PROMPT-FUN* seems
  60     ;; odd. But maybe there *is* a valid reason in some
  61     ;; circumstances? perhaps some deadlock issue when being driven
  62     ;; by another process or something...)
  63     (force-output *standard-output*))
  64   (let* ((form (funcall *repl-read-form-fun*
  65                         *standard-input*
  66                         *standard-output*))
  67          (results (multiple-value-list (sb-impl::interactive-eval form))))
  68     (unless *noprint*
  69       (dolist (result results)
  70         ;; FIXME: Calling fresh-line before a result ensures the result starts
  71         ;; on a newline, but it usually generates an empty line.
  72         ;; One solution would be to have the newline's entered on the
  73         ;; input stream inform the output stream that the column should be
  74         ;; reset to the beginning of the line.
  75         (fresh-line *standard-output*)
  76         (prin1 result *standard-output*)))))