[4898ef]: contrib / sb-aclrepl / toplevel.lisp Maximize Restore History

Download this file

toplevel.lisp    81 lines (76 with data), 3.1 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
(cl:defpackage :sb-aclrepl
(: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 *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")
(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
(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)))))))
(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*)))))