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

Clojure stack traces via source registry + native frame walk

Browse source 
A direct-link build emits (jolt-register-source! short-name ns name file line)
once per fn def — at definition time, so zero per-call cost. On an uncaught
error the reporter walks Chez's native continuation frames (jolt-throw captures
the live continuation via call/cc; host conditions carry their own
&continuation), maps each frame's procedure name through the registry, and
prints a Clojure backtrace 'ns/name (file:line)'. Wired into both the cli and a
built binary's launcher.

Frames are keyed by the short munged fn name Chez actually reports (emit-fn's
letrec self-binding), not jv$ns$name; a cross-namespace collision degrades to
the bare frame name rather than a wrong attribution. The analyzer carries the
original form's position through defn macroexpansion onto the def node.

Calling a non-fn now throws a catchable ClassCastException (via jolt-throw)
naming the operator, instead of a raw Chez error.

Caveats (documented in source-registry.ss): names map only in direct-link/AOT
closed-world builds — the open-world -e/repl/run path falls back to the
top-level location; and pervasive TCO erases tail-call frames, so a mapped
trace shows only the non-tail spine. JOLT_DEBUG_FRAMES dumps raw frame names.

Re-mint (analyzer + backend); prelude byte-identical (direct-link off during
mint). Corpus rows certified, build-smoke asserts the trace.
This commit is contained in:
Yogthos 2026-06-25 21:49:11 -04:00
parent 9bf3d1c80e
commit 57bab5d409
12 changed files with 288 additions and 105 deletions
Download patch file Download diff file Expand all files Collapse all files

13
host/chez/build-smoke.sh
View file

@ -81,6 +81,19 @@ fi
if ! grep -q '(jv\$app.util\$shout' "$out.build/flat.ss"; then
echo " FAIL: --direct-link did not emit a direct app->app call"; exit 1
fi
# A direct-link build registers fn sources, so an uncaught throw prints a Clojure
# stack trace mapping each native frame back to ns/name (file:line).
if ! grep -q 'jolt-register-source!' "$out.build/flat.ss"; then
echo " FAIL: --direct-link did not emit source registrations"; exit 1
fi
boom_err="$(cd / && "$out" --boom 2>&1 >/dev/null)"
for frame in 'app.util/deep-boom' 'app.util/mid-boom' 'app.core/-main'; do
if ! printf '%s' "$boom_err" | grep -q "$frame"; then
echo " FAIL: stack trace missing frame $frame"
echo "--- got ----"; echo "$boom_err"
exit 1
fi
done
# Tree-shaking (opt-in): same result, and an unreachable def (the `twice` macro,
# expanded at AOT and never called at runtime) is dropped.
if ! JOLT_PWD="$app" bin/joltc build -m app.core -o "$out" --tree-shake >/dev/null 2>&1; then

19
host/chez/build.ss
View file

@ -337,18 +337,20 @@
;; ns + register aliases before this ns's forms; dce
;; keeps original order.
(let ((src (read-file-string (cdr nf))))
(append
(map (lambda (s) (dce-rec #t #f '() s))
(bld-ns-prelude (car nf) src))
(ei-emit-ns-records (car nf) src))))
(parameterize ((rdr-source-file (cdr nf)))
(append
(map (lambda (s) (dce-rec #t #f '() s))
(bld-ns-prelude (car nf) src))
(ei-emit-ns-records (car nf) src)))))
ordered))
(string-append entry-ns "/-main"))
(values #f
(apply append
(map (lambda (nf)
(let ((src (read-file-string (cdr nf))))
(append (bld-ns-prelude (car nf) src)
(bld-emit-ns (car nf) src))))
(parameterize ((rdr-source-file (cdr nf)))
(append (bld-ns-prelude (car nf) src)
(bld-emit-ns (car nf) src)))))
ordered))
#f)))
(lambda ()
@ -400,7 +402,10 @@
" (list \"jolt-core\" \"stdlib\"))))\n"))
(put-string out (string-append
" (let ((mainv (var-deref " (ei-str-lit entry-ns) " \"-main\")))\n"
" (apply jolt-invoke mainv args))\n"
;; render an uncaught throw (+ Clojure backtrace) instead
;; of Chez's opaque dump, then exit non-zero.
" (guard (v (#t (jolt-report-throwable v (current-error-port)) (exit 1)))\n"
" (apply jolt-invoke mainv args)))\n"
" (exit 0)))\n"))
(close-port out))
;; 4. compile -> boot -> embed -> link.

25
host/chez/cli.ss
View file

@ -32,30 +32,17 @@
(set-source-roots! (list "jolt-core" "stdlib"))
;; Render an uncaught jolt throw (any value, not just a Chez condition) to stderr
;; and exit non-zero, instead of Chez's opaque "non-condition value" dump. An
;; ex-info shows its message + ex-data; anything else is pr-str'd.
;; 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)))
(if (and (jolt=2 (jolt-get v jolt-kw-ex-type jolt-nil) jolt-kw-ex-info))
(begin
(display "Unhandled exception: " port)
(display (jolt-str-render-one (jolt-get v jolt-kw-message jolt-nil)) port)
(newline port)
(let ((data (jolt-get v jolt-kw-data jolt-nil)))
(unless (jolt-nil? data)
(display " ex-data: " port) (display (jolt-pr-str data) port) (newline port)))
(let ((cause (jolt-get v jolt-kw-cause jolt-nil)))
(when (condition? cause)
(display " cause: " port)
(display (with-output-to-string (lambda () (display-condition cause))) port)
(newline port))))
(begin
(display "Unhandled exception: " port)
(display (if (condition? v) (with-output-to-string (lambda () (display-condition v))) (jolt-pr-str v)) port)
(newline 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)))
(when loc (display " at " port) (display loc port) (newline port)))
(let ((bt (jolt-backtrace-string v)))
(when bt (display " trace:\n" port) (display bt port)))
(exit 1)))
(guard (v (#t (jolt-report-uncaught v)))

12
host/chez/rt.ss
View file

@ -35,7 +35,13 @@
;; 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.
(define (jolt-throw v) (raise v))
;; 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 (jolt-throw v)
(call/cc (lambda (k) (jolt-throw-cont (cons v k)) (raise v))))
;; 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).
@ -408,3 +414,7 @@
;; printing. Loads LAST so its set!-wraps of jolt-class/jolt=2/the printers sit
;; outermost over every earlier extension.
(load "host/chez/java/bigdec.ss")
;; Native stack traces: jv$ns$name -> source registry + continuation frame walk +
;; uncaught-throwable renderer. After the printers/equality it relies on.
(load "host/chez/source-registry.ss")

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

File diff suppressed because one or more lines are too long

7
host/chez/seq.ss
View file

@ -154,7 +154,12 @@
=> (lambda (m) (apply jolt-invoke m f args)))
((and (reified-methods f) (hashtable-ref (reified-methods f) "invoke" #f))
=> (lambda (m) (apply jolt-invoke m f args)))
(else (error 'invoke "not a fn" f))))
;; calling a non-fn: a ClassCastException naming the operator, thrown via
;; jolt-throw so it is catchable and carries the throw-site continuation for a
;; stack trace.
(else (jolt-throw (jolt-host-throwable "java.lang.ClassCastException"
(string-append (guard (e (#t "value")) (jolt-pr-str f))
" cannot be cast to clojure.lang.IFn"))))))
;; ============================================================================
;; map / filter / reduce / into / remove + range / take / concat / apply

128
host/chez/source-registry.ss Normal file
View file

@ -0,0 +1,128 @@
;; source-registry.ss — map emitted procedures back to Clojure source for native
;; stack traces, and render an uncaught throwable.
;;
;; A direct-linked def compiles to (define jv$ns$name <fn>); the back end also
;; emits (jolt-register-source! "jv$ns$name" ns name file line) once per such def
;; — at definition time, so there is zero per-call cost. On an uncaught error we
;; walk Chez's native continuation frames, read each frame's procedure name, and
;; look it up here to print a Clojure backtrace.
;;
;; CAVEATS. Names map only for stable Chez procedure names — direct-link / AOT
;; closed-world builds. The open-world -e/repl/run path stores fns in var cells
;; as anonymous lambdas, so its frames don't map (the trace falls back to the
;; top-level location compile-eval.ss tracks). Pervasive tail-call optimization
;; also erases tail-called frames, so even a mapped trace shows only the non-tail
;; spine — the immediate error site is often a tail call and won't appear.
;; Keyed by the procedure name Chez actually reports for a frame — the SHORT
;; munged fn name (the letrec self-binding emit-fn uses), e.g. "deepest", not the
;; jv$ns$name global. Two vars in different namespaces can share a short name; an
;; 'ambiguous marker then keeps the frame name in the trace but drops the
;; (now-uncertain) ns/file:line, so a trace is never misattributed.
(define source-registry (make-hashtable string-hash string=?))
(define (jolt-register-source! procname ns nm file line)
(let ((existing (hashtable-ref source-registry procname #f)))
(cond
((not existing) (hashtable-set! source-registry procname (vector ns nm file line)))
((and (vector? existing)
(or (not (equal? (vector-ref existing 0) ns))
(not (equal? (vector-ref existing 1) nm))))
(hashtable-set! source-registry procname 'ambiguous))))
jolt-nil)
(def-var! "jolt.host" "register-source!" jolt-register-source!)
;; The continuation to walk for an uncaught value: the one jolt-throw captured for
;; THIS value (identity-tagged via jolt-throw-cont, so a stale entry from an
;; earlier caught throw is never reused), else a host condition's own
;; &continuation, else #f.
(define (jolt-error-continuation v)
(let ((tc (jolt-throw-cont)))
(cond
((and (pair? tc) (eq? (car tc) v)) (cdr tc))
((and (condition? v) (continuation-condition? v)) (condition-continuation v))
(else #f))))
;; A frame inspector's procedure name as a string, or #f for a non-frame / unnamed.
(define (srcreg-frame-name io)
(and (guard (e (#t #f)) (eq? (io 'type) 'continuation))
(let ((code (guard (e (#t #f)) (io 'code))))
(and code
(let ((nm (guard (e (#t #f)) (code 'name))))
(cond ((string? nm) nm)
((symbol? nm) (symbol->string nm))
(else #f)))))))
;; Walk a continuation, returning the registered jolt frames (innermost first) as
;; (frame-name . record) pairs, where record is #(ns name file line) or the symbol
;; 'ambiguous. Unmapped frames (host spine, anonymous lambdas) are skipped; raw
;; depth is capped.
(define srcreg-debug? (getenv "JOLT_DEBUG_FRAMES"))
(define (jolt-frame-records k)
(guard (e (#t '()))
(let loop ((io (inspect/object k)) (n 0) (acc '()))
(if (or (not io) (fx>=? n 400))
(reverse acc)
(let* ((nm (srcreg-frame-name io))
(src (and nm (hashtable-ref source-registry nm #f))))
(when (and srcreg-debug? nm)
(display (string-append " [frame] " nm (if src " *MAPPED*" "") "\n")
(current-error-port)))
(loop (guard (e (#t #f)) (io 'link)) (fx+ n 1)
(if src (cons (cons nm src) acc) acc)))))))
;; Multi-line backtrace for an uncaught value — " ns/name (file:line)" for a
;; mapped frame, the bare frame name for an ambiguous one — or #f when no jolt
;; frame maps (the caller then prints just the top-level location). Capped to the
;; innermost frames.
(define (jolt-backtrace-string v)
(let ((k (jolt-error-continuation v)))
(and k
(let ((recs (jolt-frame-records k)))
(and (pair? recs)
(let ((port (open-output-string)))
(let loop ((rs recs) (shown 0))
(when (and (pair? rs) (fx<? shown 30))
(let* ((p (car rs)) (frame-name (car p)) (r (cdr p)))
(put-string port " ")
(if (vector? r)
(let ((ns (vector-ref r 0)) (nm (vector-ref r 1))
(file (vector-ref r 2)) (line (vector-ref r 3)))
(put-string port ns) (put-string port "/") (put-string port nm)
(when (string? file)
(put-string port " (") (put-string port file)
(put-string port ":") (put-string port (number->string line))
(put-string port ")")))
(put-string port frame-name)) ; 'ambiguous: bare name
(put-char port #\newline))
(loop (cdr rs) (fx+ shown 1))))
(get-output-string port)))))))
;; 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)
(if (jolt=2 (jolt-get v jolt-kw-ex-type jolt-nil) jolt-kw-ex-info)
(begin
(display "Unhandled exception: " port)
(display (jolt-str-render-one (jolt-get v jolt-kw-message jolt-nil)) port)
(newline port)
(let ((data (jolt-get v jolt-kw-data jolt-nil)))
(unless (jolt-nil? data)
(display " ex-data: " port) (display (jolt-pr-str data) port) (newline port)))
(let ((cause (jolt-get v jolt-kw-cause jolt-nil)))
(when (condition? cause)
(display " cause: " port)
(display (with-output-to-string (lambda () (display-condition cause))) port)
(newline port))))
(begin
(display "Unhandled exception: " port)
(display (if (condition? v) (with-output-to-string (lambda () (display-condition v))) (jolt-pr-str v)) 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).
(define (jolt-report-throwable v port)
(jolt-render-throwable v port)
(let ((bt (jolt-backtrace-string v)))
(when bt (display " trace:\n" port) (display bt port))))