Merge pull request #41 from jolt-lang/stage3-retire-bootstrap
Stage 3: retire the bootstrap compiler
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
bf885078f9
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