backend: cache resolved var cells per reference site (run-path ~5x)

Profiling jolt-i5if showed <=60-bit arithmetic is already native-fast; the real
general overhead in the run/-e/-m path is var resolution. Every var reference
compiled to (var-deref ns name), which builds + hashes a fresh "ns/name" string
and does a hashtable lookup per access (~45ns). The var cell is interned and
def-var! mutates it in place, so caching the resolved cell is sound under
redefinition.

Generalize the devirt per-site cache-cell mechanism to var value references: a
ref inside a fn resolves its cell once into the def's closure, then reads it via
var-cell-deref (a field read after the first). var-cell-deref is the cell-based
var-deref — binding-aware (dynamic vars + *ns* still resolve) and lenient on an
unbound root (a forward-declared var doesn't throw, unlike jolt-var-get).

Gated by a runtime flag: ON for runtime-compiled code (compile-eval.ss), OFF for
the seed mint and AOT build (emit-image.ss) so the seed stays a byte-fixpoint --
prelude.ss is unchanged, only image.ss picks up the new backend. ~5x on a
var-ref-heavy loop (1058ms->205ms); ~1.2x on test.check (its generators are more
deftype/dispatch-bound than var-deref-bound). No C/FFI.

Corpus rows pin redefinition / dynamic binding / forward ref through a cached
ref. make test + shakesmoke green, selfhost holds, SCI 211/218, certify 0-new.

host/chez/compile-eval.ss

@@ -104,6 +104,12 @@
 ;; is only for the bare -e subset with no prelude. Turn prelude mode on once, here,
 ;; so every analyze->emit on this spine sees the full core.
 ((var-deref "jolt.backend-scheme" "set-prelude-mode!") #t)
+;; Cache resolved var cells per reference site in runtime-compiled code (the big
+;; win for libraries / REPL code). emit-image.ss turns this back off so the seed
+;; mint and AOT build stay byte-deterministic. Guarded: the flag is absent in an
+;; older seed during the first re-mint pass.
+(let ((scv (var-deref "jolt.backend-scheme" "set-var-cache!")))
+  (when (procedure? scv) (scv #t)))
 
 ;; (quote X) -> X, else x — unwraps a quoted require spec.
 (define (ce-unquote x)

host/chez/dyn-binding.ss

@@ -117,6 +117,16 @@
               ((eq? cell star-ns-cell) (intern-ns! (chez-current-ns)))
               (else (var-cell-root cell)))))))
 
+;; var-deref's read on an ALREADY-RESOLVED cell — what compiled code emits when it
+;; caches the cell at a reference site. Binding stack first, then *ns* thread-local,
+;; else the raw root. Lenient on an unbound root (returns the sentinel), matching
+;; var-deref — NOT the strict jolt-var-get, which throws "Unbound var".
+(define (var-cell-deref cell)
+  (let ((bv (dyn-binding-value cell)))
+    (cond ((not (eq? bv dyn-no-binding)) bv)
+          ((eq? cell star-ns-cell) (intern-ns! (chez-current-ns)))
+          (else (var-cell-root cell)))))
+
 ;; jolt-var-get (vars.ss): the var-get fn + deref/@ on a cell. Stack first, then
 ;; the original (which errors on an unbound root, matching Clojure).
 (define %dyn-var-get jolt-var-get)

host/chez/emit-image.ss

@@ -41,6 +41,11 @@
 ;; top-level entry: in direct-link mode it binds jv$<fqn> for a top-level def; off
 ;; that mode (the minter, runtime eval) it is exactly emit, so output is unchanged.
 (define jolt-ce-emit-top (var-deref "jolt.backend-scheme" "emit-top-form"))
+;; Seed mint and AOT build must stay byte-deterministic, so emit the image with var
+;; cell-caching OFF (compile-eval.ss turned it on for runtime eval; this file loads
+;; after it). Guarded for the first re-mint pass off an older seed.
+(let ((scv (var-deref "jolt.backend-scheme" "set-var-cache!")))
+  (when (procedure? scv) (scv #f)))
 (define (ei-compile-form ctx f optimize?)
   (let ((ir (jolt-ce-analyze ctx f)))
     (jolt-ce-emit-top (if optimize? (jolt-ce-run-passes ir ctx) ir))))

jolt-core/jolt/backend_scheme.clj

@@ -160,6 +160,14 @@
 (def direct-link-fns (atom #{}))
 (defn direct-link-reset! [] (reset! direct-link-defined #{}) (reset! direct-link-fns #{}))
 
+;; Cache a resolved var cell in a per-site cell so a non-direct-linked var
+;; reference skips the name lookup (string-append + hash) after the first use.
+;; OFF during the seed mint (the seed must stay a byte-fixpoint, and caching the
+;; compiler's own refs shifts the gensym-numbered cell names every pass); the
+;; runtime eval path turns it on for user code, where it's the big win.
+(def var-cache? (atom false))
+(defn set-var-cache! [on] (reset! var-cache? on))
+
 ;; A direct-link Scheme binding name for a var. The fqn maps to a unique identifier
 ;; jv$<ns>$<name>; chars that break a Scheme identifier or the `$` separator are
 ;; escaped so distinct vars never collide.
@@ -183,14 +191,29 @@
 (def ^:private gensym-counter (atom 0))
 (defn- fresh-label [prefix] (str prefix (swap! gensym-counter inc)))
 
-;; Per-site devirt cache cells collected while emitting one top-level def. A
+;; Per-site cache cells collected while emitting one top-level def. A site that
-;; devirtualized call resolves a CONSTANT impl (static tag/proto/method), so it
+;; resolves a STABLE value — a devirtualized impl (constant tag/proto/method) or a
-;; needs resolving once, not per call — the inline cache the JVM gets for free. When
+;; var cell (interned, so the cell never changes even when the var is redefined) —
-;; a def init is being emitted this holds an atom; each devirt site appends a fresh
+;; resolves it once, not per call, the inline cache the JVM gets for free. When a
-;; cell name (bound to #f in a let wrapping the def, so it persists across calls and
+;; def init is being emitted this holds an atom; each site appends a fresh cell name
-;; is shared by every invocation), and the site resolves into it on first use. nil
+;; (bound to #f in a let wrapping the def, so it persists across calls and is shared
-;; outside a def (a devirt there falls back to a per-call resolve).
+;; by every invocation) and resolves into it on first use. nil outside a def (a site
-(def ^:private devirt-cells (atom nil))
+;; there falls back to a per-call resolve).
+(def ^:private cache-cells (atom nil))
+
+;; Emit a def's init (via the supplied thunk) under a fresh cache-cell collector,
+;; then wrap the result in a let binding any cells its body registered so they
+;; persist in the def's closure. Saves/restores the outer collector for nested
+;; defs. Used by both the runtime def emit and the direct-link top-level emit.
+(defn- emit-with-cells [emit-thunk]
+  (let [cells (atom [])
+        prev @cache-cells
+        _ (reset! cache-cells cells)
+        raw (emit-thunk)
+        _ (reset! cache-cells prev)]
+    (if (seq @cells)
+      (str "(let (" (str/join " " (map (fn [c] (str "(" c " #f)")) @cells)) ") " raw ")")
+      raw)))
 
 ;; Scheme syntactic keywords. A jolt local with one of these names would, when
 ;; emitted verbatim, shadow the Scheme form in operator position (a local named
@@ -569,7 +592,7 @@
                           dv (str "(devirt-resolve " (chez-str-lit (:devirt-type node)) " "
                                   (chez-str-lit (:devirt-proto node)) " " (chez-str-lit (:devirt-method node))
                                   " " r ")")
-                          cells @devirt-cells
+                          cells @cache-cells
                           ;; cache the resolved impl in a per-site cell when inside a
                           ;; def (resolved once on first call, then reused); else
                           ;; resolve per call.
@@ -699,7 +722,22 @@
              (and (stdlib-var? node) (not (deref prelude-mode?)))
              (throw (ex-info (str "emit: unsupported stdlib ref `" (:ns node) "/" (:name node)
                                   "` (no core on Chez yet)") {}))
-             :else (str "(var-deref " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")))
+             ;; inside a def, cache the interned var cell in a per-site cell so the
+             ;; name lookup (string-append + hash) runs once, not per access; the
+             ;; cell is stable and def-var! mutates its root in place, so this stays
+             ;; correct under redefinition. Read through var-cell-deref — the
+             ;; cell-based var-deref: binding-aware (a thread-bound dynamic var
+             ;; resolves to its binding) AND lenient on an unbound root (the strict
+             ;; jolt-var-get throws on a forward-declared var). Outside a def,
+             ;; resolve per access.
+             :else
+             (let [cells @cache-cells
+                   nslit (chez-str-lit (:ns node)) nmlit (chez-str-lit (:name node))]
+               (if (and @var-cache? cells)
+                 (let [c (fresh-label "_vc$")]
+                   (swap! cells conj c)
+                   (str "(var-cell-deref (or " c " (let ((_v (jolt-var " nslit " " nmlit "))) (set! " c " _v) _v)))"))
+                 (str "(var-deref " nslit " " nmlit ")")))))
     :the-var (str "(jolt-var " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
     ;; (set! *var* val) -> set the var's innermost binding (else root); returns val.
     :set-var (str "(jolt-var-set " (emit (:the-var node)) " " (emit (:val node)) ")")
@@ -770,10 +808,10 @@
            (str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
            (jmeta-nonempty? (:meta node))
            (str "(def-var-with-meta! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
-                (emit (:init node)) " " (emit-def-meta node) ")")
+                (emit-with-cells #(emit (:init node))) " " (emit-def-meta node) ")")
            :else
            (str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
-                (emit (:init node)) ")"))
+                (emit-with-cells #(emit (:init node))) ")"))
     (throw (ex-info (str "emit: op not yet ported / unhandled: " (pr-str (:op node))) {}))))
 
 ;; ^:dynamic / ^:redef on a def opts it out of direct-linking: it stays redefinable,
@@ -786,45 +824,53 @@
 ;; Off direct-link mode this is exactly `emit`, so the seed mint and runtime eval are
 ;; byte-unchanged. Nested defs (a defonce's inner def) never reach a top-level branch
 ;; here, so they stay indirect — a `define` would be illegal in their position.
+;; Emit a def, wrapping its init in a let that binds each per-site cache cell
+;; (var-ref + devirt) so a hot loop's lookups resolve once into the def's closure.
+;; Runs in BOTH modes; in direct-link mode a non-opt-out def also binds jv$<fqn>
+;; and registers it for app->app direct linking + a source-map frame.
+(defn- emit-def-cached [node]
+  (let [ns (:ns node) nm (:name node)
+        dl? (and @direct-link? (not (dl-opt-out? (:meta node))))
+        b (dl-name ns nm)
+        fn? (= :fn (:op (:init node)))
+        ;; A fn def gets a source-registry entry so a native backtrace can map its
+        ;; frame to ns/name (file:line). Chez names the frame by whatever emit-fn
+        ;; binds the lambda to: a NAMED fn (defn, or (fn foo …)) gets a letrec
+        ;; self-binding = munge-name of the fn's own name; an ANONYMOUS fn def has
+        ;; no letrec, so the lambda sits directly under (define jv$ns$name …) and
+        ;; takes that name. Register under whichever Chez will report.
+        pos (:pos node)
+        frame-name (when fn? (if-let [fnm (:name (:init node))] (munge-name fnm) b))
+        reg (when (and dl? fn? pos)
+              (str " (jolt-register-source! " (chez-str-lit frame-name) " "
+                   (chez-str-lit ns) " " (chez-str-lit nm) " "
+                   (if (get pos :file) (chez-str-lit (get pos :file)) "jolt-nil") " "
+                   (or (get pos :line) 0) ")"))
+        ;; register before emitting the init so a self-referential body direct-links.
+        _ (when dl? (swap! direct-link-defined conj (dl-fqn ns nm))
+                    (when fn? (swap! direct-link-fns conj (dl-fqn ns nm))))
+        init (emit-with-cells #(emit (:init node)))]
+    (cond
+      dl?
+      (if (jmeta-nonempty? (:meta node))
+        (str "(begin (define " b " " init ") (def-var-with-meta! "
+             (chez-str-lit ns) " " (chez-str-lit nm) " " b " " (emit-def-meta node) ")" (or reg "") ")")
+        (str "(begin (define " b " " init ") (def-var! "
+             (chez-str-lit ns) " " (chez-str-lit nm) " " b ")" (or reg "") ")"))
+      (jmeta-nonempty? (:meta node))
+      (str "(def-var-with-meta! " (chez-str-lit ns) " " (chez-str-lit nm) " " init " " (emit-def-meta node) ")")
+      :else
+      (str "(def-var! " (chez-str-lit ns) " " (chez-str-lit nm) " " init ")"))))
+
 (defn emit-top-form [node]
   (cond
+    ;; off direct-link (the seed mint + runtime-via-image) this is exactly `emit`,
+    ;; whose :def case already wraps cache cells, so the seed stays byte-unchanged.
     (not @direct-link?) (emit node)
     ;; top-level do splices: each statement/ret is itself a top-level form.
     (= :do (:op node))
     (str "(begin " (str/join " " (map emit-top-form (:statements node)))
          (if (empty? (:statements node)) "" " ") (emit-top-form (:ret node)) ")")
     (and (= :def (:op node)) (not (:no-init node)) (not (dl-opt-out? (:meta node))))
-    (let [ns (:ns node) nm (:name node) b (dl-name ns nm)
+    (emit-def-cached node)
-          fn? (= :fn (:op (:init node)))
-          ;; A fn def gets a source-registry entry so a native backtrace can map its
-          ;; frame to ns/name (file:line). Chez names the frame by whatever emit-fn
-          ;; binds the lambda to: a NAMED fn (defn, or (fn foo …)) gets a letrec
-          ;; self-binding = munge-name of the fn's own name; an ANONYMOUS fn def has
-          ;; no letrec, so the lambda sits directly under (define jv$ns$name …) and
-          ;; takes that name. Register under whichever Chez will report.
-          pos (:pos node)
-          frame-name (when fn?
-                       (if-let [fnm (:name (:init node))] (munge-name fnm) b))
-          reg (when (and fn? pos)
-                (str " (jolt-register-source! " (chez-str-lit frame-name) " "
-                     (chez-str-lit ns) " " (chez-str-lit nm) " "
-                     (if (get pos :file) (chez-str-lit (get pos :file)) "jolt-nil") " "
-                     (or (get pos :line) 0) ")"))]
-      ;; register before emitting the init so a self-referential body direct-links.
-      (swap! direct-link-defined conj (dl-fqn ns nm))
-      (when fn? (swap! direct-link-fns conj (dl-fqn ns nm)))
-      (let [cells (atom [])
-            _ (reset! devirt-cells cells)
-            raw (emit (:init node))
-            _ (reset! devirt-cells nil)
-            ;; wrap the init so each devirt site's cache cell persists across calls,
-            ;; shared by every invocation of this def.
-            init (if (seq @cells)
-                   (str "(let (" (str/join " " (map (fn [c] (str "(" c " #f)")) @cells)) ") " raw ")")
-                   raw)]
-        (if (jmeta-nonempty? (:meta node))
-          (str "(begin (define " b " " init ") (def-var-with-meta! "
-               (chez-str-lit ns) " " (chez-str-lit nm) " " b " " (emit-def-meta node) ")" (or reg "") ")")
-          (str "(begin (define " b " " init ") (def-var! "
-               (chez-str-lit ns) " " (chez-str-lit nm) " " b ")" (or reg "") ")"))))
     :else (emit node)))

test/chez/corpus.edn

@@ -1550,6 +1550,12 @@
   {:suite "numbers / variadic bit ops" :label "bit-xor in value position" :expected "0" :actual "(reduce bit-xor 0 [1 2 3])"}
   {:suite "numbers / variadic bit ops" :label "bit-or via apply" :expected "7" :actual "(apply bit-or [1 2 4])"}
   {:suite "numbers / variadic bit ops" :label "unsigned-shift over a full 64-bit value" :expected "17179869183" :actual "(unsigned-bit-shift-right -1 30)"}
+  ;; var-reference cell caching (runtime path): a ref inside a fn caches the
+  ;; resolved cell, but stays correct under redefinition (cell root mutated in
+  ;; place) and dynamic binding (read goes through the binding-aware path).
+  {:suite "vars / cached reference stays correct" :label "redefinition is seen through a cached ref" :expected "2" :actual "(do (def x 1) (defn f [] x) (def x 2) (f))"}
+  {:suite "vars / cached reference stays correct" :label "dynamic binding is seen through a cached ref" :expected "[1 9 1]" :actual "(do (def ^:dynamic *d* 1) (defn g [] *d*) [(g) (binding [*d* 9] (g)) (g)])"}
+  {:suite "vars / cached reference stays correct" :label "forward reference resolves once the var is defined" :expected "42" :actual "(do (defn a [] (b)) (defn b [] 42) (a))"}
   {:suite "predicates / nil & boolean" :label "nil? true" :expected "true" :actual "(nil? nil)"}
   {:suite "predicates / nil & boolean" :label "nil? false" :expected "false" :actual "(nil? 0)"}
   {:suite "predicates / nil & boolean" :label "some? true" :expected "true" :actual "(some? 0)"}