diff --git a/src/jolt/backend.janet b/src/jolt/backend.janet index 32a7718..5025e3d 100644 --- a/src/jolt/backend.janet +++ b/src/jolt/backend.janet @@ -32,6 +32,14 @@ # var-get/tuple-slice/...) and jolt runtime helpers resolve by name. (def jolt-runtime-env (curenv)) +# Janet's `in` accessor as an embedded VALUE (jolt-fjb1). The back end uses `in` +# to index cells/shape-recs/arg tuples in code it EMITS. Emitting the bare symbol +# `in` is unhygienic: a user local named `in` (malli's explainer binds `[value in +# acc]`) shadows it in the surrounding scope, so the generated `(in cell :root)` +# would call the user's value as a function — " called with 2 arguments". +# Embedding the function value (as with jolt-call/core-get) can't be shadowed. +(def- jin in) + (defn ctx-janet-env "Lazily create/cache a per-context Janet environment for compiled code: a child of the runtime env (so core fns resolve) that holds this context's user defs. @@ -120,10 +128,21 @@ # So we direct-link exactly the call-optimization case; everything else stays # indirect (live var deref → redefinable). Default user/REPL units: flag off, # so all user calls are indirect and redefinable with no annotation. +# A var DEF'd earlier as a sibling in the current compilation unit can't be +# direct-linked/const-linked: its embedded root is the value from BEFORE this +# unit runs, but the unit's own (def …) rebinds it first — so a later reference +# in the same unit (e.g. deftype's `(def ->R R)` alias after `(def R …)`) would +# capture the stale pre-redef root (jolt-wf4). Self-reference inside a def's own +# init is unaffected: the cell is registered only AFTER its init is emitted, so a +# fn body's recursive call still direct-links (and runs after the def completes). +(defn- unit-redefined? [ctx cell] + (let [ud (get (ctx :env) :unit-defs)] (and ud (get ud cell) true))) + (defn- direct-var? [ctx cell] (and (get (ctx :env) :direct-linking?) (not (cell :dynamic)) (not (let [m (cell :meta)] (and m (get m :redef)))) + (not (unit-redefined? ctx cell)) (let [r (cell :root)] (or (function? r) (cfunction? r))))) # Whole-program constant-linking (closed world): under JOLT_WHOLE_PROGRAM every @@ -141,6 +160,7 @@ (and (get (ctx :env) :whole-program?) (get (ctx :env) :direct-linking?) (not (cell :dynamic)) + (not (unit-redefined? ctx cell)) (not (nil? (cell :root))))) # Fresh Janet symbol for back-end-introduced bindings (arity dispatch). NOT @@ -181,7 +201,7 @@ (defn- emit-arity-invoke [ctx ar jargs] (def nfixed (length (vview (ar :params)))) (def call @[(emit-arity-fn ctx ar)]) - (for i 0 nfixed (array/push call ['in jargs i])) + (for i 0 nfixed (array/push call [jin jargs i])) # empty rest binds to NIL, not () — (f) with [& r] gives r = nil in Clojure (when (ar :rest) (array/push call ['if ['> ['length jargs] nfixed] ['tuple/slice jargs nfixed]])) @@ -213,7 +233,7 @@ # live-root call the :var emit uses, for the ns get/set helpers below. (defn- core-fn-call [ctx nm & args] (def cell (cell-for ctx "clojure.core" nm)) - (tuple (tuple 'in (tuple 'quote cell) :root) ;args)) + (tuple (tuple jin (tuple 'quote cell) :root) ;args)) (defn- emit-try [ctx node] (def core @@ -408,11 +428,11 @@ # NOT gated on compile-time shapes — core is baked without the flag but still # receives user shape-recs, so this must hold in baked core too. (jolt-t34) (defn get-or-shape [getexpr] - (if sidx ['in m sidx] + (if sidx [jin m sidx] (let [pos (jsym)] ['if ['and ['tuple? m] ['struct? ['get m 0]]] ['let [pos ['get [['get m 0] :idx] k]] - ['if ['nil? pos] (tuple core-get m k nil) ['in m ['+ 1 pos]]]] + ['if ['nil? pos] (tuple core-get m k nil) [jin m ['+ 1 pos]]]] getexpr]))) (if (nil? d-expr) (let [fast (get-or-shape ['get m k])] @@ -620,9 +640,9 @@ # majority) pay two native table ops + a branch instead of a # function call. (let [qcell (tuple 'quote cell)] - ['if ['in qcell :dynamic] + ['if [jin qcell :dynamic] (tuple var-get qcell) - ['in qcell :root]])))) + [jin qcell :root]])))) # (var x): the var object itself (not its value) — the embedded cell, by # reference. binding keys its thread-binding frame on this exact cell. :the-var (tuple 'quote (cell-for ctx (node :ns) (node :name))) @@ -633,10 +653,15 @@ :try (emit-try ctx node) :throw ['error (emit ctx (node :expr))] :def (let [cell (cell-for ctx (node :ns) (node :name)) - meta (node :meta)] + meta (node :meta) + setter (if (and meta (not (empty? meta))) (var-setter-meta cell meta) (var-setter cell))] (inline-stash! ctx cell node) - (tuple (if (and meta (not (empty? meta))) (var-setter-meta cell meta) (var-setter cell)) - (emit ctx (node :init)))) + # Emit the init BEFORE marking the cell unit-defined, so a recursive + # self-reference in the init still direct-links; a LATER sibling + # reference in this unit then sees it as redefined (jolt-wf4). + (let [init-form (emit ctx (node :init))] + (when-let [ud (get (ctx :env) :unit-defs)] (put ud cell true)) + (tuple setter init-form))) :let (emit-let ctx node) :fn (emit-fn ctx node) :invoke (emit-invoke ctx node) @@ -649,6 +674,10 @@ (defn emit-ir "IR node -> Janet form (public entry for the back end)." [ctx node] + # Fresh per-unit set of vars (re)defined in THIS top-level form, so a sibling + # reference to one can't direct-link to its pre-redef root (jolt-wf4). Scoped + # to one emit pass; each compile-and-eval / re-emit call is its own unit. + (when (table? (get ctx :env)) (put (ctx :env) :unit-defs @{})) (emit ctx node)) # --- pipeline wiring (the self-hosted compile path) --- diff --git a/test/integration/direct-linking-test.janet b/test/integration/direct-linking-test.janet index 0bb1fe5..ba0e101 100644 --- a/test/integration/direct-linking-test.janet +++ b/test/integration/direct-linking-test.janet @@ -58,6 +58,19 @@ (let [ctx (init {:compile? true :aot-core? false})] (check "aot-core off still correct" (eval-string ctx "(last [1 2 3])") 3)) +# 6. Redefining a record with REORDERED fields must rebind the ctor (jolt-wf4). +# deftype expands to (do (def R (make-deftype-ctor ...)) (def ->R R) ...): the +# `->R` alias references R in the SAME compiled unit. Direct-link embeds a var's +# root as a compile-time constant, but R's redefined root hasn't RUN yet when +# that unit compiles — so ->R must NOT seal to R's stale (pre-redef) ctor. +(let [ctx (init {:compile? true :direct-linking? true})] + (eval-string ctx "(defrecord R [x a])") + (eval-string ctx "(defrecord R [a x])") + (check "record field-reorder redefine: :a reads the new layout" + (eval-string ctx "(:a (->R 10 20))") 10) + (check "record field-reorder redefine: :x reads the new layout" + (eval-string ctx "(:x (->R 10 20))") 20)) + (if (pos? failures) (do (printf "direct-linking: %d failure(s)" failures) (os/exit 1)) (print "direct-linking: all matrix cases passed")) diff --git a/test/spec/functions-spec.janet b/test/spec/functions-spec.janet index 060ec78..ba1f07c 100644 --- a/test/spec/functions-spec.janet +++ b/test/spec/functions-spec.janet @@ -11,7 +11,13 @@ ["variadic with fixed" "[1 [2 3]]" "(do (defn f [a & xs] [a xs]) (f 1 2 3))"] ["closure captures" "8" "(do (defn adder [n] (fn [x] (+ x n))) ((adder 5) 3))"] ["recursion" "120" "(do (defn fact [n] (if (< n 2) 1 (* n (fact (dec n))))) (fact 5))"] - ["named fn self-ref" "120" "((fn fact [n] (if (< n 2) 1 (* n (fact (dec n))))) 5)"]) + ["named fn self-ref" "120" "((fn fact [n] (if (< n 2) 1 (* n (fact (dec n))))) 5)"] + # A param whose name collides with a Janet builtin the back end emits in + # generated code (here `in`, used to deref vars / index shape-recs) must not + # shadow it — malli's explainer binds `[value in acc]` (jolt-fjb1). + ["param named `in`" "1" "((fn [in] (first in)) [1 2 3])"] + ["param `in` via core fn" "3" "((fn [in] (count in)) [1 2 3])"] + ["local `in` in let body" "2" "(let [in [2 3]] (first in))"]) (defspec "functions / application" ["apply" "6" "(apply + [1 2 3])"]