diff --git a/src/jolt/api.janet b/src/jolt/api.janet index d071e0d..6917164 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -12,6 +12,7 @@ (import ./backend :as backend) (import ./stdlib_embed :as stdlib-embed) (import ./host_iface :as host) +(import ./config :as config) # Host interop: JVM class/method shims + collection interop (.iterator/.nth/...) # register into the evaluator at module load. See src/jolt/host_interop.janet. (import ./host_interop) @@ -318,22 +319,10 @@ (def [h len] (source-fingerprint)) # Opts land in the key via their printed form; an opt that prints unstably # (e.g. a closure in :namespaces) just degrades to a cache miss, never to a - # wrong hit. Runtime knobs that shape the ctx outside opts ride along too. - (def key (string/format "%q|%q|%q|%q|%q|%q|%q|%q|%q|%q|%q|%q" - (string janet/version "-" janet/build) - opts - (os/getenv "JOLT_PATH") - (os/getenv "JOLT_MUTABLE") - (os/getenv "JOLT_AOT_CORE") - (os/getenv "JOLT_FEATURES") - (os/getenv "JOLT_INTERPRET_MACROS") - (os/getenv "JOLT_DIRECT_LINK") - (os/getenv "JOLT_NO_IR_PASSES") - (os/getenv "JOLT_CHECK_HINTS") - # :shapes? is baked into the image; key on every input - # to it so a cache hit never carries a wrong shape state - (os/getenv "JOLT_SHAPE") - (os/getenv "JOLT_NO_SHAPE"))) + # wrong hit. Every ctx-shaping env var rides along via config/ctx-cache-key — + # one canonical list shared with the deps-image key (jolt-q5ql), so a new knob + # can't be added to one key and forgotten in the other. + (def key (config/ctx-cache-key [:janet (string janet/version "-" janet/build) :opts opts])) (string dir "/jolt-ctx-" (band h 0x7FFFFFFF) "-" len "-" (band (hash key) 0x7FFFFFFF) ".jimg")) (defn init-cached diff --git a/src/jolt/config.janet b/src/jolt/config.janet index f4e6a11..55bc364 100644 --- a/src/jolt/config.janet +++ b/src/jolt/config.janet @@ -13,3 +13,60 @@ # Convenience: immutable? is the default. (def immutable? (not mutable?)) + +# --------------------------------------------------------------------------- +# Run-mode + cache-key policy (jolt-q5ql). Lifted out of main so it is unit- +# testable without the CLI and so the disk-cache keys share ONE canonical list +# of ctx-shaping env vars (a positional %q key silently misaligned if a knob was +# added in only one place — the footgun this fixes). +# --------------------------------------------------------------------------- + +# Every env var that shapes the built/optimized ctx. Both image caches key on +# this exact list, so adding a knob here updates every cache key at once. +(def ctx-shaping-env-vars + ["JOLT_PATH" "JOLT_MUTABLE" "JOLT_AOT_CORE" "JOLT_FEATURES" + "JOLT_INTERPRET" "JOLT_INTERPRET_MACROS" "JOLT_DIRECT_LINK" + "JOLT_NO_DIRECT_LINK" "JOLT_OPTIMIZE" "JOLT_WHOLE_PROGRAM" + "JOLT_NO_WHOLE_PROGRAM" "JOLT_SHAPE" "JOLT_NO_SHAPE" + "JOLT_NO_IR_PASSES" "JOLT_CHECK_HINTS"]) + +(defn ctx-cache-key + "Build a disk-cache key from labeled prefix pairs plus the value of every + ctx-shaping env var. Each component is tagged by name (`label=value`), so a + new knob can't positionally alias two different builds. `prefix` is a flat + array of label,value,label,value,... (e.g. version + entry ns + opts)." + [prefix] + (def parts @[]) + (var i 0) + (while (< i (length prefix)) + (array/push parts (string/format "%s=%q" (in prefix i) (in prefix (+ i 1)))) + (+= i 2)) + (each ev ctx-shaping-env-vars + (array/push parts (string/format "%s=%q" ev (os/getenv ev)))) + (string/join parts "|")) + +(defn resolve-run-mode + "Resolve the compile/optimization knobs from argv-derived flags + env. + `open-mode?` = an interactive/non-program invocation (repl/-e/help/uberscript); + `main-entry?` = a -m/-M program entry. Returns the ctx env knob map that main + installs. Explicit env always wins (JOLT_NO_DIRECT_LINK / JOLT_DIRECT_LINK)." + [open-mode? main-entry?] + (def dl-forced + (cond (os/getenv "JOLT_NO_DIRECT_LINK") :off + (= "1" (os/getenv "JOLT_DIRECT_LINK")) :on + :none)) + (def dl (case dl-forced :off false :on true (not open-mode?))) + # Inference/specialization is the expensive part — default OFF, opt in with + # JOLT_OPTIMIZE (or an explicit JOLT_DIRECT_LINK, which signals a full build). + (def optimize? + (and dl (or (not (nil? (os/getenv "JOLT_OPTIMIZE"))) + (= "1" (os/getenv "JOLT_DIRECT_LINK"))))) + {:direct-linking? dl + :inline? optimize? + # auto-enabled (vs explicitly requested) — suppresses the checker default-on. + :direct-link-auto? (and dl (= dl-forced :none)) + :shapes? (and dl (not (os/getenv "JOLT_NO_SHAPE"))) + :map-shapes? (and (os/getenv "JOLT_SHAPE") (not (os/getenv "JOLT_NO_SHAPE"))) + :whole-program? (and optimize? + (not (os/getenv "JOLT_NO_WHOLE_PROGRAM")) + (or main-entry? (os/getenv "JOLT_WHOLE_PROGRAM")))}) diff --git a/src/jolt/main.janet b/src/jolt/main.janet index f25c51c..2558d77 100644 --- a/src/jolt/main.janet +++ b/src/jolt/main.janet @@ -441,13 +441,11 @@ # invalidates it. JOLT_NO_DEPS_CACHE=1 disables. (defn- deps-image-path [ns-name] (def dir (or (os/getenv "JOLT_IMAGE_CACHE_DIR") (os/getenv "TMPDIR") "/tmp")) - (def env (ctx :env)) - (def key (string/format "%q|%q|%q|%q|%q|%q|%q|%q|%q" - jolt-version ns-name (os/getenv "JOLT_PATH") - (get env :direct-linking?) (get env :inline?) - (get env :shapes?) (get env :map-shapes?) - (get env :whole-program?) - (os/getenv "JOLT_FEATURES"))) + # Key on the jolt version + entry ns + every ctx-shaping env var (ctx-cache-key, + # jolt-q5ql): the run-mode flags this image bakes are all derived from those + # vars, so keying on the canonical list can't miss one the way the old + # hand-built positional key could. + (def key (ctx-cache-key [:jolt-version jolt-version :ns ns-name])) (string dir "/jolt-deps-" (band (hash key) 0x7FFFFFFF) ".jimg")) (defn- manifest-of [files] @@ -591,46 +589,12 @@ (= (argv 0) "repl") (nrepl-flags (argv 0)) (eval-flags (argv 0)) (= (argv 0) "uberscript"))) (def main-entry? (and (not (empty? argv)) (main-flags (argv 0)))) - (def dl-forced - (cond (os/getenv "JOLT_NO_DIRECT_LINK") :off - (= "1" (os/getenv "JOLT_DIRECT_LINK")) :on - :none)) - (def dl (case dl-forced :off false :on true (not open-mode?))) - (put (ctx :env) :direct-linking? dl) - # Inference / specialization (inlining + scalar replacement + structural type - # inference + the per-namespace re-emit fixpoint) is the EXPENSIVE part — like - # Stalin's whole-program analysis or a Clojure AOT pass, it belongs at BUILD - # time or behind an explicit opt-in, not paid on every program startup. Direct- - # linking (cheap compile-time call resolution; FASTER startup + calls, per - # Clojure's :direct-linking) does not need it. So default it OFF and turn it on - # with JOLT_OPTIMIZE (or an explicit JOLT_DIRECT_LINK, which signals a fully - # optimized build). The native build bakes an optimized image once. - (def optimize? (and dl (truthy? (or (os/getenv "JOLT_OPTIMIZE") - (= "1" (os/getenv "JOLT_DIRECT_LINK")))))) - (put (ctx :env) :inline? optimize?) - # Mark direct-linking that was AUTO-enabled by the run mode (vs explicitly - # requested). The success checker (RFC 0006) rides on the inference for free, - # but a casual program run shouldn't spam type warnings just because it now - # direct-links — so the checker's default-on is suppressed in the auto case - # (JOLT_TYPE_CHECK still opts in). API/build callers never set this flag, so an - # explicit :direct-linking? there keeps the checker as before. See backend. - (put (ctx :env) :direct-link-auto? (and dl (= dl-forced :none))) - # Shape gates, recomputed from the runtime env (the baked ctx computed them at - # build time). :shapes? = shape-recs active (records), on with direct-linking; - # :map-shapes? = also shape generic maps (opt-in JOLT_SHAPE). - (put (ctx :env) :shapes? - (and dl (not (os/getenv "JOLT_NO_SHAPE")))) - (put (ctx :env) :map-shapes? - (and (os/getenv "JOLT_SHAPE") (not (os/getenv "JOLT_NO_SHAPE")))) - # Whole-program (closed-world cross-namespace inference) auto-enables for a - # -m/-M program entry under direct-linking — that's the point where every - # require is done and -main is about to run. JOLT_WHOLE_PROGRAM forces it on in - # other direct-linked modes; JOLT_NO_WHOLE_PROGRAM opts out. Namespaces required - # later (inside -main) fall back to per-ns inference (see loader). - (put (ctx :env) :whole-program? - (and optimize? - (not (os/getenv "JOLT_NO_WHOLE_PROGRAM")) - (or main-entry? (os/getenv "JOLT_WHOLE_PROGRAM")))) + # Run-mode policy lives in config/resolve-run-mode now (jolt-q5ql) — unit- + # testable without the CLI, and the same canonical knob list backs the cache + # keys. Install the resolved knobs onto the runtime env (the baked ctx computed + # them at build time; a program run recomputes from the live env). + (let [mode (resolve-run-mode open-mode? main-entry?)] + (eachp [k v] mode (put (ctx :env) k v))) (cond (empty? argv) (run-repl) (help-flags (argv 0)) (print-help) diff --git a/test/unit/config-test.janet b/test/unit/config-test.janet new file mode 100644 index 0000000..8d59e4a --- /dev/null +++ b/test/unit/config-test.janet @@ -0,0 +1,73 @@ +(use ../../src/jolt/config) + +# ============================================================ +# resolve-run-mode (jolt-q5ql) +# ============================================================ + +# Save/restore the env vars these tests poke at. +(def touched ["JOLT_DIRECT_LINK" "JOLT_NO_DIRECT_LINK" "JOLT_OPTIMIZE" + "JOLT_WHOLE_PROGRAM" "JOLT_NO_WHOLE_PROGRAM" "JOLT_SHAPE" + "JOLT_NO_SHAPE"]) +(def saved (table ;(mapcat (fn [k] [k (os/getenv k)]) touched))) +(defn clear-env [] (each k touched (os/setenv k nil))) +(defn restore-env [] (each k touched (os/setenv k (get saved k)))) + +(clear-env) + +# Interactive (open) mode: no direct-linking, no optimization. +(let [m (resolve-run-mode true false)] + (assert (= false (m :direct-linking?)) "open mode: not direct-linked") + (assert (= false (m :inline?)) "open mode: not inlined") + (assert (not (m :whole-program?)) "open mode: no whole-program")) + +# Program entry (-m): direct-links by default, but optimization stays OFF unless +# opted in, so whole-program is off too. +(let [m (resolve-run-mode false true)] + (assert (= true (m :direct-linking?)) "program run: direct-linked") + (assert (= false (m :inline?)) "program run: optimization off by default") + (assert (m :direct-link-auto?) "program run: direct-link auto flag set") + (assert (not (m :whole-program?)) "program run: no whole-program without optimize")) + +# JOLT_OPTIMIZE turns on inlining; a -m entry then enables whole-program. +(os/setenv "JOLT_OPTIMIZE" "1") +(let [m (resolve-run-mode false true)] + (assert (m :inline?) "JOLT_OPTIMIZE: inlining on") + (assert (m :whole-program?) "JOLT_OPTIMIZE + main entry: whole-program on")) +(os/setenv "JOLT_OPTIMIZE" nil) + +# Explicit env wins: JOLT_NO_DIRECT_LINK forces open even for a program entry. +(os/setenv "JOLT_NO_DIRECT_LINK" "1") +(let [m (resolve-run-mode false true)] + (assert (= false (m :direct-linking?)) "JOLT_NO_DIRECT_LINK forces open") + (assert (not (m :direct-link-auto?)) "forced-off is not auto")) +(os/setenv "JOLT_NO_DIRECT_LINK" nil) + +# JOLT_DIRECT_LINK forces direct-linking + optimization on even in open mode. +(os/setenv "JOLT_DIRECT_LINK" "1") +(let [m (resolve-run-mode true false)] + (assert (m :direct-linking?) "JOLT_DIRECT_LINK forces direct-link in open mode") + (assert (m :inline?) "JOLT_DIRECT_LINK implies optimization") + (assert (not (m :direct-link-auto?)) "explicit direct-link is not auto")) +(os/setenv "JOLT_DIRECT_LINK" nil) + +# ============================================================ +# ctx-cache-key footgun (jolt-q5ql): the key must change when ANY ctx-shaping +# env var changes, and stay stable otherwise. +# ============================================================ + +(clear-env) +(def k0 (ctx-cache-key [:v "1" :ns "app"])) +(assert (= k0 (ctx-cache-key [:v "1" :ns "app"])) "same inputs -> same key") +(assert (not= k0 (ctx-cache-key [:v "2" :ns "app"])) "prefix change -> different key") + +# Every ctx-shaping env var must participate (this is the regression that the +# old positional key could miss): flipping each one alone changes the key. +(each ev ctx-shaping-env-vars + (os/setenv ev "X") + (assert (not= k0 (ctx-cache-key [:v "1" :ns "app"])) + (string "ctx-cache-key ignores " ev " — cache-key footgun")) + (os/setenv ev nil)) + +(restore-env) + +(print "config-test: all assertions passed")