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.
This commit is contained in:
parent
9bf3d1c80e
commit
57bab5d409
12 changed files with 288 additions and 105 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -674,14 +674,25 @@
|
|||
(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 named fn def gets a source-registry entry so a native backtrace can
|
||||
;; map its frame to ns/name (file:line). Chez names a frame by the fn's
|
||||
;; SHORT self-binding (emit-fn's letrec name = munge-name), not jv$ns$name,
|
||||
;; so register under that. Non-fn defs are not procedures.
|
||||
pos (:pos node)
|
||||
reg (when (and fn? pos)
|
||||
(str " (jolt-register-source! " (chez-str-lit (munge-name nm)) " "
|
||||
(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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue