0e3584884f
init in compile mode is ~2.4 s (tier loading, analyzer self-compile, macro recompilation), paid by every process that builds a ctx from source — each jpm-test file, embedders, workers. init-cached marshals the built ctx to a disk image (same root-env dicts as snapshot/fork) and later processes unmarshal it in ~5 ms, any process: nothing from the baking process is needed at load. The cache key fingerprints the embedded .clj stdlib (which covers jolt-core: analyzer, IR, core tiers), the .janet seed sources next to the module, the janet version, the init opts, and the env knobs that shape a ctx (JOLT_PATH/ MUTABLE/AOT_CORE/FEATURES) — any change rebuilds. Corrupt or non-ctx images fall back to a rebuild (unmarshal of garbage can 'succeed' with a scalar, so the shape is checked, not just the throw). Writes are atomic (tmp + rename) so racing cold starts never publish a torn image. JOLT_NO_IMAGE_CACHE=1 opts out; JOLT_IMAGE_CACHE_DIR overrides the location (default TMPDIR). Test consumers switch to init-cached (harness, suite-worker, conformance, the behavioral unit/integration tests); tests that validate the bootstrap itself (bootstrap-fixpoint, staged-bootstrap, aot round-trip, direct-linking) and the deps tests (tmp-dir :paths would fragment the key) keep real init. Full jpm test: 2:46 -> 1:58 (~29%). New ctx-image-test covers cold/warm, cross-process load (subprocess runs defn/redef/macros/protocols/multimethods off the baked image), per-opts keying, and corrupt-image fallback.
101 lines
4.7 KiB
Text
101 lines
4.7 KiB
Text
(use ../../src/jolt/evaluator)
|
|
(use ../../src/jolt/types)
|
|
(use ../../src/jolt/reader)
|
|
(use ../../src/jolt/api)
|
|
(use ../../src/jolt/reader)
|
|
# SCI is a clj/cljs-targeted library: its .cljc sources select implementation
|
|
# via #?(:clj ...) and have no :jolt branches — load it under clj-compat
|
|
# features (spec 02-reader S18: feature sets are a property of the loading
|
|
# context; the portable default is #{:jolt :default}).
|
|
(reader-features-set! ["jolt" "clj" "default"])
|
|
|
|
(defn- load-stubs [ctx filepath]
|
|
(var s (slurp filepath))
|
|
(while (> (length (string/trim s)) 0)
|
|
(def [form rest] (parse-next s))
|
|
(set s rest)
|
|
(when (not (nil? form))
|
|
(protect (eval-form ctx @{} form)))))
|
|
|
|
(defn- load-file [ctx path]
|
|
(var s (slurp path))
|
|
(while (> (length (string/trim s)) 0)
|
|
(def [form rest] (parse-next s))
|
|
(set s rest)
|
|
(when (not (nil? form))
|
|
# Tolerant: SCI's clojure.core registration maps reference the full
|
|
# clojure.core surface (redundant for Jolt's native core); skip forms
|
|
# that don't resolve rather than aborting the bootstrap.
|
|
(protect (eval-form ctx @{} form)))))
|
|
|
|
# Run from project root so paths resolve
|
|
(def root (if (has-value? (dyn :syspath) 0) (first (dyn :syspath)) "."))
|
|
|
|
(def ctx (init-cached))
|
|
|
|
(load-stubs ctx (string root "/src/jolt/clojure/sci/lang_stubs.clj"))
|
|
(load-stubs ctx (string root "/src/jolt/clojure/sci/io_stubs.clj"))
|
|
|
|
(def sci-base (string root "/vendor/sci/src/sci"))
|
|
(each file ["impl/macros.cljc" "impl/protocols.cljc" "impl/types.cljc"
|
|
"impl/unrestrict.cljc" "impl/vars.cljc" "lang.cljc"
|
|
"impl/utils.cljc" "ctx_store.cljc" "impl/deftype.cljc"
|
|
"impl/records.cljc" "impl/core_protocols.cljc" "impl/hierarchies.cljc"
|
|
"impl/namespaces.cljc" "core.cljc"]
|
|
(load-file ctx (string sci-base "/" file)))
|
|
|
|
# ── Verify sci.lang NS and Type ─────────────────────────────────
|
|
(assert (not (nil? (ctx-find-ns ctx "sci.lang")))
|
|
"sci.lang namespace exists")
|
|
(assert (not (nil? (ctx-find-ns ctx "sci.core")))
|
|
"sci.core namespace exists")
|
|
|
|
# sci.lang has Type constructor
|
|
(def sci-lang (ctx-find-ns ctx "sci.lang"))
|
|
(def type-var (ns-find sci-lang "Type"))
|
|
(assert (not (nil? type-var)) "sci.lang/Type var exists")
|
|
(def ->Type (ns-find sci-lang "->Type"))
|
|
(assert (not (nil? ->Type)) "sci.lang/->Type constructor exists")
|
|
|
|
# Instantiate a Type and check field access
|
|
(def type-inst ((var-get type-var) {:sci.impl/type-name "user.Foo"}))
|
|
(assert (table? type-inst) "Type instance is a table")
|
|
(assert (not (nil? (get type-inst :jolt/deftype))) "Type instance has deftype tag")
|
|
(assert (= "user.Foo" (get (get type-inst :data) :sci.impl/type-name)) "Type field access via data")
|
|
|
|
# ── Verify sci.lang/Var ─────────────────────────────────────────
|
|
(def var-ctor-var (ns-find sci-lang "Var"))
|
|
(assert (not (nil? var-ctor-var)) "sci.lang/Var constructor exists")
|
|
|
|
(def test-var ((var-get var-ctor-var) 42 'my-var nil nil nil nil nil))
|
|
(assert (table? test-var) "Var instance is a table")
|
|
(assert (= 42 (get test-var :root)) "Var deref")
|
|
|
|
# var? check — SCI Var is not a Jolt var but is a table with proper fields
|
|
(assert (not (nil? test-var)) "Var instance is not nil")
|
|
|
|
# ── Verify sci.impl.types/IBox protocol ─────────────────────────
|
|
(def types-ns (ctx-find-ns ctx "sci.impl.types"))
|
|
(def vars-ns (ctx-find-ns ctx "sci.impl.vars"))
|
|
(assert (not (nil? types-ns)) "sci.impl.types namespace exists")
|
|
(assert (not (nil? vars-ns)) "sci.impl.vars namespace exists")
|
|
|
|
(def ibox-getVal (ns-find types-ns "getVal"))
|
|
(def ibox-setVal (ns-find types-ns "setVal"))
|
|
(assert (not (nil? ibox-getVal)) "sci.impl.types/getVal exists")
|
|
(assert (not (nil? ibox-setVal)) "sci.impl.types/setVal exists")
|
|
|
|
# Test IBox setVal/getVal exist but skip dispatch (SCI protocol machinery not fully booted)
|
|
(assert (function? (var-get ibox-setVal)) "sci.impl.types/setVal is callable")
|
|
(assert (function? (var-get ibox-getVal)) "sci.impl.types/getVal is callable")
|
|
|
|
# ── Verify sci.impl.vars/IVar protocol methods exist ─────────────
|
|
(def ivar-toSymbol (ns-find vars-ns "toSymbol"))
|
|
(def ivar-hasRoot (ns-find vars-ns "hasRoot"))
|
|
(assert (not (nil? ivar-toSymbol)) "sci.impl.vars/toSymbol exists")
|
|
(assert (not (nil? ivar-hasRoot)) "sci.impl.vars/hasRoot exists")
|
|
|
|
# ── Verify SCI eval function exists ─────────────────────────────
|
|
(def sci-core (ctx-find-ns ctx "sci.core"))
|
|
(assert (not (nil? sci-core)) "sci.core namespace exists")
|
|
(printf "\nAll SCI runtime tests passed!\n")
|