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

Record type hints resolve across namespace boundaries (fields and params)

Browse source 
A ^RecordType hint only resolved against the current namespace's ctor key, so a
hint naming a record defined in another namespace degraded to :any. That made a
decomposed multi-namespace program much slower than the monolith: per-namespace
inference can't see a record param's callers in other namespaces, and the
declared hint that could have typed it was dropped.

Resolution now works cross-namespace, for both record FIELD hints (defrecord)
and fn PARAM hints, in both spellings — ^Vec3 where the type is referred and
^v/Vec3 where the namespace is aliased:

- reader keeps a tag's namespace qualifier (^t/Ray -> "t/Ray", was "Ray").
- make-deftype-ctor-impl indexes each ctor closure by value; record-hint-ctor-key
  resolves a hint name against the COMPILE ns (referred names live there; aliases
  resolve through it) and maps the type var's root back to its home ctor key.
  Using the ctor value, not the var's :ns, is what makes :refer work — :refer
  re-interns a fresh var whose :ns is the referring ns.
- the analyzer captures record param hints as arity :phints [name ctor-key];
  reinfer-def seeds those param types, so a record param is typed even with no
  inferred caller — the open-world / cross-ns case.

Effect on the multi-namespace ray tracer: per-ns compile 30.4s -> 7.9s with
param hints, matching whole-program (8.1s) and the single-ns monolith (8.3s).
cross-ns-hints-test covers field + param hints, refer + as, and the reader tag.
This commit is contained in:
Yogthos 2026-06-14 12:40:14 -04:00
parent 4018eb87ed
commit 1525c7adfb
6 changed files with 197 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

30
jolt-core/jolt/analyzer.clj
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? form-position]]))
record-type? record-ctor-key form-position]]))
(declare analyze)
@ -61,6 +61,16 @@
(defn- add-hint [env nm h]
(if h (assoc env :hints (assoc (:hints env) nm h)) env))
;; The resolved record ctor-key ("ns/->Name") for a ^Type param hint, or nil.
;; Unlike hint-of (which collapses any record hint to the coarse :struct guard-
;; skip marker), this carries the SPECIFIC record type — cross-namespace aware —
;; so the inference can seed the param's type and read its fields shaped/typed,
;; not just :any (the lever for a typed multi-namespace program without whole-
;; program inference).
(defn- phint-of [ctx sym]
(let [m (form-sym-meta sym)]
(when m (let [t (get m :tag)] (when t (record-ctor-key ctx t))))))
(defn- analyze-seq [ctx forms env]
(let [v (mapv #(analyze ctx % env) forms)
n (count v)]
@ -83,18 +93,21 @@
(defn- parse-params [ctx pvec]
;; :hints is a vector of [name hint] pairs (vector, not a map, so the caller
;; folds it with a plain reduce — no reduce-over-map in the kernel subset).
(loop [i 0 fixed [] rest-name nil hints []]
;; :phints is the parallel vector of [name ctor-key] for record param hints,
;; carrying the specific type for the inference to seed.
(loop [i 0 fixed [] rest-name nil hints [] phints []]
(if (< i (count pvec))
(let [p (nth pvec i)]
(when-not (form-sym? p) (uncompilable "destructuring fn param"))
(if (= "&" (form-sym-name p))
(let [r (nth pvec (inc i))]
(when-not (form-sym? r) (uncompilable "destructuring fn rest"))
(recur (+ i 2) fixed (form-sym-name r) hints))
(let [nm (form-sym-name p) h (hint-of ctx p)]
(recur (+ i 2) fixed (form-sym-name r) hints phints))
(let [nm (form-sym-name p) h (hint-of ctx p) ph (phint-of ctx p)]
(recur (inc i) (conj fixed nm) rest-name
(if h (conj hints [nm h]) hints)))))
{:fixed fixed :rest rest-name :hints hints})))
(if h (conj hints [nm h]) hints)
(if ph (conj phints [nm ph]) phints)))))
{:fixed fixed :rest rest-name :hints hints :phints phints})))
(defn- analyze-arity [ctx pvec body env fn-name]
(let [pp (parse-params ctx (vec (form-vec-items pvec)))
@ -113,7 +126,10 @@
env0 (-> (add-locals env names) (with-recur rname))
env* (reduce (fn [e pr] (add-hint e (nth pr 0) (nth pr 1))) env0 (:hints pp))
arity {:params fixed :recur-name rname
:body (analyze-seq ctx body env*)}]
:body (analyze-seq ctx body env*)}
;; carry record param hints (name -> ctor-key) for the inference to seed
;; the param type; only when present so a hintless arity stays a struct.
arity (if (seq (:phints pp)) (assoc arity :phints (:phints pp)) arity)]
;; :rest only when variadic — an absent :rest reads back nil, same as before,
;; but keeps a fixed arity a nil-free struct rather than a phm.
(if rst (assoc arity :rest rst) arity)))

15
jolt-core/jolt/passes.clj
View file

@ -1425,7 +1425,20 @@
(if (= :fn (get fnode :op))
(assoc def-node :init
(assoc fnode :arities
(mapv (fn [a] (assoc a :body (nth (infer (get a :body) ptmap) 1)))
(mapv (fn [a]
;; seed declared record param hints (:phints, name ->
;; ctor-key) so a record param is typed even with no
;; inferred caller type — the open-world / cross-ns
;; case. An inferred type in ptmap wins (it's at least
;; as precise), so this only fills the gaps.
(let [pt (reduce (fn [m pr]
(let [nm (nth pr 0)
e (get @record-shapes-box (nth pr 1))]
(if (and e (not (contains? m nm)))
(assoc m nm (record-type-from-entry e type-depth))
m)))
ptmap (get a :phints))]
(assoc a :body (nth (infer (get a :body) pt) 1))))
(get fnode :arities))))
def-node)))

83
src/jolt/evaluator.janet
View file

@ -1366,6 +1366,50 @@
(when dc (each k (keys dc) (put dc k nil))))
mm-var)
(defn- hint-cross-ns-key
"Resolve a record-typed field hint (\"Vec3\", \"v/Vec3\", \"rt.vec/Vec3\") to the
home namespace's ctor key (\"rt.vec/->Vec3\") when the type is defined in a
DIFFERENT namespace and referred/aliased into the one being defined. The local
current-ns/->Type lookup misses those; this resolves the hint name through the
ns's :refer/:as bindings to the type var, then maps its root ctor value back to
the home key via the ctor-value index. Using the ctor VALUE, not the var's :ns,
is what makes :refer work — a :refer re-interns a fresh var whose :ns is the
referring ns, but its root is the same shared ctor closure. nil if unresolved."
[ctx t cix]
# Resolve against the COMPILE ns (the user ns being analyzed), not ctx-current-ns
# — during compilation the analyzer rebinds ctx-current-ns to jolt.analyzer, so a
# bare referred name would otherwise miss. Qualified alias/Name resolves the alias
# against the compile ns; a bare name looks up the compile ns's own mappings
# (which include :refer-interned vars).
(def cur-name (or (get (ctx :env) :compile-ns) (ctx-current-ns ctx)))
(def cur-ns (ctx-find-ns ctx cur-name))
(def slash (string/find "/" t))
(def v (when cur-ns
(if slash
(let [a (string/slice t 0 slash) nm (string/slice t (inc slash))
home (or (ns-alias-lookup cur-ns a) (ns-import-lookup cur-ns a))]
(when home (ns-find (ctx-find-ns ctx home) nm)))
(ns-find cur-ns t))))
(when (and v (table? v)) (get cix (v :root))))
(defn record-hint-ctor-key
"Resolve a record-type hint NAME (as written on a ^Type field/param — bare,
aliased, or fully qualified) to its home ctor key in the record-shapes registry
(\"rt.vec/->Vec3\"), or nil if it is not a known record type. Local
current-ns/->Name wins; otherwise cross-ns via the ctor-value index. Public so
the analyzer (through jolt.host) can type a ^Type PARAM hint exactly as a field
hint resolves, which is what carries a record param's type across a namespace
boundary without whole-program inference."
[ctx name]
(def rs (get (ctx :env) :record-shapes))
(when rs
(def cur (or (get (ctx :env) :compile-ns) (ctx-current-ns ctx)))
(def local (string cur "/->" name))
(if (get rs local)
local
(let [cix (get (ctx :env) :record-ctor-index)]
(when cix (hint-cross-ns-key ctx name cix))))))
(defn make-deftype-ctor-impl
"Build a deftype constructor closure. The ns-qualified type tag is baked at
definition time (this runs during the deftype's (def …), in the type's ns), so
@ -1379,33 +1423,44 @@
# type name), "num", or nil. The inference resolves these to the field's exact
# type so reading a field back carries it (a nested record stays typed).
(def tags (if field-tags (d-realize field-tags) (array/new-filled (length kws))))
# The ctor closure itself. Built FIRST so it can be indexed by value below.
# Records are shape-recs when shapes are active (:shapes? = direct-link, where
# the inference proves the reads) — the whole field-access pipeline handles
# them; otherwise the original :jolt/deftype tables. Read at ctor-BUILD time so
# a type is consistently one representation or the other.
(def the-ctor
(if (get (ctx :env) :shapes?)
(fn [& args] (make-record type-tag kws args))
(fn [& args]
(var inst @{:jolt/deftype type-tag})
(var i 0) (each kw kws (put inst kw (in args i)) (++ i))
inst)))
# jolt-t34: register this record's ctor return shape (DECLARED field order) so
# the inference types (->Name ...) as a struct of these fields and field reads
# on the result bare-index. Keyed by the ctor var-key "ns/->Name" to match how
# the IR names the call head. Harmless when records aren't shaped (sidx gated).
(let [rs (or (get (ctx :env) :record-shapes)
(let [t @{}] (put (ctx :env) :record-shapes t) t))
# ctor-value index: maps each ctor closure to its rs key, so a ^Type hint
# in another namespace can resolve home through the type var's root value
# (jolt-3ko cross-ns hints; see hint-cross-ns-key).
cix (or (get (ctx :env) :record-ctor-index)
(let [t @{}] (put (ctx :env) :record-ctor-index t) t))
# resolve a record-typed hint ("Vec3") to its ctor-key ("ns/->Vec3") so
# the inference resolves it with a direct lookup. "num" stays as-is; an
# unresolved name (cross-ns / not-yet-defined) stays bare -> :any.
# the inference resolves it with a direct lookup. "num" stays as-is; a
# local def wins; else try cross-ns resolution; an unresolved name (not a
# known record type) stays bare -> :any.
resolved (map (fn [t]
(cond (nil? t) nil
(= t "num") "num"
(let [ck (string (ctx-current-ns ctx) "/->" t)]
(if (get rs ck) ck t))))
(if (get rs ck) ck
(or (hint-cross-ns-key ctx t cix) t)))))
tags)]
(put rs (string (ctx-current-ns ctx) "/->" (type-name-sym :name))
{:fields (tuple ;kws) :type type-tag :tags (tuple ;resolved)}))
# Records are shape-recs when shapes are active (:shapes? = direct-link, where
# the inference proves the reads) — the whole field-access pipeline handles
# them; otherwise the original :jolt/deftype tables. Read at ctor-BUILD time so
# a type is consistently one representation or the other.
(if (get (ctx :env) :shapes?)
(fn [& args] (make-record type-tag kws args))
(fn [& args]
(var inst @{:jolt/deftype type-tag})
(var i 0) (each kw kws (put inst kw (in args i)) (++ i))
inst)))
{:fields (tuple ;kws) :type type-tag :tags (tuple ;resolved)})
(put cix the-ctor (string (ctx-current-ns ctx) "/->" (type-name-sym :name))))
the-ctor)
(defn install-stateful-fns!
"Intern ctx-capturing closures for the stateful primitives into clojure.core, so

17
src/jolt/host_iface.janet
View file

@ -228,12 +228,16 @@
# presence is the marker. Lets the analyzer resolve a ^Record type hint to the
# struct fast path: record instances are tables tagged :jolt/deftype (NOT
# :jolt/type), so a raw keyword get is correct for them (jolt-94n).
(defn h-record-ctor-key [ctx name]
# The home ctor key ("ns/->Name") for a ^Type hint, resolving cross-ns
# (referred/aliased) records too — nil if `name` is not a known record type.
(record-hint-ctor-key ctx name))
(defn h-record-type? [ctx name]
(def ctor (string "->" name))
(def cns (ctx-find-ns ctx (h-current-ns ctx)))
(if (or (and cns (ns-find cns ctor))
(ns-find (ctx-find-ns ctx "clojure.core") ctor))
true false))
# A ^Type hint names a record iff it resolves to a ctor key (local OR cross-ns,
# via record-hint-ctor-key — so a referred/aliased foreign record is recognized,
# not just one whose ->Name happens to be interned in the current ns).
(if (record-hint-ctor-key ctx name) true false))
(def- exports
{"form-sym?" h-sym? "form-sym-name" h-sym-name "form-sym-ns" h-sym-ns
@ -250,7 +254,8 @@
"form-syntax-quote-lower" h-syntax-quote-lower
"host-intern!" h-intern!
"inline-enabled?" h-inline-enabled? "inline-ir" h-inline-ir
"record-type?" h-record-type? "form-position" h-form-position})
"record-type?" h-record-type? "form-position" h-form-position
"record-ctor-key" h-record-ctor-key})
(defn install! [ctx]
(def ns (ctx-find-ns ctx "jolt.host"))

9
src/jolt/reader.janet
View file

@ -613,7 +613,14 @@
[meta-form]
(cond
(keyword? meta-form) {meta-form true}
(and (struct? meta-form) (= :symbol (meta-form :jolt/type))) {:tag (meta-form :name)}
# A symbol tag keeps its namespace qualifier (^t/Ray -> "t/Ray", not "Ray") so
# an aliased/qualified record hint resolves through the ns's aliases the same
# way a bare referred one does; dropping it silently mis-hinted across
# namespaces. Bare symbols (^Ray, ^String) are unchanged.
(and (struct? meta-form) (= :symbol (meta-form :jolt/type)))
{:tag (if (meta-form :ns)
(string (meta-form :ns) "/" (meta-form :name))
(meta-form :name))}
(string? meta-form) {:tag meta-form}
nil))

72
test/integration/cross-ns-hints-test.janet Normal file
View file

@ -0,0 +1,72 @@
# Cross-namespace ^Type field hints (jolt-3ko follow-up): a record field hinted
# with a record type defined in ANOTHER namespace — referred (:refer) or aliased
# (:as) in — must resolve to that type's HOME ctor key in the record-shapes
# registry, the same as a same-namespace hint does. That resolved key is what
# lets the inference type a field read back to the foreign record type instead of
# :any (the lever for fast nested-record code across a multi-namespace program).
# Guards both the :refer and :as spellings — for record FIELD hints and for
# fn PARAM hints (which seed the inference so a record param's reads are typed
# across a namespace boundary without whole-program). Also guards that the
# reader keeps a tag's namespace qualifier (^g/Pt -> "g/Pt", not "Pt").
(use ../../src/jolt/api)
(import ../../src/jolt/types :as ty)
(import ../../src/jolt/core :as jc)
(import ../../src/jolt/reader :as rd)
(var failures 0)
(defn- check [label got want]
(unless (deep= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-xns-hints"))
(os/mkdir dir)
(os/mkdir (string dir "/geo"))
# Pt lives in geo.pt; shape records in geo.shape hint ^Pt across the boundary.
(spit (string dir "/geo/pt.clj")
"(ns geo.pt)\n(defrecord Pt [x y z])\n")
(spit (string dir "/geo/shape.clj")
(string "(ns geo.shape (:require [geo.pt :as g :refer [Pt]]))\n"
"(defrecord Seg [^Pt a ^Pt b])\n" # :refer field hint
"(defrecord Tri [^g/Pt a ^g/Pt b ^g/Pt c])\n" # :as field hint
# param hints, both spellings: ^Pt (referred), ^g/Pt (aliased)
"(defn mid [^Pt a ^g/Pt b] a)\n"))
(def ctx (init {:compile? true :direct-linking? true}))
(array/push (get (ctx :env) :source-paths) dir)
(eval-string ctx "(require '[geo.shape])")
(def rs (get (ctx :env) :record-shapes))
(check ":refer ^Pt field hint resolves to home ctor key"
(get (get rs "geo.shape/->Seg") :tags)
["geo.pt/->Pt" "geo.pt/->Pt"])
(check ":as ^g/Pt field hint resolves to home ctor key"
(get (get rs "geo.shape/->Tri") :tags)
["geo.pt/->Pt" "geo.pt/->Pt" "geo.pt/->Pt"])
# the foreign type's own shape is registered under its home key
(check "home type registered"
(get (get rs "geo.pt/->Pt") :fields)
[:x :y :z])
# --- param hints: the arity carries [name ctor-key] for each record param, both
# the :refer (^Pt) and :as (^g/Pt) spellings resolved to the home key ----------
(def shape-ns (ty/ctx-find-ns ctx "geo.shape"))
(def mid-ir (get (get (get shape-ns :mappings) "mid") :infer-ir))
(def mid-arity (first (jc/vview (get (get mid-ir :init) :arities))))
(def phints (when (get mid-arity :phints)
(map jc/vview (jc/vview (get mid-arity :phints)))))
(check "param hints resolve cross-ns (refer + as)"
phints
@[@["a" "geo.pt/->Pt"] @["b" "geo.pt/->Pt"]])
# --- reader keeps a tag's namespace qualifier ---------------------------------
(check "reader preserves qualified tag ^g/Pt"
(get (get (rd/parse-string "^g/Pt x") :meta) :tag)
"g/Pt")
(check "reader bare tag ^Pt unchanged"
(get (get (rd/parse-string "^Pt x") :meta) :tag)
"Pt")
(if (= 0 failures)
(print "cross-ns-hints: all cases passed")
(do (printf "cross-ns-hints: %d FAILURES" failures) (os/exit 1)))