Source locations: reader positions, error locations, native stack traces (#218)

* Reader records source line/column on list forms

The reader stamps 1-based :line/:column metadata on every list form (plus
:file when load-jolt-file is reading a file), and jolt.host/form-position
reads it back so the analyzer's :pos scaffold finally gets real data. A
left-to-right cursor counts newlines over the delta between successive forms,
so it stays O(n). Vector/map/set literals are untouched (their metadata is a
runtime value the analyzer would have to wrap in with-meta); empty () can't
carry meta. ^meta now merges onto the position keys instead of clobbering them.

Re-mint is byte-identical (the backend doesn't emit :pos), so this is a pure
scaffold for the error-location work that follows.

* Report source location on uncaught errors

Each top-level form records its source position (thread-local) before it
compiles+evals, and cli.ss jolt-report-uncaught appends 'at file:line:col'
when an error propagates out. Covers joltc -e, joltc run <file>, and
load-string — every interpreted path. Top-level granularity, one set per
form; deeper frames come from the Phase 2 frame walk.

Runtime .ss only, no re-mint.

* Clojure stack traces via source registry + native frame walk

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.

* Propagate source position through macroexpansion

hc-expand-1 now carries the macro call form's :line/:column onto the top of a
list expansion that has none of its own (merged under any meta the macro set),
so errors and stack traces in macro-generated code point at the call site —
Clojure parity. The analyze recursion re-expands inner macros, so each level's
top form picks it up, matching the reference compiler. (meta (macroexpand-1
'(when x y))) now reports the call-site line.

A direct-link fn defined through a user macro (build-app's defguarded) registers
with a real line, so build-smoke's trace assertion covers macro-defined fns.

Runtime .ss (host-contract.ss) — no re-mint; selfhost holds.

Phase 3's optional items are deferred: :line-in-ex-data has no clean consumer
(it would pollute ex-data, break = and printing, and positions already surface
via the trace + top-level location), and Chez source-object emission is a large
backend change the jv$-name registry already sidesteps.

* Review fixes: registration key, thread-locals, debug flag timing

- Register a fn under the name Chez actually reports for its frame, not the def
  name: a named fn literal whose name differs from the def (def foo (fn bar …))
  is framed as 'bar', and an anonymous fn def (def foo (fn …)) as jv$ns$foo.
  Both previously registered under the def name and so never appeared in traces.
- rdr-source-file / rdr-pos-cursor are thread parameters, so concurrent compiles
  (futures, core.async) don't clobber each other's file/line attribution.
- Read JOLT_DEBUG_FRAMES at call time: a built binary evaluates top-level forms
  at heap-build time, where a load-time getenv is always unset.

Re-mint (backend + reader); prelude byte-identical, selfhost holds.

---------

Co-authored-by: Yogthos <yogthos@gmail.com>

host/chez/build-smoke.sh

@@ -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

host/chez/build.ss

@@ -337,18 +337,20 @@
                                ;; ns + register aliases before this ns's forms; dce
                                ;; keeps original order.
                                (let ((src (read-file-string (cdr nf))))
-                                 (append
+                                 (parameterize ((rdr-source-file (cdr nf)))
-                                   (map (lambda (s) (dce-rec #t #f '() s))
+                                   (append
-                                        (bld-ns-prelude (car nf) src))
+                                     (map (lambda (s) (dce-rec #t #f '() s))
-                                   (ei-emit-ns-records (car nf) src))))
+                                          (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)
+                                       (parameterize ((rdr-source-file (cdr nf)))
-                                               (bld-emit-ns (car nf) src))))
+                                         (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.

host/chez/cli.ss

@@ -32,27 +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
+;; and exit non-zero, instead of Chez's opaque "non-condition value" dump. The
-;; ex-info shows its message + ex-data; anything else is pr-str'd.
+;; 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))
+    (jolt-render-throwable v port)
-        (begin
+    ;; The top-level form that was evaluating when this propagated (file:line:col).
-          (display "Unhandled exception: " port)
+    (let ((loc (jolt-current-source-string)))
-          (display (jolt-str-render-one (jolt-get v jolt-kw-message jolt-nil)) port)
+      (when loc (display "  at " port) (display loc port) (newline port)))
-          (newline port)
+    (let ((bt (jolt-backtrace-string v)))
-          (let ((data (jolt-get v jolt-kw-data jolt-nil)))
+      (when bt (display "  trace:\n" port) (display bt port)))
-            (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)))
     (exit 1)))
 
 (guard (v (#t (jolt-report-uncaught v)))

host/chez/compile-eval.ss

@@ -20,6 +20,29 @@
 ;; whose data conversion would turn those into real sets.
 (define jolt-ce-read jolt-read-form-raw)
 
+;; --- current source location ------------------------------------------------
+;; The position of the top-level form currently compiling/evaluating, so an
+;; uncaught error can report where it came from (cli.ss jolt-report-uncaught).
+;; Thread-local: a future/agent worker tracks its own form. Holds #f or a
+;; {:line :column :file?} position map (jolt.host/form-position's shape).
+;; Top-level granularity — one set per top-level form, nothing per call.
+(define jolt-current-source (make-thread-parameter #f))
+(define (jolt-enter-form! form)
+  (let ((p (hc-form-position form)))
+    (when (pmap? p) (jolt-current-source p))))
+
+;; "file:line:col" / "line:col" for the current form, or #f when none is set.
+(define (jolt-current-source-string)
+  (let ((p (jolt-current-source)))
+    (and (pmap? p)
+         (let ((line (jolt-get p hc-kw-line jolt-nil))
+               (col  (jolt-get p hc-kw-column jolt-nil))
+               (file (jolt-get p hc-kw-file jolt-nil)))
+           (string-append
+             (if (jolt-nil? file) "" (string-append file ":"))
+             (if (jolt-nil? line) "?" (number->string line)) ":"
+             (if (jolt-nil? col) "?" (number->string col)))))))
+
 ;; The spine ALWAYS runs with the full clojure.core prelude loaded, so a clojure.*
 ;; ref must lower to var-deref (resolved from the prelude), not trip the emitter's
 ;; "unsupported stdlib fn (no core on Chez yet)" out-of-subset guard — that guard
@@ -124,6 +147,9 @@
     ;; of the expander fn + (mark-macro! …) so subsequent forms expand it. One
     ;; macro-expansion path (no separate spine interception).
     (else
+     ;; record this form's source location first, so a compile- or run-time error
+     ;; in it reports the right place.
+     (jolt-enter-form! form)
      (eval (read (open-input-string (jolt-analyze-emit-form form ns)))
            (interaction-environment)))))
 

host/chez/host-contract.ss

@@ -119,8 +119,22 @@
 (define (hc-inst-source x) (jolt-get x hc-kw-form))
 (define (hc-uuid-source x) (jolt-get x hc-kw-form))
 
-;; The Chez reader does not record source offsets yet.
+;; Source position for a list form: the reader stamps :line/:column (+ :file when
-(define (hc-form-position x) jolt-nil)
+;; compiling a file) into the form's metadata. Return a clean {:line :column
+;; :file?} map, or nil for a synthetic/macro-built form that carries none.
+(define hc-kw-line   (keyword #f "line"))
+(define hc-kw-column (keyword #f "column"))
+(define hc-kw-file   (keyword #f "file"))
+(define (hc-form-position x)
+  (let ((m (jolt-meta x)))
+    (if (and (pmap? m) (not (jolt-nil? (jolt-get m hc-kw-line))))
+        (let ((line (jolt-get m hc-kw-line))
+              (col  (jolt-get m hc-kw-column))
+              (file (jolt-get m hc-kw-file)))
+          (if (jolt-nil? file)
+              (jolt-hash-map hc-kw-line line hc-kw-column col)
+              (jolt-hash-map hc-kw-line line hc-kw-column col hc-kw-file file)))
+        jolt-nil)))
 
 ;; --- special forms ----------------------------------------------------------
 ;; Mirrors host_iface special-names + interop-head? — forms the analyzer marks
@@ -170,12 +184,31 @@
 ;; of the list), and the analyzer re-analyzes the returned form.
 (define (hc-macro? ctx sym)
   (macro-var? (hc-resolve-cell ctx sym)))
+;; Clojure parity: a macro expansion inherits the call form's source position, so
+;; errors/traces in macro-generated code point at the macro call site. Carry it
+;; onto the top of a LIST expansion (code) that has none of its own — merged under
+;; any meta the macro set, leaving collection literals (runtime data) alone. The
+;; recursion through analyze re-expands inner macros, so each level's top form
+;; picks up the position the same way (as the reference compiler does).
+(define (hc-propagate-pos src dst)
+  (if (and (cseq? dst) (cseq-list? dst))
+      (let ((sp (hc-form-position src))
+            (dm (jolt-meta dst)))
+        (if (and (pmap? sp)
+                 (or (jolt-nil? dm) (jolt-nil? (jolt-get dm hc-kw-line))))
+            (jolt-with-meta dst
+              (if (pmap? dm)
+                  (pmap-fold sp (lambda (k v acc) (jolt-assoc1 acc k v)) dm)
+                  sp))
+            dst))
+      dst))
+
 (define (hc-expand-1 ctx form)
   (let* ((items (seq->list form))
          (head (car items))
          (args (cdr items))
          (expander (var-cell-root (hc-resolve-cell ctx head))))
-    (apply jolt-invoke expander args)))
+    (hc-propagate-pos form (apply jolt-invoke expander args))))
 
 ;; Classify a global (non-local) symbol reference against the var registry:
 ;;   {:kind :var :ns NS :name NAME}   — a defined var (compile ns / clojure.core)

host/chez/loader.ss

@@ -169,17 +169,20 @@
 ;; skip the no-op form and continue to true end-of-string.
 (define (load-jolt-file path)
   (let* ((src (read-file-string path)) (end (string-length src)))
-    (let loop ((i 0))
+    ;; parameterize (not a bare set!) so a require nested in this file's ns form
-      (when (< i end)
+    ;; restores path when control returns to the rest of this file.
-        (let-values (((form j) (rdr-read-form src i end)))
+    (parameterize ((rdr-source-file path))   ; list forms read here carry :file = path
-          (when (> j i)
+      (let loop ((i 0))
-            (unless (rdr-eof? form)
+        (when (< i end)
-              (when (getenv "JOLT_TRACE_LOAD")
+          (let-values (((form j) (rdr-read-form src i end)))
-                (display "  [load-form] " (current-error-port))
+            (when (> j i)
-                (display (jolt-pr-str form) (current-error-port)) (newline (current-error-port)))
+              (unless (rdr-eof? form)
-              (jolt-compile-eval-form (if data-readers-active (ldr-apply-readers form) form)
+                (when (getenv "JOLT_TRACE_LOAD")
-                                      (chez-current-ns)))
+                  (display "  [load-form] " (current-error-port))
-            (loop j)))))))
+                  (display (jolt-pr-str form) (current-error-port)) (newline (current-error-port)))
+                (jolt-compile-eval-form (if data-readers-active (ldr-apply-readers form) form)
+                                        (chez-current-ns)))
+              (loop j))))))))
 
 ;; load-namespace: load `name`'s source once. Marked loaded BEFORE eval so a
 ;; dependency cycle terminates (Clojure's behavior). The caller's current ns is

host/chez/reader.ss

@@ -316,7 +316,11 @@
     ;; (with-meta form meta) for a meta-carrying collection literal in code, so
     ;; (meta ^{:tag :int} [1 2]) / ^:foo {} still works.
     (else
-     (let ((c (jolt-with-meta target meta)))
+     ;; Merge onto any metadata the target already carries (a list form picks up
+     ;; :line/:column first, then ^meta folds its keys on top).
+     (let* ((old (jolt-meta target))
+            (merged (rdr-merge-meta (if (jolt-nil? old) jolt-nil old) meta))
+            (c (jolt-with-meta target merged)))
        ;; jolt-with-meta copies a pmap, giving it a fresh identity the rdr-map-order
        ;; side-table (source key order for left-to-right map-literal eval) loses —
        ;; carry the order entry over to the copy.
@@ -324,6 +328,45 @@
          (when order (hashtable-set! rdr-map-order c order)))
        c))))
 
+;; --- source position --------------------------------------------------------
+;; List forms (code) carry 1-based :line/:column, plus :file when the compiler
+;; bound rdr-source-file. read-string leaves the file unset. The analyzer reads
+;; this back via jolt.host/form-position to stamp :pos on call nodes; macros and
+;; (meta (read-string "(…)")) see it too.
+(define rdr-source-file (make-thread-parameter #f))
+(define rdr-kw-line   (keyword #f "line"))
+(define rdr-kw-column (keyword #f "column"))
+(define rdr-kw-file   (keyword #f "file"))
+
+;; Forms are read left-to-right, so the indices queried are non-decreasing within
+;; one source string — keep a cursor and count newlines only over the delta
+;; (O(n) total, not O(n^2)). A different string or a backward index resets it.
+(define rdr-pos-cursor (make-thread-parameter #f))   ; #f | (vector s i line col)
+(define (rdr-line-col-at s i)
+  (let* ((cur (rdr-pos-cursor))
+         (reuse (and (vector? cur) (eq? (vector-ref cur 0) s)
+                     (fx<=? (vector-ref cur 1) i)))
+         (k0 (if reuse (vector-ref cur 1) 0))
+         (l0 (if reuse (vector-ref cur 2) 1))
+         (c0 (if reuse (vector-ref cur 3) 1)))
+    (let loop ((k k0) (line l0) (col c0))
+      (if (fx>=? k i)
+          (begin (rdr-pos-cursor (vector s k line col)) (values line col))
+          (if (char=? (string-ref s k) #\newline)
+              (loop (fx+ k 1) (fx+ line 1) 1)
+              (loop (fx+ k 1) line (fx+ col 1)))))))
+
+(define (rdr-pos-meta line col)
+  (let ((f (rdr-source-file)))
+    (if f
+        (jolt-hash-map rdr-kw-line line rdr-kw-column col rdr-kw-file f)
+        (jolt-hash-map rdr-kw-line line rdr-kw-column col))))
+
+(define (rdr-attach-pos lst line col)
+  (if (empty-list-t? lst)            ; () is interned, can't carry meta (= Clojure)
+      lst
+      (rdr-attach-meta lst (rdr-pos-meta line col))))
+
 ;; --- # dispatch -------------------------------------------------------------
 ;; #(...) anonymous fn shorthand: % -> p1, %N -> pN, %& -> rest. The
 ;; fixed arity is the MAX positional used (Clojure: #(do %2 %&) -> [p1 p2 & rest]).
@@ -496,8 +539,9 @@
         (values rdr-eof i)
         (let ((c (string-ref s i)))
           (cond
-            ((char=? c #\() (let-values (((es j) (rdr-read-seq s (+ i 1) end #\))))
+            ((char=? c #\() (let-values (((line col) (rdr-line-col-at s i)))
-                              (values (apply jolt-list es) j)))
+                              (let-values (((es j) (rdr-read-seq s (+ i 1) end #\))))
+                                (values (rdr-attach-pos (apply jolt-list es) line col) j))))
             ((char=? c #\[) (let-values (((es j) (rdr-read-seq s (+ i 1) end #\])))
                               (values (apply jolt-vector es) j)))
             ((char=? c #\{) (let-values (((es j) (rdr-read-seq s (+ i 1) end #\})))

host/chez/rt.ss

@@ -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")

host/chez/seq.ss

@@ -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

host/chez/smoke.sh

@@ -18,6 +18,18 @@ check() {
 }
 pass=0
 
+# An uncaught error reports the source location of the top-level form (stderr).
+check_loc() {
+  err="$(bin/joltc -e "$1" 2>&1 >/dev/null)"
+  if printf '%s' "$err" | grep -q "$2"; then
+    pass=$((pass + 1))
+  else
+    echo "  FAIL (loc): $1"
+    echo "    want stderr to contain \`$2\`, got \`$err\`"
+    fails=$((fails + 1))
+  fi
+}
+
 check '(+ 1 2)' '3'
 check '(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 15)' '610'
 check '(->> (range 10) (filter even?) (map (fn [x] (* x x))) (reduce +))' '120'
@@ -31,6 +43,8 @@ check '(deref (future (+ 1 2)))' '3'
 check '(/ 1 2)' '1/2'
 check '(= 3 3.0)' 'false'
 check '(== 3 3.0)' 'true'
+check_loc '(throw (ex-info "boom" {}))' '  at 1:'
+check_loc '(do (+ 1 1) (/ 1 0))' '  at 1:'
 
 echo "cli smoke: $pass passed, $fails failed"
 [ "$fails" -eq 0 ]

host/chez/source-registry.ss

@@ -0,0 +1,130 @@
+;; 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 (jolt-frame-records k)
+  ;; read the env at call time, not load time: a built binary runs top-level forms
+  ;; at heap-build time, where this would always be unset.
+  (let ((debug? (getenv "JOLT_DEBUG_FRAMES")))
+   (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 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))))

jolt-core/jolt/analyzer.clj

@@ -613,7 +613,12 @@
           ;; macro `def`/`and`/`or` (clojure.spec.alpha) keeps the special form `def`.
           (and (form-sym? head) (not shadowed)
                (not (contains? handled hname)) (form-macro? ctx head))
-            (analyze ctx (form-expand-1 ctx form) env)
+            ;; defn/defn- expand to (def name (fn …)); carry the ORIGINAL form's
+            ;; source offset onto the resulting def, since the macro builds a fresh
+            ;; (def …) with no metadata. So the back end can register fn defs.
+            (let [node (analyze ctx (form-expand-1 ctx form) env)
+                  p (form-position form)]
+              (if (and p (= :def (:op node))) (assoc node :pos p) node))
           ;; jolt.ffi/__cfn — the foreign-function special form (always emitted
           ;; fully-qualified by the jolt.ffi/foreign-fn macro, so aliases resolve).
           (and (form-sym? head) (= "jolt.ffi" (form-sym-ns head))
@@ -628,7 +633,11 @@
           ;; `if` does not change the meaning of (if …) in operator position, per
           ;; spec §3 and the reference. No (not shadowed) guard here.
           (and hname (contains? handled hname))
-            (analyze-special ctx hname items env)
+            ;; stamp the form's source offset onto a top-level def so the back end
+            ;; can register it (jv$ns$name -> source) for native stack traces.
+            (let [node (analyze-special ctx hname items env)
+                  p (form-position form)]
+              (if (and p (= :def (:op node))) (assoc node :pos p) node))
           (and hname (not shadowed) (method-head? hname))
             (analyze-host-call ctx hname items env)
           ;; (Class. args*) — trailing-dot constructor sugar.

jolt-core/jolt/backend_scheme.clj

@@ -674,14 +674,29 @@
     (str "(begin " (str/join " " (map emit-top-form (:statements node)))
          (if (empty? (:statements node)) "" " ") (emit-top-form (:ret node)) ")")
     (and (= :def (:op node)) (not (:no-init node)) (not (dl-opt-out? (:meta node))))
-    (let [ns (:ns node) nm (:name node) b (dl-name ns nm)]
+    (let [ns (:ns node) nm (:name node) b (dl-name ns nm)
+          fn? (= :fn (:op (:init node)))
+          ;; A fn def gets a source-registry entry so a native backtrace can map its
+          ;; frame to ns/name (file:line). Chez names the frame by whatever emit-fn
+          ;; binds the lambda to: a NAMED fn (defn, or (fn foo …)) gets a letrec
+          ;; self-binding = munge-name of the fn's own name; an ANONYMOUS fn def has
+          ;; no letrec, so the lambda sits directly under (define jv$ns$name …) and
+          ;; takes that name. Register under whichever Chez will report.
+          pos (:pos node)
+          frame-name (when fn?
+                       (if-let [fnm (:name (:init node))] (munge-name fnm) b))
+          reg (when (and fn? pos)
+                (str " (jolt-register-source! " (chez-str-lit frame-name) " "
+                     (chez-str-lit ns) " " (chez-str-lit nm) " "
+                     (if (get pos :file) (chez-str-lit (get pos :file)) "jolt-nil") " "
+                     (or (get pos :line) 0) ")"))]
       ;; register before emitting the init so a self-referential body direct-links.
       (swap! direct-link-defined conj (dl-fqn ns nm))
-      (when (= :fn (:op (:init node))) (swap! direct-link-fns conj (dl-fqn ns nm)))
+      (when fn? (swap! direct-link-fns conj (dl-fqn ns nm)))
       (let [init (emit (:init node))]
         (if (jmeta-nonempty? (:meta node))
           (str "(begin (define " b " " init ") (def-var-with-meta! "
-               (chez-str-lit ns) " " (chez-str-lit nm) " " b " " (emit-def-meta node) "))")
+               (chez-str-lit ns) " " (chez-str-lit nm) " " b " " (emit-def-meta node) ")" (or reg "") ")")
           (str "(begin (define " b " " init ") (def-var! "
-               (chez-str-lit ns) " " (chez-str-lit nm) " " b "))"))))
+               (chez-str-lit ns) " " (chez-str-lit nm) " " b ")" (or reg "") ")"))))
     :else (emit node)))

test/chez/build-app/src/app/core.clj

@@ -12,6 +12,10 @@
 (defmethod greet :soft [_] "greet:soft")
 
 (defn -main [& args]
+  ;; --boom: throw through a two-deep call chain so build-smoke can assert the
+  ;; native stack trace. Off the normal path, so default output is unchanged.
+  (when (= (first args) "--boom")
+    (util/mid-boom "not-a-number"))
   ;; the resource is baked into the binary (deps.edn :jolt/build :embed), so this
   ;; resolves with no resources/ dir on disk, run from any cwd.
   (println (slurp (io/resource "greeting.txt")))

test/chez/build-app/src/app/util.clj

@@ -4,6 +4,19 @@
 (defn shout [s]
   (str/upper-case (str s "!")))
 
+;; A two-deep non-tail call chain that throws — exercises native stack traces in a
+;; direct-link build (build-smoke runs -main with a --boom sentinel arg). deep-boom
+;; is defined through a USER macro: its source registration only gets a real line
+;; if the reader position survives macroexpansion (so the trace frame maps).
+(defmacro defguarded [name args & body]
+  `(defn ~name ~args (assert (number? ~(first args)) "needs a number") ~@body))
+
+(defguarded deep-boom [x]
+  (* x 2))
+
+(defn mid-boom [x]
+  (inc (deep-boom x)))
+
 (defmacro twice [x]
   `(do ~x ~x))
 

test/chez/corpus.edn

@@ -611,6 +611,8 @@
   {:suite "host-interop / class tokens & readers" :label "indexOf int needle is a char code" :expected "1" :actual "(.indexOf \"a=b\" 61)"}
   {:suite "host-interop / exception + HashMap shims" :label "getMessage on a thrown string" :expected "\"class java.lang.String cannot be cast to class java.lang.Throwable (java.lang.String and java.lang.Throwable are in module java.base of loader 'bootstrap')\"" :actual "(try (throw \"boom\") (catch Throwable e (.getMessage e)))"}
   {:suite "host-interop / exception + HashMap shims" :label "getMessage on ex-info" :expected "\"bad\"" :actual "(try (throw (ex-info \"bad\" {})) (catch Throwable e (.getMessage e)))"}
+  {:suite "host-interop / exception + HashMap shims" :label "calling a non-fn throws ClassCastException" :expected ":ccx" :actual "(try (1 2) (catch ClassCastException _ :ccx))"}
+  {:suite "host-interop / exception + HashMap shims" :label "non-fn cast is a RuntimeException too" :expected ":rt" :actual "(try ((identity 5)) (catch RuntimeException _ :rt))"}
   {:suite "host-interop / exception + HashMap shims" :label "HashMap get" :expected "2" :actual "(let [m (HashMap. {:a 1 :b 2})] (.get m :b))"}
   {:suite "host-interop / exception + HashMap shims" :label "HashMap put + size" :expected "2" :actual "(let [m (HashMap. {})] (.put m :x 1) (.put m :y 2) (.size m))"}
   {:suite "host-interop / reader-feature toggle" :label "features default to jolt+default" :expected "true" :actual "(contains? (set (__reader-features)) \"jolt\")"}

test/chez/unit.edn

@@ -331,6 +331,17 @@
   {:suite "reader" :expr "(nil? (read-string \"  , ,\"))" :expected "true"}
   {:suite "reader" :expr "(:tag (meta (read-string \"^String x\")))" :expected "String"}
   {:suite "reader" :expr "(:foo (meta (read-string \"^:foo x\")))" :expected "true"}
+  {:suite "reader" :expr "(:line (meta (read-string \"(foo bar)\")))" :expected "1"}
+  {:suite "reader" :expr "(:column (meta (read-string \"(foo bar)\")))" :expected "1"}
+  {:suite "reader" :expr "(:line (meta (read-string \"\\n\\n  (x)\")))" :expected "3"}
+  {:suite "reader" :expr "(:column (meta (read-string \"\\n\\n  (x)\")))" :expected "3"}
+  {:suite "reader" :expr "(nil? (meta (read-string \"[1 2]\")))" :expected "true"}
+  {:suite "reader" :expr "(nil? (meta (read-string \"()\")))" :expected "true"}
+  {:suite "reader" :expr "(:foo (meta (read-string \"^:foo (x y)\")))" :expected "true"}
+  {:suite "reader" :expr "(:line (meta (read-string \"^:foo (x y)\")))" :expected "1"}
+  {:suite "reader" :expr "(:line (meta (macroexpand-1 (read-string \"(when x y)\"))))" :expected "1"}
+  {:suite "reader" :expr "(:line (meta (macroexpand-1 (read-string \"\\n\\n(when x y)\"))))" :expected "3"}
+  {:suite "reader" :expr "(:column (meta (macroexpand-1 (read-string \"(when x y)\"))))" :expected "1"}
   {:suite "reader" :expr "(= 42 (with-in-str \"42\" (read)))" :expected "true"}
   {:suite "reader" :expr "(= (quote (+ 1 2)) (with-in-str \"(+ 1 2)\" (read)))" :expected "true"}
   {:suite "reader" :expr "(with-in-str \"1 2\" [(read) (read)])" :expected "[1 2]"}