core: Stage 3 — retire the bootstrap compiler (compiler.janet deleted)

The 1104-line Janet bootstrap compiler existed to build jolt.ir/jolt.analyzer
and the kernel tier before the self-hosted analyzer could exist. It is
replaced by the interpreter + one fixpoint turn:

1. bootstrap-load-source loads the compiler sources INTERPRETED (the
   evaluator can run the analyzer — it always could).
2. After the overlay is up, self-compile-compiler! re-runs the kernel tier,
   jolt.ir, and jolt.analyzer through the SELF-HOSTED pipeline — the
   interpreted analyzer compiles itself, and steady state runs compiled with
   no bootstrap compiler involved.

Measured: init {:compile? true} 1093 -> ~2400 ms (the one-time interpreted
pass + self-compilation), but steady-state compilation is 2.8x FASTER
(100 forms: 134 -> 48 ms) — the self-hosted pipeline emits better code than
the bootstrap did. An AOT image for init cost is future work (aot.janet's
machinery is the natural vehicle).

The bootstrap's runtime kernel moves to backend.janet (jolt-runtime-env,
ctx-janet-env, build-map-literal); aot imports it from there. The
uncompilable-error? punt check unwraps the interpreter's exception struct
(the interpreted analyzer's throw arrives wrapped). compile-string/
compile-file (the bootstrap's source-text emitter API, no callers outside
the bootstrap's own unit test) are removed with it, as is compiler-test.

Gate green across everything incl. fixpoint stage1==2==3, AOT round-trip,
uberscript, CLI; conformance 326x3; suite 4566 >= 4540; bench in band.
This commit is contained in:
Yogthos 2026-06-10 13:32:14 -04:00
parent 90a35a5dc0
commit cbab7f66df
5 changed files with 88 additions and 1468 deletions

View file

@ -11,14 +11,14 @@
# marshal *against* it: core fns are referenced by name, and only the user's # marshal *against* it: core fns are referenced by name, and only the user's
# bytecode plus its var cells are actually serialized. # bytecode plus its var cells are actually serialized.
(use ./compiler) # jolt-runtime-env (import ./backend :as backend) # backend/jolt-runtime-env
(use ./types) (use ./types)
# Forward dict (key -> value) for unmarshal; reverse (value -> key) for marshal. # Forward dict (key -> value) for unmarshal; reverse (value -> key) for marshal.
# Built from the runtime env, which chains to the Janet boot env, so both core fns # Built from the runtime env, which chains to the Janet boot env, so both core fns
# and Janet builtins resolve by name. # and Janet builtins resolve by name.
(defn- fwd-dict [] (env-lookup jolt-runtime-env)) (defn- fwd-dict [] (env-lookup backend/jolt-runtime-env))
(defn- rev-dict [] (invert (env-lookup jolt-runtime-env))) (defn- rev-dict [] (invert (env-lookup backend/jolt-runtime-env)))
(defn marshal-ns (defn marshal-ns
"Marshal namespace `ns-name`'s var mappings to a byte buffer. The whole mappings "Marshal namespace `ns-name`'s var mappings to a byte buffer. The whole mappings

View file

@ -7,7 +7,6 @@
(use ./reader) (use ./reader)
(use ./evaluator) (use ./evaluator)
(use ./core) (use ./core)
(use ./compiler)
(use ./loader) (use ./loader)
(use ./async) (use ./async)
(import ./backend :as backend) (import ./backend :as backend)
@ -100,6 +99,11 @@
(when (tier :kernel) (put env :kernel-ready? true)))) (when (tier :kernel) (put env :kernel-ready? true))))
(put env :direct-linking? user-dl) (put env :direct-linking? user-dl)
(ctx-set-current-ns ctx saved) (ctx-set-current-ns ctx saved)
# Stage 3 interpreted bootstrap: the analyzer was loaded INTERPRETED (no
# bootstrap compiler); have it compile itself + the kernel tier before the
# macro pass, so steady-state compilation runs compiled.
(when compile?
(backend/self-compile-compiler! ctx))
# Staged bootstrap: the early macros (00-syntax) were defined while the analyzer # Staged bootstrap: the early macros (00-syntax) were defined while the analyzer
# was still being built, so their expanders are interpreted closures. Now that the # was still being built, so their expanders are interpreted closures. Now that the
# full overlay + analyzer are in place, recompile those expanders to native code — # full overlay + analyzer are in place, recompile those expanders to native code —
@ -226,16 +230,3 @@
(set result (eval-one ctx form)))) (set result (eval-one ctx form))))
result) result)
(defn compile-string
"Compile a Clojure source string to Janet source.
Returns the Janet source string."
[s]
(let [form (parse-string s)]
(compile-form form)))
(defn compile-file
"Compile a .clj file to Janet source and optionally eval it.
When ctx has :compile? enabled, also evaluates the compiled forms.
Returns the namespace name."
[ctx filepath]
(load-ns ctx filepath))

View file

@ -10,7 +10,6 @@
(use ./types) (use ./types)
(use ./core) (use ./core)
(import ./compiler :as comp)
(use ./evaluator) (use ./evaluator)
(import ./reader :as r) (import ./reader :as r)
(import ./phm :as phm) (import ./phm :as phm)
@ -24,6 +23,42 @@
# field as nil). Structs (the common case) pass through untouched. Applied at the # field as nil). Structs (the common case) pass through untouched. Applied at the
# few points where a node first reaches the emitter, so the rest of the back end # few points where a node first reaches the emitter, so the rest of the back end
# keeps using plain (node :key) access and the portable front end never sees this. # keeps using plain (node :key) access and the portable front end never sees this.
# --- Runtime kernel (absorbed from the retired bootstrap compiler) ----------
# The Janet env compiled code evaluates in. Captured at module load: backend's
# env chains types/core/evaluator/reader/phm, so emitted symbols (let/fn/in/
# var-get/tuple-slice/...) and jolt runtime helpers resolve by name.
(def jolt-runtime-env (curenv))
(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.
For a nil context (one-off compile/eval) returns a fresh child env."
[ctx]
(if (and ctx (table? (get ctx :env)))
(or (get (ctx :env) :janet-rt)
(let [e (make-env jolt-runtime-env)]
(put (ctx :env) :janet-rt e)
e))
(make-env jolt-runtime-env)))
(defn build-map-literal
"Build a map value from evaluated k v k v ... args. A phm (not a Janet struct)
when a key is a collection (value hashing) or a key/value is nil (structs drop
nil; phm preserves it, matching Clojure)."
[& kvs]
(var need-phm false)
(var ki 0)
(while (< ki (length kvs))
(let [kk (in kvs ki) vv (in kvs (+ ki 1))]
(when (or (table? kk) (array? kk) (nil? kk) (nil? vv)) (set need-phm true)))
(+= ki 2))
(if need-phm
(do (var m (phm/make-phm)) (var j 0)
(while (< j (length kvs)) (set m (phm/phm-assoc m (in kvs j) (in kvs (+ j 1)))) (+= j 2))
m)
(struct ;kvs)))
(defn- norm-node [n] (defn- norm-node [n]
(if (phm/phm? n) (phm/phm-to-struct n) n)) (if (phm/phm? n) (phm/phm-to-struct n) n))
@ -228,7 +263,7 @@
(tuple make-vec (tuple/slice (array/concat @['tuple] items)))) (tuple make-vec (tuple/slice (array/concat @['tuple] items))))
(defn- emit-map [ctx node] (defn- emit-map [ctx node]
(def args @[comp/build-map-literal]) (def args @[build-map-literal])
(each pair (vview (node :pairs)) (each pair (vview (node :pairs))
(def p (vview pair)) (def p (vview pair))
(array/push args (emit ctx (in p 0))) (array/push args (emit ctx (in p 0)))
@ -291,7 +326,13 @@
# kernel tier (the structural fns the analyzer itself calls) get built. The # kernel tier (the structural fns the analyzer itself calls) get built. The
# analyzer uses unqualified referred names (jolt.host form-* + IR ctors), so the # analyzer uses unqualified referred names (jolt.host form-* + IR ctors), so the
# bootstrap's plain :var path compiles it; stateful forms fall back to interp. # bootstrap's plain :var path compiles it; stateful forms fall back to interp.
(defn bootstrap-load-source [ctx target-ns src] (defn bootstrap-load-source
"Stage-1 builder: load a source string into target-ns INTERPRETED. Runs before
the self-hosted analyzer exists (it builds jolt.ir/jolt.analyzer and the kernel
tier); self-compile-compiler! then re-runs those sources through the live
analyzer so the steady-state compiler is compiled by itself — the retired
bootstrap compiler's job, done by the interpreter + one fixpoint turn."
[ctx target-ns src]
(def saved (ctx-current-ns ctx)) (def saved (ctx-current-ns ctx))
(ctx-set-current-ns ctx target-ns) (ctx-set-current-ns ctx target-ns)
(var s src) (var s src)
@ -300,11 +341,7 @@
(set s (in parsed 1)) (set s (in parsed 1))
(def f (in parsed 0)) (def f (in parsed 0))
(when (not (nil? f)) (when (not (nil? f))
# Guard BOTH compile and the Janet-compile-of-emitted step: a form whose (eval-form ctx @{} f)))
# emitted Janet is invalid (e.g. a bad splice) falls back to interpreted
# definition rather than killing the whole load.
(def r (protect (comp/eval-compiled (comp/compile-ast f ctx) ctx)))
(unless (r 0) (eval-form ctx @{} f))))
(ctx-set-current-ns ctx saved)) (ctx-set-current-ns ctx saved))
# Compile-load an embedded jolt-core namespace by name (source from the stdlib map). # Compile-load an embedded jolt-core namespace by name (source from the stdlib map).
@ -374,8 +411,14 @@
# "jolt/uncompilable: <why>". Anything else escaping the compile step is an # "jolt/uncompilable: <why>". Anything else escaping the compile step is an
# unexpected compiler error, not a punt. # unexpected compiler error, not a punt.
(defn- uncompilable-error? [err] (defn- uncompilable-error? [err]
(and (or (string? err) (buffer? err)) # The punt may arrive as a plain string (compiled analyzer) or wrapped in the
(string/has-prefix? "jolt/uncompilable" (string err)))) # interpreter's exception struct {:jolt/type :jolt/exception :value s}
# (interpreted analyzer — the stage-3 bootstrap path).
(def msg (if (and (struct? err) (= :jolt/exception (get err :jolt/type)))
(get err :value)
err))
(and (or (string? msg) (buffer? msg))
(string/has-prefix? "jolt/uncompilable" (string msg))))
(defn compile-and-eval (defn compile-and-eval
"Self-hosted compile path: analyze (portable Clojure) -> IR -> Janet -> eval. "Self-hosted compile path: analyze (portable Clojure) -> IR -> Janet -> eval.
@ -387,11 +430,36 @@
[ctx form] [ctx form]
(def compiled (protect (emit-ir ctx (analyze-form ctx form)))) (def compiled (protect (emit-ir ctx (analyze-form ctx form))))
(if (compiled 0) (if (compiled 0)
(eval (compiled 1) (comp/ctx-janet-env ctx)) (eval (compiled 1) (ctx-janet-env ctx))
(if (uncompilable-error? (compiled 1)) (if (uncompilable-error? (compiled 1))
(eval-form ctx @{} form) (eval-form ctx @{} form)
(error (compiled 1))))) (error (compiled 1)))))
(defn self-compile-compiler!
"Stage 3 (interpreted bootstrap): once the overlay + interpreted analyzer are
alive, run the kernel tier, jolt.ir, and jolt.analyzer back through the
SELF-HOSTED pipeline — the analyzer compiles itself (and the kernel fns it
uses), so by steady state the compiler runs compiled with no bootstrap
compiler involved. Forms a punt can't compile stay interpreted (the
deliberate channel)."
[ctx]
(def saved (ctx-current-ns ctx))
(each [ns-name target] [["clojure.core.00-kernel" "clojure.core"]
["jolt.ir" "jolt.ir"]
["jolt.analyzer" "jolt.analyzer"]]
(def src (get (get (ctx :env) :embedded-sources @{}) ns-name))
(when src
(ctx-set-current-ns ctx target)
(var s src)
(while (> (length (string/trim s)) 0)
(def parsed (r/parse-next s))
(set s (in parsed 1))
(def f (in parsed 0))
(when (not (nil? f))
(def r (protect (compile-and-eval ctx f)))
(unless (r 0) (eval-form ctx @{} f))))))
(ctx-set-current-ns ctx saved))
(defn analyzer-built? [ctx] (defn analyzer-built? [ctx]
(> (length ((ctx-find-ns ctx "jolt.analyzer") :mappings)) 0)) (> (length ((ctx-find-ns ctx "jolt.analyzer") :mappings)) 0))
@ -403,7 +471,7 @@
(when (analyzer-built? ctx) (when (analyzer-built? ctx)
(def compiled (protect (emit-ir ctx (analyze-form ctx fn-form)))) (def compiled (protect (emit-ir ctx (analyze-form ctx fn-form))))
(when (compiled 0) (when (compiled 0)
(def r (protect (eval (compiled 1) (comp/ctx-janet-env ctx)))) (def r (protect (eval (compiled 1) (ctx-janet-env ctx))))
(when (r 0) (r 1))))) (when (r 0) (r 1)))))
# Wrap expanders in the `fn` MACRO, not the `fn*` primitive: `fn` desugars a # Wrap expanders in the `fn` MACRO, not the `fn*` primitive: `fn` desugars a

File diff suppressed because it is too large Load diff

View file

@ -1,335 +0,0 @@
# Jolt Compiler Tests — Phase 2
# Tests for source-to-source Clojure→Janet compilation.
# Core ops: const, do, if, def, fn, let, invoke
# Phase 2 adds: symbol classification with binding awareness
(use ../../src/jolt/compiler)
(use ../../src/jolt/reader)
(defn compile-str [s]
(let [form (parse-string s)]
(compile-form form)))
# ============================================================
# 1. Literals (const)
# ============================================================
(print "1: literal constants...")
(assert (= "42" (compile-str "42")) "integer")
(assert (= "nil" (compile-str "nil")) "nil")
(assert (= "true" (compile-str "true")) "true")
(assert (= "false" (compile-str "false")) "false")
(assert (= "\"hello\"" (compile-str "\"hello\"")) "string")
(assert (= ":foo" (compile-str ":foo")) "keyword")
(print " passed")
# ============================================================
# 2. do
# ============================================================
(print "2: do...")
(assert (= "(do 1 2)" (compile-str "(do 1 2)")) "do two exprs")
(assert (= "(do 42)" (compile-str "(do 42)")) "do single expr")
(assert (= "(do (core-inc 1) (core-inc 2))" (compile-str "(do (inc 1) (inc 2))")) "do with fn calls")
(print " passed")
# ============================================================
# 3. if
# ============================================================
(print "3: if...")
(assert (= "(if true 1 2)" (compile-str "(if true 1 2)")) "if three-arg")
(assert (= "(if false 1 nil)" (compile-str "(if false 1)")) "if two-arg")
(print " passed")
# ============================================================
# 4. def
# ============================================================
(print "4: def...")
(assert (= "(def x 42)" (compile-str "(def x 42)")) "def constant")
(assert (= "(def f (fn [x] (core-inc x)))" (compile-str "(def f (fn* [x] (inc x)))")) "def with fn")
(print " passed")
# ============================================================
# 5. fn
# ============================================================
(print "5: fn...")
(assert (= "(fn [x] (core-inc x))" (compile-str "(fn* [x] (inc x))")) "fn single arity")
(assert (= "(fn [] 42)" (compile-str "(fn* [] 42)")) "fn no args")
(assert (= "(fn [x] (do (core-print x) (core-inc x)))"
(compile-str "(fn* [x] (print x) (inc x))")) "fn multi-expr body")
(print " passed")
# ============================================================
# 6. let
# ============================================================
(print "6: let...")
(assert (= "(let [x 1] (core-inc x))" (compile-str "(let* [x 1] (inc x))")) "let single binding")
(assert (= "(let [x 1 y 2] (+ x y))" (compile-str "(let* [x 1 y 2] (+ x y))")) "let two bindings")
(assert (= "(let [x (core-inc 1)] (core-inc x))" (compile-str "(let* [x (inc 1)] (inc x))")) "let with fn in binding")
(print " passed")
# ============================================================
# 7. invoke (function calls)
# ============================================================
(print "7: invoke...")
(assert (= "(core-inc 1)" (compile-str "(inc 1)")) "inc call")
(assert (= "(+ 1 2)" (compile-str "(+ 1 2)")) "+ call")
(assert (= "(+ (core-inc 1) 2)" (compile-str "(+ (inc 1) 2)")) "nested calls")
(assert (= "(core-map core-inc (core-vec 1 2 3))"
(compile-str "(map inc (vec 1 2 3))")) "multi-arg call")
(print " passed")
# ============================================================
# 8. Local symbol classification (Phase 2)
# ============================================================
(print "8: local classification...")
# Shadowing: local inc should NOT be rewritten to core-inc
(assert (= "(let [inc 5] (inc inc))"
(compile-str "(let* [inc 5] (inc inc))")) "local shadows core fn")
# fn params are locals, not core symbols
(assert (= "(fn [map] (core-vec map))"
(compile-str "(fn* [map] (vec map))")) "fn param shadows core map")
# nested let with shadowing
(assert (= "(let [x 1] (let [inc x] (inc x)))"
(compile-str "(let* [x 1] (let* [inc x] (inc x)))")) "nested let local")
(print " passed")
(print "\nAll compiler Phase 2 tests passed!")
# ============================================================
# 9. Compile-and-eval round-trip (Phase 3)
# ============================================================
(print "9: compile-and-eval...")
(use ../../src/jolt/core) # need core fns in scope for eval
(defn compile-eval-str [s]
(let [form (parse-string s)]
(compile-and-eval form nil)))
(assert (= 42 (compile-eval-str "42")) "eval literal")
(assert (= 2 (compile-eval-str "(inc 1)")) "eval inc")
(assert (= 3 (compile-eval-str "(+ 1 2)")) "eval +")
(assert (= 6 (compile-eval-str "(+ (inc 1) (inc 3))")) "eval nested")
(assert (= 2 (compile-eval-str "(do 1 2)")) "eval do")
(assert (= 1 (compile-eval-str "(if true 1 2)")) "eval if true")
(assert (= 2 (compile-eval-str "(if false 1 2)")) "eval if false")
(assert (= 2 (compile-eval-str "(let* [x 1] (inc x))")) "eval let")
(let [f (compile-eval-str "(fn* [x] (inc x))")]
(assert (function? f) "eval fn returns fn")
(assert (= 6 (f 5)) "eval fn works"))
(print " passed")
# ============================================================
# 10. Compile flag in context (Phase 3)
# ============================================================
(print "10: compile flag...")
(use ../../src/jolt/api)
# Without compile flag
(let [ctx (init)]
(assert (= 2 (eval-string ctx "(inc 1)")) "no-compile flag: inc works"))
# With compile flag: pure expressions use compile-and-eval
(let [ctx (init {:compile? true})]
(assert (= 2 (eval-string ctx "(inc 1)")) "compile flag: inc works")
(assert (= 3 (eval-string ctx "(+ 1 2)")) "compile flag: + works")
(assert (= 6 (eval-string ctx "(+ (inc 1) (inc 3))")) "compile flag: nested works"))
# With compile flag: stateful forms fall back to interpreter
(let [ctx (init {:compile? true})]
(eval-string ctx "(def foo 99)")
(assert (= 99 (eval-string ctx "foo")) "compile flag: def works"))
(print " passed")
(print "\nAll compiler Phase 3 tests passed!")
# ============================================================
# 11. Macro expansion (Phase 4)
# ============================================================
(print "11: macro expansion...")
(use ../../src/jolt/api)
(let [ctx (init {:compile? true})]
# defn expands via compiler, produces Janet def
(eval-string ctx "(defn square [n] (* n n))")
(assert (= 25 (eval-string ctx "(square 5)")) "defn via compiler")
# when macro
(assert (= 42 (eval-string ctx "(when true 42)")) "when true")
(assert (= nil (eval-string ctx "(when false 42)")) "when false")
# let macro
(assert (= 30 (eval-string ctx "(let [x 10 y 20] (+ x y))")) "let macro")
# fn macro
(assert (= 49 (eval-string ctx "((fn [x] (* x x)) 7)")) "fn macro")
# and/or
(assert (= 3 (eval-string ctx "(and 1 2 3)")) "and")
(assert (= 99 (eval-string ctx "(or nil false 99)")) "or"))
(print " passed")
(print "\nAll compiler Phase 4 tests passed!")
# ============================================================
# 12. throw, try, loop*/recur (Phase 5)
# ============================================================
(print "12: throw/try/loop...")
(use ../../src/jolt/api)
(let [ctx (init {:compile? true})]
# throw/catch via compiler
(assert (= "caught"
(eval-string ctx "(try (throw 42) (catch Exception e \"caught\"))"))
"try/catch")
# try without catch returns body
(assert (= 1 (eval-string ctx "(try 1 (catch Exception e 2))")) "try no throw")
# throw in nested context
(assert (= "ok"
(eval-string ctx "(try (do (throw 99) 1) (catch Exception e \"ok\"))"))
"throw in do")
# loop*/recur
(assert (= 3 (eval-string ctx "(loop* [x 0] (if (< x 3) (recur (inc x)) x))"))
"loop count up")
(assert (= 3
(eval-string ctx "(loop* [i 0 acc 0] (if (< i 3) (recur (inc i) (+ acc i)) acc))"))
"loop with acc"))
(print " passed")
(print "\nAll compiler Phase 5 tests passed!")
# ============================================================
# 13. defn/def integration (Phase 0 fix)
# ============================================================
(print "13: defn/def integration...")
(use ../../src/jolt/api)
(let [ctx (init {:compile? true})]
# defn produces a resolvable var
(eval-string ctx "(defn identity-fn [x] x)")
(assert (= 1 (eval-string ctx "(identity-fn 1)")) "defn works")
(let [f (eval-string ctx "identity-fn")]
(assert (function? f) "bare defn symbol returns fn"))
# def produces a resolvable var
(eval-string ctx "(def answer 42)")
(assert (= 42 (eval-string ctx "answer")) "def bare symbol")
(assert (= 43 (eval-string ctx "(inc answer)")) "def in call"))
(print " passed")
(print "\nAll compiler tests passed!")
# ============================================================
# 14. Phase 1: ns accessors + ns form extensions
# ============================================================
(print "14: ns accessors...")
(use ../../src/jolt/api)
(let [ctx (init)]
(eval-string ctx "(ns mytest.core)")
(def ns-list (eval-string ctx "(all-ns)"))
(assert (> (length ns-list) 0) "all-ns returns namespaces")
# create-ns
(eval-string ctx "(create-ns mytest.extra)")
(def all (eval-string ctx "(all-ns)"))
(assert (> (length all) 1) "create-ns adds namespace"))
(print " passed")
(print "15: ns form extensions...")
(let [ctx (init)]
# ns with :require + :refer
(eval-string ctx "(ns test.ns-ext (:require [clojure.core :refer [inc +]]))")
(assert (= 2 (eval-string ctx "(inc 1)")) "refer inc works"))
(print " passed")
(print "\nAll Phase 1 tests passed!")
# ============================================================
# 17. Phase 3: Var system completion
# ============================================================
(print "17: var system...")
(use ../../src/jolt/api)
(let [ctx (init)]
(eval-string ctx "(def x-var-test 42)")
(assert (= true (eval-string ctx "(var? (var x-var-test))")) "var?")
(eval-string ctx "(def y-var-test 99)")
(assert (= 99 (eval-string ctx "(var-get (var y-var-test))")) "var-get")
(eval-string ctx "(def z-var-test 10)")
(assert (= 20 (eval-string ctx "(do (var-set (var z-var-test) 20) (var-get (var z-var-test)))")) "var-set")
(eval-string ctx "(def a-var-test 1)")
(assert (= 2 (eval-string ctx "(do (alter-var-root (var a-var-test) inc) (var-get (var a-var-test)))")) "alter-var-root")
(eval-string ctx "(def fv-var-test :found)")
(assert (= :found (eval-string ctx "(var-get (find-var 'fv-var-test))")) "find-var")
(eval-string ctx "(intern (the-ns) 'iv-var-test 77)")
(assert (= 77 (eval-string ctx "iv-var-test")) "intern")
(eval-string ctx "(def ^:dynamic *dv* 1)")
(assert (= 99 (eval-string ctx "(binding [*dv* 99] *dv*)")) "dynamic binding"))
(print " passed")
# ============================================================
# 18. Phase 3: Var metadata
# ============================================================
(print "18: var metadata...")
(let [ctx (init)]
(eval-string ctx "(def mvar 42)")
(eval-string ctx "(alter-meta! (var mvar) assoc :doc \"the answer\")")
(assert (= "the answer" (eval-string ctx "(:doc (meta (var mvar)))")) "alter-meta!")
(eval-string ctx "(reset-meta! (var mvar) {:a 1})")
(assert (= 1 (eval-string ctx "(:a (meta (var mvar)))")) "reset-meta!"))
(print " passed")
(print "\nAll Phase 3 tests passed!")
# ============================================================
# 19. Phase 4: deftype
# ============================================================
(print "19: deftype...")
(use ../../src/jolt/api)
(let [ctx (init)]
(eval-string ctx "(deftype Point [x y])")
(assert (not (nil? (eval-string ctx "(Point. 3 4)"))) "deftype constructs")
(assert (= 3 (eval-string ctx "(. (Point. 3 4) x)")) ".x access")
(assert (= 4 (eval-string ctx "(. (Point. 3 4) y)")) ".y access")
(assert (= 10 (eval-string ctx "(let [p (Point. 3 4)] (set! (.-x p) 10) (. p x))")) "set! field")
(assert (= true (eval-string ctx "(instance? Point (Point. 1 2))")) "instance?")
(assert (= false (eval-string ctx "(instance? Point {:x 1})")) "instance? false")
(assert (= 5 (eval-string ctx "(. (->Point 5 6) x)")) "arrow factory"))
(print " passed")
# ============================================================
# 20. Phase 4: defrecord
# ============================================================
(print "20: defrecord...")
(let [ctx (init)]
(eval-string ctx "(defrecord Person [name age])")
(assert (not (nil? (eval-string ctx "(Person. \"Alice\" 30)"))) "record constructs")
(assert (= true (eval-string ctx "(map? (Person. \"Alice\" 30))")) "record is map?")
(assert (= "Alice" (eval-string ctx "(:name (Person. \"Alice\" 30))")) "keyword access")
(assert (= 30 (eval-string ctx "(get (Person. \"Alice\" 30) :age)")) "get access")
(assert (= "Alice" (eval-string ctx "(. (Person. \"Alice\" 30) name)")) ".name access")
(assert (= 30 (eval-string ctx "(. (Person. \"Alice\" 30) age)")) ".age access")
(assert (= 2 (eval-string ctx "(count (Person. \"Alice\" 30))")) "count")
(assert (= "Bob" (eval-string ctx "(:name (->Person \"Bob\" 25))")) "arrow factory"))
(print " passed")
# ============================================================
# 21. Phase 4: record equality
# ============================================================
(print "21: record equality...")
(let [ctx (init)]
(eval-string ctx "(defrecord Point3D [x y z])")
(assert (= true (eval-string ctx "(= (Point3D. 1 2 3) (Point3D. 1 2 3))")) "same values")
(assert (= false (eval-string ctx "(= (Point3D. 1 2 3) (Point3D. 4 5 6))")) "different values"))
(print " passed")
(print "\nAll Phase 4 tests passed!")