Bare-index field reads for statically-known records (#228)

When the inference types a keyword-lookup receiver as a record — it carries the
field-order :shape and :hint :struct from the whole-program fixpoint — the back
end reads the field by its declared slot via jrec-field-at instead of jolt-get.
That skips the jolt-get case-lambda, the dispatch fn, and the field-key
hashtable lookup, leaving a jrec? check + a static-index vector-ref.

jrec-field-at falls back to jolt-get when the receiver isn't the expected record
(a map downgraded by dissoc, or a value the inference mistyped), so it stays
correct if the static type is wrong. Only the no-default form takes the bare
path (a declared field is always present).

Sound only for non-nil records: a self-recursive param that can be nil (e.g.
binary-trees check-tree, whose untagged child is nil at leaves) types :any and
keeps jolt-get — the whole-program fixpoint demotes it. The target is non-nil
record params, like a Vec3 dot product (~5% there; boxed-flonum arithmetic
dominates the rest, a separate numeric lever).

run-fieldread.ss gate: emitted form uses jrec-field-at at the right slot and
matches jolt-get for each declared field; a non-field key and a default-arg form
keep the generic path. make test / shakesmoke green, 0 new divergences.

Co-authored-by: Yogthos <yogthos@gmail.com>

Makefile

@@ -4,7 +4,7 @@
 # build step. `make test` is the full gate. `make remint` rebuilds the seed after a
 # source change.
 
-.PHONY: test ci values corpus unit smoke buildsmoke selfhost sci certify ffi transient infer wp devirt directlink numeric inline shakesmoke remint
+.PHONY: test ci values corpus unit smoke buildsmoke selfhost sci certify ffi transient infer wp devirt fieldread directlink numeric inline shakesmoke remint
 
 # Full gate (dev machine). Includes the self-host byte-fixpoint, which only holds
 # on the same Chez that minted the seed.
@@ -15,7 +15,7 @@ test: selfhost ci
 # lockfile) — it RUNS correctly on any Chez, but `selfhost` rebuilds it and a
 # different Chez version may emit byte-different (gensym/order) output, so the
 # byte-fixpoint is a dev-machine check, not a CI one (jolt-8479).
-ci: values corpus unit smoke buildsmoke sci ffi transient infer wp devirt directlink numeric inline certify
+ci: values corpus unit smoke buildsmoke sci ffi transient infer wp devirt fieldread directlink numeric inline certify
 	@echo "OK: CI gates passed"
 
 # Self-host fixpoint: bootstrap.ss rebuild == checked-in seed.
@@ -73,6 +73,12 @@ wp:
 devirt:
 	@chez --script host/chez/run-devirt.ss
 
+# Native record field reads: a keyword lookup on a statically-known record reads
+# the field by its declared slot (jrec-field-at) instead of jolt-get; the value
+# must match, and a non-field key / default-arg form keeps the generic path.
+fieldread:
+	@chez --script host/chez/run-fieldread.ss
+
 # Direct-linking emission: a closed-world build binds top-level app defs to jv$
 # Scheme bindings and routes app->app calls/refs to them, skipping var-deref +
 # jolt-invoke; ^:dynamic/^:redef and nested defs opt out.

host/chez/records.ss

@@ -146,6 +146,17 @@
                          => (lambda (m) (jolt-invoke m coll k d)))
                         (else d))
                   v))))))
+;; bare-index field read for a statically-known record field — emitted by `jolt
+;; build --opt` for a struct-typed receiver, where i is the field's declared slot.
+;; When r is the expected record it reads the value vector directly: no field-key
+;; hashtable lookup, no jolt-get dispatch. Falls back to jolt-get otherwise (a map
+;; downgraded by dissoc, or a value the inference mistyped), so it stays correct
+;; even if the static type is wrong.
+(define (jrec-field-at r i k)
+  (if (and (jrec? r) (fx< i (vector-length (jrec-vals r))))
+      (vector-ref (jrec-vals r) i)
+      (jolt-get r k)))
+
 ;; mutate a deftype's mutable field in place: the value vector is mutable, so
 ;; vector-set! updates the field. (set! field v) inside a method lowers to this;
 ;; returns v, as set! does.

host/chez/run-fieldread.ss

@@ -0,0 +1,72 @@
+;; run-fieldread.ss — native record field-read gate (backend_scheme emit).
+;;
+;; When the inference types a keyword-lookup receiver as a record (it carries the
+;; field-order :shape + :hint :struct), the back end reads the field by its static
+;; slot via jrec-field-at instead of jolt-get. This gate pins the emit shape and
+;; that the value matches jolt-get — for a declared field, a non-field key (no
+;; bare path), and a default-arg form (no bare path).
+;;
+;;   chez --script host/chez/run-fieldread.ss
+(import (chezscheme))
+(load "host/chez/rt.ss")
+(set-chez-ns! "clojure.core")
+(load "host/chez/seed/prelude.ss")
+(load "host/chez/post-prelude.ss")
+(set-chez-ns! "user")
+(load "host/chez/host-contract.ss")
+(load "host/chez/seed/image.ss")
+(load "host/chez/compile-eval.ss")
+
+(define analyze (var-deref "jolt.analyzer" "analyze"))
+(define emit    (var-deref "jolt.backend-scheme" "emit"))
+(define kw      (lambda (n) (keyword #f n)))
+(define (evals src) (jolt-compile-eval (string-append "(do " src ")") "user"))
+
+(evals "(defrecord Vec3 [x y z])")
+(evals "(def a (->Vec3 10 20 30))")
+
+;; emit (:KEY a [default]) with arg 0 marked as a Vec3 struct receiver.
+(define (mark-emit src)
+  (let* ((ir (analyze (make-analyze-ctx "user") (jolt-ce-read src)))
+         (a0 (jolt-nth (jolt-get ir (kw "args")) 0))
+         (marked (jolt-assoc a0 (kw "hint") (kw "struct")
+                             (kw "shape") (jolt-vector (kw "x") (kw "y") (kw "z"))))
+         (args (jolt-get ir (kw "args")))
+         (args2 (jolt-assoc args 0 marked)))
+    (emit (jolt-assoc ir (kw "args") args2))))
+
+(define (run-emit scm) (eval (read (open-input-string scm)) (interaction-environment)))
+(define (has-sub? s sub)
+  (let ((n (string-length s)) (m (string-length sub)))
+    (let loop ((i 0)) (cond ((> (+ i m) n) #f)
+                            ((string=? (substring s i (+ i m)) sub) #t)
+                            (else (loop (+ i 1)))))))
+(define fails 0) (define total 0)
+(define (check label actual expected)
+  (set! total (+ total 1))
+  (unless (equal? actual expected)
+    (set! fails (+ fails 1))
+    (printf "  FAIL ~a: got ~s expected ~s\n" label actual expected)))
+
+;; a declared field -> bare-index path, value matches jolt-get
+(let ((e (mark-emit "(:y a)")))
+  (check "declared field uses jrec-field-at" (has-sub? e "jrec-field-at") #t)
+  (check "field 1 -> static slot 1" (has-sub? e " 1 ") #t)
+  (check "bare read == jolt-get" (run-emit e) (evals "(:y a)")))   ; 20
+
+;; first/last fields too
+(check "field x == jolt-get" (run-emit (mark-emit "(:x a)")) (evals "(:x a)"))   ; 10
+(check "field z == jolt-get" (run-emit (mark-emit "(:z a)")) (evals "(:z a)"))   ; 30
+
+;; a key that is NOT a declared field -> no bare path, still correct (nil)
+(let ((e (mark-emit "(:w a)")))
+  (check "non-field key no jrec-field-at" (has-sub? e "jrec-field-at") #f)
+  (check "non-field key == jolt-get" (run-emit e) (evals "(:w a)")))   ; nil
+
+;; a default-arg form keeps jolt-get (the bare path is no-default only)
+(let ((e (mark-emit "(:y a 99)")))
+  (check "default-arg keeps jolt-get" (has-sub? e "jrec-field-at") #f))
+
+(if (= fails 0)
+    (begin (printf "fieldread gate: ~a/~a passed\n" total total) (exit 0))
+    (begin (printf "fieldread gate: ~a/~a passed (~a failed)\n" (- total fails) total fails) (exit 1)))

jolt-core/jolt/backend_scheme.clj

@@ -482,6 +482,14 @@
     (let [op (case kind :double (dbl-ops nm) :long (lng-ops nm) :bigdec (bd-ops nm))]
       (order-args (fn [as] (str "(" op " " (str/join " " as) ")"))))))
 
+;; slot of a declared field key in a record's field-order shape, or nil.
+(defn- struct-field-index [shape kw]
+  (when shape
+    (loop [i 0]
+      (cond (>= i (count shape)) nil
+            (= (nth shape i) kw) i
+            :else (recur (inc i))))))
+
 (defn- emit-invoke [node]
   (let [fnode (:fn node)
         arg-nodes (:args node)
@@ -519,9 +527,18 @@
       (and nop (= 1 (count args)) (cmp1-ops nop)) (str "(begin " (first args) " #t)")
       nop (order-args (fn [as] (str "(" nop " " (str/join " " as) ")")))
       ;; (:k coll [default]) -> (jolt-get coll :k [default]) — the key (fnode) is a
-      ;; const, so only the coll/default args carry order.
+      ;; const, so only the coll/default args carry order. When the inference typed
+      ;; the receiver as a record whose declared fields include :k (it carries the
+      ;; field-order :shape), read the field by its static slot — no field-key
+      ;; lookup, no jolt-get dispatch. Only the no-default form (a declared field is
+      ;; always present, so a default is never taken).
       (= kind :keyword)
-      (order-args (fn [as] (str "(jolt-get " (first as) " " (emit fnode) (defstr as) ")")))
+      (let [recv (first arg-nodes)
+            idx (when (and (= :struct (:hint recv)) (= 1 (count arg-nodes)))
+                  (struct-field-index (:shape recv) (:val fnode)))]
+        (if idx
+          (order-args (fn [as] (str "(jrec-field-at " (first as) " " idx " " (emit fnode) ")")))
+          (order-args (fn [as] (str "(jolt-get " (first as) " " (emit fnode) (defstr as) ")")))))
       ;; (coll k [default]) -> (jolt-get coll k [default]) — coll (fnode) is the
       ;; callee, evaluated before the key/default args.
       (= kind :coll)