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:
parent
90a35a5dc0
commit
cbab7f66df
5 changed files with 88 additions and 1468 deletions
|
|
@ -11,14 +11,14 @@
|
|||
# marshal *against* it: core fns are referenced by name, and only the user's
|
||||
# bytecode plus its var cells are actually serialized.
|
||||
|
||||
(use ./compiler) # jolt-runtime-env
|
||||
(import ./backend :as backend) # backend/jolt-runtime-env
|
||||
(use ./types)
|
||||
|
||||
# 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
|
||||
# and Janet builtins resolve by name.
|
||||
(defn- fwd-dict [] (env-lookup jolt-runtime-env))
|
||||
(defn- rev-dict [] (invert (env-lookup jolt-runtime-env)))
|
||||
(defn- fwd-dict [] (env-lookup backend/jolt-runtime-env))
|
||||
(defn- rev-dict [] (invert (env-lookup backend/jolt-runtime-env)))
|
||||
|
||||
(defn marshal-ns
|
||||
"Marshal namespace `ns-name`'s var mappings to a byte buffer. The whole mappings
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
(use ./reader)
|
||||
(use ./evaluator)
|
||||
(use ./core)
|
||||
(use ./compiler)
|
||||
(use ./loader)
|
||||
(use ./async)
|
||||
(import ./backend :as backend)
|
||||
|
|
@ -100,6 +99,11 @@
|
|||
(when (tier :kernel) (put env :kernel-ready? true))))
|
||||
(put env :direct-linking? user-dl)
|
||||
(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
|
||||
# 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 —
|
||||
|
|
@ -226,16 +230,3 @@
|
|||
(set result (eval-one ctx form))))
|
||||
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))
|
||||
|
|
|
|||
|
|
@ -10,7 +10,6 @@
|
|||
|
||||
(use ./types)
|
||||
(use ./core)
|
||||
(import ./compiler :as comp)
|
||||
(use ./evaluator)
|
||||
(import ./reader :as r)
|
||||
(import ./phm :as phm)
|
||||
|
|
@ -24,6 +23,42 @@
|
|||
# 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
|
||||
# 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]
|
||||
(if (phm/phm? n) (phm/phm-to-struct n) n))
|
||||
|
||||
|
|
@ -228,7 +263,7 @@
|
|||
(tuple make-vec (tuple/slice (array/concat @['tuple] items))))
|
||||
|
||||
(defn- emit-map [ctx node]
|
||||
(def args @[comp/build-map-literal])
|
||||
(def args @[build-map-literal])
|
||||
(each pair (vview (node :pairs))
|
||||
(def p (vview pair))
|
||||
(array/push args (emit ctx (in p 0)))
|
||||
|
|
@ -291,7 +326,13 @@
|
|||
# kernel tier (the structural fns the analyzer itself calls) get built. 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.
|
||||
(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))
|
||||
(ctx-set-current-ns ctx target-ns)
|
||||
(var s src)
|
||||
|
|
@ -300,11 +341,7 @@
|
|||
(set s (in parsed 1))
|
||||
(def f (in parsed 0))
|
||||
(when (not (nil? f))
|
||||
# Guard BOTH compile and the Janet-compile-of-emitted step: a form whose
|
||||
# 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))))
|
||||
(eval-form ctx @{} f)))
|
||||
(ctx-set-current-ns ctx saved))
|
||||
|
||||
# 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
|
||||
# unexpected compiler error, not a punt.
|
||||
(defn- uncompilable-error? [err]
|
||||
(and (or (string? err) (buffer? err))
|
||||
(string/has-prefix? "jolt/uncompilable" (string err))))
|
||||
# The punt may arrive as a plain string (compiled analyzer) or wrapped in the
|
||||
# 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
|
||||
"Self-hosted compile path: analyze (portable Clojure) -> IR -> Janet -> eval.
|
||||
|
|
@ -387,11 +430,36 @@
|
|||
[ctx form]
|
||||
(def compiled (protect (emit-ir ctx (analyze-form ctx form))))
|
||||
(if (compiled 0)
|
||||
(eval (compiled 1) (comp/ctx-janet-env ctx))
|
||||
(eval (compiled 1) (ctx-janet-env ctx))
|
||||
(if (uncompilable-error? (compiled 1))
|
||||
(eval-form ctx @{} form)
|
||||
(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]
|
||||
(> (length ((ctx-find-ns ctx "jolt.analyzer") :mappings)) 0))
|
||||
|
||||
|
|
@ -403,7 +471,7 @@
|
|||
(when (analyzer-built? ctx)
|
||||
(def compiled (protect (emit-ir ctx (analyze-form ctx fn-form))))
|
||||
(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)))))
|
||||
|
||||
# Wrap expanders in the `fn` MACRO, not the `fn*` primitive: `fn` desugars a
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -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!")
|
||||
Loading…
Add table
Add a link
Reference in a new issue