records use declared-shape layout with fast field access by default (jolt-t34)

Records (defrecord/deftype) are now shape-recs in a direct-linking unit by
default — no JOLT_SHAPE flag. A record's shape is DECLARED, so the inference
proves field reads by a lookup, not fragile shape inference, and they bare-index.
Result: ~1.4x faster than the :jolt/deftype table form on a record-heavy loop
(3.9s vs 5.5s), driven by cheaper construction + proven bare-index reads.

Two gates now:
- :shapes?     — shape-recs active; records use declared-shape layout + bare
                 index reads. On with direct-linking (where the inference runs).
- :map-shapes? — also shape generic const-key maps. Opt-in (JOLT_SHAPE), because
                 shaping maps net-loses on unproven reads (measured). Records win.

- call-ret-type types a record ctor (->Name) as a struct of its declared shape,
  fed from a ctx-env registry populated at deftype; field reads on the result
  bare-index. (set-record-shapes!/set-map-shapes! wired through infer-unit!.)
- sidx reads the field's position from the :shape vector AS-IS (declared order
  for records, str-sorted for map literals) — no re-sort — so any field order
  bare-indexes correctly. The map :map case only sets :shape under :map-shapes?.
- record-shape-for interns the descriptor per (type, fields), not per type: a
  record redefined with different fields now gets a fresh descriptor instead of a
  stale one (fixes redef descriptor staleness; old instances stay valid).

Adds record-declared-shape-test (declared-order reads, incl. non-alphabetical
fields, through fn boundaries + protocol method bodies). Known pre-existing edge
case filed as jolt-wf4 (direct (:f (->R …)) read returns nil after a record is
redefined with different fields; let-bound read works; repros without shapes).

jolt-core/jolt/passes.clj

@@ -875,6 +875,15 @@
 ;; provably wrong and the CALL is reported. Module state, like rtenv-box: a def
 ;; must precede its call (the same closed-world ordering RFC 0005 assumes).
 (def ^:private user-sig-box (atom {}))      ;; "ns/name" -> {:params [..] :body ir}
+;; jolt-t34: a record constructor's return shape. "ns/->Name" -> [field-kw ...]
+;; in DECLARED order (the runtime lays records out in declared field order, so
+;; the back end bare-indexes by that order). A call (->Point a b) types as a
+;; struct of this shape, so field reads on the result bare-index — declared
+;; shapes are clean fuel: a lookup, not fragile inference.
+(def ^:private record-shapes-box (atom {}))
+;; jolt-t34: whether to shape generic const-key MAP literals (opt-in, JOLT_SHAPE).
+;; Records are shaped regardless; maps only when this is on.
+(def ^:private map-shapes-box (atom false))
 (def ^:private checking-box (atom #{}))     ;; keys mid-recheck — cycle guard
 (def ^:private strict-box (atom false))     ;; report against user-fn domains?
 ;; When true, `infer` emits success-type diagnostics as it types (jolt audit).
@@ -897,12 +906,18 @@
   (let [op (get fnode :op)]
     (cond
       ;; a user fn whose return type the fixpoint has estimated
-      (= op :var) (let [r (get @rtenv-box (var-key fnode))]
-                    (if r r (let [nm (and (= "clojure.core" (get fnode :ns)) (get fnode :name))]
-                              (cond (nil? nm) :any
-                                    (contains? num-ret-fns nm) :num
-                                    (contains? vector-ret-fns nm) (mk-vec :any)
-                                    :else :any))))
+      (= op :var) (let [rs (get @record-shapes-box (var-key fnode))]
+                    (if rs
+                      ;; record ctor -> struct of declared shape (jolt-t34); :shape
+                      ;; is the DECLARED field order, which the back end indexes by
+                      (assoc (mk-struct (reduce (fn [m k] (assoc m k :any)) {} rs))
+                             :shape (vec rs))
+                      (let [r (get @rtenv-box (var-key fnode))]
+                        (if r r (let [nm (and (= "clojure.core" (get fnode :ns)) (get fnode :name))]
+                                  (cond (nil? nm) :any
+                                        (contains? num-ret-fns nm) :num
+                                        (contains? vector-ret-fns nm) (mk-vec :any)
+                                        :else :any))))))
       (= op :host) (let [nm (get fnode :name)]
                      (cond (contains? num-ret-fns nm) :num
                            (contains? vector-ret-fns nm) (mk-vec :any)
@@ -976,7 +991,7 @@
                    (cap (mk-struct (reduce (fn [m r] (assoc m (nth r 3) (nth r 2))) {} res)) type-depth))
             ;; a literal is a COMPLETE shape: carry its sorted key vector so the
             ;; back end can lay it out and bare-index lookups (jolt-t34)
-            shp (when (and base (struct-type? base)) (shape-order (keys (sfields base))))
+            shp (when (and @map-shapes-box base (struct-type? base)) (shape-order (keys (sfields base))))
             t (if base (if shp (assoc base :shape shp) base) :any)
             node' (assoc node :pairs (mapv (fn [r] [(nth r 0) (nth r 1)]) res))]
         [t (if shp (assoc node' :shape shp) node')])
@@ -1312,6 +1327,11 @@
   type call results during the fixpoint."
   [m] (reset! rtenv-box m))
 
+;; jolt-t34: install record-ctor shapes ("ns/->Name" -> [field-kw ...]) and the
+;; map-shaping flag (opt-in JOLT_SHAPE), both read by infer.
+(defn set-record-shapes! [m] (reset! record-shapes-box (or m {})))
+(defn set-map-shapes! [b] (reset! map-shapes-box (boolean b)))
+
 (defn set-vtypes!
   "Install var VALUE types (a map \"ns/name\" -> type): fn vars are :truthy
   (non-nil), def vars carry their inferred init type (jolt-d6u)."

src/jolt/api.janet

@@ -223,11 +223,15 @@
     # the inline pass only inlines targets that won't be redefined, the same
     # safety the direct-linking flag asserts (jolt-87f).
     (put (ctx :env) :inline? (if (get (ctx :env) :direct-linking?) true false))
-    # Shape-records are OPT-IN (jolt-t34). Measurement showed shaping generic
-    # const-key maps net-loses in a bytecode VM (unproven reads can't beat a
-    # native struct-get), so shapes are not defaulted on. The win is records
-    # with declared shapes + proven reads; that path is enabled separately.
+    # jolt-t34. Two shape gates:
+    #  :shapes?     — shape-recs are active. Records use declared-shape layout +
+    #                 bare-index reads here. ON wherever the inference that proves
+    #                 reads runs = direct-linking. JOLT_NO_SHAPE force-disables.
+    #  :map-shapes? — also shape generic const-key MAP literals. Opt-in (JOLT_SHAPE)
+    #                 because shaping maps net-loses on unproven reads; records win.
     (put (ctx :env) :shapes?
+      (and (get (ctx :env) :direct-linking?) (not (os/getenv "JOLT_NO_SHAPE"))))
+    (put (ctx :env) :map-shapes?
       (and (os/getenv "JOLT_SHAPE") (not (os/getenv "JOLT_NO_SHAPE"))))
     ctx))
 

src/jolt/backend.janet

@@ -370,15 +370,15 @@
                              "(a phm/sorted/transient/lazy-seq), not the plain "
                              "struct/record the ^:struct/^Record hint asserts")]))
   # Subject carries a complete :shape (jolt-t34) => it is provably a shape-rec;
-  # the field reads by bare index. The :shape is just the KEY SET; the layout
-  # comes from the runtime's canonical shape-sort (the same order shape-for and
-  # emit-map use), so construction and lookup always agree.
+  # the field reads by bare index. The :shape vector is ALREADY in layout order —
+  # declared order for records (record-shape-for), str-sorted for map literals
+  # (the inference's shape-order, matching emit-map) — so the field's position in
+  # :shape IS its slot. (:shapes? = shapes active = direct-link.)
   (def sidx
     (when (and (get (ctx :env) :shapes?) subj-node (subj-node :shape))
       (def raw (let [s (subj-node :shape)] (if (pv/pvec? s) (pv/pv->array s) s)))
-      (def sk (shape-sort raw))
       (var pos nil) (var i 0)
-      (each kk sk (when (= kk k) (set pos i)) (++ i))
+      (each kk raw (when (= kk k) (set pos i)) (++ i))
       (when pos (+ pos 1))))
   # sidx => proven complete shape: bare index (fastest). Otherwise a raw-get-safe
   # value may still be a shape-rec (its :shape dropped by a join, or an unproven
@@ -507,7 +507,7 @@
   # compiler's own IR-node map literals (which the back end reads with raw
   # keyword access and would break if turned into tuples)
   (def shape-keys
-    (when (and fast (get (ctx :env) :shapes?) (get (ctx :env) :inline?))
+    (when (and fast (get (ctx :env) :map-shapes?) (get (ctx :env) :inline?))
       (def ks @[])
       (each pair pairs (array/push ks ((norm-node (in (vview pair) 0)) :val)))
       (shape-sort ks)))
@@ -945,6 +945,8 @@
   (def f-infer-body (and pns (ns-find pns "infer-body")))
   (def f-reinfer (and pns (ns-find pns "reinfer-def")))
   (def f-reset-esc (and pns (ns-find pns "reset-escapes!")))
+  (def f-set-rshapes (and pns (ns-find pns "set-record-shapes!")))   # jolt-t34
+  (def f-set-mshapes (and pns (ns-find pns "set-map-shapes!")))      # jolt-t34
   (def f-get-esc (and pns (ns-find pns "collected-escapes")))
   (def ns (ctx-find-ns ctx ns-name))
   (def report @{})
@@ -976,6 +978,9 @@
           (array/push defs @{:key key :init (d :init) :vt nil}))))
     (when (or (> (length fns) 0) (> (length defs) 0))
       ((var-get f-reset-esc))
+      # jolt-t34: feed record-ctor shapes + the map-shaping flag to the inference
+      (when f-set-rshapes ((var-get f-set-rshapes) (or (get (ctx :env) :record-shapes) @{})))
+      (when f-set-mshapes ((var-get f-set-mshapes) (get (ctx :env) :map-shapes?)))
       # --- param/return/value-type fixpoint (chaotic iteration to LEAST fixpoint) ---
       # Param types are RECOMPUTED FRESH each iteration, not accumulated: :any is
       # the lattice top, so a join with an early-iteration :any (a caller whose own

src/jolt/evaluator.janet

@@ -1368,11 +1368,18 @@
   [ctx type-name-sym field-kws]
   (def type-tag (string (ctx-current-ns ctx) "." (type-name-sym :name)))
   (def kws (d-realize field-kws))
-  # Records become shape-recs only under JOLT_SHAPE (jolt-t34 R3) — part of the
-  # shape feature, which the whole field-access pipeline handles. With the flag
-  # off, records are the original :jolt/deftype tables. Read the flag at ctor-
-  # BUILD time (deftype eval) so a type is consistently one rep or the other.
-  (if (os/getenv "JOLT_SHAPE")
+  # 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))]
+    (put rs (string (ctx-current-ns ctx) "/->" (type-name-sym :name)) (tuple ;kws)))
+  # 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})

src/jolt/main.janet

@@ -506,9 +506,13 @@
   (when (= "1" (os/getenv "JOLT_DIRECT_LINK"))
     (put (ctx :env) :direct-linking? true)
     (put (ctx :env) :inline? true))
-  # Recompute :shapes? from the runtime env (the baked ctx computed it at build
-  # time, before JOLT_SHAPE was set in this process). Opt-in (jolt-t34).
+  # Recompute the shape gates from the runtime env (the baked ctx computed them
+  # at build time, before JOLT_DIRECT_LINK/JOLT_SHAPE were set here). jolt-t34:
+  # :shapes? = shape-recs active (records), on with direct-linking; :map-shapes? =
+  # also shape generic maps (opt-in JOLT_SHAPE).
   (put (ctx :env) :shapes?
+    (and (get (ctx :env) :direct-linking?) (not (os/getenv "JOLT_NO_SHAPE"))))
+  (put (ctx :env) :map-shapes?
     (and (os/getenv "JOLT_SHAPE") (not (os/getenv "JOLT_NO_SHAPE"))))
   (cond
     (empty? argv) (run-repl)

src/jolt/types.janet

@@ -674,10 +674,16 @@
   (let [idx @{}]
     (var i 0) (each k field-keys (put idx k i) (++ i))
     (struct :jolt/shape (tuple ;field-keys) :idx (table/to-struct idx) :type type-tag)))
+# Interned per (type-tag, field-keys): keying on the tag alone would hand back a
+# STALE descriptor after a record is redefined with different fields (a REPL
+# redefine, or two same-named records in different test cases) — the new instance
+# would carry the old layout. Old instances keep their own descriptor and stay
+# valid; new ones get the new layout. (jolt-t34)
 (defn record-shape-for [type-tag field-keys]
-  (or (get record-desc-cache type-tag)
+  (def ck (tuple type-tag (tuple ;field-keys)))
+  (or (get record-desc-cache ck)
       (let [desc (record-desc type-tag field-keys)]
-        (put record-desc-cache type-tag desc)
+        (put record-desc-cache ck desc)
         desc)))
 (defn make-record [type-tag field-keys args]
   (def out @[(record-shape-for type-tag field-keys)])

test/integration/record-declared-shape-test.janet

@@ -0,0 +1,39 @@
+# Records use declared-shape layout with fast field access (jolt-t34), by default
+# in a direct-linking unit — no JOLT_SHAPE needed. The key property: a record is
+# laid out in DECLARED field order, and field reads bare-index by that order, so
+# fields that are NOT alphabetically sorted must still read correctly. This is
+# what `sidx` reads off the :shape vector (declared order, not str-sorted).
+(use ../../src/jolt/api)
+
+(var failures 0)
+(defn- check [label got want]
+  (unless (= got want)
+    (++ failures)
+    (printf "FAIL [%s] got %q want %q" label got want)))
+
+# A direct-linking ctx: records are shape-recs, reads proven/bare-indexed.
+(def dl (init {:compile? true :direct-linking? true}))
+
+# --- representation: a record is a shape-rec (tuple), not a table -------------
+(check "record is a shape-rec"
+       (tuple? (eval-string dl "(do (defrecord Sp [x y]) (->Sp 1 2))")) true)
+
+# --- DECLARED-ORDER field access: fields are NOT alphabetically sorted; each
+# must read its own value, locally and through a fn boundary. Each case uses a
+# DISTINCT record name (redefining a record with new fields is jolt-wf4). -------
+(def cases
+  [["decl-order local"   "(do (defrecord Ra [b a c]) (let [r (->Ra 10 20 30)] (= [10 20 30] [(:b r) (:a r) (:c r)])))"]
+   ["decl-order via fn"   "(do (defrecord Rb [b a c]) (defn rdb [r] [(:b r) (:a r) (:c r)]) (= [10 20 30] (rdb (->Rb 10 20 30))))"]
+   ["single field z-first" "(do (defrecord Rc [z m a]) (= 7 (:z (->Rc 7 8 9))))"]
+   ["protocol method body" "(do (defprotocol Sh (area [s])) (defrecord Box [w h] Sh (area [b] (* (:w b) (:h b)))) (= 12 (area (->Box 3 4))))"]
+   ["record? true"        "(do (defrecord Rd [x y]) (record? (->Rd 1 2)))"]
+   ["record vs map not="  "(do (defrecord Re [x y]) (not (= (->Re 1 2) {:x 1 :y 2})))"]
+   ["assoc keeps type"    "(do (defrecord Rf [x y]) (record? (assoc (->Rf 1 2) :x 9)))"]
+   ["pr declared order"   "(do (defrecord Rg [b a c]) (= \"#user.Rg{:b 10, :a 20, :c 30}\" (pr-str (->Rg 10 20 30))))"]])
+
+(each [label prog] cases
+  (check label (eval-string dl prog) true))
+
+(if (pos? failures)
+  (do (printf "record-declared-shape: %d failure(s)" failures) (os/exit 1))
+  (print "record-declared-shape: all cases passed"))