feat: precise file:line:col source locations for type errors (jolt-fqy)

RFC 0006 error reporting wanted file:line:col but IR nodes carried no
position, so diagnostics read only "type error in <ns>: <msg>". Now:

    type error /tmp/scene.clj:5:5: `inc` requires a number, but argument 1 is a string

The reader records each LIST form's absolute start offset in a table keyed
by form identity (lists are fresh arrays, never interned), gated behind a
flag the loaders enable only when JOLT_TYPE_CHECK is on — zero cost off.
Keying by identity makes positions survive macroexpansion exactly when the
user's own sub-form is spliced through, and absent for macro-synthesized
structure: a `(inc :k)` written inside `(when c ...)` reports at its own
line, never at the expansion's generated if/do.

The analyzer stamps the offset onto :invoke nodes (form-position host
contract fn); the checker carries it into each diagnostic as :pos; the
loaders stash the file's source + path on the env (save/restored across
nested requires); backend/type-check! converts offset -> line:col via the
reader's line-col and renders the RFC format. Falls back to the ns when no
position is available (synthetic forms), so it is never worse than before.

Gate green, conformance 335/335, suite 4718, runtime bench even (positions
are compile-time only; off by default).
This commit is contained in:
Yogthos 2026-06-13 12:18:53 -04:00
parent 824b30defd
commit f2d65addc8
9 changed files with 106 additions and 17 deletions

View file

@ -23,7 +23,7 @@
form-map-pairs form-set-items form-special? compile-ns
form-macro? form-expand-1 resolve-global
form-sym-meta host-intern! form-syntax-quote-lower
record-type?]]))
record-type? form-position]]))
(declare analyze)
@ -250,8 +250,13 @@
(and (form-sym? head) (not shadowed) (form-macro? ctx head))
(analyze ctx (form-expand-1 ctx form) env)
:else
(invoke (analyze ctx head env)
(mapv #(analyze ctx % env) (rest items))))))))
;; stamp the list form's source offset onto the :invoke (jolt-fqy)
;; so the success checker can report file:line:col. nil when the
;; reader did not record it (synthetic/macro-built forms).
(let [n (invoke (analyze ctx head env)
(mapv #(analyze ctx % env) (rest items)))
p (form-position form)]
(if p (assoc n :pos p) n)))))))
(defn analyze
([ctx form] (analyze ctx form (empty-env)))

View file

@ -1133,15 +1133,16 @@
(defn- check-invoke
"If node is a core-op call whose argument type is provably in the error domain,
conj a diagnostic. arg-types is the vector of inferred argument types."
[cn args arg-types]
conj a diagnostic. arg-types is the vector of inferred argument types; pos is
the call form's source offset (jolt-fqy), carried into each diagnostic."
[cn args arg-types pos]
(cond
(contains? num-ops cn)
(reduce (fn [_ i]
(let [t (nth arg-types i)]
(when (not-number? t)
(swap! diag-box conj
{:op cn :argpos i :type (type-name t)
{:op cn :argpos i :type (type-name t) :pos pos
:msg (str "`" cn "` requires a number, but argument "
(inc i) " is " (type-name t))})))
nil)
@ -1150,7 +1151,7 @@
(let [t (nth arg-types 0)]
(when (not-seqable? t)
(swap! diag-box conj
{:op cn :argpos 0 :type (type-name t)
{:op cn :argpos 0 :type (type-name t) :pos pos
:msg (str "`" cn "` requires "
(if (= cn "count") "a countable collection" "a seqable")
", but argument 1 is " (type-name t))})))
@ -1200,7 +1201,7 @@
did not already have means the argument alone is provably wrong. Monotonic
binding a concrete type can only ADD error-domain hits so no false positive.
Cycle-guarded so mutually recursive fns terminate."
[key sig arg-types]
[key sig arg-types pos]
(when (not (contains? @checking-box key))
(let [prev @checking-box]
(reset! checking-box (conj prev key))
@ -1217,7 +1218,7 @@
(let [pe (assoc (all-any-env params) (nth params i) at)]
(when (> (isolated-diag-count body pe) base)
(swap! diag-box conj
{:op :user-call :argpos i :type (type-name at)
{:op :user-call :argpos i :type (type-name at) :pos pos
:msg (str "argument " (inc i) " to `" (:name sig)
"` is " (type-name at)
", which its body provably rejects")})))))
@ -1240,9 +1241,10 @@
(str (get fnode :ns) "/" (get fnode :name)))
usig (when (and @strict-box ukey) (get @user-sig-box ukey))]
(when (or cn usig)
(let [ats (mapv (fn [a] (nth (infer a tenv) 0)) args)]
(when cn (check-invoke cn args ats))
(when usig (check-user-call ukey usig ats))))
(let [ats (mapv (fn [a] (nth (infer a tenv) 0)) args)
pos (get node :pos)]
(when cn (check-invoke cn args ats pos))
(when usig (check-user-call ukey usig ats pos))))
(check-walk fnode tenv)
(reduce (fn [_ a] (check-walk a tenv) nil) nil args))
(= op :let)