simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compiler research (#10)

Browse source 
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 2026-06-09 07:30:25 +08:00 • committed by GitHub
parent 607779866e
commit d3194aae59
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
68 changed files with 6590 additions and 2019 deletions
Download patch file Download diff file Expand all files Collapse all files

42
test/bench/core-bench.janet Normal file
View file

@ -0,0 +1,42 @@
# Performance baseline for the clojure.core migration (jolt-1j0).
#
# Times representative core operations end-to-end (compile path) so a phase that
# moves fns from native Janet to the self-hosted Clojure overlay can be checked
# for regressions. Same programs before/after a phase -> relative delta is the
# migration's perf impact. Run: janet test/bench/core-bench.janet
#
# Each program carries its own internal iteration so the measured work dominates
# parse/compile overhead. Reports the min of N runs (least noisy).
(import ../../src/jolt/api :as api)
(def runs 5)
(def benches
[[:fib "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 28)"]
[:seq-pipe "(loop [i 0 a 0] (if (< i 300) (recur (inc i) (+ a (reduce + 0 (map inc (filter even? (range 200)))))) a))"]
[:reduce "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (reduce + 0 (range 500)))) a))"]
[:into-vec "(loop [i 0 a 0] (if (< i 1000) (recur (inc i) (+ a (count (into [] (map inc (range 100)))))) a))"]
[:map-build "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (count (reduce (fn [m k] (assoc m k k)) {} (range 50))))) a))"]
[:map-read "(let [m (zipmap (range 100) (range 100))] (loop [i 0 a 0] (if (< i 5000) (recur (inc i) (+ a (get m (mod i 100) 0))) a)))"]
[:str-join "(loop [i 0 a 0] (if (< i 1000) (recur (inc i) (+ a (count (apply str (map str (range 100)))))) a))"]
[:hof "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (reduce + 0 (map (comp inc inc) (range 200))))) a))"]])
(defn time-bench [ctx src]
(var best math/inf)
(for _ 0 runs
(def t0 (os/clock))
(api/load-string ctx src)
(def dt (* 1000 (- (os/clock) t0)))
(when (< dt best) (set best dt)))
best)
(defn main [&]
(def ctx (api/init {:compile? true}))
(print "bench (compile mode), min of " runs " runs, ms:")
(var total 0)
(each [name src] benches
(def ms (time-bench ctx src))
(+= total ms)
(printf " %-10s %8.2f ms" name ms))
(printf " %-10s %8.2f ms" "TOTAL" total))

149
test/clojure-stdlib/clojure/data_test/diff.cljc Normal file
View file

@ -0,0 +1,149 @@
(ns clojure.data-test.diff
(:require [clojure.test :refer [deftest is testing]]
;; NOTE (jolt): sequential-diff expectations corrected to match real Clojure —
;; clojure.data pads only to the max differing index (e.g. (diff [1 2 3] [1 9 3])
;; -> a=[nil 2], not [nil 2 nil]). The upstream clojurust fixtures had this wrong.
[clojure.data :refer [diff]]))
;; ── Atoms ────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-atoms
(testing "equal atoms"
(is (= [nil nil :a] (diff :a :a)))
(is (= [nil nil 1] (diff 1 1)))
(is (= [nil nil "hello"] (diff "hello" "hello")))
(is (= [nil nil nil] (diff nil nil)))
(is (= [nil nil true] (diff true true)))))
(deftest test-diff-unequal-atoms
(testing "unequal atoms"
(is (= [:a :b nil] (diff :a :b)))
(is (= [1 2 nil] (diff 1 2)))
(is (= ["a" "b" nil] (diff "a" "b")))
(is (= [nil 1 nil] (diff nil 1)))
(is (= [true false nil] (diff true false)))))
;; ── Maps ─────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-maps
(testing "equal maps"
(is (= [nil nil {:a 1 :b 2}] (diff {:a 1 :b 2} {:a 1 :b 2})))
(is (= [nil nil {}] (diff {} {})))))
(deftest test-diff-maps-only-in-a
(testing "keys only in a"
(let [[a b both] (diff {:a 1 :b 2} {:a 1})]
(is (= {:b 2} a))
(is (nil? b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-only-in-b
(testing "keys only in b"
(let [[a b both] (diff {:a 1} {:a 1 :b 2})]
(is (nil? a))
(is (= {:b 2} b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-different-values
(testing "same keys, different values"
(let [[a b both] (diff {:a 1 :b 2} {:a 1 :b 9})]
(is (= {:b 2} a))
(is (= {:b 9} b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-nested
(testing "nested maps"
(let [[a b both] (diff {:a {:x 1 :y 2}} {:a {:x 1 :z 3}})]
(is (= {:a {:y 2}} a))
(is (= {:a {:z 3}} b))
(is (= {:a {:x 1}} both)))))
(deftest test-diff-maps-disjoint
(testing "completely disjoint maps"
(let [[a b both] (diff {:a 1} {:b 2})]
(is (= {:a 1} a))
(is (= {:b 2} b))
(is (nil? both)))))
;; ── Sets ─────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-sets
(testing "equal sets"
(is (= [nil nil #{1 2 3}] (diff #{1 2 3} #{1 2 3})))
(is (= [nil nil #{}] (diff #{} #{})))))
(deftest test-diff-sets
(testing "overlapping sets"
(let [[a b both] (diff #{1 2 3} #{2 3 4})]
(is (= #{1} a))
(is (= #{4} b))
(is (= #{2 3} both)))))
(deftest test-diff-disjoint-sets
(testing "disjoint sets"
(let [[a b both] (diff #{1 2} #{3 4})]
(is (= #{1 2} a))
(is (= #{3 4} b))
(is (nil? both)))))
;; ── Vectors / Sequential ────────────────────────────────────────────────────
(deftest test-diff-equal-vectors
(testing "equal vectors"
(is (= [nil nil [1 2 3]] (diff [1 2 3] [1 2 3])))
(is (= [nil nil []] (diff [] [])))))
(deftest test-diff-vectors-same-length
(testing "same length, different elements"
(let [[a b both] (diff [1 2 3] [1 9 3])]
(is (= [nil 2] a))
(is (= [nil 9] b))
(is (= [1 nil 3] both)))))
(deftest test-diff-vectors-different-length
(testing "different lengths"
(let [[a b both] (diff [1 2 3] [1 2])]
(is (= [nil nil 3] a))
(is (nil? b))
(is (= [1 2] both)))
(let [[a b both] (diff [1] [1 2 3])]
(is (nil? a))
(is (= [nil 2 3] b))
(is (= [1] both)))))
(deftest test-diff-lists
(testing "lists treated as sequential"
(let [[a b both] (diff '(1 2 3) '(1 9 3))]
(is (= [nil 2] a))
(is (= [nil 9] b))
(is (= [1 nil 3] both)))))
;; ── Mixed types ─────────────────────────────────────────────────────────────
(deftest test-diff-mixed-types
(testing "different partition types treated as atoms"
(is (= [{:a 1} [1 2] nil] (diff {:a 1} [1 2])))
(is (= [#{1} [1] nil] (diff #{1} [1])))
(is (= [1 :a nil] (diff 1 :a)))))
;; ── Nil handling ────────────────────────────────────────────────────────────
(deftest test-diff-nil
(testing "nil vs non-nil"
(is (= [nil 1 nil] (diff nil 1)))
(is (= [1 nil nil] (diff 1 nil)))
(is (= [nil {:a 1} nil] (diff nil {:a 1})))))
;; ── Deeply nested ───────────────────────────────────────────────────────────
(deftest test-diff-deeply-nested
(testing "deeply nested structures"
(let [[a b both] (diff {:a {:b {:c 1}}} {:a {:b {:c 2}}})]
(is (= {:a {:b {:c 1}}} a))
(is (= {:a {:b {:c 2}}} b))
(is (nil? both))))
(testing "deeply nested with shared keys"
(let [[a b both] (diff {:a {:b 1 :c 2}} {:a {:b 1 :c 9}})]
(is (= {:a {:c 2}} a))
(is (= {:a {:c 9}} b))
(is (= {:a {:b 1}} both)))))

107
test/clojure-stdlib/clojure/edn_test/read_string.cljc Normal file
View file

@ -0,0 +1,107 @@
(ns clojure.edn-test.read-string
(:require [clojure.edn :as edn]
[clojure.test :refer [are deftest is testing]]))
(deftest test-read-string-scalars
(testing "nil, booleans"
(is (nil? (edn/read-string "nil")))
(is (true? (edn/read-string "true")))
(is (false? (edn/read-string "false"))))
(testing "integers"
(is (= 0 (edn/read-string "0")))
(is (= 42 (edn/read-string "42")))
(is (= -1 (edn/read-string "-1")))
(is (= 1000000000000 (edn/read-string "1000000000000"))))
(testing "floats"
(is (= 3.14 (edn/read-string "3.14")))
(is (= -0.5 (edn/read-string "-0.5")))
(is (= 1.0 (edn/read-string "1.0"))))
(testing "bigints"
(is (= 42N (edn/read-string "42N"))))
(testing "bigdecimals"
(is (= 3.14M (edn/read-string "3.14M"))))
(testing "strings"
(is (= "" (edn/read-string "\"\"")))
(is (= "hello" (edn/read-string "\"hello\"")))
(is (= "line1\nline2" (edn/read-string "\"line1\\nline2\"")))
(is (= "tab\there" (edn/read-string "\"tab\\there\""))))
(testing "characters"
(is (= \a (edn/read-string "\\a")))
(is (= \newline (edn/read-string "\\newline")))
(is (= \space (edn/read-string "\\space")))
(is (= \tab (edn/read-string "\\tab"))))
(testing "keywords"
(is (= :foo (edn/read-string ":foo")))
(is (= :bar/baz (edn/read-string ":bar/baz"))))
(testing "symbols"
(is (= 'foo (edn/read-string "foo")))
(is (= 'bar/baz (edn/read-string "bar/baz")))))
(deftest test-read-string-collections
(testing "vectors"
(is (= [] (edn/read-string "[]")))
(is (= [1 2 3] (edn/read-string "[1 2 3]")))
(is (= [1 [2 3] 4] (edn/read-string "[1 [2 3] 4]"))))
(testing "lists"
(is (= '() (edn/read-string "()")))
(is (= '(1 2 3) (edn/read-string "(1 2 3)")))
(is (= '(+ 1 2) (edn/read-string "(+ 1 2)"))))
(testing "maps"
(is (= {} (edn/read-string "{}")))
(is (= {:a 1} (edn/read-string "{:a 1}")))
(is (= {:a 1 :b 2} (edn/read-string "{:a 1 :b 2}")))
(is (= {:nested {:deep true}} (edn/read-string "{:nested {:deep true}}"))))
(testing "sets"
(is (= #{} (edn/read-string "#{}")))
(is (= #{1 2 3} (edn/read-string "#{1 2 3}"))))
(testing "mixed nested"
(is (= {:users [{:name "Alice" :age 30}
{:name "Bob" :age 25}]}
(edn/read-string "{:users [{:name \"Alice\" :age 30} {:name \"Bob\" :age 25}]}")))))
(deftest test-read-string-tagged-literals
(testing "#uuid"
(let [u (edn/read-string "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\"")]
(is (uuid? u))
(is (= u (edn/read-string "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\""))))))
(deftest test-read-string-eof
(testing "empty string with :eof option"
(is (= :eof (edn/read-string {:eof :eof} "")))
(is (= nil (edn/read-string {:eof nil} "")))
(is (= 42 (edn/read-string {:eof 42} ""))))
(testing "whitespace-only with :eof option"
(is (= :done (edn/read-string {:eof :done} " "))))
(testing "nil input returns nil"
(is (nil? (edn/read-string nil)))))
(deftest test-read-string-comments
(testing "comments are skipped"
(is (= 42 (edn/read-string "; this is a comment\n42"))))
(testing "discard reader macro"
(is (= 2 (edn/read-string "#_ 1 2")))))
(deftest test-read-string-only-first-form
(testing "reads only the first form"
(is (= 1 (edn/read-string "1 2 3")))
(is (= :a (edn/read-string ":a :b :c")))))
(deftest test-read-string-ratios
(testing "ratios"
(is (= 1/2 (edn/read-string "1/2")))
(is (= 3/4 (edn/read-string "3/4")))))

101
test/clojure-stdlib/clojure/walk_test/walk.cljc Normal file
View file

@ -0,0 +1,101 @@
(ns clojure.walk-test.walk
(:require [clojure.test :refer [deftest is testing]]
[clojure.walk :as w]))
(deftest test-walk
(testing "walk with identity"
(is (= [1 2 3] (w/walk identity identity [1 2 3])))
(is (= '(1 2 3) (w/walk identity identity '(1 2 3))))
(is (= #{1 2 3} (w/walk identity identity #{1 2 3}))))
(testing "walk with inner transform"
(is (= [2 3 4] (w/walk inc identity [1 2 3])))
(is (= [2 3 4] (w/walk inc vec [1 2 3]))))
(testing "walk with outer transform"
(is (= [1 2 3] (w/walk identity vec '(1 2 3))))))
(deftest test-postwalk
(testing "postwalk with numbers"
(is (= [2 3 4] (w/postwalk #(if (number? %) (inc %) %) [1 2 3]))))
(testing "postwalk with nested structures"
(is (= [2 [3 4] 5]
(w/postwalk #(if (number? %) (inc %) %) [1 [2 3] 4]))))
(testing "postwalk preserves types"
(is (vector? (w/postwalk identity [1 2 3])))
(is (list? (w/postwalk identity '(1 2 3))))
(is (set? (w/postwalk identity #{1 2 3})))
(is (map? (w/postwalk identity {:a 1 :b 2}))))
(testing "postwalk on maps"
(is (= {:a 2 :b 3}
(w/postwalk #(if (number? %) (inc %) %) {:a 1 :b 2}))))
(testing "postwalk on empty collections"
(is (= [] (w/postwalk identity [])))
(is (= {} (w/postwalk identity {})))
(is (= #{} (w/postwalk identity #{})))
(is (= '() (w/postwalk identity '())))))
(deftest test-prewalk
(testing "prewalk with numbers"
(is (= [2 3 4] (w/prewalk #(if (number? %) (inc %) %) [1 2 3]))))
(testing "prewalk with nested structures"
(is (= [2 [3 4] 5]
(w/prewalk #(if (number? %) (inc %) %) [1 [2 3] 4]))))
(testing "prewalk transforms before descending"
;; prewalk applies f to the outer form first, so we can replace
;; entire subtrees before they are walked
(is (= [:replaced]
(w/prewalk #(if (= % [1 2 3]) [:replaced] %) [1 2 3])))))
(deftest test-keywordize-keys
(testing "basic keywordize"
(is (= {:a 1 :b 2} (w/keywordize-keys {"a" 1 "b" 2}))))
(testing "nested keywordize"
(is (= {:a {:b 2}} (w/keywordize-keys {"a" {"b" 2}}))))
(testing "non-string keys unchanged"
(is (= {:a 1 42 2} (w/keywordize-keys {"a" 1 42 2}))))
(testing "already keyword keys unchanged"
(is (= {:a 1} (w/keywordize-keys {:a 1})))))
(deftest test-stringify-keys
(testing "basic stringify"
(is (= {"a" 1 "b" 2} (w/stringify-keys {:a 1 :b 2}))))
(testing "nested stringify"
(is (= {"a" {"b" 2}} (w/stringify-keys {:a {:b 2}}))))
(testing "non-keyword keys unchanged"
(is (= {"a" 1 42 2} (w/stringify-keys {:a 1 42 2})))))
(deftest test-postwalk-replace
(testing "basic replacement"
(is (= [:x :y :c] (w/postwalk-replace {:a :x :b :y} [:a :b :c]))))
(testing "nested replacement"
(is (= [:x [:y :c]] (w/postwalk-replace {:a :x :b :y} [:a [:b :c]]))))
(testing "no matches"
(is (= [1 2 3] (w/postwalk-replace {:a :x} [1 2 3]))))
(testing "empty smap"
(is (= [1 2 3] (w/postwalk-replace {} [1 2 3])))))
(deftest test-prewalk-replace
(testing "basic replacement"
(is (= [:x :y :c] (w/prewalk-replace {:a :x :b :y} [:a :b :c]))))
(testing "nested replacement"
(is (= [:x [:y :c]] (w/prewalk-replace {:a :x :b :y} [:a [:b :c]]))))
(testing "replaces before descending"
;; prewalk-replace replaces the whole form first, then walks children
(is (= :replaced (w/prewalk-replace {[:a :b] :replaced} [:a :b])))))

122
test/clojure-stdlib/clojure/zip_test/zip.cljc Normal file
View file

@ -0,0 +1,122 @@
(ns clojure.zip-test.zip
(:require [clojure.test :refer [deftest is testing run-tests]]
[clojure.zip :as zip]))
(deftest test-vector-zip-navigation
(let [data [[1 2] [3 [4 5]]]
z (zip/vector-zip data)]
(testing "root node"
(is (= (zip/node z) [[1 2] [3 [4 5]]]))
(is (zip/branch? z)))
(testing "down"
(is (= (zip/node (zip/down z)) [1 2])))
(testing "right"
(is (= (zip/node (zip/right (zip/down z))) [3 [4 5]])))
(testing "down into nested"
(is (= (zip/node (zip/down (zip/right (zip/down z)))) 3)))
(testing "up returns parent"
(is (= (zip/node (zip/up (zip/down z))) [[1 2] [3 [4 5]]])))
(testing "rights"
(is (= (zip/rights (zip/down z)) '([3 [4 5]]))))
(testing "lefts"
(is (= (zip/lefts (zip/right (zip/down z))) [[1 2]])))))
(deftest test-vector-zip-rightmost-leftmost
(let [z (zip/vector-zip [1 2 3])]
(testing "rightmost"
(is (= (zip/node (zip/rightmost (zip/down z))) 3)))
(testing "leftmost"
(is (= (zip/node (zip/leftmost (zip/rightmost (zip/down z)))) 1)))))
(deftest test-seq-zip-navigation
(let [z (zip/seq-zip '(1 (2 3) 4))]
(testing "root"
(is (= (zip/node z) '(1 (2 3) 4))))
(testing "down"
(is (= (zip/node (zip/down z)) 1)))
(testing "right"
(is (= (zip/node (zip/right (zip/down z))) '(2 3))))
(testing "down into nested list"
(is (= (zip/node (zip/down (zip/right (zip/down z)))) 2)))))
(deftest test-path
(let [z (zip/vector-zip [[1 2] [3 4]])]
(testing "path at root is nil"
(is (nil? (zip/path z))))
(testing "path one level down"
(is (= (zip/path (zip/down z)) [[[1 2] [3 4]]])))
(testing "path two levels down"
(is (= (zip/path (zip/down (zip/down z)))
[[[1 2] [3 4]] [1 2]])))))
(deftest test-edit
(let [z (zip/vector-zip [1 [2 3] [4 5]])]
(testing "edit a leaf"
(let [loc (-> z zip/down zip/right zip/down)
edited (zip/edit loc inc)]
(is (= (zip/root edited) [1 [3 3] [4 5]]))))
(testing "edit a branch"
(let [loc (-> z zip/down zip/right)
edited (zip/edit loc (fn [x] (vec (map inc x))))]
(is (= (zip/root edited) [1 [3 4] [4 5]]))))))
(deftest test-replace
(let [z (zip/vector-zip '[a b c])]
(is (= (zip/root (zip/replace (zip/down z) 'x))
'[x b c]))))
(deftest test-insert-left-right
(let [z (zip/vector-zip [1 2 3])
loc (-> z zip/down zip/right)]
(testing "insert-left"
(is (= (zip/root (zip/insert-left loc 'x)) [1 'x 2 3])))
(testing "insert-right"
(is (= (zip/root (zip/insert-right loc 'y)) [1 2 'y 3])))))
(deftest test-insert-child-append-child
(let [z (zip/vector-zip [1 2 3])]
(testing "insert-child"
(is (= (zip/root (zip/insert-child z 0)) [0 1 2 3])))
(testing "append-child"
(is (= (zip/root (zip/append-child z 4)) [1 2 3 4])))))
(deftest test-remove
(let [z (zip/vector-zip [1 2 3])
loc (-> z zip/down zip/right)]
(is (= (zip/root (zip/remove loc)) [1 3]))))
(deftest test-next-traversal
(let [z (zip/vector-zip [1 [2 3]])]
(testing "next enumerates depth-first"
(is (= (loop [loc z, acc []]
(if (zip/end? loc)
acc
(recur (zip/next loc) (conj acc (zip/node loc)))))
[[1 [2 3]] 1 [2 3] 2 3])))))
(deftest test-end?
(let [z (zip/vector-zip [1 2])]
(testing "not end at start"
(is (not (zip/end? z))))
(testing "end after full traversal"
(is (zip/end? (-> z zip/next zip/next zip/next))))))
(deftest test-prev
(let [z (zip/vector-zip [1 [2 3]])]
(testing "prev from second child"
(let [loc (-> z zip/next zip/next)]
(is (= (zip/node loc) [2 3]))
(is (= (zip/node (zip/prev loc)) 1))))
(testing "prev from leaf inside nested"
(let [loc (-> z zip/next zip/next zip/next)]
(is (= (zip/node loc) 2))
(is (= (zip/node (zip/prev loc)) [2 3]))))))
(deftest test-root-after-edits
(testing "root unwinds all the way after deep edits"
(let [z (zip/vector-zip [[1 2] [3 [4 5]]])
loc (-> z zip/down zip/right zip/down zip/right zip/down)
edited (zip/edit loc inc)]
(is (= (zip/root edited) [[1 2] [3 [5 5]]])))))
(run-tests)

43
test/integration/aot-test.janet Normal file
View 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
View 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
View 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"))

48
test/integration/clojure-test-suite-test.janet
View file

@ -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 @[])))

38
test/integration/compile-mode-test.janet
View file

@ -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!")

124
test/integration/conformance-test.janet
View file

@ -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
View 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
View 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
View 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
View 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
View 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)"))

22
test/integration/suite-worker.janet
View file

@ -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)"))

25
test/spec/control-flow-spec.janet
View file

@ -44,6 +44,22 @@
["if-some zero" "1" "(if-some [x 0] (inc x) :none)"]
["when-some nil" "nil" "(when-some [x nil] x)"])
# Regression: if-let/when-let/if-some/when-some bind the name ONLY in the
# then/body branch. The else branch (and a falsy when-let body, which there is
# none of) must see the surrounding scope, not the binding — so the else of
# (let [x 5] (if-let [x nil] ...)) sees x=5, like Clojure. (Previously the macros
# wrapped the whole `if` in the binding's let*, leaking it into the else.)
(defspec "control / conditional-binding scope"
["if-let else sees outer" "5" "(let [x 5] (if-let [x nil] :then x))"]
["if-let then binds" "7" "(let [x 5] (if-let [x 7] x :else))"]
["if-some else sees outer" "5" "(let [x 5] (if-some [x nil] :then x))"]
["if-some binds false" "false" "(if-some [x false] x :else)"]
["when-let else via or" "5" "(let [x 5] (or (when-let [x nil] x) x))"]
["when-let multi-form body" "14" "(when-let [x 7] (inc x) (* x 2))"]
["if-let in fn param" "9" "((fn [xs] (if-let [xs nil] :then xs)) 9)"]
["when-some binds zero" "1" "(when-some [x 0] (inc x))"]
["if-let evals test once" "1" "(let [c (atom 0)] (if-let [v (do (swap! c inc) :v)] @c :none))"])
(defspec "control / iteration"
["dotimes side-effect" "5" "(let [a (atom 0)] (dotimes [i 5] (swap! a inc)) @a)"]
["while" "5" "(let [a (atom 0)] (while (< @a 5) (swap! a inc)) @a)"]
@ -52,8 +68,15 @@
["for :when" "[0 2 4]" "(for [x (range 6) :when (even? x)] x)"]
["for :while" "[0 1 2]" "(for [x (range 10) :while (< x 3)] x)"]
["for :let" "[0 1 4]" "(for [x (range 3) :let [sq (* x x)]] sq)"]
["for :let+:when" "[4 6 8]" "(for [x (range 5) :let [y (* x 2)] :when (> y 3)] y)"]
["for multi :when" "[[1 :a] [1 :b]]" "(for [x [0 1] :when (odd? x) y [:a :b]] [x y])"]
["for destructure" "[3 7]" "(for [[a b] [[1 2] [3 4]]] (+ a b))"]
["doseq side-effect" "6" "(let [a (atom 0)] (doseq [x [1 2 3]] (swap! a (fn [v] (+ v x)))) @a)"]
["doseq nested" "4" "(let [c (atom 0)] (doseq [x [1 2] y [10 20]] (swap! c inc)) @c)"])
["doseq nested" "4" "(let [c (atom 0)] (doseq [x [1 2] y [10 20]] (swap! c inc)) @c)"]
["doseq :when" "[1 3]" "(let [a (atom [])] (doseq [x [1 2 3] :when (odd? x)] (swap! a conj x)) @a)"]
["doseq :while" "6" "(let [a (atom 0)] (doseq [x (range 10) :while (< x 4)] (swap! a + x)) @a)"]
["doseq :let" "[0 1 4]" "(let [a (atom [])] (doseq [x (range 3) :let [sq (* x x)]] (swap! a conj sq)) @a)"]
["doseq returns nil" "nil" "(doseq [x [1 2 3]] x)"])
(defspec "control / threading"
["->" "6" "(-> 1 inc (+ 4))"]

14
test/spec/destructuring-spec.janet
View file

@ -35,7 +35,10 @@
[":strs" "7" "(let [{:strs [a]} {\"a\" 7}] a)"]
[":syms" "8" "(let [{:syms [a]} {(quote a) 8}] a)"]
["namespaced :keys" "3" "(let [{:keys [x/y]} {:x/y 3}] y)"]
["namespaced :syms" "4" "(let [{:syms [p/q]} {(quote p/q) 4}] q)"])
["namespaced :syms" "4" "(let [{:syms [p/q]} {(quote p/q) 4}] q)"]
# :keys also accepts keyword elements ({:keys [:a :b]}), binding bare locals.
["keyword :keys" "3" "(let [{:keys [:a :b]} {:a 1 :b 2}] (+ a b))"]
["keyword :keys ns" "3" "(let [{:keys [:x/y]} {:x/y 3}] y)"])
(defspec "destructure / keyword args (& {:keys})"
["fn kwargs" "[1 2]" "(do (defn f [& {:keys [a b]}] [a b]) (f :a 1 :b 2))"]
@ -43,6 +46,15 @@
["fn kwargs :or" "9" "(do (defn h [& {:keys [a] :or {a 9}}] a) (h))"]
["fn kwargs trailing map" "7" "(do (defn k [& {:keys [a]}] a) (k {:a 7}))"])
(defspec "destructure / fn params & loop"
["fn vector param" "7" "((fn [[a b]] (+ a b)) [3 4])"]
["fn map param" "30" "((fn [{:keys [x y]}] (* x y)) {:x 5 :y 6})"]
["fn :or param" "7" "((fn [{:keys [x] :or {x 7}}] x) {})"]
["fn multi-arity destr" "15" "((fn ([[a]] a) ([[a] b] (+ a b))) [10] 5)"]
["loop vector binding" "[4 2]" "(loop [[a b] [1 2] n 0] (if (< n 3) (recur [(inc a) b] (inc n)) [a b]))"]
["loop map binding" "4" "(loop [{:keys [v]} {:v 1} n 0] (if (< n 2) (recur {:v (* v 2)} (inc n)) v))"]
["loop init sees destr" "[1 2 3]" "(loop [[a b] [1 2] c (+ a b)] [a b c])"])
(defspec "destructure / macro params"
["macro & [a & more :as all]"
"[1 [2 3] [1 2 3]]"

5
test/spec/exceptions-spec.janet
View file

@ -35,4 +35,7 @@
["catch binds thrown value" "42"
"(try (throw 42) (catch :default e e))"]
["rethrow preserves ex" "\"inner\""
"(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"])
"(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"]
["ex-data on non-ex" "nil" "(ex-data 42)"]
["ex-cause on non-ex" "nil" "(ex-cause {:k 1})"]
["ex-message of string" "\"hi\"" "(ex-message \"hi\")"])

7
test/spec/host-interop-spec.janet
View file

@ -31,3 +31,10 @@
["janet-type string" ":string" "(do (require (quote [jolt.interop :as j])) (j/janet-type \"x\"))"]
["janet-type number" ":number" "(do (require (quote [jolt.interop :as j])) (j/janet-type 1))"]
["janet-type keyword" ":keyword" "(do (require (quote [jolt.interop :as j])) (j/janet-type :a))"])
(defspec "interop / arrays (aget/aset/alength)"
["alength" "3" "(alength (object-array [1 2 3]))"]
["aget" "20" "(aget (object-array [10 20 30]) 1)"]
["aset returns val" "9" "(aset (object-array [1 2 3]) 1 9)"]
["aset mutates" "[7 2 3]" "(let [a (object-array [1 2 3])] (aset a 0 7) (vec a))"]
["aget 2d" "4" "(aget (to-array-2d [[1 2] [3 4]]) 1 1)"])

47
test/spec/macros-spec.janet
View file

@ -25,3 +25,50 @@
"(= (gensym) (gensym))"]
["gensym# in template" "true"
"(do (defmacro m [] `(let [x# 1] x#)) (= 1 (m)))"])
# Core macros ported from Janet to the Clojure overlay (jolt-1j0 phase 3,
# jolt-core/clojure/core/30-macros.clj).
(defspec "macros / core-overlay"
["if-not true branch" ":then" "(if-not false :then :else)"]
["if-not else branch" ":else" "(if-not true :then :else)"]
["if-not no else" "nil" "(if-not true :then)"]
["if-not no else hit" ":then" "(if-not false :then)"]
["comment -> nil" "nil" "(comment a b c)"]
["comment in do" "42" "(do (comment ignored) 42)"]
["if-let then" "6" "(if-let [x 5] (inc x) :none)"]
["if-let else" ":none" "(if-let [x nil] (inc x) :none)"]
["if-let else scope" "9" "(let [x 9] (if-let [x nil] :t x))"]
["if-some zero" "1" "(if-some [x 0] (inc x) :none)"]
["if-some nil" ":none" "(if-some [x nil] x :none)"]
["when-some multi" "14" "(when-some [x 7] (inc x) (* x 2))"]
["when-some nil" "nil" "(when-some [x nil] x)"]
["while loop" "3" "(let [a (atom 0)] (while (< @a 3) (swap! a inc)) @a)"]
["dotimes sum" "10" "(let [a (atom 0)] (dotimes [i 5] (swap! a + i)) @a)"]
["as-> threads" "12" "(as-> 5 x (+ x 1) (* x 2))"]
["as-> no forms" "5" "(as-> 5 x)"]
["some-> through" "6" "(some-> {:a {:b 5}} :a :b inc)"]
["some-> short-circuit" "nil" "(some-> {:a nil} :a :b)"]
["some->> through" "9" "(some->> [1 2 3] (map inc) (reduce +))"]
["some->> nil" "nil" "(some->> nil (map inc))"]
["doto returns obj" "[1 2]" "(deref (doto (atom []) (swap! conj 1) (swap! conj 2)))"]
["when-first" "20" "(when-first [x [10 20 30]] (* x 2))"]
["when-first empty" "nil" "(when-first [x []] :body)"]
["when-first nil coll" "nil" "(when-first [x nil] :body)"]
["when-first range" "0" "(when-first [x (range 5)] x)"]
["cond->> threads" "12" "(cond->> 5 true (+ 1) false (* 100) true (* 2))"]
["cond->> skip" "10" "(cond->> 10 false (+ 1))"]
["assert pass" ":ok" "(do (assert (= 1 1)) :ok)"]
["assert throws" ":threw" "(try (assert (= 1 2)) (catch :default e :threw))"]
["assert message" "\"nope\"" "(try (assert false \"nope\") (catch :default e (ex-message e)))"]
["delay value" "42" "(deref (delay 42))"]
["delay forces once" "1" "(let [c (atom 0) d (delay (swap! c inc))] @d @d @c)"]
["future deref" "9" "(deref (future (* 3 3)))"]
["letfn simple" "25" "(letfn [(sq [x] (* x x))] (sq 5))"]
["letfn mutual" "true" "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 8))"]
["condp match" ":two" "(condp = 2 1 :one 2 :two 3 :three)"]
["condp default" ":else" "(condp = 9 1 :one 2 :two :else)"]
["condp :>> form" "\"got 2\"" "(condp some [1 2 3] #{0 9} :>> (fn [x] (str \"got \" x)) #{2 6} :>> (fn [x] (str \"got \" x)))"]
["condp no match" ":threw" "(try (condp = 9 1 :one) (catch :default e :threw))"]
["binding rebinds" "99" "(do (def ^:dynamic *bx* 10) (binding [*bx* 99] *bx*))"]
["binding restores" "10" "(do (def ^:dynamic *by* 10) (binding [*by* 99] *by*) *by*)"]
["binding seen by fn" "7" "(do (def ^:dynamic *bz* 0) (defn rdz [] *bz*) (binding [*bz* 7] (rdz)))"])

29
test/spec/maps-spec.janet
View file

@ -115,3 +115,32 @@
["subvec float trunc" "[0]" "(subvec [0 1 2] 0.5 1.33)"]
["subvec NaN start" "[0 1 2]" "(subvec [0 1 2] ##NaN 3)"]
["subvec NaN end" "[]" "(subvec [0 1 2] 0 ##NaN)"])
# A nil value is a PRESENT key in Clojure (distinct from a missing key); Janet
# structs drop nil, so jolt builds these maps as a phm. Tested via literals (the
# reader path) and the construction/op surface, in every spec mode.
(defspec "map / nil values preserved"
["literal contains" "true" "(contains? {:b nil} :b)"]
["literal not= empty" "false" "(= {:b nil} {})"]
["literal get nil" "nil" "(get {:b nil} :b :x)"]
["literal keys incl nil" "true" "(= #{:a :b} (set (keys {:a nil :b 1})))"]
["literal count" "2" "(count {:a nil :b 1})"]
["literal vals incl nil" "2" "(count (vals {:a nil :b 1}))"]
["eval values w/ nil" "3" "(:a {:a (+ 1 2) :b nil})"]
["nil key present" "true" "(contains? {nil :v} nil)"]
["assoc nil present" "true" "(contains? (assoc {:a 1} :b nil) :b)"]
["assoc nil get" "nil" "(get (assoc {:a 1} :b nil) :b :x)"]
["assoc overwrite nil" "nil" "(get (assoc {:a 1} :a nil) :a :x)"]
["hash-map nil" "true" "(contains? (hash-map :b nil) :b)"]
["merge new nil" "true" "(contains? (merge {:a 1} {:b nil}) :b)"]
["merge overwrite nil" "nil" "(get (merge {:a 1} {:a nil}) :a :x)"]
["merge-with present nil" "true" "(= [nil 1] (get (merge-with (fn [a b] [a b]) {:a nil} {:a 1}) :a))"]
["into nil val" "true" "(contains? (into {} [[:a nil]]) :a)"]
["conj map nil" "true" "(contains? (conj {:x 1} {:a nil}) :a)"]
["zipmap nil" "true" "(contains? (zipmap [:a] [nil]) :a)"]
["select-keys nil" "true" "(contains? (select-keys {:a nil} [:a]) :a)"]
["get-in present nil" "nil" "(get-in {:a nil} [:a] :x)"]
["get-in through nil" ":x" "(get-in {:a nil} [:a :b] :x)"]
["dissoc keeps nil" "true" "(contains? (dissoc {:a nil :b 1} :b) :a)"]
["reduce-kv sees nil" "true" "(= #{:a :b} (reduce-kv (fn [acc k v] (conj acc k)) #{} {:a nil :b 2}))"]
["nil-free stays fast" "true" "(= {:a 1 :b 2} {:b 2 :a 1})"])

4
test/spec/metadata-spec.janet
View file

@ -7,8 +7,10 @@
["with-meta preserves value" "true" "(= [1 2 3] (with-meta [1 2 3] {:a 1}))"]
["with-meta on map" "{:doc \"x\"}" "(meta (with-meta {:k 1} {:doc \"x\"}))"]
["vary-meta" "{:a 2}" "(meta (vary-meta (with-meta [1] {:a 1}) update :a inc))"]
["vary-meta extra args" "{:a 1 :b 2}" "(meta (vary-meta (with-meta [1] {:a 1}) assoc :b 2))"]
["meta reader ^" "{:tag :int}" "(meta ^{:tag :int} [1 2])"]
["with-meta on fn ok" "true" "(fn? (with-meta inc {:a 1}))"])
["with-meta on fn ok" "true" "(fn? (with-meta inc {:a 1}))"]
["with-meta nil clears" "nil" "(meta (with-meta [1 2 3] nil))"])
(defspec "metadata / type hints"
# ^Type / ^:kw / ^"str" on a symbol attach as metadata and are otherwise inert:

44
test/spec/predicates-spec.janet
View file

@ -59,6 +59,50 @@
["symbol constructor" "(quote x)" "(symbol \"x\")"]
["name of string" "\"s\"" "(name \"s\")"])
# Predicates moved from Janet to the Clojure overlay (jolt-1j0). Jolt has no
# ratio/bigdecimal types (so ratio?/decimal? are always false, rational?=int?),
# and no distinct host object/undefined types (object?/undefined? always false).
(defspec "predicates / overlay-migrated"
["not-any? true" "true" "(not-any? even? [1 3 5])"]
["not-any? false" "false" "(not-any? even? [1 2 3])"]
["not-every? true" "true" "(not-every? even? [2 4 5])"]
["not-every? false" "false" "(not-every? even? [2 4 6])"]
["ident? number" "false" "(ident? 1)"]
["qualified-ident?" "true" "(qualified-ident? :a/b)"]
["qualified-ident? no" "false" "(qualified-ident? :a)"]
["simple-ident?" "true" "(simple-ident? :a)"]
["ratio?" "false" "(ratio? 3)"]
["decimal?" "false" "(decimal? 3)"]
["rational? int" "true" "(rational? 3)"]
["rational? float" "false" "(rational? 3.5)"]
["nat-int? zero" "true" "(nat-int? 0)"]
["nat-int? neg" "false" "(nat-int? -1)"]
["pos-int?" "true" "(pos-int? 5)"]
["neg-int?" "true" "(neg-int? -3)"]
["NaN? on nan" "true" "(NaN? (/ 0.0 0.0))"]
["NaN? on number" "false" "(NaN? 5)"]
["abs negative" "3" "(abs -3)"]
["abs positive" "2.5" "(abs 2.5)"]
["object?" "false" "(object? 1)"]
["undefined?" "false" "(undefined? 1)"]
["keyword-identical?" "true" "(keyword-identical? :a :a)"]
["keyword-identical? no" "false" "(keyword-identical? :a :b)"])
# Tagged-value predicates moved to the overlay in Phase 4 (read the value's
# :jolt/type via get). The constructors stay native.
(defspec "predicates / tagged-value (Phase 4)"
["atom? yes" "true" "(atom? (atom 1))"]
["atom? no" "false" "(atom? 1)"]
["volatile? yes" "true" "(volatile? (volatile! 1))"]
["volatile? no" "false" "(volatile? (atom 1))"]
["record? yes" "true" "(do (defrecord Rp [a]) (record? (->Rp 1)))"]
["record? no map" "false" "(record? {:a 1})"]
["record? no nil" "false" "(record? nil)"]
["tagged-literal? yes" "true" "(tagged-literal? (tagged-literal (quote inst) \"2020\"))"]
["tagged-literal? no" "false" "(tagged-literal? 1)"]
["reader-conditional? no" "false" "(reader-conditional? 1)"]
["chunked-seq? always false" "false" "(chunked-seq? (seq [1 2 3]))"])
(defspec "predicates / equality & identity"
["= same" "true" "(= 1 1)"]
["= vectors" "true" "(= [1 2] [1 2])"]

64
test/spec/sequences-spec.janet
View file

@ -43,6 +43,14 @@
["map" "[2 3 4]" "(map inc [1 2 3])"]
["map two colls" "[5 7 9]" "(map + [1 2 3] [4 5 6])"]
["map stops at shortest" "[5 7]" "(map + [1 2] [4 5 6])"]
# nil elements are values, not end-of-seq: multi-coll map must not truncate.
["map keeps nil elements" "[[1 :a] [nil :b] [3 nil]]" "(map vector [1 nil 3] [:a :b nil])"]
["map 3 colls" "[12 15 18]" "(map + [1 2 3] [4 5 6] [7 8 9])"]
["map 3 colls shortest" "[12 15]" "(map + [1 2] [4 5 6] [7 8 9])"]
["map 4 colls" "[16 20]" "(map + [1 2] [3 4] [5 6] [7 8])"]
["map 3 colls nils" "[[1 :a 10] [nil :b 20] [3 nil 30]]" "(map vector [1 nil 3] [:a :b nil] [10 20 30])"]
["map empty coll" "()" "(map + [] [1 2 3] [4 5 6])"]
["map lazy+concrete" "[11 22 33]" "(map + (map identity [1 2 3]) [10 20 30])"]
["map-indexed" "[[0 :a] [1 :b]]" "(map-indexed vector [:a :b])"]
["mapv" "[2 3 4]" "(mapv inc [1 2 3])"]
["filter" "[2 4]" "(filter even? [1 2 3 4])"]
@ -54,8 +62,15 @@
["reduce single no init" "5" "(reduce + [5])"]
["reduced short-circuits" "3" "(reduce (fn [a x] (if (> a 2) (reduced a) (+ a x))) 0 [1 2 3 4 5])"]
["reduce-kv" "6" "(reduce-kv (fn [a k v] (+ a v)) 0 {:a 1 :b 2 :c 3})"]
["reduce-kv on vector" "[[0 :a] [1 :b]]" "(reduce-kv (fn [a i v] (conj a [i v])) [] [:a :b])"]
["reduce-kv honors reduced" "[:a]" "(reduce-kv (fn [a i v] (if (= i 1) (reduced a) (conj a v))) [] [:a :b :c])"]
["reduce-kv on nil" "0" "(reduce-kv (fn [a k v] (+ a v)) 0 nil)"]
["reductions" "[1 3 6]" "(reductions + [1 2 3])"]
["mapcat" "[1 1 2 2]" "(mapcat (fn [x] [x x]) [1 2])"]
["mapcat two colls" "[1 3 2 4]" "(mapcat vector [1 2] [3 4])"]
["mapcat three colls" "[1 2 3]" "(mapcat vector [1] [2] [3])"]
["mapcat empty coll" "()" "(mapcat vector [] [1 2] [3 4])"]
["mapcat seqs" "[1 2 3 4]" "(mapcat identity [[1 2] [3 4]])"]
["keep" "[1 3]" "(keep (fn [x] (if (odd? x) x nil)) [1 2 3 4])"]
["some truthy" "true" "(some even? [1 2 3])"]
["some nil" "nil" "(some even? [1 3 5])"]
@ -197,3 +212,52 @@
["nthnext nil count" :throws "(nthnext [0 1 2] nil)"]
["update vec oob" :throws "(update [] 1 identity)"]
["update vec kw key" :throws "(update [1 2 3] :k identity)"])
# Regression cases for clojure.core fns moved from Janet to the Clojure overlay
# (jolt-1j0), plus two bugs fixed in the process: nthrest returns () (not nil)
# for an exhausted n>0 walk, and distinct? compares by VALUE (equal collections
# are not distinct).
(defspec "seq / overlay-migrated fns"
["nthrest exhausted -> ()" "()" "(nthrest nil 100)"]
["nthrest vec exhausted" "()" "(nthrest [1 2 3] 100)"]
["nthrest n<=0 keeps coll" "[1 2 3]" "(nthrest [1 2 3] 0)"]
["nthrest drops n" "[3 4 5]" "(nthrest [1 2 3 4 5] 2)"]
["nthnext exhausted -> nil" "nil" "(nthnext [1 2] 5)"]
["nthnext surprising nil" "nil" "(nthnext nil nil)"]
["nthnext drops n" "[3 4]" "(nthnext [1 2 3 4] 2)"]
["distinct? distinct" "true" "(distinct? 1 2 3)"]
["distinct? dup" "false" "(distinct? 1 2 1)"]
["distinct? equal colls" "false" "(distinct? [1 2] [1 2])"]
["distinct? single" "true" "(distinct? 5)"]
["replace maps elements" "[:a 2 :c 2]" "(replace {1 :a 3 :c} [1 2 3 2])"]
["replace preserves nil val" "[1 nil 3]" "(replace {2 nil} [1 2 3])"]
["take-last" "[3 4]" "(take-last 2 [1 2 3 4])"]
["take-last empty -> nil" "nil" "(take-last 2 [])"]
["take-last n>len" "[1 2]" "(take-last 9 [1 2])"]
["drop-last default 1" "[1 2]" "(drop-last [1 2 3])"]
["drop-last n" "[1 2]" "(drop-last 2 [1 2 3 4])"]
["split-with" "[[2 4] [5 6]]" "(split-with even? [2 4 5 6])"]
["replicate" "[:x :x :x]" "(replicate 3 :x)"]
["bounded-count" "3" "(bounded-count 3 [1 2 3 4 5])"]
["run! side effects" "6" "(let [a (atom 0)] (run! (fn [x] (swap! a + x)) [1 2 3]) @a)"]
["completing wraps rf" "3" "((completing +) 1 2)"]
["comparator <" "[1 2 3]" "(sort (comparator <) [3 1 2])"]
["comparator >" "[3 2 1]" "(sort (comparator >) [3 1 2])"]
["reductions" "[1 3 6 10]" "(reductions + [1 2 3 4])"]
["reductions with init" "[10 11 13 16]" "(reductions + 10 [1 2 3])"]
["reductions empty calls f" "[0]" "(reductions + [])"]
["reductions empty + init" "[5]" "(reductions + 5 [])"]
["tree-seq pre-order" "[[1 [2] 3] 1 [2] 2 3]" "(tree-seq sequential? seq [1 [2] 3])"]
["some found" "true" "(some even? [1 3 4])"]
["some none -> nil" "nil" "(some even? [1 3 5])"]
["some keyword pred" "7" "(some :a [{:b 1} {:a 7}])"]
["some returns value" "4" "(some (fn [x] (when (even? x) x)) [1 3 4 5])"]
["flatten nested" "[1 2 3 4 5]" "(flatten [1 [2 [3 4]] 5])"]
["flatten lists too" "[1 2 3]" "(flatten [1 (list 2 3)])"]
["flatten scalar -> empty" "[]" "(flatten 5)"]
["interleave" "[1 :a 2 :b]" "(interleave [1 2 3] [:a :b])"]
["interleave empty" "[]" "(interleave)"]
["rationalize identity" "5" "(rationalize 5)"]
["dedupe consecutive" "[1 2 3 1]" "(dedupe [1 1 2 2 3 1 1])"]
["dedupe empty" "[]" "(dedupe [])"]
["dedupe no dups" "[1 2 3]" "(dedupe [1 2 3])"])

5
test/spec/strings-spec.janet
View file

@ -48,3 +48,8 @@
["subs end past len" :throws "(subs \"abcde\" 1 6)"]
["subs nil start" :throws "(subs \"abcde\" nil 2)"]
["subs on nil" :throws "(subs nil 1 2)"])
(defspec "string / namespace-munge"
["hyphens to underscores" "\"a_b_c\"" "(namespace-munge \"a-b-c\")"]
["from a symbol" "\"foo_bar\"" "(namespace-munge (quote foo-bar))"]
["no hyphens unchanged" "\"ok\"" "(namespace-munge \"ok\")"])

7
test/spec/vectors-spec.janet
View file

@ -24,7 +24,12 @@
["count" "3" "(count [1 2 3])"]
["contains? index" "true" "(contains? [:a :b] 1)"]
["contains? past end" "false" "(contains? [:a] 3)"]
["vector as fn" ":b" "([:a :b :c] 1)"])
["vector as fn" ":b" "([:a :b :c] 1)"]
# An IFn collection held in a binding (not just a literal) must dispatch as IFn,
# not as a host call: applies to vectors, keywords, and meta-bearing vectors.
["vector-in-local as fn" "20" "(let [v [10 20 30]] (v 1))"]
["keyword-in-local as fn" "7" "(let [k :a] (k {:a 7}))"]
["meta vector as fn" "10" "((with-meta [10 20] {:k 1}) 0)"])
(defspec "vector / update (persistent)"
["conj appends" "[1 2 3]" "(conj [1 2] 3)"]

16
test/support/lazy-eval.janet Normal file
View file

@ -0,0 +1,16 @@
# Worker: evaluate a Clojure equality check in a fresh Jolt ctx and print
# @@RESULT true or @@RESULT false. Used by lazy-infinite-test under a wall-clock
# deadline so infinite-seq hangs are caught as test failures.
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(def expected (get (dyn :args) 1))
(def actual (get (dyn :args) 2))
(when (and expected actual)
(def ctx (init {}))
(def prog (string "(= " expected " " actual ")"))
(def [ok val] (protect (eval-string ctx prog)))
(if ok
(printf "@@RESULT %q" val)
(printf "@@ERROR %q" val)))

15
test/unit/types-test.janet
View file

@ -40,6 +40,21 @@
(assert (deep= {:name 'x :private true} (var-meta v2)) "with-meta merges meta")
(assert (= 42 (var-get v2)) "with-meta preserves root binding"))
# generation counter — bumps on every root change (substrate for direct-link
# staleness detection and redefinition-aware dispatch caches)
(let [v (make-var 'g 1)]
(assert (= 0 (v :gen)) "fresh var starts at generation 0")
(bind-root v 2)
(assert (= 1 (v :gen)) "bind-root bumps generation")
(var-set v 3)
(assert (= 2 (v :gen)) "var-set (root) bumps generation")
(alter-var-root v inc)
(assert (= 3 (v :gen)) "alter-var-root bumps generation")
(assert (= 4 (var-get v)) "value still tracks through gen bumps"))
(let [v (make-var 'g 1)
v2 (with-meta v {:doc "x"})]
(assert (= (v :gen) (v2 :gen)) "with-meta carries generation"))
# var with namespace
(let [ns (make-ns 'my.ns)
v (make-var 'my.ns/x 1 {:ns ns})]