Specialize record field reads in method bodies; fix with-meta on symbols (#141)
A protocol method reads its fields through the generic guarded keyword lookup because the method's `this` param is untyped. defrecord now hints `this` with the record type, the per-form inference seeds ^Record-hinted params (the :fn branch previously typed all params :any — only the whole-program path seeded phints), and run-passes feeds the inference the record shapes. So a hinted param's field reads bare-index instead of going through the :jolt/type tag guard. This needed a with-meta fix: (with-meta sym ..) returned a proto'd table, so symbol? was false and the macro-attached hint broke fn destructuring. Symbols now carry metadata in-place in their struct (matching how the reader attaches ^hint), keeping symbol? true, as in Clojure. Modest on dispatch (~3-5%): the field read is a small fraction of a dispatch; the machinery (record-tag + protocol lookup + wrapper) dominates, which is the inline-cache target (jolt-ez5h). But it's a correctness fix and lets any ^Record-hinted code — not just methods — drop the field-read guard per-form, not only under whole-program. Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
parent
7d0b1d5695
commit
6772e28eae
4 changed files with 32 additions and 6 deletions
|
|
@ -445,8 +445,12 @@
|
||||||
~@(map (fn [spec]
|
~@(map (fn [spec]
|
||||||
(let [argv (nth spec 1)
|
(let [argv (nth spec 1)
|
||||||
inst (first argv)
|
inst (first argv)
|
||||||
|
;; hint `this` with the record type so the inference
|
||||||
|
;; types it (jolt-3ko) and its field reads bare-index
|
||||||
|
;; instead of going through the runtime tag guard.
|
||||||
|
hinted (assoc argv 0 (vary-meta inst assoc :tag (name name-sym)))
|
||||||
binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
|
binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
|
||||||
`(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec)))))
|
`(~(first spec) ~hinted (let [~@binds] ~@(drop 2 spec)))))
|
||||||
specs)))]
|
specs)))]
|
||||||
`(do
|
`(do
|
||||||
;; deftype already defines ->name (= the ctor); no (name. …) interop needed,
|
;; deftype already defines ->name (= the ctor); no (name. …) interop needed,
|
||||||
|
|
|
||||||
|
|
@ -34,6 +34,10 @@
|
||||||
[node ctx]
|
[node ctx]
|
||||||
(if (inline-enabled? ctx)
|
(if (inline-enabled? ctx)
|
||||||
(let [_ (set-rec-shapes! (record-shapes ctx)) ;; record ctor fold (jolt-15jq)
|
(let [_ (set-rec-shapes! (record-shapes ctx)) ;; record ctor fold (jolt-15jq)
|
||||||
|
;; resolve ^Record param hints (incl. defrecord/extend-type method
|
||||||
|
;; `this`) to bare field reads per-form, not only under whole-program
|
||||||
|
;; (jolt-3ko). Same shapes the inline pass uses.
|
||||||
|
_ (set-record-shapes! (record-shapes ctx))
|
||||||
opt (loop [i 0 n (const-fold node)]
|
opt (loop [i 0 n (const-fold node)]
|
||||||
(reset! dirty false)
|
(reset! dirty false)
|
||||||
(let [n2 (const-fold (scalar-replace (flatten-lets (inline-node n ctx))))]
|
(let [n2 (const-fold (scalar-replace (flatten-lets (inline-node n ctx))))]
|
||||||
|
|
|
||||||
|
|
@ -526,11 +526,21 @@
|
||||||
[:any (assoc node :args (mapv (fn [a] (nth (infer a tenv) 1)) (get node :args)))]
|
[:any (assoc node :args (mapv (fn [a] (nth (infer a tenv) 1)) (get node :args)))]
|
||||||
(= op :fn)
|
(= op :fn)
|
||||||
;; a closure inherits the enclosing tenv so CAPTURED locals keep their
|
;; a closure inherits the enclosing tenv so CAPTURED locals keep their
|
||||||
;; types (e.g. a reduce closure that calls (f captured-struct ...)); its own
|
;; types (e.g. a reduce closure that calls (f captured-struct ...)). Its own
|
||||||
;; params/rest shadow to :any (unknown until Phase 1 types them via callers).
|
;; params shadow to :any UNLESS a param carries a ^Record declared hint
|
||||||
|
;; (:phints, name -> ctor-key) — then seed it to that record type so field
|
||||||
|
;; reads off it bare-index per-form, not only under whole-program. This is
|
||||||
|
;; what makes a protocol method's `this` (hinted by defrecord/extend-type)
|
||||||
|
;; read its fields without the runtime tag guard (jolt-3ko).
|
||||||
[:any (assoc node :arities
|
[:any (assoc node :arities
|
||||||
(mapv (fn [a]
|
(mapv (fn [a]
|
||||||
(let [pe (reduce (fn [e p] (assoc e p :any)) tenv (get a :params))
|
(let [phm (reduce (fn [m pr] (assoc m (nth pr 0) (nth pr 1)))
|
||||||
|
{} (get a :phints))
|
||||||
|
pe (reduce (fn [e p]
|
||||||
|
(assoc e p
|
||||||
|
(let [ent (get @record-shapes-box (get phm p))]
|
||||||
|
(if ent (record-type-from-entry ent type-depth) :any))))
|
||||||
|
tenv (get a :params))
|
||||||
pe (if (get a :rest) (assoc pe (get a :rest) :any) pe)]
|
pe (if (get a :rest) (assoc pe (get a :rest) :any) pe)]
|
||||||
(assoc a :body (nth (infer (get a :body) pe) 1))))
|
(assoc a :body (nth (infer (get a :body) pe) 1))))
|
||||||
(get node :arities)))]
|
(get node :arities)))]
|
||||||
|
|
|
||||||
|
|
@ -55,9 +55,17 @@
|
||||||
(defn core-with-meta [obj meta]
|
(defn core-with-meta [obj meta]
|
||||||
# Functions and scalars can't carry metadata in Jolt's model — return as-is
|
# Functions and scalars can't carry metadata in Jolt's model — return as-is
|
||||||
# rather than crashing (Clojure attaches meta only to IObj values).
|
# rather than crashing (Clojure attaches meta only to IObj values).
|
||||||
(if (or (function? obj) (cfunction? obj) (number? obj) (boolean? obj)
|
(cond
|
||||||
(nil? obj) (string? obj) (keyword? obj) (buffer? obj))
|
(or (function? obj) (cfunction? obj) (number? obj) (boolean? obj)
|
||||||
|
(nil? obj) (string? obj) (keyword? obj) (buffer? obj))
|
||||||
obj
|
obj
|
||||||
|
# Symbols carry metadata IN-PLACE in their struct's :meta field (this is how
|
||||||
|
# the reader attaches ^hint and keeps symbol? true — see reader/read-meta).
|
||||||
|
# The table-proto path below would make (symbol? (with-meta sym ..)) false and
|
||||||
|
# break destructuring/hint reading, so keep a symbol a symbol.
|
||||||
|
(and (struct? obj) (= :symbol (obj :jolt/type)))
|
||||||
|
(struct ;(kvs obj) :meta meta)
|
||||||
|
true
|
||||||
(do
|
(do
|
||||||
(var new-obj @{})
|
(var new-obj @{})
|
||||||
(each k (keys obj)
|
(each k (keys obj)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue