Compiler research (#10)
adds self-hosted compiler is functionally: - The default compile path is the portable pipeline using jolt.analyzer (Clojure) → host-neutral IR → backend.janet. - The analyzer is itself Clojure, compiled by jolt for true self-hosting. - bootstrap-fixpoint passes (stage1 == stage2 == stage3): rebuilding the compiler on its own output. - clojure.core is now self-hosted in the overlay. - Stateful forms (defmacro/ns/deftype/defmulti/require/in-ns) are interpreted by design.
This commit is contained in:
Dmitri Sotnikov
GitHub
parent
607779866e
commit
d3194aae59
68 changed files with 6590 additions and 2019 deletions
43
test/integration/aot-test.janet
Normal file
43
test/integration/aot-test.janet
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
# AOT image round-trip: compile a namespace, marshal it to bytecode, load it into
|
||||
# a FRESH context, and run the loaded functions without recompiling.
|
||||
(use ../../src/jolt/api)
|
||||
(use ../../src/jolt/aot)
|
||||
(use ../../src/jolt/types)
|
||||
|
||||
(print "AOT image round-trip...")
|
||||
|
||||
(def img-path (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-aot-test.jimg"))
|
||||
|
||||
# 1. Compile a namespace into ctx1: a constant, a fn over it, a fn using core
|
||||
# fns, and a recursive fn.
|
||||
(def ctx1 (init {:compile? true}))
|
||||
(ctx-set-current-ns ctx1 "demo")
|
||||
(eval-string ctx1 "(def base 100)")
|
||||
(eval-string ctx1 "(defn add-base [x] (+ x base))")
|
||||
(eval-string ctx1 "(defn sum-sq [xs] (reduce + (map (fn [x] (* x x)) xs)))")
|
||||
(eval-string ctx1 "(defn fact [n] (if (zero? n) 1 (* n (fact (dec n)))))")
|
||||
|
||||
(assert (= 107 (eval-string ctx1 "(add-base 7)")) "ctx1 add-base")
|
||||
(assert (= 14 (eval-string ctx1 "(sum-sq [1 2 3])")) "ctx1 sum-sq")
|
||||
(assert (= 120 (eval-string ctx1 "(fact 5)")) "ctx1 fact")
|
||||
|
||||
# 2. Save an AOT image of the compiled namespace.
|
||||
(save-ns ctx1 "demo" img-path)
|
||||
(assert (os/stat img-path) "image written")
|
||||
|
||||
# 3. Load it into a brand-new context — no recompilation of demo.
|
||||
(def ctx2 (init {:compile? true}))
|
||||
(load-ns-image ctx2 "demo" img-path)
|
||||
(ctx-set-current-ns ctx2 "demo")
|
||||
|
||||
(assert (= 107 (eval-string ctx2 "(add-base 7)")) "ctx2 add-base from image")
|
||||
(assert (= 14 (eval-string ctx2 "(sum-sq [1 2 3])")) "ctx2 sum-sq from image")
|
||||
(assert (= 3628800 (eval-string ctx2 "(fact 10)")) "ctx2 fact from image (new arg)")
|
||||
|
||||
# 4. The loaded vars are live: redefining one is visible to callers compiled in
|
||||
# ctx2 that reference it.
|
||||
(eval-string ctx2 "(def base 1000)")
|
||||
(assert (= 1007 (eval-string ctx2 "(add-base 7)")) "loaded var still redefinable")
|
||||
|
||||
(os/rm img-path)
|
||||
(print "AOT round-trip passed!")
|
||||
81
test/integration/bootstrap-fixpoint-test.janet
Normal file
81
test/integration/bootstrap-fixpoint-test.janet
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
# Bootstrap fixpoint (jolt-d0r).
|
||||
#
|
||||
# Soundness gate for self-hosting: the self-hosted compiler, rebuilt by compiling
|
||||
# its OWN source through itself (stage2), must behave identically to the compiler
|
||||
# built by the Janet bootstrap (stage1). We test this BEHAVIORALLY — run a corpus
|
||||
# of programs through each stage and compare results — rather than by comparing
|
||||
# emitted code, because emitted forms embed live setter/getter closures and the IR
|
||||
# carries representation-level gensyms; behavioral parity is the property that
|
||||
# actually matters and is representation-independent.
|
||||
#
|
||||
# stage1 = analyzer as built by the bootstrap.
|
||||
# stage2 = analyzer rebuilt by compiling jolt.ir + jolt.analyzer through stage1
|
||||
# (self-host, the fractal turn) and installing the result over itself.
|
||||
# stage3 = the same self-rebuild applied again, on top of stage2.
|
||||
# All three must produce identical results on the corpus.
|
||||
|
||||
(use ../../src/jolt/types)
|
||||
(use ../../src/jolt/api)
|
||||
(use ../../src/jolt/reader)
|
||||
(import ../../src/jolt/backend :as be)
|
||||
(import ../../src/jolt/stdlib_embed :as se)
|
||||
|
||||
(defn- forms [src]
|
||||
(var s src) (def fs @[])
|
||||
(while (> (length (string/trim s)) 0)
|
||||
(def p (parse-next s)) (set s (p 1))
|
||||
(when (p 0) (array/push fs (p 0))))
|
||||
fs)
|
||||
|
||||
# Programs exercising the compiled constructs (fn/multi-arity/recur/loop/if/let/
|
||||
# map+vector literals/closures/higher-order/protocol dispatch). Each is a single
|
||||
# expression evaluated through the compile pipeline; we compare printed results.
|
||||
(def corpus
|
||||
["(let [f (fn [x] (* x x))] (map f [1 2 3 4]))"
|
||||
"(loop [i 0 acc 0] (if (< i 10) (recur (inc i) (+ acc i)) acc))"
|
||||
"((fn fact [n] (if (zero? n) 1 (* n (fact (dec n))))) 6)"
|
||||
"(reduce + 0 (filter even? (range 20)))"
|
||||
"(let [[a b & r] [1 2 3 4 5]] [a b r])"
|
||||
"(mapv (juxt identity inc dec) [10 20])"
|
||||
"(frequencies (concat [:a :a] [:b]))"
|
||||
"(group-by odd? (range 8))"
|
||||
"(get-in {:a {:b {:c 42}}} [:a :b :c])"
|
||||
"(first {:x 1})"
|
||||
"(into {} (map (fn [k] [k (* k k)]) (range 5)))"
|
||||
"((comp inc inc) 10)"
|
||||
"(apply max [3 1 4 1 5 9 2 6])"
|
||||
"(str (reverse \"hello\") (count [1 2 3]))"
|
||||
"(let [m {:a 1}] (assoc m :b (+ (:a m) 1)))"])
|
||||
|
||||
(defn- run-corpus [ctx]
|
||||
(map (fn [p] (def r (protect (eval-string ctx p)))
|
||||
(if (r 0) (string/format "%j" (normalize-pvecs (r 1))) (string "ERR:" (r 1))))
|
||||
corpus))
|
||||
|
||||
# Rebuild the analyzer through the self-hosted pipeline, in place.
|
||||
(defn- self-rebuild! [ctx]
|
||||
(def saved (ctx-current-ns ctx))
|
||||
(each nsn ["jolt.ir" "jolt.analyzer"]
|
||||
(ctx-set-current-ns ctx nsn)
|
||||
(each f (forms (get se/sources nsn)) (protect (be/compile-and-eval ctx f))))
|
||||
(ctx-set-current-ns ctx saved))
|
||||
|
||||
(def ctx (init {:compile? true}))
|
||||
(def r1 (run-corpus ctx)) # stage1 (bootstrap-built)
|
||||
(self-rebuild! ctx)
|
||||
(def r2 (run-corpus ctx)) # stage2 (self-built)
|
||||
(self-rebuild! ctx)
|
||||
(def r3 (run-corpus ctx)) # stage3 (self-built from stage2)
|
||||
|
||||
(var failures 0)
|
||||
(for i 0 (length corpus)
|
||||
(unless (and (= (r1 i) (r2 i)) (= (r2 i) (r3 i)))
|
||||
(++ failures)
|
||||
(printf "FAIL [%s]\n stage1=%s\n stage2=%s\n stage3=%s" (corpus i) (r1 i) (r2 i) (r3 i)))
|
||||
# also guard against everything silently erroring
|
||||
(when (string/has-prefix? "ERR:" (r1 i))
|
||||
(++ failures) (printf "FAIL [%s] stage1 errored: %s" (corpus i) (r1 i))))
|
||||
|
||||
(if (pos? failures)
|
||||
(do (printf "bootstrap-fixpoint: %d failure(s)" failures) (os/exit 1))
|
||||
(printf "bootstrap-fixpoint: stage1 == stage2 == stage3 on %d programs\n" (length corpus)))
|
||||
61
test/integration/clojure-stdlib-suite-test.janet
Normal file
61
test/integration/clojure-stdlib-suite-test.janet
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
# Vendored stdlib-namespace battery (jolt-0mb).
|
||||
#
|
||||
# clojure.test suites for stdlib namespaces beyond clojure.core, vendored from
|
||||
# clojurust's clojure-test-suite fork (test/clojure-stdlib/, with corrected
|
||||
# fixtures where the upstream expectations disagreed with real Clojure). Each
|
||||
# file runs in the shared per-file worker; we guard a minimum pass count so a
|
||||
# regression is caught and improvements (e.g. finishing clojure.edn) can raise
|
||||
# the floor.
|
||||
|
||||
(def files
|
||||
# [relative-path min-pass must-be-clean?]
|
||||
[["clojure/walk_test/walk.cljc" 34 true]
|
||||
["clojure/zip_test/zip.cljc" 33 true]
|
||||
["clojure/data_test/diff.cljc" 61 true]
|
||||
# clojure.edn reads via clojure.core/read-string (opts/:eof + nil/blank) and
|
||||
# constructs set/nested values. Only #uuid remains (no real uuid type) —
|
||||
# jolt-b7y. Guard the passing subset.
|
||||
["clojure/edn_test/read_string.cljc" 49 false]])
|
||||
|
||||
(def root "test/clojure-stdlib")
|
||||
(def per-file-timeout 6)
|
||||
|
||||
(defn- run-file [path]
|
||||
(def proc (os/spawn ["janet" "test/integration/suite-worker.janet" path] :p {:out :pipe}))
|
||||
(def out (proc :out))
|
||||
(var data nil)
|
||||
(def ok (try
|
||||
(ev/with-deadline per-file-timeout
|
||||
(set data (ev/read out 0x10000))
|
||||
(os/proc-wait proc) true)
|
||||
([err] false)))
|
||||
(when (not ok)
|
||||
(protect (os/proc-kill proc true))
|
||||
(protect (ev/with-deadline 2 (os/proc-wait proc))))
|
||||
(protect (:close out))
|
||||
(if (and ok data) (string data) nil))
|
||||
|
||||
(defn- counts [s]
|
||||
(var r nil)
|
||||
(each line (string/split "\n" (or s ""))
|
||||
(when (string/has-prefix? "@@COUNTS " line)
|
||||
(let [p (string/split " " (string/trim line))]
|
||||
(when (= 4 (length p)) (set r [(scan-number (p 1)) (scan-number (p 2)) (scan-number (p 3))])))))
|
||||
r)
|
||||
|
||||
(var failures 0)
|
||||
(each [rel min-pass clean?] files
|
||||
(def path (string root "/" rel))
|
||||
(def c (counts (run-file path)))
|
||||
(if (nil? c)
|
||||
(do (++ failures) (printf "FAIL %s: no result (crash/timeout)" rel))
|
||||
(let [[p f e] c]
|
||||
(printf " %-34s pass=%d fail=%d err=%d" rel p f e)
|
||||
(when (< p min-pass)
|
||||
(++ failures) (printf "FAIL %s: pass %d < baseline %d" rel p min-pass))
|
||||
(when (and clean? (or (pos? f) (pos? e)))
|
||||
(++ failures) (printf "FAIL %s: expected clean, got %d fail / %d err" rel f e)))))
|
||||
|
||||
(if (pos? failures)
|
||||
(do (printf "clojure-stdlib-suite: %d failure(s)" failures) (os/exit 1))
|
||||
(print "clojure-stdlib-suite: OK"))
|
||||
|
|
@ -1,20 +1,20 @@
|
|||
# clojure-test-suite conformance: runs the external, cross-dialect
|
||||
# clojure-test-suite (https://github.com/lread/clojure-test-suite, EPL) against
|
||||
# Jolt and asserts the number of passing per-function test files stays at/above
|
||||
# a baseline. Like the jank battery, this does NOT vendor the suite — it
|
||||
# references ~/src/clojure-test-suite if present and SKIPS cleanly when absent.
|
||||
# clojure-test-suite (jank-lang fork) against Jolt and asserts the number of
|
||||
# passing per-function test files stays at/above a baseline. The suite is a git
|
||||
# submodule at vendor/clojure-test-suite (CI checks it out via submodules:
|
||||
# recursive). The test SKIPS cleanly only if the submodule isn't initialized
|
||||
# (run `git submodule update --init`).
|
||||
#
|
||||
# Each suite file is a `clojure.test` namespace (one per clojure.core/string
|
||||
# function). A minimal clojure.test + portability shim (test/support/clojure_test.clj)
|
||||
# lets Jolt load them; `when-var-exists` auto-skips fns Jolt doesn't implement.
|
||||
#
|
||||
# Files are run in a one-shot worker subprocess (test/integration/suite-worker.janet)
|
||||
# under a wall-clock deadline. Some suite tests build infinite sequences
|
||||
# (cycle/range/transducers-over-infinite) that Jolt's eager evaluator can't
|
||||
# truncate and so HANG rather than fail; the deadline contains them — a timed-out
|
||||
# file is reported as :timeout and contributes nothing, no manual skip-list needed.
|
||||
# under a wall-clock deadline. A few suite tests build infinite sequences that an
|
||||
# uncompilable/eager path can't truncate and so HANG rather than fail; the
|
||||
# deadline contains them — a timed-out file contributes nothing, no skip-list.
|
||||
|
||||
(def suite-dir (string (os/getenv "HOME") "/src/clojure-test-suite/test/clojure"))
|
||||
(def suite-dir "vendor/clojure-test-suite/test/clojure")
|
||||
|
||||
# Baseline: assertions Jolt currently passes across the suite. Raise as Jolt
|
||||
# improves so a regression (previously-passing assertion breaking) is caught.
|
||||
|
|
@ -25,12 +25,30 @@
|
|||
# running thread (Janet OS threads can't be interrupted), so `(deref (future
|
||||
# (sleep 1)))` re-raises the unresolved-`Thread/sleep` error — a documented
|
||||
# platform gap, not a regression in any previously-working behavior.
|
||||
(def baseline-pass 3913)
|
||||
# Raised 3913 -> 3916 with the staged-bootstrap kernel tier (ns-restore-on-throw
|
||||
# + faithful subvec coercion), then 3916 -> 3919 moving juxt/every-pred/some-fn to
|
||||
# Clojure (the canonical defs are more correct than the prior Janet ones). Raised
|
||||
# 3919 -> 3926 preserving nil map values (jolt-c7h): a nil value is a present key,
|
||||
# which several suite tests assert. Runs read 3927 consistently, occasionally 3926
|
||||
# when a timeout-prone test (of the 9 that can time out) doesn't finish; floor at
|
||||
# the consistent-minus-one 3926.
|
||||
# Raised 3971 -> 3981 with Option A full laziness (jolt-fng): transformers return
|
||||
# lazy seqs, lazy interleave stops timing out, and the lazy-seq nil-element +
|
||||
# non-seqable-input fixes (case/seq/reverse/empty? over nil-first lazy seqs;
|
||||
# lazy-from throws on non-seqable like Clojure) recovered + extended the suite.
|
||||
# clean files 45 -> 66 (Option A makes seq?/vector? results match Clojure across
|
||||
# many cross-dialect files). Stable across runs.
|
||||
(def baseline-pass 3981)
|
||||
# A file is "clean" when it ran with zero failures AND zero errors.
|
||||
(def baseline-clean-files 45)
|
||||
# Per-file wall-clock budget (seconds). Normal files finish in well under 1s;
|
||||
# this only fires on infinite-sequence hangs.
|
||||
(def per-file-timeout 6)
|
||||
(def baseline-clean-files 66)
|
||||
# Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so
|
||||
# this normally only fires on genuinely-infinite-sequence hangs. It's an env var
|
||||
# (JOLT_SUITE_TIMEOUT) so CI — whose runners are slower than a dev machine — can
|
||||
# give slow-but-finite files generous headroom without timing them out (which
|
||||
# would drop total-pass below the baseline and flake CI red). Default 6 locally.
|
||||
(def per-file-timeout
|
||||
(let [e (os/getenv "JOLT_SUITE_TIMEOUT")]
|
||||
(or (and e (scan-number e)) 6)))
|
||||
|
||||
(defn- walk [dir acc]
|
||||
(each e (os/dir dir)
|
||||
|
|
@ -73,7 +91,7 @@
|
|||
result)
|
||||
|
||||
(if (not (os/stat suite-dir))
|
||||
(print "clojure-test-suite: ~/src/clojure-test-suite not present — skipped")
|
||||
(print "clojure-test-suite: vendor/clojure-test-suite not initialized — skipped (run: git submodule update --init)")
|
||||
(do
|
||||
(def progress? (os/getenv "SUITE_PROGRESS"))
|
||||
(def files (sort (walk suite-dir @[])))
|
||||
|
|
|
|||
|
|
@ -98,12 +98,44 @@
|
|||
(assert (= 1 (ct-eval ctx "(:a {:a 1})")) "keyword as fn")
|
||||
(assert (= 1 (ct-eval ctx "({:a 1} :a)")) "map as fn")
|
||||
(assert (= 2 (ct-eval ctx "(#{1 2 3} 2)")) "set as fn")
|
||||
(assert (= true (ct-eval ctx "(= [1 2] [1 2])")) "= is value equality, not core-= bypass"))
|
||||
(assert (= true (ct-eval ctx "(= [1 2] [1 2])")) "= is value equality, not core-= bypass")
|
||||
|
||||
# Context isolation: a def in one compiled context is invisible in another.
|
||||
# Phase 2: hybrid fallback. Forms the compiler can't compile (destructuring,
|
||||
# multi-arity, named fns) interpret instead of erroring or miscompiling. The
|
||||
# result is the same — compilation is a transparent speedup.
|
||||
(print " hybrid fallback (destructuring / multi-arity)...")
|
||||
(assert (= 3 (ct-eval ctx "(let [[a b] [1 2]] (+ a b))")) "vector destructuring let")
|
||||
(assert (= 6 (ct-eval ctx "(let [{:keys [x y z]} {:x 1 :y 2 :z 3}] (+ x y z))")) "map destructuring let")
|
||||
(assert (= 3 (ct-eval ctx "((fn [[a b]] (+ a b)) [1 2])")) "destructuring fn param")
|
||||
(assert (= 5 (ct-eval ctx "(let [[a & more] [1 2 3 4 5]] (+ a (count more)))")) "rest destructuring")
|
||||
(ct-eval ctx "(defn arity ([a] a) ([a b] (+ a b)) ([a b & more] (apply + a b more)))")
|
||||
(assert (= 5 (ct-eval ctx "(arity 5)")) "multi-arity 1")
|
||||
(assert (= 7 (ct-eval ctx "(arity 3 4)")) "multi-arity 2")
|
||||
(assert (= 15 (ct-eval ctx "(arity 1 2 3 4 5)")) "multi-arity variadic clause")
|
||||
(assert (= 10 (ct-eval ctx "((fn self [n] (if (zero? n) 0 (+ n (self (dec n))))) 4)")) "named fn recursion")
|
||||
# recur directly inside a fn (not a loop) — re-enters the fn's arity. Compiles
|
||||
# to a self-call; was previously broken under compilation.
|
||||
(assert (= 15 (ct-eval ctx "((fn [n acc] (if (zero? n) acc (recur (dec n) (+ acc n)))) 5 0)")) "recur in fn")
|
||||
(assert (= 3 (ct-eval ctx "((fn cnt [acc & xs] (if (seq xs) (recur (inc acc) (rest xs)) acc)) 0 :a :b :c)")) "recur into variadic arity")
|
||||
(assert (= 6 (ct-eval ctx "(loop [[x & xs] [1 2 3] acc 0] (if x (recur xs (+ acc x)) acc))")) "destructuring loop binding")
|
||||
# A runtime error in compiled code must propagate, not silently fall back to a
|
||||
# second (interpreted) evaluation.
|
||||
(assert (= :threw (try (do (ct-eval ctx "(inc nil)") :no-throw) ([_] :threw)))
|
||||
"runtime error in compiled code propagates"))
|
||||
|
||||
# Context isolation: a def in one compiled context is invisible in another. With
|
||||
# var-indirection each context has its own var cells, so b's `secret` is a
|
||||
# distinct, unbound var (nil) rather than a's 7.
|
||||
(let [a (init {:compile? true}) b (init {:compile? true})]
|
||||
(eval-string a "(def secret 7)")
|
||||
(assert (= 7 (ct-eval a "secret")) "def visible in its own ctx")
|
||||
(assert (not ((protect (ct-eval b "secret")) 0)) "def isolated to its ctx"))
|
||||
(assert (nil? (ct-eval b "secret")) "def isolated to its ctx"))
|
||||
|
||||
# Redefinition is visible to already-compiled callers (var-indirection).
|
||||
(let [c (init {:compile? true})]
|
||||
(eval-string c "(defn g [] 1)")
|
||||
(eval-string c "(defn calls-g [] (g))")
|
||||
(eval-string c "(defn g [] 2)")
|
||||
(assert (= 2 (ct-eval c "(calls-g)")) "compiled caller sees redefined global"))
|
||||
|
||||
(print "\nAll Phase 6 tests passed!")
|
||||
|
|
|
|||
|
|
@ -13,6 +13,8 @@
|
|||
# until a minimal clojure.test lets us load the real files directly.
|
||||
|
||||
(use ../../src/jolt/api)
|
||||
(import ../../src/jolt/backend :as selfhost)
|
||||
(use ../../src/jolt/reader)
|
||||
|
||||
(def cases
|
||||
[
|
||||
|
|
@ -60,6 +62,30 @@
|
|||
["into map onto map" "{:a 1 :b 2 :c 3}" "(into {:a 1} [[:b 2] [:c 3]])"]
|
||||
["into list" "(quote (3 2 1))" "(into (list) [1 2 3])"]
|
||||
|
||||
### ---- Option A: lazy transformers return seqs, not vectors ----
|
||||
# map/filter/take/take-while over a concrete vector yield a lazy seq, matching
|
||||
# Clojure: (seq? (map ...)) is true, (vector? (map ...)) is false.
|
||||
["map vec is seq" "true" "(seq? (map inc [1 2 3]))"]
|
||||
["map vec not vector" "false" "(vector? (map inc [1 2 3]))"]
|
||||
["filter vec is seq" "true" "(seq? (filter odd? [1 2 3]))"]
|
||||
["take vec is seq" "true" "(seq? (take 2 [1 2 3]))"]
|
||||
["map over set" "true" "(= #{2 3 4} (set (map inc #{1 2 3})))"]
|
||||
["filter over map ev" "(quote ([:b 2]))" "(filter (fn [[k v]] (> v 1)) {:a 1 :b 2})"]
|
||||
# cons of cons over a lazy tail must not leak the rest-thunk
|
||||
["cons cons lazy" "(quote (1 2 3))" "(cons 1 (cons 2 (lazy-seq (cons 3 nil))))"]
|
||||
["juxt fns in vec" "[1 3]" "((juxt first last) [1 2 3])"]
|
||||
["last of lazy take" "5" "(last (take 5 (iterate inc 1)))"]
|
||||
["next empty lazy" "nil" "(next (take 1 [1]))"]
|
||||
# drop/distinct/partition/map-indexed/take-nth/interpose/keep are lazy too
|
||||
["drop vec is seq" "true" "(seq? (drop 1 [1 2 3]))"]
|
||||
["distinct vec is seq" "true" "(seq? (distinct [1 1 2]))"]
|
||||
["map-indexed is seq" "true" "(seq? (map-indexed vector [1 2]))"]
|
||||
["partition vec lazy" "(quote ((1 2) (3 4)))" "(partition 2 [1 2 3 4 5])"]
|
||||
# nth over a lazy seq must not treat a false/nil element as end-of-seq
|
||||
["nth lazy false elem" "false" "(nth (map identity [false 1 2]) 0)"]
|
||||
["nth lazy past false" "2" "(nth (drop 1 (list false 1 2)) 1)"]
|
||||
["cond-> false clause" "2" "(cond-> 1 true inc false inc)"]
|
||||
|
||||
### ---- HIGH: destructuring ----
|
||||
["destr nested seq" "[1 2 3]" "(let [[a [b c]] [1 [2 3]]] [a b c])"]
|
||||
["destr rest+as" "[1 (quote (2 3)) [1 2 3]]" "(let [[a & r :as all] [1 2 3]] [a r all])"]
|
||||
|
|
@ -106,6 +132,7 @@
|
|||
["subvec" "[2 3]" "(subvec [1 2 3 4 5] 1 3)"]
|
||||
["subvec to-end" "[3 4 5]" "(subvec [1 2 3 4 5] 2)"]
|
||||
["reduce-kv" "{:a 2 :b 3}" "(reduce-kv (fn [m k v] (assoc m k (inc v))) {} {:a 1 :b 2})"]
|
||||
["reduce-kv vector idx" "(quote ([0 :a] [1 :b]))" "(reduce-kv (fn [a i v] (conj a [i v])) [] [:a :b])"]
|
||||
|
||||
### ---- iterating maps yields entries ----
|
||||
["map over map" "true" "(= #{1 2} (set (map val {:a 1 :b 2})))"]
|
||||
|
|
@ -125,6 +152,20 @@
|
|||
["reductions" "(quote (1 3 6 10))" "(reductions + [1 2 3 4])"]
|
||||
["reductions init" "(quote (0 1 3 6))" "(reductions + 0 [1 2 3])"]
|
||||
["dedupe" "(quote (1 2 3 1))" "(dedupe [1 1 2 3 3 1])"]
|
||||
# partition-by with a strict pred (odd?) — guards jolt-r81: a lazy overlay fn
|
||||
# whose lazy-seq leaked its expansion in compile mode passed a non-int to odd?.
|
||||
["partition-by odd?" "(quote ((1 1) (2) (3 3)))" "(partition-by odd? [1 1 2 3 3])"]
|
||||
["reductions inf" "(quote (0 1 3 6))" "(take 4 (reductions + (range)))"]
|
||||
["tree-seq strict" "10" "(reduce + 0 (filter (complement coll?) (tree-seq coll? seq [1 [2 [3 4]]])))"]
|
||||
# nil/collection case-constants past the point where Option A's lazy `drop`
|
||||
# made the case macro's (empty? (drop 2 cls)) hit a nil-first lazy seq.
|
||||
["case nil + default" "[:nilr :def]" "(let [f (fn [x] (case x 1 :one nil :nilr :def))] [(f nil) (f 9)])"]
|
||||
["case collection consts" "[:v :m :s]" "(let [f (fn [x] (case x [1 2] :v {:a 1} :m #{3} :s :def))] [(f [1 2]) (f {:a 1}) (f #{3})])"]
|
||||
# a lazy seq whose first element is nil is non-empty (seq/empty?/reverse)
|
||||
["seq of nil-first" "true" "(boolean (seq (cons nil (list 1))))"]
|
||||
["reverse nil elem" "[2 nil 1]" "(vec (reverse (list 1 nil 2)))"]
|
||||
# lazy transformer over a non-seqable scalar throws (matches Clojure)
|
||||
["map non-seqable throws" "true" "(try (doall (map inc 5)) false (catch Throwable _ true))"]
|
||||
["keep-indexed" "(quote (:b :d))" "(keep-indexed (fn [i x] (if (odd? i) x)) [:a :b :c :d])"]
|
||||
["map-indexed" "(quote ([0 :a] [1 :b]))" "(map-indexed (fn [i x] [i x]) [:a :b])"]
|
||||
["trampoline" ":done" "(do (defn a [n] (if (zero? n) :done (fn [] (a (dec n))))) (trampoline a 5))"]
|
||||
|
|
@ -271,6 +312,10 @@
|
|||
["transduce remove" "[1 3 5]" "(into [] (remove even?) [1 2 3 4 5])"]
|
||||
["transduce take-while" "[1 2]" "(into [] (take-while (fn [x] (< x 3))) [1 2 3 4 1])"]
|
||||
["transduce map-indexed" "[[0 :a] [1 :b]]" "(into [] (map-indexed (fn [i x] [i x])) [:a :b])"]
|
||||
["partition-all xform" "[[1 2] [3 4] [5]]" "(into [] (partition-all 2) [1 2 3 4 5])"]
|
||||
["partition-all xform comp" "[2 2 1]" "(into [] (comp (partition-all 2) (map count)) [1 2 3 4 5])"]
|
||||
["partition-by xform" "[[1 1] [2 4] [5]]" "(into [] (partition-by odd?) [1 1 2 4 5])"]
|
||||
["partition-by xform reduced" "[[1 1] [2 4]]" "(into [] (comp (partition-by odd?) (take 2)) [1 1 2 4 5 5])"]
|
||||
|
||||
### ==== regex (capturing groups, backtracking, flags, lookahead) ====
|
||||
["re-find groups" "[\"12-34\" \"12\" \"34\"]" "(re-find #\"(\\d+)-(\\d+)\" \"x12-34y\")"]
|
||||
|
|
@ -297,29 +342,64 @@
|
|||
["map literal nested" "{:a {:b 2}}" "(let [y 2] {:a {:b y}})"]
|
||||
["map literal keyfn" "{:x 1}" "(let [k :x] {k 1})"]
|
||||
["map literal in fn" "6" "(do (defn mk [a b] {:sum (+ a b)}) (:sum (mk 2 4)))"]
|
||||
|
||||
### ---- overlay migration (jolt-1j0): run in all 3 modes ----
|
||||
# if-let/when-let bind only in the taken branch (else sees outer scope)
|
||||
["if-let else outer scope" "5" "(let [x 5] (if-let [x nil] :then x))"]
|
||||
["if-some else outer" "5" "(let [x 5] (if-some [x nil] :then x))"]
|
||||
["when-let body multi" "14" "(when-let [x 7] (inc x) (* x 2))"]
|
||||
# nthrest returns () (not nil) for an exhausted n>0 walk; coll for n<=0
|
||||
["nthrest exhausted" "(quote ())" "(nthrest nil 100)"]
|
||||
["nthrest n=0 keeps coll" "[1 2 3]" "(nthrest [1 2 3] 0)"]
|
||||
["nthnext surprising nil" "nil" "(nthnext nil nil)"]
|
||||
# distinct? compares by value
|
||||
["distinct? equal colls" "false" "(distinct? [1 2] [1 2])"]
|
||||
["not-any?" "true" "(not-any? even? [1 3 5])"]
|
||||
["take-last" "[3 4]" "(take-last 2 [1 2 3 4])"]
|
||||
["replace nil val" "[1 nil 3]" "(replace {2 nil} [1 2 3])"]
|
||||
])
|
||||
|
||||
(var pass 0)
|
||||
(def fails @[])
|
||||
(each [name expected actual] cases
|
||||
(def ctx (init))
|
||||
(def prog (string "(= " expected " " actual ")"))
|
||||
(def res (protect (eval-string ctx prog)))
|
||||
(cond
|
||||
(not= (res 0) true)
|
||||
(array/push fails [name "ERROR" (string (res 1))])
|
||||
(= (res 1) true)
|
||||
(++ pass)
|
||||
# not equal: re-eval actual alone to show what we got
|
||||
(let [got (protect (eval-string (init) actual))]
|
||||
(array/push fails [name "MISMATCH"
|
||||
(string "want=" expected
|
||||
" got=" (if (= (got 0) true) (string/format "%q" (got 1)) (string "ERR:" (got 1))))]))))
|
||||
# Run every case under a given context factory and return the failures. The same
|
||||
# cases run under both the interpreter and the compiler: results must match real
|
||||
# Clojure semantics either way, so the compile path (hybrid: hot compiles,
|
||||
# unsupported forms fall back to the interpreter) must not diverge.
|
||||
# mode: {} interpret, {:compile? true} bootstrap compiler, {:selfhost true} the
|
||||
# self-hosted pipeline (portable Clojure analyzer -> IR -> Janet back end).
|
||||
(defn- run-cases [mode]
|
||||
(def selfhost? (get mode :selfhost))
|
||||
(def init-opts (if selfhost? {} mode))
|
||||
(defn ev [ctx prog]
|
||||
(if selfhost? (selfhost/compile-and-eval ctx (parse-string prog)) (eval-string ctx prog)))
|
||||
(def fails @[])
|
||||
(each [name expected actual] cases
|
||||
(def ctx (init init-opts))
|
||||
(def prog (string "(= " expected " " actual ")"))
|
||||
(def res (protect (ev ctx prog)))
|
||||
(cond
|
||||
(not= (res 0) true)
|
||||
(array/push fails [name "ERROR" (string (res 1))])
|
||||
(= (res 1) true)
|
||||
nil
|
||||
(let [got (protect (ev (init init-opts) actual))]
|
||||
(array/push fails [name "MISMATCH"
|
||||
(string "want=" expected
|
||||
" got=" (if (= (got 0) true) (string/format "%q" (got 1)) (string "ERR:" (got 1))))]))))
|
||||
fails)
|
||||
|
||||
(printf "\n=== CONFORMANCE: %d/%d passed ===" pass (length cases))
|
||||
(unless (empty? fails)
|
||||
(print "\n--- Failures ---")
|
||||
(each [name kind detail] fails
|
||||
(printf "[%s] %s: %s" kind name detail)))
|
||||
(defn- report [label fails]
|
||||
(printf "=== CONFORMANCE (%s): %d/%d passed ===" label (- (length cases) (length fails)) (length cases))
|
||||
(unless (empty? fails)
|
||||
(print "--- Failures ---")
|
||||
(each [name kind detail] fails
|
||||
(printf "[%s] %s: %s" kind name detail))))
|
||||
|
||||
(def interp-fails (run-cases {}))
|
||||
(report "interpret" interp-fails)
|
||||
(def compile-fails (run-cases {:compile? true}))
|
||||
(report "compile" compile-fails)
|
||||
(def selfhost-fails (run-cases {:selfhost true}))
|
||||
(report "self-host" selfhost-fails)
|
||||
(print)
|
||||
(when (pos? (length fails)) (os/exit 1))
|
||||
(when (or (pos? (length interp-fails)) (pos? (length compile-fails))
|
||||
(pos? (length selfhost-fails)))
|
||||
(os/exit 1))
|
||||
|
|
|
|||
63
test/integration/direct-linking-test.janet
Normal file
63
test/integration/direct-linking-test.janet
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
# Direct-linking / redefinition matrix (jolt-d9j, jolt-g86).
|
||||
#
|
||||
# Direct-linking is a per-compilation-UNIT property (Clojure model). A call
|
||||
# compiles direct iff the unit has direct-linking on AND the target is not
|
||||
# ^:redef/^:dynamic AND the target is an already-defined fn. Otherwise indirect
|
||||
# (live var deref → redefinable). This pins the user-visible semantics:
|
||||
# - default user/REPL unit (direct-linking off): redefine anything, callers see it
|
||||
# - direct-linked unit: callers don't see a later redef (unless target ^:redef)
|
||||
# - :aot-core? gates whether the core tiers compile direct-linked
|
||||
|
||||
(use ../../src/jolt/api)
|
||||
|
||||
(var failures 0)
|
||||
(defn- check [label got want]
|
||||
(unless (= got want)
|
||||
(++ failures)
|
||||
(printf "FAIL [%s] got %q want %q" label got want)))
|
||||
|
||||
# 1. Default unit (direct-linking OFF): redefinition reaches compiled callers.
|
||||
(let [ctx (init {:compile? true})]
|
||||
(eval-string ctx "(defn add [a b] (+ a b))")
|
||||
(eval-string ctx "(defn caller [] (add 1 2))")
|
||||
(check "default before redef" (eval-string ctx "(caller)") 3)
|
||||
(eval-string ctx "(defn add [a b] (* a b))")
|
||||
(check "default sees redef (indirect)" (eval-string ctx "(caller)") 2))
|
||||
|
||||
# 2. Direct-linked unit: compiled caller keeps the original target after a redef.
|
||||
(let [ctx (init {:compile? true :direct-linking? true})]
|
||||
(eval-string ctx "(defn add [a b] (+ a b))")
|
||||
(eval-string ctx "(defn caller [] (add 1 2))")
|
||||
(check "direct before redef" (eval-string ctx "(caller)") 3)
|
||||
(eval-string ctx "(defn add [a b] (* a b))")
|
||||
(check "direct ignores redef (sealed)" (eval-string ctx "(caller)") 3)
|
||||
# the var itself is still redefined; only the direct-linked call is frozen
|
||||
(check "direct var still updated" (eval-string ctx "(add 3 4)") 12))
|
||||
|
||||
# 3. ^:redef opts a var OUT of direct-linking even in a direct-linked unit.
|
||||
(let [ctx (init {:compile? true :direct-linking? true})]
|
||||
(eval-string ctx "(defn ^:redef add [a b] (+ a b))")
|
||||
(eval-string ctx "(defn caller [] (add 1 2))")
|
||||
(check "redef-tagged before" (eval-string ctx "(caller)") 3)
|
||||
(eval-string ctx "(defn ^:redef add [a b] (* a b))")
|
||||
(check "redef-tagged sees redef" (eval-string ctx "(caller)") 2))
|
||||
|
||||
# 4. :aot-core? true (default): redefining a core fn (in clojure.core) is still
|
||||
# seen by USER code, because user calls are indirect regardless of core being
|
||||
# direct-linked internally.
|
||||
(let [ctx (init {:compile? true})]
|
||||
(eval-string ctx "(defn uses-last [] (last [1 2 3]))")
|
||||
(check "core call before" (eval-string ctx "(uses-last)") 3)
|
||||
(eval-string ctx "(in-ns (quote clojure.core))")
|
||||
(eval-string ctx "(def last (fn [coll] :patched))")
|
||||
(eval-string ctx "(in-ns (quote user))")
|
||||
(check "user sees core redef (indirect)" (eval-string ctx "(uses-last)") :patched))
|
||||
|
||||
# 5. :aot-core? false: core compiles indirect too, so even core-internal callers
|
||||
# see a redef — the whole language is redefinable.
|
||||
(let [ctx (init {:compile? true :aot-core? false})]
|
||||
(check "aot-core off still correct" (eval-string ctx "(last [1 2 3])") 3))
|
||||
|
||||
(if (pos? failures)
|
||||
(do (printf "direct-linking: %d failure(s)" failures) (os/exit 1))
|
||||
(print "direct-linking: all matrix cases passed"))
|
||||
51
test/integration/dispatch-cache-test.janet
Normal file
51
test/integration/dispatch-cache-test.janet
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
# Protocol host-value dispatch cache (jolt-4ay).
|
||||
#
|
||||
# Host-value protocol dispatch used to recompute the candidate type-tag list and
|
||||
# walk the registry on every call. It's now a generation-guarded cache keyed by
|
||||
# (most-specific-host-tag, protocol, method); registering a protocol impl bumps
|
||||
# the registry generation and invalidates it. This pins correctness: the cache
|
||||
# must never hide a re-extension.
|
||||
|
||||
(use ../../src/jolt/api)
|
||||
|
||||
(var failures 0)
|
||||
(defn- check [label got want]
|
||||
(unless (= got want)
|
||||
(++ failures)
|
||||
(printf "FAIL [%s] got %q want %q" label got want)))
|
||||
|
||||
(each mode [{:compile? true} {} {:aot-core? false}]
|
||||
(def ctx (init mode))
|
||||
(eval-string ctx "(defprotocol P (m [x]))")
|
||||
(eval-string ctx "(extend-protocol P Number (m [x] (* x 2)))")
|
||||
(check (string mode " host dispatch") (eval-string ctx "(m 5)") 10)
|
||||
(check (string mode " cache hit (same class)") (eval-string ctx "(m 7)") 14)
|
||||
# Re-extend: registry generation bumps, cache must invalidate.
|
||||
(eval-string ctx "(extend-protocol P Number (m [x] (+ x 100)))")
|
||||
(check (string mode " sees re-extension") (eval-string ctx "(m 5)") 105)
|
||||
# Extending a different host class bumps gen too; number impl re-resolves.
|
||||
(eval-string ctx "(extend-protocol P String (m [x] (str \"s:\" x)))")
|
||||
(check (string mode " other class") (eval-string ctx "(m \"hi\")") "s:hi")
|
||||
(check (string mode " number after other-class extend") (eval-string ctx "(m 3)") 103))
|
||||
|
||||
# Multimethod hierarchy-fallback cache (jolt-g8w): the isa? walk result for a
|
||||
# dispatch value is cached; defmethod/remove-method must invalidate it.
|
||||
(each mode [{:compile? true} {} {:aot-core? false}]
|
||||
(def ctx (init mode))
|
||||
(eval-string ctx "(derive ::circle ::shape)")
|
||||
(eval-string ctx "(derive ::square ::shape)")
|
||||
(eval-string ctx "(defmulti area identity)")
|
||||
(eval-string ctx "(defmethod area ::shape [_] :generic)")
|
||||
(check (string mode " mm hierarchy") (eval-string ctx "(area ::circle)") :generic)
|
||||
(check (string mode " mm cache hit") (eval-string ctx "(area ::circle)") :generic)
|
||||
# adding a more specific method must invalidate the cached hierarchy result
|
||||
(eval-string ctx "(defmethod area ::circle [_] :specific)")
|
||||
(check (string mode " mm sees new method") (eval-string ctx "(area ::circle)") :specific)
|
||||
(check (string mode " mm other still hierarchy") (eval-string ctx "(area ::square)") :generic)
|
||||
# removing it must re-expose the hierarchy fallback
|
||||
(eval-string ctx "(remove-method area ::circle)")
|
||||
(check (string mode " mm sees removal") (eval-string ctx "(area ::circle)") :generic))
|
||||
|
||||
(if (pos? failures)
|
||||
(do (printf "dispatch-cache: %d failure(s)" failures) (os/exit 1))
|
||||
(print "dispatch-cache: all cases passed (compile, interpret, aot-core off)"))
|
||||
123
test/integration/lazy-infinite-test.janet
Normal file
123
test/integration/lazy-infinite-test.janet
Normal file
|
|
@ -0,0 +1,123 @@
|
|||
# Deadlined infinite-seq conformance harness (Phase 5 Step 0).
|
||||
#
|
||||
# Each case is [name expected-clj actual-clj]. The harness spawns a subprocess
|
||||
# worker (test/support/lazy-eval.janet) that evaluates (= expected actual) and
|
||||
# prints @@RESULT true/false. Workers run under a wall-clock deadline; a hang
|
||||
# = a FAIL. This is the safety net that makes it safe to convert transformers
|
||||
# to lazy — wrong answers hang instead of silently passing.
|
||||
#
|
||||
# Pattern mirrors clojure-test-suite-test.janet: os/spawn + ev/with-deadline
|
||||
# + os/proc-kill on timeout. Never probe infinite cases in-process.
|
||||
|
||||
(def per-case-timeout 5)
|
||||
|
||||
(defn- run-case [expected actual]
|
||||
(def proc (os/spawn ["janet" "test/support/lazy-eval.janet" expected actual] :p {:out :pipe}))
|
||||
(def out (proc :out))
|
||||
(var data nil)
|
||||
(def ok
|
||||
(try
|
||||
(ev/with-deadline per-case-timeout
|
||||
(set data (ev/read out 0x10000))
|
||||
(os/proc-wait proc)
|
||||
true)
|
||||
([err] false)))
|
||||
(when (not ok)
|
||||
(protect (os/proc-kill proc true))
|
||||
(protect (ev/with-deadline 2 (os/proc-wait proc))))
|
||||
(protect (:close out))
|
||||
(if (and ok data) (string data) nil))
|
||||
|
||||
(defn- parse-result [s]
|
||||
(def prefix-len (length "@@RESULT "))
|
||||
(if (string/has-prefix? "@@RESULT " s)
|
||||
(let [val (string/slice s prefix-len (dec (length s)))]
|
||||
[:ok val])
|
||||
(if (string/has-prefix? "@@ERROR " s)
|
||||
(let [msg (string/slice s (length "@@ERROR ") (dec (length s)))]
|
||||
[:error msg])
|
||||
nil)))
|
||||
|
||||
# ---- Cases from phase-5.md §6.2 ----
|
||||
# Expected values use Clojure quote syntax so the worker evaluates
|
||||
# (= (quote ...) actual) with Clojure's = semantics.
|
||||
(def cases
|
||||
[
|
||||
["nth of map inc range" "1001" "(nth (map inc (range)) 1000)"]
|
||||
["first filter even? drop range" "4" "(first (filter even? (drop 3 (range))))"]
|
||||
["take 3 remove odd? range" "(quote (0 2 4))" "(take 3 (remove odd? (range)))"]
|
||||
["take 3 drop-while <5 range" "(quote (5 6 7))" "(take 3 (drop-while (fn [x] (< x 5)) (range)))"]
|
||||
["take 4 interleave range iterate" "(quote (0 10 1 11))" "(take 4 (interleave (range) (iterate inc 10)))"]
|
||||
["take 4 reductions + range" "(quote (0 1 3 6))" "(take 4 (reductions + (range)))"]
|
||||
["take 3 tree-seq infinite" "(quote (0 0 0))" "(take 3 (tree-seq (fn [_] true) (fn [n] [n]) 0))"]
|
||||
["sequence xform lazy inf" "(quote (1 2 3))" "(take 3 (sequence (map inc) (range)))"]
|
||||
["sequence comp xform inf" "(quote (2 4 6))" "(take 3 (sequence (comp (filter odd?) (map inc)) (range)))"]
|
||||
["every? short-circuits on inf" "false" "(every? pos? (range))"]
|
||||
["not-every? short-circuits on inf" "true" "(not-every? pos? (range))"]
|
||||
["take 3 partition 2 range" "(quote ((0 1) (2 3) (4 5)))" "(take 3 (partition 2 (range)))"]
|
||||
["take 3 partition-all 2 range" "(quote ((0 1) (2 3) (4 5)))" "(take 3 (partition-all 2 (range)))"]
|
||||
["take 3 map-indexed vector range" "(quote ([0 0] [1 1] [2 2]))" "(take 3 (map-indexed vector (range)))"]
|
||||
["take 3 distinct cycle" "(quote (1 2 3))" "(take 3 (distinct (cycle [1 2 1 3 1])))"]
|
||||
["take 6 mapcat dup range" "(quote (0 0 1 1 2 2))" "(take 6 (mapcat (fn [x] [x x]) (range)))"]
|
||||
["first rest lazy" "1" "(let [[a & r] (range)] (first r))"]
|
||||
["take 3 rest lazy" "(quote (1 2 3))" "(let [[a & r] (range)] (take 3 r))"]
|
||||
["dedupe inf" "(quote (1 2 1 2 1))" "(take 5 (dedupe (cycle [1 1 2 2])))"]
|
||||
["take 3 take-nth 2 range" "(quote (0 2 4))" "(take 3 (take-nth 2 (range)))"]
|
||||
["take 3 interpose :x range" "(quote (0 :x 1))" "(take 3 (interpose :x (range)))"]
|
||||
["take 3 map vector range iterate" "(quote ([0 100] [1 101] [2 102]))" "(take 3 (map vector (range) (iterate inc 100)))"]
|
||||
|
||||
# §6.3 Laziness counter tests — realize exactly the demanded prefix. Under
|
||||
# Option A `take` is lazy, so the take result must be forced (dorun) to drive
|
||||
# realization; reading the counter without forcing would (correctly) see 0.
|
||||
["LAZY map" "3" "(do (def c (atom 0)) (dorun (take 3 (map (fn [x] (swap! c inc) x) (range)))) @c)"]
|
||||
["LAZY filter" "6" "(do (def c (atom 0)) (dorun (take 3 (filter (fn [x] (swap! c inc) (odd? x)) (range)))) @c)"]
|
||||
["LAZY remove" "6" "(do (def c (atom 0)) (dorun (take 3 (remove (fn [x] (swap! c inc) (even? x)) (range)))) @c)"]
|
||||
["LAZY take-while" "6" "(do (def c (atom 0)) (dorun (take-while (fn [x] (swap! c inc) (< x 5)) (range))) @c)"]
|
||||
["LAZY drop-while" "6" "(do (def c (atom 0)) (dorun (take 3 (drop-while (fn [x] (swap! c inc) (< x 5)) (range)))) @c)"]
|
||||
["LAZY distinct" "4" "(do (def c (atom 0)) (dorun (take 3 (distinct (map (fn [x] (swap! c inc) x) (cycle [1 2 1 3 1]))))) @c)"]
|
||||
["LAZY take-nth" "7" "(do (def c (atom 0)) (dorun (take 3 (take-nth 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
|
||||
["LAZY map-indexed" "3" "(do (def c (atom 0)) (dorun (take 3 (map-indexed (fn [i x] (swap! c inc) [i x]) (range)))) @c)"]
|
||||
["LAZY keep" "6" "(do (def c (atom 0)) (dorun (take 3 (keep (fn [x] (swap! c inc) (if (odd? x) x nil)) (range)))) @c)"]
|
||||
["LAZY keep-indexed" "6" "(do (def c (atom 0)) (dorun (take 3 (keep-indexed (fn [i x] (swap! c inc) (if (odd? i) x)) (range)))) @c)"]
|
||||
["LAZY interpose" "2" "(do (def c (atom 0)) (dorun (take 3 (interpose :x (map (fn [x] (swap! c inc) x) (range))))) @c)"]
|
||||
["LAZY partition" "6" "(do (def c (atom 0)) (dorun (take 3 (partition 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
|
||||
["LAZY partition-all" "6" "(do (def c (atom 0)) (dorun (take 3 (partition-all 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
|
||||
["LAZY mapcat" "3" "(do (def c (atom 0)) (dorun (take 6 (mapcat (fn [x] (swap! c inc) [x x]) (range)))) @c)"]
|
||||
["LAZY dedupe" "9" "(do (def c (atom 0)) (dorun (take 5 (dedupe (map (fn [x] (swap! c inc) x) (cycle [1 1 2 2]))))) @c)"]
|
||||
["LAZY repeated inc" "3" "(do (def c (atom 0)) (dorun (take 3 (map (fn [x] (swap! c inc) x) (iterate inc 0)))) @c)"]
|
||||
|
||||
# Already-working cases (guard against regression)
|
||||
["take 5 iterate inc" "(quote (0 1 2 3 4))" "(take 5 (iterate inc 0))"]
|
||||
["take 3 range" "(quote (0 1 2))" "(take 3 (range))"]
|
||||
["take 3 repeat" "(quote (7 7 7))" "(take 3 (repeat 7))"]
|
||||
["take 3 cycle" "(quote (1 2 1))" "(take 3 (cycle [1 2]))"]
|
||||
["take 3 filter even? range" "(quote (0 2 4))" "(take 3 (filter even? (range)))"]
|
||||
["take 5 lazily filtered from range" "(quote (1 3 5 7 9))" "(take 5 (filter odd? (range)))"]
|
||||
])
|
||||
|
||||
# ---- Run ----
|
||||
(var fails @[])
|
||||
(var timeouts 0)
|
||||
(var passed 0)
|
||||
|
||||
(each [name expected expr] cases
|
||||
(def out (run-case expected expr))
|
||||
(cond
|
||||
(nil? out)
|
||||
(do (++ timeouts) (array/push fails (string "TIMEOUT: " name)))
|
||||
(let [res (parse-result out)]
|
||||
(case (res 0)
|
||||
:ok (if (= "true" (res 1))
|
||||
(++ passed)
|
||||
(array/push fails (string "MISMATCH: " name " — expected " expected)))
|
||||
:error (array/push fails (string "ERROR: " name " — " (res 1)))
|
||||
(array/push fails (string "PARSE: " name " — raw: " (string/trim out)))))))
|
||||
|
||||
(printf "lazy-infinite: %d cases — %d passed / %d timeouts / %d failures"
|
||||
(length cases) passed timeouts (length fails))
|
||||
(when (> (length fails) 0)
|
||||
(print "\nFailures:")
|
||||
(each f fails (printf " %s" f)))
|
||||
|
||||
(if (or (> (length fails) 0) (> timeouts 0))
|
||||
(os/exit 1))
|
||||
88
test/integration/self-host-test.janet
Normal file
88
test/integration/self-host-test.janet
Normal file
|
|
@ -0,0 +1,88 @@
|
|||
# End-to-end proof of the self-hosting pipeline: a reader form is analyzed by the
|
||||
# PORTABLE Clojure analyzer (jolt.analyzer, in jolt-core) into host-neutral IR,
|
||||
# then the Janet back end lowers the IR to a Janet form and evaluates it. No use
|
||||
# of compiler.janet's analyzer — this is the Clojure-in-Clojure front end.
|
||||
(import ../../src/jolt/backend :as backend)
|
||||
(use ../../src/jolt/api)
|
||||
(use ../../src/jolt/reader)
|
||||
(use ../../src/jolt/types)
|
||||
|
||||
(defn ce [ctx s] (normalize-pvecs (backend/compile-and-eval ctx (parse-string s))))
|
||||
|
||||
(print "self-host pipeline (Clojure analyzer -> IR -> Janet)...")
|
||||
(let [ctx (init)]
|
||||
# primitives + control flow
|
||||
(assert (= 3 (ce ctx "(+ 1 2)")) "+")
|
||||
(assert (= 6 (ce ctx "(* 2 3)")) "*")
|
||||
(assert (= :a (ce ctx "(if true :a :b)")) "if true")
|
||||
(assert (= :b (ce ctx "(if false :a :b)")) "if false")
|
||||
(assert (= 10 (ce ctx "(let [x 4 y 6] (+ x y))")) "let")
|
||||
(assert (= 6 (ce ctx "(do 1 2 6)")) "do")
|
||||
|
||||
# literals
|
||||
(assert (= [2 3 4] (ce ctx "(map inc [1 2 3])")) "vector literal + core fn")
|
||||
(assert (= 1 (ce ctx "(get {:a 1 :b 2} :a)")) "map literal")
|
||||
(assert (= 42 (ce ctx "(quote 42)")) "quote literal")
|
||||
|
||||
# def + global reference (name-based var resolution)
|
||||
(ce ctx "(def base 100)")
|
||||
(assert (= 142 (ce ctx "(+ base 42)")) "def + later ref")
|
||||
|
||||
# fn / defn (defn is a macro -> expand -> def of fn*)
|
||||
(ce ctx "(defn add [a b] (+ a b))")
|
||||
(assert (= 7 (ce ctx "(add 3 4)")) "defn")
|
||||
(assert (= 49 (ce ctx "((fn [x] (* x x)) 7)")) "anon fn")
|
||||
|
||||
# recursion through the var cell (no recur needed)
|
||||
(ce ctx "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
|
||||
(assert (= 55 (ce ctx "(fib 10)")) "recursive fib via var")
|
||||
|
||||
# multi-arity + variadic
|
||||
(ce ctx "(defn arity ([a] a) ([a b] (+ a b)) ([a b & more] (apply + a b more)))")
|
||||
(assert (= 5 (ce ctx "(arity 5)")) "multi-arity 1")
|
||||
(assert (= 7 (ce ctx "(arity 3 4)")) "multi-arity 2")
|
||||
(assert (= 15 (ce ctx "(arity 1 2 3 4 5)")) "multi-arity variadic")
|
||||
|
||||
# loop / recur
|
||||
(assert (= 15 (ce ctx "(loop [i 0 acc 0] (if (< i 6) (recur (inc i) (+ acc i)) acc))")) "loop/recur")
|
||||
# recur directly in a fixed-arity fn
|
||||
(assert (= 15 (ce ctx "((fn [n acc] (if (zero? n) acc (recur (dec n) (+ acc n)))) 5 0)")) "recur in fn")
|
||||
# try / catch / finally
|
||||
(assert (= "caught" (ce ctx "(try (throw 42) (catch Exception e \"caught\"))")) "try/catch")
|
||||
(assert (= 7 (ce ctx "(try 7 (finally 0))")) "try/finally")
|
||||
|
||||
# higher-order + nesting
|
||||
(assert (= 15 (ce ctx "(reduce + (map inc [0 1 2 3 4]))")) "reduce+map"))
|
||||
|
||||
# eval-toplevel routing: :compile? IS the self-hosted pipeline now — the only
|
||||
# compile path. Forms the analyzer can't handle (stateful / destructuring) fall
|
||||
# back to the interpreter, with the same observable results.
|
||||
(print "self-host via eval-toplevel routing...")
|
||||
(let [ctx (init {:compile? true})]
|
||||
(defn ev [s] (normalize-pvecs (eval-one ctx (parse-string s))))
|
||||
(assert (= 3 (ev "(+ 1 2)")) "tl +")
|
||||
(ev "(defn sq [x] (* x x))") # def via self-host
|
||||
(assert (= 81 (ev "(sq 9)")) "tl defn")
|
||||
(ev "(defmacro twice [x] (list (quote do) x x))") # stateful -> interp fallback
|
||||
(assert (= 5 (ev "(do (twice 1) 5)")) "tl macro fallback")
|
||||
(assert (= [1 2 3] (ev "(let [{:keys [a b c]} {:a 1 :b 2 :c 3}] [a b c])")) "tl destructuring fallback")
|
||||
(assert (= 15 (ev "(reduce + (range 6))")) "tl reduce/range")
|
||||
# Proof the self-hosted pipeline actually ran: only backend/ensure-analyzer
|
||||
# populates jolt.analyzer. An interpret-only ctx never loads it.
|
||||
(assert (pos? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) "analyzer loaded under :compile?"))
|
||||
(let [ctx (init {})]
|
||||
(eval-one ctx (parse-string "(+ 1 2)"))
|
||||
(assert (zero? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) "analyzer NOT loaded when interpreting"))
|
||||
|
||||
# clojure.core overlay: fns moved from core.janet to jolt-core/clojure/core.clj
|
||||
# load into clojure.core at init and work the same compiled or interpreted.
|
||||
(print "clojure.core overlay (Clojure-defined core fns)...")
|
||||
(each opts [{:compile? true} {}]
|
||||
(let [ctx (init opts)]
|
||||
(defn ev [s] (normalize-pvecs (eval-one ctx (parse-string s))))
|
||||
(assert (= 1 (ev "(ffirst [[1 2] [3 4]])")) "ffirst")
|
||||
(assert (= [2] (ev "(nfirst [[1 2] [3 4]])")) "nfirst")
|
||||
(assert (= 2 (ev "(fnext [1 2 3])")) "fnext")
|
||||
(assert (= [3 4] (ev "(nnext [1 2 3 4])")) "nnext")))
|
||||
|
||||
(print "self-host pipeline passed!")
|
||||
63
test/integration/staged-bootstrap-test.janet
Normal file
63
test/integration/staged-bootstrap-test.janet
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
# Staged-bootstrap soundness (jolt-vcx, under epic jolt-tzo).
|
||||
#
|
||||
# The self-hosted compiler's structural deps — second/peek/subvec/mapv/update —
|
||||
# now come from the Clojure kernel tier (jolt-core/clojure/core/00-kernel.clj),
|
||||
# bootstrap-compiled into clojure.core BEFORE the analyzer is built. This pins
|
||||
# the two properties that make that safe:
|
||||
#
|
||||
# 1. Compile mode: the analyzer (which itself calls second/peek/subvec/mapv)
|
||||
# compiles analyzer-exercising forms correctly — the exact case that broke
|
||||
# when `second` was a plain overlay fn: (first {:a 1}) / (key (first ...)).
|
||||
# 2. Bootstrap FIXPOINT: rebuilding the compiler (rebuild-compiler!) against the
|
||||
# now Clojure-defined core still yields a correct compiler. This is the
|
||||
# soundness gate for every future fractal turn (S2 -> S3).
|
||||
|
||||
(use ../../src/jolt/api)
|
||||
(import ../../src/jolt/backend :as backend)
|
||||
|
||||
(var failures 0)
|
||||
|
||||
# Each probe is a jolt boolean expression; compared with jolt's own `=`.
|
||||
(def probes
|
||||
["(= 2 (second [1 2 3]))"
|
||||
"(= nil (second [1]))"
|
||||
"(= 3 (peek [1 2 3]))"
|
||||
"(= 1 (peek (list 1 2 3)))"
|
||||
"(= nil (peek []))"
|
||||
"(= [2 3] (subvec [1 2 3 4 5] 1 3))"
|
||||
"(= [3 4 5] (subvec [1 2 3 4 5] 2))"
|
||||
"(= [2 3 4] (mapv inc [1 2 3]))"
|
||||
"(= [11 22 33] (mapv + [1 2 3] [10 20 30]))"
|
||||
"(= {:a 2} (update {:a 1} :a inc))"
|
||||
"(= {:a 1 :b 1} (update {:a 1} :b (fnil inc 0)))"
|
||||
# Regression: these run the analyzer's own second/map-pair path in compile mode.
|
||||
"(= [:a 1] (first {:a 1}))"
|
||||
"(= :a (key (first {:a 1})))"
|
||||
"(= 1 (val (first {:a 1})))"
|
||||
"(= 3 (let [[a b] [1 2]] (+ a b)))"
|
||||
"(= 3 (loop [i 0 acc 0] (if (< i 3) (recur (inc i) (+ acc i)) acc)))"])
|
||||
|
||||
(defn- run-probes [ctx label]
|
||||
(each prog probes
|
||||
(def got (protect (eval-string ctx prog)))
|
||||
(unless (and (got 0) (= (got 1) true))
|
||||
(++ failures)
|
||||
(printf "FAIL [%s] %s => %s" label prog
|
||||
(if (got 0) (string/format "%q" (got 1)) (string "ERR:" (got 1)))))))
|
||||
|
||||
# Interpret mode: kernel tier interpreted, no analyzer involved.
|
||||
(run-probes (init {}) "interpret")
|
||||
|
||||
# Compile mode: kernel tier bootstrap-compiled, analyzer built against it.
|
||||
(def cctx (init {:compile? true}))
|
||||
(run-probes cctx "compile")
|
||||
|
||||
# Fixpoint: rebuild the compiler against the current (Clojure-defined) core and
|
||||
# re-run. A correct compiler recompiled on the language it just defined stays
|
||||
# correct.
|
||||
(backend/rebuild-compiler! cctx)
|
||||
(run-probes cctx "compile+rebuilt")
|
||||
|
||||
(if (pos? failures)
|
||||
(do (printf "staged-bootstrap: %d failure(s)" failures) (os/exit 1))
|
||||
(print "staged-bootstrap: all probes passed (interpret, compile, compile+rebuilt)"))
|
||||
|
|
@ -5,6 +5,7 @@
|
|||
(use ../../src/jolt/api)
|
||||
(use ../../src/jolt/reader)
|
||||
(use ../../src/jolt/evaluator)
|
||||
(import ../../src/jolt/backend :as selfhost)
|
||||
|
||||
(defn- parse-forms [src]
|
||||
(var s src) (def fs @[]) (var go true)
|
||||
|
|
@ -19,8 +20,21 @@
|
|||
(def path (get (dyn :args) 1))
|
||||
|
||||
(when path
|
||||
(def ctx (init))
|
||||
(each f (parse-forms (slurp "test/support/clojure_test.clj")) (eval-form ctx @{} f))
|
||||
# JOLT_COMPILE=1 runs the suite through the compile path (hybrid: hot forms
|
||||
# compile, unsupported forms fall back to the interpreter) so the whole battery
|
||||
# validates compile-mode correctness against the same baseline.
|
||||
(def compile? (= "1" (os/getenv "JOLT_COMPILE")))
|
||||
# JOLT_SELFHOST=1 routes each form through the self-hosted pipeline (the
|
||||
# portable Clojure analyzer + Janet back end, hybrid with interpreter fallback)
|
||||
# so the whole battery validates the self-hosted compiler against the baseline.
|
||||
(def selfhost? (= "1" (os/getenv "JOLT_SELFHOST")))
|
||||
(def ctx (init (if compile? {:compile? true} {})))
|
||||
(defn run-form [f]
|
||||
(cond
|
||||
selfhost? (selfhost/compile-and-eval ctx f)
|
||||
compile? (eval-one ctx f)
|
||||
(eval-form ctx @{} f)))
|
||||
(each f (parse-forms (slurp "test/support/clojure_test.clj")) (run-form f))
|
||||
|
||||
# Pre-load the suite's own clojure.core-test.number-range helper ns if present
|
||||
# (35 files require it for r/max-int, r/max-double, … — its :default branches are
|
||||
|
|
@ -29,10 +43,10 @@
|
|||
(let [dir (string/slice path 0 (- (length path) (length (last (string/split "/" path)))))
|
||||
nr (string dir "number_range.cljc")]
|
||||
(when (os/stat nr)
|
||||
(each f (parse-forms (slurp nr)) (protect (eval-form ctx @{} f)))))
|
||||
(each f (parse-forms (slurp nr)) (protect (run-form f)))))
|
||||
|
||||
(eval-string ctx "(clojure.test/reset-report!)")
|
||||
(each form (parse-forms (slurp path)) (protect (eval-form ctx @{} form)))
|
||||
(each form (parse-forms (slurp path)) (protect (run-form form)))
|
||||
(protect (eval-string ctx "(clojure.test/run-registered)"))
|
||||
(def p (eval-string ctx "(clojure.test/n-pass)"))
|
||||
(def f (eval-string ctx "(clojure.test/n-fail)"))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue