simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make the REPL read multi-line forms and render real error messages

Browse source 
The REPL evaluated one line at a time, so a form split across lines
(e.g. `(+` then `1 2)`) raised instead of waiting. The read loop now
accumulates lines until delimiters are balanced — skipping string,
char, regex and comment context — printing a `... ` continuation prompt
for each extra line.

Reader/runtime errors rendered as Chez's "attempt to apply
non-procedure #[chez-pmap...]" instead of their real message. Two causes:

jolt-throw raised the thrown value raw. When a throw crossed the host
`eval` boundary, Chez re-wrapped the non-condition into a compound
condition whose message extraction applies the value, losing the message
and crashing on ex-info's empty-map :data. jolt-throw now raises a
&jolt-throw condition wrapping the value; catch (lowered to `guard`),
jolt-report-uncaught and jolt-render-throwable unwrap it back via
jolt-unwrap-throw, so ex-data/ex-message and the backtrace tag survive.

Every reader/post-prelude EOF-throw site used `(empty-pmap)` (with
parens), applying the empty-map value as a procedure and crashing during
ex-info construction before jolt-throw ran. Fixed to `empty-pmap`.

Re-minted the seed; smoke 23/23, unit 574/574.
This commit is contained in:
Yogthos 2026-06-30 20:36:06 -04:00
parent a58bca3bee
commit 240458d994
10 changed files with 225 additions and 132 deletions
Download patch file Download diff file Expand all files Collapse all files

5
host/chez/cli.ss
View file

@ -35,8 +35,9 @@
;; and exit non-zero, instead of Chez's opaque "non-condition value" dump. The
;; message/ex-data/cause + a mapped Clojure backtrace come from the shared
;; renderer (source-registry.ss); the cli adds the top-level source location.
(define (jolt-report-uncaught v)
(let ((port (current-error-port)))
(define (jolt-report-uncaught raw)
(let ((v (jolt-unwrap-throw raw))
(port (current-error-port)))
(jolt-render-throwable v port)
;; The top-level form that was evaluating when this propagated (file:line:col).
(let ((loc (jolt-current-source-string)))

6
host/chez/post-prelude.ss
View file

@ -112,13 +112,13 @@
((stream)
(if (reader-jhost? stream)
(let-values (((form found?) (host-reader-read-form stream)))
(if found? form (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap)))))
(if found? form (jolt-throw (jolt-ex-info "EOF while reading" empty-pmap))))
(jolt-invoke ov-read stream)))
((stream e? ev)
(if (reader-jhost? stream)
(let-values (((form found?) (host-reader-read-form stream)))
(cond (found? form)
((jolt-truthy? e?) (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap))))
((jolt-truthy? e?) (jolt-throw (jolt-ex-info "EOF while reading" empty-pmap)))
(else ev)))
(jolt-invoke ov-read stream e? ev))))))
(let ((ov-rps (var-deref "clojure.core" "read+string")))
@ -131,7 +131,7 @@
(let* ((s (drain-reader stream)) (pr (jolt-parse-next s)))
(if (jolt-nil? pr)
(begin (reader-refill! stream "")
(if (jolt-truthy? e?) (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap)))
(if (jolt-truthy? e?) (jolt-throw (jolt-ex-info "EOF while reading" empty-pmap))
(jolt-vector ev "")))
(let ((rest (jolt-nth pr 1)))
(reader-refill! stream rest)

32
host/chez/reader.ss
View file

@ -170,7 +170,7 @@
;; opening quote already consumed; read to the closing quote, processing escapes.
(define (rdr-read-string-lit s i end)
(let loop ((i i) (acc '()))
(when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading string" (empty-pmap))))
(when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading string" empty-pmap)))
(let ((c (string-ref s i)))
(cond
((char=? c #\") (values (list->string (reverse acc)) (+ i 1)))
@ -213,7 +213,7 @@
;; backslash already consumed; read a Clojure character literal.
(define (rdr-read-char s i end)
(when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading char" (empty-pmap))))
(when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading char" empty-pmap)))
(let ((c0 (string-ref s i)))
(if (char-alphabetic? c0)
;; named / unicode / single-letter: collect the alnum run
@ -242,7 +242,7 @@
((char=? (string-ref name 0) #\o)
(integer->char (string->number (substring name 1 (string-length name)) 8)))
(else (jolt-throw (jolt-ex-info (string-append "Unsupported character: \\" name)
(empty-pmap))))))
empty-pmap)))))
;; --- token (symbol / keyword / number / nil|true|false) ---------------------
(define (rdr-read-token s i end)
@ -273,7 +273,7 @@
(let loop ((i i) (acc '()))
(let ((i (rdr-skip-ws s i end)))
(cond
((>= i end) (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap))))
((>= i end) (jolt-throw (jolt-ex-info "EOF while reading" empty-pmap)))
((char=? (string-ref s i) close) (values (reverse acc) (+ i 1)))
(else
(let-values (((form j) (rdr-read-form s i end)))
@ -452,7 +452,7 @@
(let* ((splice (and (< i end) (char=? (string-ref s i) #\@)))
(start (if splice (+ i 1) i)))
(let-values (((form j) (rdr-read-form s start end)))
(when (rdr-eof? form) (jolt-throw (jolt-ex-info "EOF after #?" (empty-pmap))))
(when (rdr-eof? form) (jolt-throw (jolt-ex-info "EOF after #?" empty-pmap)))
(let ((items (cond ((pvec? form) (seq->list form))
((or (cseq? form) (empty-list-t? form)) (seq->list form))
(else '()))))
@ -493,7 +493,7 @@
(vector->list (pvec-v form))))
(else (jolt-throw (jolt-ex-info
(string-append "Unreadable constructor form: #" tok)
(empty-pmap)))))))
empty-pmap))))))
;; #:ns{…} namespaced map literal: a bare keyword/symbol key gets `ns`, a `:_/x`
;; key is un-namespaced, an already-qualified key stays. #::{…} uses the current
@ -521,7 +521,7 @@
(i2 (if auto? (+ i 1) i)))
(let loop ((j i2))
(cond
((>= j end) (jolt-throw (jolt-ex-info "EOF in namespaced map literal" (empty-pmap))))
((>= j end) (jolt-throw (jolt-ex-info "EOF in namespaced map literal" empty-pmap)))
((char=? (string-ref s j) #\{)
(let* ((nstok (substring s i2 j))
(mapns (if auto?
@ -533,7 +533,7 @@
(else (loop (+ j 1)))))))
(define (rdr-read-dispatch s i end) ; i points just past the '#'
(when (>= i end) (jolt-throw (jolt-ex-info "EOF after #" (empty-pmap))))
(when (>= i end) (jolt-throw (jolt-ex-info "EOF after #" empty-pmap)))
(let ((c (string-ref s i)))
(cond
((char=? c #\{) ; #{...} set
@ -549,7 +549,7 @@
(values (jolt-re-pattern src) j)))
((char=? c #\_) ; #_ discard the next form
(let-values (((_ j) (rdr-read-form s (+ i 1) end)))
(when (rdr-eof? _) (jolt-throw (jolt-ex-info "EOF after #_" (empty-pmap))))
(when (rdr-eof? _) (jolt-throw (jolt-ex-info "EOF after #_" empty-pmap)))
(rdr-read-form s j end)))
((char=? c #\') ; #'x var-quote -> (var x)
(let-values (((form j) (rdr-read-form s (+ i 1) end)))
@ -558,7 +558,7 @@
(let-values (((mform j) (rdr-read-form s (+ i 1) end)))
(let-values (((target k) (rdr-read-form s j end)))
(when (rdr-eof? target)
(jolt-throw (jolt-ex-info "EOF after #^meta" (empty-pmap))))
(jolt-throw (jolt-ex-info "EOF after #^meta" empty-pmap)))
(values (rdr-attach-meta target (rdr-meta-map mform)) k))))
((char=? c #\#) ; ## symbolic value: ##Inf / ##-Inf / ##NaN
(let-values (((tok j) (rdr-read-token s (+ i 1) end)))
@ -566,7 +566,7 @@
((string=? tok "-Inf") -inf.0)
((string=? tok "NaN") +nan.0)
(else (jolt-throw (jolt-ex-info (string-append "unknown ## literal: " tok)
(empty-pmap)))))
empty-pmap))))
j)))
((char=? c #\?) ; #?(...) / #?@(...) reader conditional
(rdr-read-reader-cond s (+ i 1) end))
@ -575,7 +575,7 @@
(else ; #tag form -> tagged {:tag :#tag :form ...}
(let-values (((tok j) (rdr-read-token s i end)))
(let-values (((form k) (rdr-read-form s j end)))
(when (rdr-eof? form) (jolt-throw (jolt-ex-info "EOF after #tag" (empty-pmap))))
(when (rdr-eof? form) (jolt-throw (jolt-ex-info "EOF after #tag" empty-pmap)))
(if (rdr-record-tag? tok) ; #ns.Type{..}/[..] record literal
(values (rdr-record-ctor-form tok form) k)
(values (rdr-make-tagged (keyword #f (string-append "#" tok)) form) k))))))))
@ -584,7 +584,7 @@
;; every other backslash sequence is kept verbatim (regex engine semantics).
(define (rdr-read-regex s i end)
(let loop ((i i) (acc '()))
(when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading regex" (empty-pmap))))
(when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading regex" empty-pmap)))
(let ((c (string-ref s i)))
(cond
((char=? c #\") (values (list->string (reverse acc)) (+ i 1)))
@ -638,7 +638,7 @@
;; inert: ``42 reads as 42, ```"meow" as "meow".
((char=? c #\`)
(let-values (((form j) (rdr-read-form s (+ i 1) end)))
(when (rdr-eof? form) (jolt-throw (jolt-ex-info "EOF after `" (empty-pmap))))
(when (rdr-eof? form) (jolt-throw (jolt-ex-info "EOF after `" empty-pmap)))
(values (if (rdr-self-eval-literal? form)
form
(jolt-list (jolt-symbol #f "syntax-quote") form))
@ -655,7 +655,7 @@
(let-values (((mform j) (rdr-read-form s (+ i 1) end)))
(let-values (((target k) (rdr-read-form s j end)))
(when (rdr-eof? target)
(jolt-throw (jolt-ex-info "EOF after ^meta" (empty-pmap))))
(jolt-throw (jolt-ex-info "EOF after ^meta" empty-pmap)))
(values (rdr-attach-meta target (rdr-meta-map mform)) k))))
(else
(let-values (((tok j) (rdr-read-token s i end)))
@ -670,7 +670,7 @@
(define (rdr-wrap s i end head)
(let-values (((form j) (rdr-read-form s i end)))
(when (rdr-eof? form)
(jolt-throw (jolt-ex-info "EOF while reading reader macro" (empty-pmap))))
(jolt-throw (jolt-ex-info "EOF while reading reader macro" empty-pmap)))
(values (jolt-list head form) j)))
;; --- form -> data -----------------------------------------------------------

28
host/chez/rt.ss
View file

@ -37,16 +37,36 @@
(define (jolt-not x) (if (jolt-truthy? x) #f #t))
;; --- exceptions --------------------------------------------------------------
;; throw raises the jolt value RAW (no envelope);
;; catch (emitted as `guard`) binds it directly. Chez `raise` accepts any
;; object, so a thrown number/map/ex-info all work; uncaught -> non-zero exit.
;; throw raises a Chez condition WRAPPING the jolt value; catch (emitted as
;; `guard`) and jolt-report-uncaught unwrap it back via jolt-unwrap-throw.
;; Raising the value RAW broke when a throw crossed the host/`eval` boundary:
;; Chez re-wrapped the non-condition into a compound condition whose
;; message-extraction APPLIES the value (crashing on an empty-map :data ->
;; "attempt to apply non-procedure"), and the real message was lost. A real
;; condition propagates intact through any number of eval boundaries.
;; Capture the live continuation at the throw site (identity-tagged with the
;; thrown value) so an uncaught error can walk the native frames back to a Clojure
;; stack trace (source-registry.ss). call/cc is paid only on a throw, never per
;; call; the captured k is walked, never invoked.
(define jolt-throw-cont (make-thread-parameter #f))
(define-condition-type &jolt-throw &condition
make-jolt-throw-condition jolt-throw-condition?
(value jolt-throw-condition-value))
;; Fallback &message for a leaked condition; the real message always comes from
;; the unwrapped value via ex-message.
(define (jolt-throw-message v)
(if (and (pmap? v)
(jolt=2 (jolt-get v jolt-kw-ex-type jolt-nil) jolt-kw-ex-info))
(let ((m (jolt-get v jolt-kw-message jolt-nil)))
(if (string? m) m "jolt error"))
"jolt error"))
(define (jolt-throw v)
(call/cc (lambda (k) (jolt-throw-cont (cons v k)) (raise v))))
(call/cc (lambda (k)
(jolt-throw-cont (cons v k))
(raise (condition (make-message-condition (jolt-throw-message v))
(make-jolt-throw-condition v))))))
(define (jolt-unwrap-throw x)
(if (jolt-throw-condition? x) (jolt-throw-condition-value x) x))
;; ex-info builds the tagged map {:jolt/type :jolt/ex-info :message :data :cause}
;; — a real jolt-hash-map, so the ex-data/ex-message/ex-cause tier fns read it
;; via jolt-get for free. Arity 2 (msg data) or 3 (msg data cause).

156
host/chez/seed/image.ss
View file

File diff suppressed because one or more lines are too long

19
host/chez/smoke.sh
View file

@ -44,6 +44,14 @@ check '(/ 1 2)' '1/2'
check '(= 3 3.0)' 'false'
check '(== 3 3.0)' 'true'
check_loc '(throw (ex-info "boom" {}))' ' at 1:'
# A throw that crosses the eval boundary (eval / load-string) must surface its
# ex-info :message, not Chez's "attempt to apply non-procedure" noise from
# re-wrapping a raw value raised through `eval`.
check '(try (eval (read-string "(throw (ex-info \"boom\" {}))")) (catch :default e (ex-message e)))' 'boom'
check '(try (load-string "(+") (catch :default e (ex-message e)))' 'EOF while reading'
# An uncaught throw prints the ex-info message alongside its source location.
check_loc '(throw (ex-info "boom" {}))' 'boom'
check_loc '(do (+ 1 1) (/ 1 0))' ' at 1:'
# --help prints usage, and lists the nREPL server under its real flag name.
@ -88,5 +96,16 @@ else
fails=$((fails + 1))
fi
# A form split across lines is accumulated and evaluated once complete, with a
# secondary continuation prompt before each continued line.
repl_out="$(printf '(+ 1\n2)\n:exit\n' | bin/joltc repl 2>/dev/null)"
if printf '%s' "$repl_out" | grep -q '3' && ! printf '%s' "$repl_out" | grep -q 'error'; then
pass=$((pass + 1))
else
echo " FAIL: repl should accumulate multi-line forms to 3"
printf '%s\n' "$repl_out" | sed 's/^/ | /'
fails=$((fails + 1))
fi
echo "cli smoke: $pass passed, $fails failed"
[ "$fails" -eq 0 ]

5
host/chez/source-registry.ss
View file

@ -103,7 +103,8 @@
;; Render an uncaught jolt throw (any value, not just a Chez condition) to a port:
;; an ex-info shows its message + ex-data (+ a host cause); anything else is
;; pr-str'd. Shared by the cli (cli.ss) and a built binary's launcher (build.ss).
(define (jolt-render-throwable v port)
(define (jolt-render-throwable raw port)
(let ((v (jolt-unwrap-throw raw)))
(if (jolt=2 (jolt-get v jolt-kw-ex-type jolt-nil) jolt-kw-ex-info)
(begin
(display "Unhandled exception: " port)
@ -120,7 +121,7 @@
(begin
(display "Unhandled exception: " port)
(display (if (condition? v) (with-output-to-string (lambda () (display-condition v))) (jolt-pr-str v)) port)
(newline port))))
(newline port)))))
;; Render the throwable, then its Clojure backtrace when one maps. The caller adds
;; any top-level source location (the runtime cli does; a built binary has none).

2
jolt-core/jolt/analyzer.clj
View file

@ -258,6 +258,7 @@
(let [n {:op :try :body (analyze-seq ctx @body env)}
n (if (seq @catches)
(let [evar-name (gen-name "catch")
raw-name (gen-name "catch-raw")
evar (symbol evar-name)
dispatch
(reduce
@ -278,6 +279,7 @@
(list 'throw evar)
(reverse @catches))]
(assoc n :catch-sym evar-name
:catch-raw-sym raw-name
:catch-body (analyze-seq ctx (list dispatch)
(add-locals env [evar-name]))))
n)

16
jolt-core/jolt/backend_scheme.clj
View file

@ -666,14 +666,18 @@
:else
(invoke))))
;; try/catch/finally. throw raises the jolt value RAW (jolt-throw =
;; Scheme `raise`); catch lowers to `guard` with an `else` clause (the IR drops
;; the class), finally to `dynamic-wind`'s after-thunk (runs on success, catch and
;; escape — Clojure finally semantics). Both keys optional on the node.
;; try/catch/finally. throw raises a Chez condition wrapping the jolt value
;; (jolt-throw = Scheme `raise` of a &jolt-throw condition); catch lowers to
;; `guard`, whose raw binding is unwrapped via jolt-unwrap-throw so the catch var
;; receives the jolt value (preserving ex-data/ex-message and the backtrace
;; identity tag). finally lowers to `dynamic-wind`'s after-thunk (runs on
;; success, catch and escape — Clojure finally semantics). Both keys optional.
(defn- emit-try [node]
(let [core (if-let [cs (:catch-sym node)]
(str "(guard (" (munge-name cs) " (else " (emit (:catch-body node)) ")) "
(emit (:body node)) ")")
(let [raw (munge-name (:catch-raw-sym node))]
(str "(guard (" raw " (else (let ((" (munge-name cs) " (jolt-unwrap-throw " raw "))) "
(emit (:catch-body node)) "))) "
(emit (:body node)) ")"))
(emit (:body node)))]
(if-let [fin (:finally node)]
(str "(dynamic-wind (lambda () #f) (lambda () " core ") (lambda () " (emit fin) "))")

56
jolt-core/jolt/main.clj
View file

@ -88,6 +88,53 @@
(let [{:keys [roots]} (deps/resolve-project (project-dir))]
(println (str/join ":" roots))))
(defn- repl-form-complete?
"True when `s` has balanced ()/[]/{}, no open string/char/regex, and at most
a trailing comment past the last form. Drives the REPL's read-until-complete
decision so a form split across lines is accumulated, not evaluated half-read."
[s]
(let [n (count s)]
(loop [i 0 depth 0 state :code] ; state: :code :string :regex :comment
(if (>= i n)
(and (<= depth 0) (#{:code :comment} state))
(let [c (get s i)]
(case state
:code (cond
(= c \;) (recur (inc i) depth :comment)
(= c \\) (recur (+ i 2) depth :code) ; char literal: \(
(= c \") (recur (inc i) depth :string)
(= c \#) (recur (inc i) depth
(if (= (get s (inc i)) \") :regex :code))
(#{\( \[ \{} c) (recur (inc i) (inc depth) :code)
(#{\) \] \}} c) (recur (inc i) (dec depth) :code)
:else (recur (inc i) depth :code))
:string (cond
(= c \\) (recur (+ i 2) depth :string) ; escaped char
(= c \") (recur (inc i) depth :code)
:else (recur (inc i) depth :string))
:regex (cond
(= c \\) (recur (+ i 2) depth :regex)
(= c \") (recur (inc i) depth :code)
:else (recur (inc i) depth :regex))
:comment (recur (inc i) depth
(if (#{\newline \return} c) :code :comment))))))))
(defn- repl-read-form []
;; Read lines — printing a secondary prompt for continuations — until the
;; accumulated buffer is a complete form. Returns the (possibly multi-line)
;; buffer, or nil on EOF at the primary prompt.
(loop [buf nil]
(print (if buf "... " "user=> ")) (flush)
(let [line (read-line)]
(cond
(nil? line) buf ; EOF: nil at primary, partial mid-form
(nil? buf) (cond
(str/blank? line) (recur nil) ; skip a blank first line
(repl-form-complete? line) line
:else (recur line))
:else (let [nb (str buf "\n" line)]
(if (repl-form-complete? nb) nb (recur nb)))))))
(defn- repl []
;; resolve the project so deps (git libs) are on the roots and native libs are
;; loaded — same context a run gets, so (require '[some.lib]) works in the REPL.
@ -95,15 +142,14 @@
(catch :default _ nil))
(println ";; jolt repl — :repl/quit or ^D to exit")
(loop []
(print "user=> ") (flush)
(let [line (read-line)]
(when line
(let [form (repl-read-form)]
(when form
;; :repl/quit / :exit exit the loop — a reliable gesture that works in any
;; terminal, unlike ^D (some terminals/editors don't deliver it as EOF).
(if (#{:repl/quit :exit} (try (read-string line) (catch :default _ nil)))
(if (#{:repl/quit :exit} (try (read-string form) (catch :default _ nil)))
nil
(do
(try (println (pr-str (load-string line)))
(try (println (pr-str (load-string form)))
(catch :default e
(println "error:" (or (ex-message e)
(try ((resolve 'jolt.host/condition-message) e) (catch :default _ nil))