record field type hints -> per-field value types in inference (jolt-3ko)
A record field can carry a type hint — ^Vec3 (a defined record type) or ^:num — and the inference now resolves it so reading the field back yields that exact type instead of :any. A Vec3 stored in a Ray field reads out as Vec3, so the vec ops on field-read values prove their reads (bare-index). This is Stalin's per-slot type sets, but DECLARED rather than inferred: the exact shape is known up front. - deftype captures each field's :tag / :num metadata (was stripped) and passes it to make-deftype-ctor; the ctor registers per-field tags, resolving a record-type hint to its ctor-key (same-ns) so the inference can look it up directly. - call-ret-type builds a record's struct type with field types resolved from the hints, recursing into nested record types (depth-bounded for self/cyclic types). Measured: a nested-record read loop (:r (:origin ray)) runs 1.3s with ^Vec3 hints vs 7.1s without — 5.5x. This is the lever the ray tracer needed (vecs flow through container fields); records without it read back as :any and stay unproven.
This commit is contained in:
parent
872cea1c37
commit
840f699f54
3 changed files with 52 additions and 10 deletions
|
|
@ -286,6 +286,15 @@
|
||||||
;; a seq of field keywords; spliced into a vector LITERAL below ([~@…]) so
|
;; a seq of field keywords; spliced into a vector LITERAL below ([~@…]) so
|
||||||
;; the analyzer sees a vector form, not a runtime pvec value.
|
;; the analyzer sees a vector form, not a runtime pvec value.
|
||||||
field-kws (map (fn [f] (keyword (name f))) fields)
|
field-kws (map (fn [f] (keyword (name f))) fields)
|
||||||
|
;; per-field TYPE HINT (jolt-3ko): ^Vec3 origin -> "Vec3" (a record type
|
||||||
|
;; name), ^:num x -> "num", else nil. Lets the inference know a field's
|
||||||
|
;; exact type up front, so reading it back carries that type (not :any) —
|
||||||
|
;; the key to fast nested-record code. Spliced as a vector literal too.
|
||||||
|
field-tags (map (fn [f] (let [mt (meta f)]
|
||||||
|
(cond (and mt (:tag mt)) (:tag mt)
|
||||||
|
(and mt (:num mt)) "num"
|
||||||
|
:else nil)))
|
||||||
|
fields)
|
||||||
impl (fn [proto specs]
|
impl (fn [proto specs]
|
||||||
`(extend-type ~tname ~proto
|
`(extend-type ~tname ~proto
|
||||||
~@(map (fn [spec]
|
~@(map (fn [spec]
|
||||||
|
|
@ -295,7 +304,7 @@
|
||||||
`(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec)))))
|
`(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec)))))
|
||||||
specs)))]
|
specs)))]
|
||||||
`(do
|
`(do
|
||||||
(def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws]))
|
(def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws] [~@field-tags]))
|
||||||
(def ~arrow ~tname)
|
(def ~arrow ~tname)
|
||||||
~@(map (fn [g] (impl (first g) (rest g))) (group-by-head body))
|
~@(map (fn [g] (impl (first g) (rest g))) (group-by-head body))
|
||||||
~tname)))
|
~tname)))
|
||||||
|
|
|
||||||
|
|
@ -884,6 +884,27 @@
|
||||||
;; jolt-41m: protocol-method registry "ns/method" -> [proto method], for
|
;; jolt-41m: protocol-method registry "ns/method" -> [proto method], for
|
||||||
;; devirtualizing a protocol call whose receiver is a known record type.
|
;; devirtualizing a protocol call whose receiver is a known record type.
|
||||||
(def ^:private protocol-methods-box (atom {}))
|
(def ^:private protocol-methods-box (atom {}))
|
||||||
|
|
||||||
|
;; jolt-3ko: build a record's struct TYPE from its registry entry, resolving each
|
||||||
|
;; field's declared type hint. A field tagged with a record type (its ctor-key)
|
||||||
|
;; recurses, so a Vec3 stored in a Ray field reads back as Vec3 — not :any —
|
||||||
|
;; which is what lets nested-record code prove its reads. Depth-bounded so a
|
||||||
|
;; self/cyclic-referencing record type can't loop.
|
||||||
|
(declare record-type-from-entry)
|
||||||
|
(defn- field-type-from-tag [tag depth]
|
||||||
|
(cond
|
||||||
|
(or (nil? tag) (<= depth 0)) :any
|
||||||
|
(= tag "num") :num
|
||||||
|
:else (let [e (get @record-shapes-box tag)]
|
||||||
|
(if e (record-type-from-entry e depth) :any))))
|
||||||
|
(defn- record-type-from-entry [rs depth]
|
||||||
|
(let [fields (get rs :fields)
|
||||||
|
tags (get rs :tags)
|
||||||
|
fmap (reduce (fn [m i]
|
||||||
|
(assoc m (nth fields i)
|
||||||
|
(field-type-from-tag (when tags (nth tags i)) (dec depth))))
|
||||||
|
{} (range (count fields)))]
|
||||||
|
(assoc (mk-struct fmap) :shape (vec fields) :type (get rs :type))))
|
||||||
;; jolt-t34: whether to shape generic const-key MAP literals (opt-in, JOLT_SHAPE).
|
;; jolt-t34: whether to shape generic const-key MAP literals (opt-in, JOLT_SHAPE).
|
||||||
;; Records are shaped regardless; maps only when this is on.
|
;; Records are shaped regardless; maps only when this is on.
|
||||||
(def ^:private map-shapes-box (atom false))
|
(def ^:private map-shapes-box (atom false))
|
||||||
|
|
@ -912,11 +933,10 @@
|
||||||
(= op :var) (let [rs (get @record-shapes-box (var-key fnode))]
|
(= op :var) (let [rs (get @record-shapes-box (var-key fnode))]
|
||||||
(if rs
|
(if rs
|
||||||
;; record ctor -> struct of declared shape (jolt-t34); :shape
|
;; record ctor -> struct of declared shape (jolt-t34); :shape
|
||||||
;; is the DECLARED field order the back end indexes by, and
|
;; is the DECLARED field order the back end indexes by, :type
|
||||||
;; :type is the record tag (for devirtualizing protocol calls)
|
;; the record tag (devirt), and field types come from the
|
||||||
(let [fields (get rs :fields)]
|
;; declared hints so nested records stay typed (jolt-3ko)
|
||||||
(assoc (mk-struct (reduce (fn [m k] (assoc m k :any)) {} fields))
|
(record-type-from-entry rs type-depth)
|
||||||
:shape (vec fields) :type (get rs :type)))
|
|
||||||
(let [r (get @rtenv-box (var-key fnode))]
|
(let [r (get @rtenv-box (var-key fnode))]
|
||||||
(if r r (let [nm (and (= "clojure.core" (get fnode :ns)) (get fnode :name))]
|
(if r r (let [nm (and (= "clojure.core" (get fnode :ns)) (get fnode :name))]
|
||||||
(cond (nil? nm) :any
|
(cond (nil? nm) :any
|
||||||
|
|
|
||||||
|
|
@ -1372,17 +1372,30 @@
|
||||||
instances carry a stable tag matching what extend-type registers methods under.
|
instances carry a stable tag matching what extend-type registers methods under.
|
||||||
field-kws is the [:f1 :f2 …] keyword vector; the ctor maps positional args to
|
field-kws is the [:f1 :f2 …] keyword vector; the ctor maps positional args to
|
||||||
those keys. A ctx-capturing closure (make-deftype-ctor) is the public handle."
|
those keys. A ctx-capturing closure (make-deftype-ctor) is the public handle."
|
||||||
[ctx type-name-sym field-kws]
|
[ctx type-name-sym field-kws &opt field-tags]
|
||||||
(def type-tag (string (ctx-current-ns ctx) "." (type-name-sym :name)))
|
(def type-tag (string (ctx-current-ns ctx) "." (type-name-sym :name)))
|
||||||
(def kws (d-realize field-kws))
|
(def kws (d-realize field-kws))
|
||||||
|
# per-field type hints (jolt-3ko): a tuple parallel to kws — "Vec3" (a record
|
||||||
|
# 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))))
|
||||||
# jolt-t34: register this record's ctor return shape (DECLARED field order) so
|
# 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
|
# 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
|
# 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).
|
# the IR names the call head. Harmless when records aren't shaped (sidx gated).
|
||||||
(let [rs (or (get (ctx :env) :record-shapes)
|
(let [rs (or (get (ctx :env) :record-shapes)
|
||||||
(let [t @{}] (put (ctx :env) :record-shapes t) t))]
|
(let [t @{}] (put (ctx :env) :record-shapes 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.
|
||||||
|
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))))
|
||||||
|
tags)]
|
||||||
(put rs (string (ctx-current-ns ctx) "/->" (type-name-sym :name))
|
(put rs (string (ctx-current-ns ctx) "/->" (type-name-sym :name))
|
||||||
{:fields (tuple ;kws) :type type-tag}))
|
{:fields (tuple ;kws) :type type-tag :tags (tuple ;resolved)}))
|
||||||
# Records are shape-recs when shapes are active (:shapes? = direct-link, where
|
# Records are shape-recs when shapes are active (:shapes? = direct-link, where
|
||||||
# the inference proves the reads) — the whole field-access pipeline handles
|
# the inference proves the reads) — the whole field-access pipeline handles
|
||||||
# them; otherwise the original :jolt/deftype tables. Read at ctor-BUILD time so
|
# them; otherwise the original :jolt/deftype tables. Read at ctor-BUILD time so
|
||||||
|
|
@ -1467,7 +1480,7 @@
|
||||||
(ns-intern core "refer-clojure" (fn [& args] (refer-clojure-impl ctx ;args)))
|
(ns-intern core "refer-clojure" (fn [& args] (refer-clojure-impl ctx ;args)))
|
||||||
(ns-intern core "defmulti-setup" (fn [name-sym dispatch & opts] (defmulti-setup ctx name-sym dispatch ;opts)))
|
(ns-intern core "defmulti-setup" (fn [name-sym dispatch & opts] (defmulti-setup ctx name-sym dispatch ;opts)))
|
||||||
(ns-intern core "defmethod-setup" (fn [mm-sym dval impl] (defmethod-setup ctx mm-sym dval impl)))
|
(ns-intern core "defmethod-setup" (fn [mm-sym dval impl] (defmethod-setup ctx mm-sym dval impl)))
|
||||||
(ns-intern core "make-deftype-ctor" (fn [name-sym field-kws] (make-deftype-ctor-impl ctx name-sym field-kws)))
|
(ns-intern core "make-deftype-ctor" (fn [name-sym field-kws &opt field-tags] (make-deftype-ctor-impl ctx name-sym field-kws field-tags)))
|
||||||
# Var/namespace lookups that need the ctx (the rest of the var fns — var-get/
|
# Var/namespace lookups that need the ctx (the rest of the var fns — var-get/
|
||||||
# var-set/var?/alter-var-root/alter-meta!/reset-meta! — are plain core-bindings).
|
# var-set/var?/alter-var-root/alter-meta!/reset-meta! — are plain core-bindings).
|
||||||
(ns-intern core "find-var" (fn [sym] (find-var ctx sym)))
|
(ns-intern core "find-var" (fn [sym] (find-var ctx sym)))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue