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

Delete the Janet host — Chez is the sole substrate

Browse source 
Remove the Janet seed (src/jolt/*.janet: reader, value layer, vars/ns, the
tree-walking interpreter, the Janet backend, the optimizing compiler), the
Janet->Scheme cross-compiler (host/chez/{driver,emit,jolt-chez}.janet),
bin/jolt-chez, the jpm build (project.janet) and the Janet test runner
(run-tests.janet), plus the entire Janet test suite. jolt now builds and runs
on Chez alone: bin/joltc off the checked-in seed, bootstrap.ss to rebuild it.

The portable Clojure stays: jolt-core/**, host/chez/**.ss, and the stdlib +
tooling under src/jolt/clojure + src/jolt/jolt (read by the seed build, no
Janet). The gate is 'make test' (self-host, corpus, unit, cli smoke, certify).
Drop the sci and clojure-test-suite submodules (used only by deleted Janet
integration tests); irregex stays.

Filesystem corpus/unit cases that probed project.janet now probe README.md.

jolt-cf1q.6
This commit is contained in:
Yogthos 2026-06-21 11:29:03 -04:00
parent 5c1fdfc336
commit 58d03d67be
221 changed files with 16 additions and 29925 deletions
Download patch file Download diff file Expand all files Collapse all files

49
test/chez/_atomwatch.janet
View file

@ -1,49 +0,0 @@
# jolt-mn9o — atom watches + validators on Chez. The Chez atom record carries
# watches (alist) + validator slots; swap!/reset! validate-then-set-then-notify;
# add-watch/remove-watch/set-validator!/get-validator are native (post-prelude.ss
# re-asserts them over the overlay's ref-put!-based versions).
#
# janet test/chez/_atomwatch.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
# [expr expected] — :throws asserts a non-zero exit (validator rejection); the
# exception message text is not compared.
(def cases
[["(let [a (atom 0) seen (atom 0)] (add-watch a :k (fn [k r o n] (reset! seen 1))) (reset! a 5) @seen)" "1"]
["(let [a (atom 0) seen (atom 0)] (add-watch a :k (fn [k r o n] (swap! seen inc))) (remove-watch a :k) (reset! a 5) @seen)" "0"]
["(let [a (atom 0) log (atom [])] (add-watch a :k (fn [k r o n] (swap! log conj [o n]))) (reset! a 1) (reset! a 2) @log)" "[[0 1] [1 2]]"]
["(let [a (atom 0)] (set-validator! a number?) (reset! a 5) @a)" "5"]
["(let [a (atom 5)] (set-validator! a pos?) (swap! a inc) @a)" "6"]
["(let [a (atom 0)] (set-validator! a number?) (fn? (get-validator a)))" "true"]
["(let [a (atom 0)] (nil? (get-validator a)))" "true"]
["(let [a (atom 0)] (set-validator! a pos?) (reset! a -1))" :throws]
["(let [a (atom 5)] (set-validator! a pos?) (swap! a (fn [_] -1)) @a)" :throws]
["(let [a (atom 0) c (atom 0)] (add-watch a :k (fn [k r o n] (swap! c inc))) (swap! a inc) (swap! a inc) @c)" "2"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(= expected :throws)
(if (not= code 0) (++ pass)
(array/push fails [expr (string "expected throw; exit " code)]))
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_atomwatch parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

59
test/chez/_class.janet
View file

@ -1,59 +0,0 @@
# jolt-13zk — bare class-name tokens + (class x) on Chez. A class name (String,
# Keyword, File...) evaluates to its JVM canonical-name STRING — the same value
# (class instance) returns — so (= String (class "x")) holds and a (defmethod m
# String ...) keys against a (class ...) dispatch. host-class.ss ports
# Scalar (class x) returns the JVM-style class-name symbol.
# Collection (class ...) is host-taxonomy-dependent and is NOT compared here.
#
# janet test/chez/_class.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- bare class tokens evaluate to canonical strings ---
["String" "java.lang.String"]
["Number" "java.lang.Number"]
["Keyword" "clojure.lang.Keyword"]
["File" "java.io.File"]
["Exception" "java.lang.Exception"]
["MapEntry" "clojure.lang.MapEntry"]
# --- (class x) on scalars matches core-class ---
["(class 1)" "java.lang.Number"]
["(class 1.5)" "java.lang.Number"]
["(class \"s\")" "java.lang.String"]
["(class :k)" "clojure.lang.Keyword"]
["(class true)" "java.lang.Boolean"]
["(class false)" "java.lang.Boolean"]
["(class nil)" ""]
# --- token <-> class equality ---
["(= String (class \"abc\"))" "true"]
["(= Number (class 7))" "true"]
["(= String (class 7))" "false"]
# --- defmulti dispatch on class ---
["(do (defmulti cm (fn [x] (class x))) (defmethod cm String [x] :str) (cm \"a\"))" ":str"]
["(do (defmulti cn (fn [x] (class x))) (defmethod cn nil [x] :nil) (defmethod cn String [x] :str) (cn nil))" ":nil"]
["(do (defmulti cn (fn [x] (class x))) (defmethod cn nil [x] :nil) (defmethod cn String [x] :str) (cn \"z\"))" ":str"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_class parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

68
test/chez/_dotform.janet
View file

@ -1,68 +0,0 @@
# jolt-kuic — the `.` special form + `.-field` field-access desugar on Chez. The
# analyzer lowers (. target member arg*) and (.-field target) to a :host-call;
# the Chez emit routes a non-shimmed :host-call through record-method-dispatch,
# which dot-forms.ss extends with field access + map/vector member dispatch.
# Each case carries its expected printed value.
#
# janet test/chez/_dotform.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# strings: method calls via the String surface
["(. \"HI\" toLowerCase)" "hi"]
["(. \"abc\" length)" "3"]
["(. \"abc\" toUpperCase)" "ABC"]
# vectors / maps: collection interop (count/nth/get/containsKey)
["(. [1 2 3] count)" "3"]
["(. [10 20 30] nth 1)" "20"]
["(. {:a 1 :b 2} count)" "2"]
["(. {:a 1 :b 2} get :b)" "2"]
["(. {:a 1} containsKey :a)" "true"]
["(. {:count 99} count)" "1"]
# map member: stored fn called with self (+ args), else field value
["(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" "v=41"]
["(. {:greet (fn [self n] (str \"Hello \" n))} greet \"Alice\")" "Hello Alice"]
["(. {:value 41} value)" "41"]
# field access via .-field head
["(.-value {:value 41})" "41"]
["(.-x {:x 7 :y 9})" "7"]
# field access via (. obj -field)
["(. {:value 41} -value)" "41"]
# records: .-field reads a field, .method dispatches the protocol method
["(do (defrecord Rf [x]) (.-x (->Rf 7)))" "7"]
["(do (defrecord Rg [a b]) (.-b (->Rg 1 2)))" "2"]
["(do (defprotocol Greet (hi [_])) (defrecord Rh [nm] Greet (hi [_] (str \"hi \" nm))) (. (->Rh \"x\") hi))" "hi x"]
# universal object-methods on a non-record map win over a field lookup
["(try (throw (ex-info \"bad\" {})) (catch Throwable e (.getMessage e)))" "bad"]
["(try (throw (ex-info \"bad\" {:k 1})) (catch Throwable e (.getMessage e)))" "bad"]
["(try (throw \"boom\") (catch Throwable e (.getMessage e)))" "boom"]
["(try (throw (Exception. \"boom\")) (catch Throwable e (.getMessage e)))" "boom"]
["(try (throw (IllegalArgumentException. \"bad\")) (catch Exception e (.getMessage e)))" "bad"]
["(.equals \"a\" \"a\")" "true"]
["(.equals \"a\" \"b\")" "false"]
["(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" "v=41"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_dotform parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

75
test/chez/_dynbind.janet
View file

@ -1,75 +0,0 @@
# jolt-2o7x — dynamic var binding (binding / with-bindings* / var-set /
# thread-bound? / with-local-vars / with-redefs / bound-fn* / get-thread-bindings).
# Expectations are the JVM-canonical values. TDD harness: bin/joltc
# -e per case, last non-empty line == expected.
#
# janet test/chez/_dynbind.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- binding: install / restore / seen across a fn call ---
["binding rebinds" "(do (def ^:dynamic *bx* 10) (binding [*bx* 99] *bx*))" "99"]
["binding restores" "(do (def ^:dynamic *by* 10) (binding [*by* 99] *by*) *by*)" "10"]
["binding seen by fn" "(do (def ^:dynamic *bz* 0) (defn rdz [] *bz*) (binding [*bz* 7] (rdz)))" "7"]
["binding both: vec" "(do (def ^:dynamic *bv* 1) [(binding [*bv* 2] *bv*) *bv*])" "[2 1]"]
["nested binding" "(do (def ^:dynamic *bn* 1) (binding [*bn* 2] (binding [*bn* 3] *bn*)))" "3"]
["nested binding outer" "(do (def ^:dynamic *bo* 1) (binding [*bo* 2] (binding [*bo* 3] nil) *bo*))" "2"]
# (a macro reading a dynamic var — corpus 606/607 — needs top-level defmacro
# in the -e path, which the Chez driver can't compile yet; out of scope here.)
# --- var-set inside a binding targets the frame; restored on exit ---
["var-set in binding" "(do (def ^:dynamic *z* 1) (binding [*z* 0] (var-set (var *z*) 5) *z*))" "5"]
["var-set frame restores" "(do (def ^:dynamic *zr* 1) (binding [*zr* 0] (var-set (var *zr*) 5)) *zr*)" "1"]
# --- thread-bound? ---
["thread-bound? unbound" "(do (def ^:dynamic *tb* 1) (thread-bound? (var *tb*)))" "false"]
["thread-bound? in scope" "(do (def ^:dynamic *tc* 1) (binding [*tc* 2] (thread-bound? (var *tc*))))" "true"]
# --- with-bindings* / bound-fn* / get-thread-bindings ---
# Binding frames look up by var cell identity, so a var-keyed binding map
# resolves: the Clojure-correct value is 7.
["with-bindings*" "(do (def ^:dynamic *wb* 1) (with-bindings* {(var *wb*) 7} (fn [] *wb*)))" "7"]
["bound-fn* conveys" "(do (def ^:dynamic *cf* 1) (let [g (binding [*cf* 3] (bound-fn* (fn [] *cf*)))] (g)))" "3"]
["get-thread-bindings" "(do (def ^:dynamic *gb* 1) (binding [*gb* 9] (get (get-thread-bindings) (var *gb*))))" "9"]
# --- with-local-vars ---
["local-var get" "(with-local-vars [x 1] (var-get x))" "1"]
["local-var set" "(with-local-vars [x 1] (var-set x 2) (var-get x))" "2"]
["local-var two" "(with-local-vars [a 1 b 2] [(var-get a) (var-get b)])" "[1 2]"]
["local-var as value" "(with-local-vars [x 0] (let [bump (fn [v] (var-set v (+ 5 (var-get v))))] (bump x) (var-get x)))" "5"]
["local-var init outer" "(let [y 3] (with-local-vars [x y] (var-get x)))" "3"]
["local-var body result" "(with-local-vars [x 1] :done)" ":done"]
# --- with-redefs ---
["with-redefs rebinds" "(do (defn wrf [] 1) (with-redefs [wrf (fn [] 42)] (wrf)))" "42"]
["with-redefs restores" "(do (defn wrg [] 1) (with-redefs [wrg (fn [] 42)]) (wrg))" "1"]
["with-redefs on throw" "(do (defn wrh [] 1) (try (with-redefs [wrh (fn [] 42)] (throw (ex-info \"x\" {}))) (catch :default e nil)) (wrh))" "1"]
["with-redefs-fn" "(do (defn wri [] 1) (with-redefs-fn {(var wri) (fn [] 42)} (fn [] (wri))))" "42"]
# --- alter-var-root ---
["alter-var-root" "(do (def av 1) (alter-var-root (var av) inc) av)" "2"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_dynbind parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

74
test/chez/_insttime.janet
View file

@ -1,74 +0,0 @@
# jolt-at0a (inc X) — #inst / #uuid literals + java.time formatting on Chez.
# #inst lowers (analyzer :inst node) to a jinst value (RFC3339 ms, partial
# defaults + offsets); #uuid to a juuid; the java.time shim (DateTimeFormatter/
# Instant/ZoneId/LocalDateTime/FormatStyle/Locale/Date.
# Reader data-readers and statics emit the runtime value
# (host/chez/inst-time.ss).
#
#
# janet test/chez/_insttime.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- #inst reading + identity ---
["(inst? #inst \"2020-01-01T00:00:00Z\")" "true"]
["(inst-ms #inst \"1970-01-01T00:00:01Z\")" "1000"]
["(inst-ms #inst \"1970-01-01T00:00:00.123Z\")" "123"]
["(inst-ms #inst \"2020-01-01T00:00:00Z\")" "1577836800000"]
["(inst-ms* #inst \"1970-01-01T00:00:00Z\")" "0"]
["(some? #inst \"2020-01-01T00:00:00Z\")" "true"]
["(str (type #inst \"2020-01-01T00:00:00Z\"))" ":jolt/inst"]
# --- partial timestamps + offsets (value equality by instant) ---
["(= #inst \"2020\" #inst \"2020-01-01T00:00:00.000Z\")" "true"]
["(= #inst \"2020-03\" #inst \"2020-03-01T00:00:00Z\")" "true"]
["(= #inst \"2020-03-15\" #inst \"2020-03-15T00:00:00Z\")" "true"]
["(= #inst \"2020-01-01T01:00:00+01:00\" #inst \"2020-01-01T00:00:00Z\")" "true"]
["(= #inst \"2019-12-31T23:00:00-01:00\" #inst \"2020-01-01T00:00:00Z\")" "true"]
["(= #inst \"2020-01-01T00:00:00Z\" #inst \"2020-01-01T00:00:01Z\")" "false"]
# --- map key + pr-str round trip ---
["(get {#inst \"2020-01-01T00:00:00Z\" :v} #inst \"2020-01-01T00:00:00.000Z\")" ":v"]
["(pr-str #inst \"2020-01-01T00:00:00Z\")" "#inst \"2020-01-01T00:00:00.000-00:00\""]
["(str #inst \"2020-01-01T00:00:00Z\")" "2020-01-01T00:00:00.000-00:00"]
# --- #uuid ---
["(uuid? #uuid \"550e8400-e29b-41d4-a716-446655440000\")" "true"]
["(= #uuid \"550E8400-E29B-41D4-A716-446655440000\" #uuid \"550e8400-e29b-41d4-a716-446655440000\")" "true"]
["(pr-str #uuid \"550e8400-e29b-41d4-a716-446655440000\")" "#uuid \"550e8400-e29b-41d4-a716-446655440000\""]
# --- java.util.Date / java.time.Instant interop ---
["(.getTime #inst \"1970-01-01T00:00:00Z\")" "0"]
["(instance? java.util.Date #inst \"2020-01-01T00:00:00Z\")" "true"]
["(instance? java.sql.Timestamp #inst \"2020-01-01T00:00:00Z\")" "false"]
["(.toEpochMilli (Instant/ofEpochMilli 1234))" "1234"]
["(instance? java.time.Instant (Instant/ofEpochMilli 0))" "true"]
["(> (.toEpochMilli (Instant/now)) 1500000000000)" "true"]
["(instance? LocalDateTime (-> #inst \"2020-03-05T13:45:30Z\" (.toInstant) (.atZone (ZoneId/systemDefault)) (.toLocalDateTime)))" "true"]
# --- DateTimeFormatter pattern engine ---
["(.format (DateTimeFormatter/ofPattern \"yyyy-MM-dd\") #inst \"2020-03-05T13:45:30Z\")" "2020-03-05"]
["(boolean (re-matches #\"[A-Z][a-z]{2} \\d{1,2}, 2020 \\d{1,2}:\\d{2} [AP]M\" (.format (DateTimeFormatter/ofPattern \"MMM d, yyyy h:mm a\") #inst \"2020-03-05T13:45:30Z\")))" "true"]
["(boolean (re-matches #\"\\d{4}-\\d{2}-\\d{2}T\\d{2}:\\d{2}:\\d{2}\" (.format DateTimeFormatter/ISO_LOCAL_DATE_TIME #inst \"2020-03-05T13:45:30Z\")))" "true"]
["(string? (.format (DateTimeFormatter/ofLocalizedDate FormatStyle/MEDIUM) #inst \"2020-03-05T13:45:30Z\"))" "true"]
["(string? (.format (.withLocale (DateTimeFormatter/ofPattern \"yyyy\") (java.util.Locale. \"en\")) #inst \"2020-01-01T00:00:00Z\"))" "true"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_insttime parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

61
test/chez/_io.janet
View file

@ -1,61 +0,0 @@
# jolt-yyud — clojure.java.io/file + java.io.File interop + slurp/spit/flush/
# file-seq on Chez. A File is a path-backed jfile record (instance? java.io.File,
# str -> path, the File method surface). This is a Chez-native implementation.
# Reader-coupled cases (line-seq, slurp over a reader, toURL) are deferred to jolt-at0a.
#
#
# janet test/chez/_io.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")"))
(def cases
[# --- File construction + method surface ---
[(io "(str (io/file \"/a/b\"))") "/a/b"]
[(io "(str (io/file \"/a\" \"b\"))") "/a/b"]
[(io "(.getName (io/file \"/a/b/c.txt\"))") "c.txt"]
[(io "(.getPath (io/file \"/a\" \"b\"))") "/a/b"]
[(io "(.isDirectory (io/file \"docs\"))") "true"]
[(io "(.isFile (io/file \"project.janet\"))") "true"]
[(io "(.isFile (io/file \"docs\"))") "false"]
[(io "(.exists (io/file \"/no/such/path/xyz\"))") "false"]
[(io "(.exists (io/file \"project.janet\"))") "true"]
# --- instance? + type ---
[(io "(instance? java.io.File (io/file \"/a/b\"))") "true"]
[(io "(instance? java.io.File \"/a/b\")") "false"]
[(io "(str (type (io/file \"/a\")))") ":jolt/file"]
# --- file-seq ---
[(io "(every? (fn [f] (instance? java.io.File f)) (file-seq (io/file \"docs\")))") "true"]
[(io "(pos? (count (filter (fn [f] (.isFile f)) (file-seq (io/file \"docs\")))))") "true"]
["(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"project.janet\")) (file-seq \".\"))))" "true"]
# --- slurp / spit / flush ---
["(string? (slurp \"project.janet\"))" "true"]
["(do (spit \"/tmp/jolt-io-test.txt\" \"hello\") (slurp \"/tmp/jolt-io-test.txt\"))" "hello"]
["(do (spit \"/tmp/jolt-io-test.txt\" \"a\") (spit \"/tmp/jolt-io-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-io-test.txt\"))" "ab"]
["(flush)" ""]
[(io "(string? (slurp (io/file \"project.janet\")))") "true"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_io parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

61
test/chez/_ioreader.janet
View file

@ -1,61 +0,0 @@
# jolt-at0a (inc W) — reader-coupled io deferred from inc V (jolt-yyud):
# clojure.java.io/reader (a StringReader over slurp/string/char[]/File/path),
# char-array, File.toURL/.toURI (-> a java.net.URL jhost), slurp draining a
# StringReader, and with-open's __close seam over both jhost readers and plain
# :close maps. All Chez-native (host/chez/io.ss); no analyzer change. Reader/edn
# runtime read (clojure.edn/read over a PushbackReader) stays jolt-r8ku.
#
#
# janet test/chez/_ioreader.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")"))
(def cases
[# --- char-array ---
["(str (char-array \"abc\"))" "(\\a \\b \\c)"]
["(.read (StringReader. (apply str (char-array \"Qz\"))))" "81"]
# --- io/reader: char[] / string-reader passthrough / path ---
[(io "(.read (io/reader (char-array \"abc\")))") "97"]
[(io "(.read (io/reader (StringReader. \"k\")))") "107"]
[(io "(slurp (io/reader (char-array \"xyz\")))") "xyz"]
[(io "(string? (slurp (io/reader \"project.janet\")))") "true"]
# --- File.toURL / .toURI ---
[(io "(.toString (.toURL (io/file \"/tmp/x\")))") "file:/tmp/x"]
[(io "(.toURI (io/file \"/tmp/x\"))") "file:/tmp/x"]
[(io "(.getPath (.toURL (io/file \"/tmp/x\")))") "/tmp/x"]
[(io "(.getAbsolutePath (io/file \"/a/b\"))") "/a/b"]
# --- slurp drains a StringReader (+ ignores :encoding opts) ---
["(slurp (StringReader. \"a=1\"))" "a=1"]
["(slurp (StringReader. \"b\") :encoding \"UTF-8\")" "b"]
# --- with-open: jhost reader + plain :close map ---
["(with-open [r (StringReader. \"a\")] (.read r))" "97"]
["(let [log (atom [])] (with-open [c {:close (fn [] (swap! log conj :closed))}] :r) (deref log))" "[:closed]"]
["(let [log (atom [])] (try (with-open [c {:close (fn [] (swap! log conj :closed))}] (throw (ex-info \"boom\" {}))) (catch Exception e nil)) (deref log))" "[:closed]"]
["(let [log (atom [])] (with-open [a {:close (fn [] (swap! log conj :outer))} b {:close (fn [] (swap! log conj :inner))}] :r) (deref log))" "[:inner :outer]"]
["(with-open [c {:close (fn [] nil) :v 5}] (:v c))" "5"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_ioreader parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

89
test/chez/_javastatic.janet
View file

@ -1,89 +0,0 @@
# jolt-avt6 — host class statics + constructors on Chez. The analyzer lowers
# Class/member to :host-static and (Class. ...) to :host-new; the Chez emit lowers
# them to host-static-ref/host-static-call/host-new (host-static.ss registry).
# Each case carries its expected printed value. Env-dependent values (os.name) are
# asserted via a predicate so the case stays portable across machines.
#
# janet test/chez/_javastatic.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[["(Math/sqrt 16)" "4"]
["(Math/abs -3)" "3"]
["(Math/max 2 7)" "7"]
["(pos? Long/MAX_VALUE)" "true"]
["(String/valueOf 42)" "42"]
["(String/valueOf \"hi\")" "hi"]
["(String/valueOf :k)" ":k"]
["(String/valueOf nil)" "null"]
["(Long/parseLong \"42\")" "42"]
["(Long/valueOf \"42\")" "42"]
["(Integer/parseInt \"ff\" 16)" "255"]
["(.byteValue (Integer/valueOf \"ff\" 16))" "-1"]
["(Boolean/parseBoolean \"true\")" "true"]
["(Boolean/parseBoolean \"yes\")" "false"]
["(Character/isUpperCase \\A)" "true"]
["(Character/isLowerCase \\a)" "true"]
["(Character/isUpperCase \\a)" "false"]
["(Thread/interrupted)" "false"]
["(string? (System/getProperty \"os.name\"))" "true"]
["(string? (get (System/getenv) \"HOME\"))" "true"]
["(string? (System/getenv \"HOME\"))" "true"]
["(fn? System/exit)" "true"]
["(string? (get (System/getProperties) \"os.name\"))" "true"]
["(pos? (count (seq (System/getenv))))" "true"]
["(let [es (map (fn [[k v]] [k v]) (System/getenv))] (and (pos? (count es)) (every? vector? es)))" "true"]
# constructors + their methods
["(.toString (StringBuilder. \"x\"))" "x"]
["(.toString (-> (StringBuilder.) (.append \"a\") (.append \\b) (.append 1)))" "ab1"]
["(.toString (.append (StringBuilder. 16) \"x\"))" "x"]
["(let [sb (StringBuilder.)] (.append sb \"abcd\") (.setLength sb 2) (.toString sb))" "ab"]
["(let [w (StringWriter.)] (.write w \"a\") (.append w \\b) (.toString w))" "ab"]
["(let [r (StringReader. \"ab\")] [(.read r) (.read r) (.read r)])" "[97 98 -1]"]
["(let [r (StringReader. \"ab\")] (.mark r 1) [(.read r) (do (.reset r) (.read r))])" "[97 97]"]
["(let [r (java.io.PushbackReader. (java.io.StringReader. \"ab\"))] [(.read r) (.read r)])" "[97 98]"]
["(let [r (PushbackReader. (StringReader. \"ab\")) a (.read r)] (.unread r a) [a (.read r) (.read r)])" "[97 97 98]"]
["(let [r (PushbackReader. (StringReader. \"a\"))] (.unread r \\x) [(.read r) (.read r)])" "[120 97]"]
["(BigInteger. \"123\")" "123"]
["(let [m (HashMap. {:a 1 :b 2})] (.get m :b))" "2"]
["(let [m (HashMap. {})] (.put m :x 1) (.put m :y 2) (.size m))" "2"]
["(let [t (StringTokenizer. \"a=1&b=2\" \"&\")] [(.nextToken t) (.nextToken t)])" "[a=1 b=2]"]
["(.toString (StringBuilder. \"x\"))" "x"]
# ring-codec surface
["(URLEncoder/encode \"a b=c\")" "a+b%3Dc"]
["(URLDecoder/decode (URLEncoder/encode \"x &=%?\"))" "x &=%?"]
["(String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))" "aGVsbG8="]
["(String. (.decode (Base64/getDecoder) (String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))))" "hello"]
["(Integer/parseInt \"ff\" 16)" "255"]
# Pattern statics
["(regex? (Pattern/compile \"a.c\"))" "true"]
["(.split (Pattern/compile \",\") \"a,b,c\")" "(a b c)"]
["(do (require '[clojure.string :as s]) (s/replace \"a1b2\" (Pattern/compile \"[0-9]\") \"\"))" "ab"]
["(boolean (re-find (Pattern/compile \"^x\" Pattern/MULTILINE) \"y\\nx\"))" "true"]
["(boolean (re-find (re-pattern (Pattern/quote \"a.c\")) \"za.cy\"))" "true"]
["(boolean (re-find (re-pattern (Pattern/quote \"a.c\")) \"zabcy\"))" "false"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_javastatic parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

54
test/chez/_ns.janet
View file

@ -1,54 +0,0 @@
# jolt-yxqm — namespace value model (find-ns/ns-name/all-ns/resolve/ns-publics/
# in-ns/*ns* …). TDD harness: drives bin/joltc -e per case (fresh subprocess
# = per-case isolation), checks the LAST printed line == expected. Expected
# values are the JVM-canonical reference, baked per case.
#
# janet test/chez/_ns.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
# [label expr expected-last-line]
(def cases
[["find-ns existing" "(some? (find-ns 'clojure.core))" "true"]
["find-ns missing" "(nil? (find-ns 'does.not.exist))" "true"]
["resolve native-op +" "(var? (resolve '+))" "true"]
["resolve undefined" "(nil? (resolve 'totally-undefined-xyz))" "true"]
["ns-publics has def" "(do (def npv 1) (some? (get (ns-publics 'user) 'npv)))" "true"]
["ns-map has def" "(do (def nmv 1) (some? (get (ns-map 'user) 'nmv)))" "true"]
["ns-aliases is a map" "(map? (ns-aliases 'clojure.core))" "true"]
["ns-interns is a map" "(map? (ns-interns 'user))" "true"]
["ns-interns count pos" "(do (def q 1) (pos? (count (ns-interns 'user))))" "true"]
["all-ns count pos" "(pos? (count (all-ns)))" "true"]
["ns-name *ns* = user" "(= (ns-name *ns*) (ns-name (find-ns 'user)))" "true"]
["in-ns returns ns str" "(str (in-ns 'jolt.test-ns-b))" "jolt.test-ns-b"]
["in-ns updates *ns*" "(do (in-ns 'jolt.test-ns-a) (str *ns*))" "jolt.test-ns-a"]
["ns-unmap clears var" "(do (def nuv 1) (ns-unmap 'user 'nuv) (nil? (resolve 'nuv)))" "true"]
["in-ns no error" "(do (in-ns 'my.ns) (symbol? 'x))" "true"]
["str ns-name *ns*" "(str (ns-name *ns*))" "user"]
["find-var qualified" "(var? (find-var 'clojure.core/map))" "true"]
["the-ns ns-name" "(= 'user (ns-name (the-ns 'user)))" "true"]
["create-ns ns-name" "(= 'foo.bar (ns-name (create-ns 'foo.bar)))" "true"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_ns parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

95
test/chez/_reader.janet
View file

@ -1,95 +0,0 @@
# jolt-r8ku (inc Y) — Chez-side Clojure data reader: read-string / read /
# read+string / with-in-str / clojure.edn. The reader (host/chez/reader.ss)
# produces jolt forms directly; the *in* family and
# clojure.edn are Clojure over the read-string / __parse-next seams.
#
# Outputs are kept order-stable (equality checks, scalars) so set/map iteration
# order — which is host-dependent — doesn't masquerade as a
# divergence.
#
# janet test/chez/_reader.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- scalars + collections (value equality, order-independent) ---
["(= 42 (read-string \"42\"))" "true"]
["(= 42 (read-string \"0x2A\"))" "true"]
# numeric tower (jolt-n6al): "1/2" reads as an exact Ratio (= JVM), so a
# category-aware = against the double 0.5 is false; assert numeric value (==),
# which holds in both the all-flonum and tower models.
["(== 0.5 (read-string \"1/2\"))" "true"]
["(= -3.5 (read-string \"-3.5\"))" "true"]
["(== 1000.0 (read-string \"1e3\"))" "true"]
["(= 1 (read-string \"1N\"))" "true"]
["(integer? (read-string \"7\"))" "true"]
["(= :foo (read-string \":foo\"))" "true"]
["(= :a/b (read-string \":a/b\"))" "true"]
["(= :foo (read-string \"::foo\"))" "true"]
["(= (quote sym) (read-string \"sym\"))" "true"]
["(= (quote ns/sym) (read-string \"ns/sym\"))" "true"]
["(nil? (read-string \"nil\"))" "true"]
["(true? (read-string \"true\"))" "true"]
["(false? (read-string \"false\"))" "true"]
["(= \\a (read-string \"\\\\a\"))" "true"]
["(= \\newline (read-string \"\\\\newline\"))" "true"]
["(= \\space (read-string \"\\\\space\"))" "true"]
["(= \"a\\nb\" (read-string \"\\\"a\\\\nb\\\"\"))" "true"]
["(= [1 2 3] (read-string \"[1 2 3]\"))" "true"]
["(= (quote (+ 1 2)) (read-string \"(+ 1 2)\"))" "true"]
["(= {:a 1 :b 2} (read-string \"{:a 1 :b 2}\"))" "true"]
# core read-string returns the raw set FORM (edn->value builds the real set)
["(:value (read-string \"#{1 2 3}\"))" "[1 2 3]"]
["(= :jolt/set (:jolt/type (read-string \"#{1 2 3}\")))" "true"]
["(= [1 [2 3] {:k :v}] (read-string \"[1 [2 3] {:k :v}]\"))" "true"]
# --- reader macros ---
["(= (quote (quote x)) (read-string \"'x\"))" "true"]
["(= (quote (clojure.core/deref a)) (read-string \"@a\"))" "true"]
["(= (quote (syntax-quote (a (unquote b)))) (read-string \"`(a ~b)\"))" "true"]
["(= (quote (unquote-splicing xs)) (read-string \"~@xs\"))" "true"]
# --- whitespace / comments / discard ---
["(= 42 (read-string \"; comment\\n42\"))" "true"]
["(= [1 2] (read-string \"[1 #_ 9 2]\"))" "true"]
["(nil? (read-string \"\"))" "true"]
["(nil? (read-string \" , ,\"))" "true"]
# --- metadata ^ on a symbol ---
["(:tag (meta (read-string \"^String x\")))" "String"]
["(:foo (meta (read-string \"^:foo x\")))" "true"]
# --- *in* reader family: read / read+string / with-in-str ---
["(= 42 (with-in-str \"42\" (read)))" "true"]
["(= (quote (+ 1 2)) (with-in-str \"(+ 1 2)\" (read)))" "true"]
["(with-in-str \"1 2\" [(read) (read)])" "[1 2]"]
["(= :done (with-in-str \"\" (read *in* false :done)))" "true"]
["(let [[v s] (with-in-str \"42 rest\" (read+string))] (and (= v 42) (string? s)))" "true"]
["(= [1 2] (with-in-str \"1 2\" [(first (read+string)) (first (read+string))]))" "true"]
# --- clojure.edn (set/tagged forms built into real values) ---
["(do (require (quote [clojure.edn :as e0])) (= #{1 2} (e0/read-string \"#{1 2}\")))" "true"]
["(do (require (quote [clojure.edn :as e0])) (uuid? (e0/read-string \"#uuid \\\"550e8400-e29b-41d4-a716-446655440000\\\"\")))" "true"]
["(do (require (quote [clojure.edn :as e0])) (inst? (e0/read-string \"#inst \\\"2020-01-01T00:00:00Z\\\"\")))" "true"]
["(do (require (quote [clojure.edn :as e0])) (= :end (e0/read-string {:eof :end} \"\")))" "true"]
["(do (require (quote [clojure.edn :as e0])) (= [:custom 5] (e0/read-string {:readers {(quote custom) (fn [v] [:custom v])}} \"#custom 5\")))" "true"]
["(do (require (quote clojure.edn)) (= {:a 1 :b 2} (clojure.edn/read-string \"{:a 1\\n :b 2}\")))" "true"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_reader parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

65
test/chez/_seqpred.janet
View file

@ -1,65 +0,0 @@
# sequential? / seq? on lazy seqs (jolt-2o7x follow-up). The inc M fix made the
# native seq? var recognize a lazy-seq (re-def-var!, not just set!). sequential?
# is overlay (`(defn sequential? [x] (or (vector? x) (seq? x)))`), so it inherits
# the fix transitively; this pins that both predicates agree with the JVM oracle
# over every lazy-seq-producing form (and the native =/hash path via set!).
# Expectations are the JVM-canonical values.
#
# janet test/chez/_seqpred.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- seq? over lazy seqs ---
# (NB: range is lazy, so (type (range 3)) is :seq not :vector
# seq; a range-container divergence, not the predicate. sequential? agrees on it.)
["seq? map" "(seq? (map inc [1 2 3]))" "true"]
["seq? filter" "(seq? (filter odd? [1 2 3]))" "true"]
["seq? lazy-seq" "(seq? (lazy-seq (cons 1 nil)))" "true"]
["seq? take iterate" "(seq? (take 3 (iterate inc 0)))" "true"]
["seq? cons onto lazy" "(seq? (cons 0 (range 3)))" "true"]
["seq? vector false" "(seq? [1 2 3])" "false"]
["seq? map-coll false" "(seq? {:a 1})" "false"]
["seq? nil false" "(seq? nil)" "false"]
# --- sequential? over lazy seqs (overlay, delegates to seq?) ---
["sequential? range" "(sequential? (range 3))" "true"]
["sequential? map" "(sequential? (map inc [1 2 3]))" "true"]
["sequential? filter" "(sequential? (filter odd? [1 2 3]))" "true"]
["sequential? lazy-seq" "(sequential? (lazy-seq (cons 1 nil)))" "true"]
["sequential? infinite" "(sequential? (take 2 (repeat 9)))" "true"]
["sequential? vector" "(sequential? [1 2 3])" "true"]
["sequential? list" "(sequential? '(1 2 3))" "true"]
["sequential? map false" "(sequential? {:a 1})" "false"]
["sequential? set false" "(sequential? #{1 2})" "false"]
["sequential? nil false" "(sequential? nil)" "false"]
# --- native =/hash path (jolt-sequential? via set!) over a raw lazy seq ---
["= vec lazyseq" "(= [0 1 2] (range 3))" "true"]
["= lazyseq vec" "(= (range 3) [0 1 2])" "true"]
["= lazyseq list" "(= (map inc [0 1]) '(1 2))" "true"]
["set contains lazyseq" "(contains? #{[0 1 2]} (vec (range 3)))" "true"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_seqpred parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

77
test/chez/_stdlib.janet
View file

@ -1,77 +0,0 @@
# jolt-j5vg / jolt-22vo / clojure.pprint — Phase-2 stdlib parity closeout.
#
# clojure.set — pure Clojure (src/jolt/clojure/set.clj) added to the Chez
# prelude tier (driver.janet stdlib-ns-files).
# clojure.math — native flonum-math shims (host/chez/math.ss) def-var!'d into
# the clojure.math ns; the analyzer already knows the ns exists
# (api.janet install-clojure-math!), so refs lower to var-deref.
# clojure.pprint — minimal shim on the prelude; pprint's 2-arity no longer uses
# (binding [*out* writer] ...) (uncompilable on the no-fallback
# Chez back end; *out* isn't a bindable var — output always goes
# through the host seam).
#
# Outputs are order-stable (value-equality / scalars) so set/map iteration order
# — which is host-dependent — never masquerades as a divergence.
#
#
# janet test/chez/_stdlib.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- clojure.math (jolt-22vo / jolt-h79) ---
["(< 1.4142 (clojure.math/sqrt 2) 1.4143)" "true"]
["(long (clojure.math/pow 2 10))" "1024"]
["(long (clojure.math/tan 0))" "0"]
["(clojure.math/round 2.6)" "3"]
["(clojure.math/floor 2.9)" "2"]
["(clojure.math/signum -7.2)" "-1"]
["(< 3.14 (clojure.math/to-radians 180) 3.15)" "true"]
["(< 3.14 clojure.math/PI 3.15)" "true"]
["(< 2.71 clojure.math/E 2.72)" "true"]
["(long (clojure.math/cbrt 27))" "3"]
["(< 4.6 (clojure.math/log 100) 4.7)" "true"]
# Chez has no native log10 (computed as log(x)/log(10)), so it can differ from
# C log10 in the last ulp (3 vs 2.9999…); range-check, don't pin.
["(< 2.99 (clojure.math/log10 1000) 3.01)" "true"]
["(do (require (quote [clojure.math :as m])) (long (m/hypot 3 4)))" "5"]
["(mapv (comp long clojure.math/sqrt) [1 4])" "[1 2]"]
["(long (clojure.math/atan2 0 1))" "0"]
# --- clojure.set (jolt-j5vg) ---
["(do (require (quote [clojure.set :as s])) (= #{1 2 3 4} (s/union #{1 2} #{3 4})))" "true"]
["(do (require (quote [clojure.set :as s])) (= #{2} (s/intersection #{1 2} #{2 3})))" "true"]
["(do (require (quote [clojure.set :as s])) (= #{1} (s/difference #{1 2} #{2 3})))" "true"]
["(do (require (quote [clojure.set :as s])) (s/subset? #{1} #{1 2}))" "true"]
["(do (require (quote [clojure.set :as s])) (s/superset? #{1 2} #{1}))" "true"]
["(do (require (quote [clojure.set :as s])) (= {1 :a 2 :b} (s/map-invert {:a 1 :b 2})))" "true"]
["(do (require (quote [clojure.set :as s])) (= #{:a} (s/select keyword? #{:a})))" "true"]
["(do (require (quote [clojure.set :as s])) (= #{{:a 1 :b 2}} (s/join #{{:a 1}} #{{:b 2}})))" "true"]
["(do (require (quote [clojure.set :as s])) (= {:b 1} (s/rename-keys {:a 1} {:a :b})))" "true"]
["(do (require (quote [clojure.set :as s])) (= 2 (count (s/index #{{:k 1} {:k 2}} [:k]))))" "true"]
# --- clojure.pprint (minimal shim) ---
["(do (require (quote [clojure.pprint :as pp])) (= \"[1 2 3]\\n\" (with-out-str (pp/pprint [1 2 3]))))" "true"]
["(do (require (quote [clojure.pprint :as pp])) (pp/with-pprint-dispatch pp/code-dispatch 42))" "42"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_stdlib parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

65
test/chez/_str.janet
View file

@ -1,65 +0,0 @@
# jolt-nfca — host java.lang.String method interop on Chez: (.toUpperCase s),
# (.indexOf s x), (.substring s a b), the regex methods (.matches/.replaceAll/
# .replaceFirst), etc. The string-methods surface. Each case carries its
# expected value.
# An expected of :throws asserts a non-zero exit (unsupported method).
#
# janet test/chez/_str.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[["toLowerCase" "(.toLowerCase \"HI\")" "hi"]
["toUpperCase" "(.toUpperCase \"hi\")" "HI"]
["trim" "(.trim \" x \")" "x"]
["length" "(.length \"abc\")" "3"]
["isEmpty" "[(.isEmpty \"\") (.isEmpty \"a\")]" "[true false]"]
["indexOf hit" "(.indexOf \"abc\" \"b\")" "1"]
["indexOf miss" "(.indexOf \"abc\" \"z\")" "-1"]
["indexOf from" "(.indexOf \"abab\" \"a\" 1)" "2"]
["indexOf int code" "(.indexOf \"a=b\" 61)" "1"]
["lastIndexOf" "(.lastIndexOf \"abab\" \"b\")" "3"]
["substring 1" "(.substring \"abc\" 1)" "bc"]
["substring 1 2" "(.substring \"abc\" 1 2)" "b"]
["startsWith" "(.startsWith \"abc\" \"ab\")" "true"]
["endsWith" "(.endsWith \"abc\" \"bc\")" "true"]
["contains" "(.contains \"abc\" \"b\")" "true"]
["replace literal" "(.replace \"abc\" \"b\" \"x\")" "axc"]
["replace all occ" "(.replace \"aaa\" \"a\" \"b\")" "bbb"]
["charAt" "(.charAt \"abc\" 1)" "\\b"]
["equalsIgnoreCase" "(.equalsIgnoreCase \"AbC\" \"aBc\")" "true"]
["toString" "(.toString \"hi\")" "hi"]
["concat" "(.concat \"ab\" \"cd\")" "abcd"]
["matches whole" "(.matches \"abc\" \"a.c\")" "true"]
["matches partial" "(.matches \"abcd\" \"a.c\")" "false"]
["replaceAll" "(.replaceAll \"a_b_c\" \"_\" \"-\")" "a-b-c"]
["replaceFirst" "(.replaceFirst \"a_b_c\" \"_\" \"-\")" "a-b_c"]
["split regex" "(vec (.split \"a,b,c\" \",\"))" "[a b c]"]
["unsupported" "(.frobnicate \"abc\")" :throws]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(= expected :throws)
(if (not= code 0) (++ pass)
(array/push fails [label (string "want throw, got `" got "` (exit 0)")]))
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_str parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

66
test/chez/_strns.janet
View file

@ -1,66 +0,0 @@
# jolt-nfca (clojure.string half) — the clojure.string namespace on Chez via the
# alias `s` established by a runtime (require '[clojure.string :as s]). The Chez
# AOT driver pre-evals require forms against the ctx so the alias resolves at
# analyze time, and clojure.string is emitted as a prelude tier over the str-*
# primitives. Each case carries its expected value.
#
# janet test/chez/_strns.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(defn- with-req [body] (string "(do (require (quote [clojure.string :as s])) " body ")"))
# [label body-after-require expected]
(def cases
[["upper-case" "(s/upper-case \"abc\")" "ABC"]
["lower-case" "(s/lower-case \"ABC\")" "abc"]
["capitalize" "(s/capitalize \"hello\")" "Hello"]
["trim" "(s/trim \" x \")" "x"]
["triml" "(= \"x \" (s/triml \" x \"))" "true"]
["trimr" "(= \" x\" (s/trimr \" x \"))" "true"]
["blank? empty" "(s/blank? \"\")" "true"]
["blank? ws" "(s/blank? \" \")" "true"]
["blank? no" "(s/blank? \"x\")" "false"]
["blank? nil" "(s/blank? nil)" "true"]
["includes? y" "(s/includes? \"abcd\" \"bc\")" "true"]
["includes? n" "(s/includes? \"abcd\" \"zz\")" "false"]
["starts-with? y" "(s/starts-with? \"abc\" \"ab\")" "true"]
["starts-with? n" "(s/starts-with? \"abc\" \"bc\")" "false"]
["ends-with? y" "(s/ends-with? \"abc\" \"bc\")" "true"]
["join no sep" "(s/join [\"a\" \"b\" \"c\"])" "abc"]
["join sep" "(s/join \",\" [\"a\" \"b\" \"c\"])" "a,b,c"]
["join nums" "(s/join \"-\" [1 2 3])" "1-2-3"]
["split literal" "(s/split \"a,b,c\" \",\")" "[a b c]"]
["split regex" "(s/split \"a1b2c\" #\"[0-9]\")" "[a b c]"]
["split-lines" "(s/split-lines \"a\\nb\\nc\")" "[a b c]"]
["replace lit" "(s/replace \"a_b_c\" \"_\" \"-\")" "a-b-c"]
["replace regex" "(s/replace \"a1b2\" #\"[0-9]\" \"\")" "ab"]
["replace-first" "(s/replace-first \"a_b_c\" \"_\" \"-\")" "a-b_c"]
["reverse" "(s/reverse \"abc\")" "cba"]
["index-of hit" "(s/index-of \"abc\" \"b\")" "1"]
["index-of miss" "(nil? (s/index-of \"abc\" \"z\"))" "true"]
["trim-newline" "(s/trim-newline \"abc\\n\\n\")" "abc"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label body expected] cases
(def [code got err] (run-capture (with-req body)))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_strns parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

81
test/chez/_type.janet
View file

@ -1,81 +0,0 @@
# jolt-fmm4 — (type x) on Chez: :type meta override, record class-name symbol,
# and a comprehensive value->taxonomy mapping (no value type crashes -> must be
# total, the recorded gotcha). Each case carries its expected value.
# (type (range 3)) is :seq (range is lazy); range-container divergences are
# covered elsewhere.
#
# janet test/chez/_type.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- scalars ---
["int" "(type 5)" ":number"]
["float" "(type 5.0)" ":number"]
["ratio-ish" "(type (/ 10 2))" ":number"]
["string" "(type \"s\")" ":string"]
["keyword" "(type :k)" ":keyword"]
["symbol" "(type 'x)" ":symbol"]
["true" "(type true)" ":boolean"]
["false" "(type false)" ":boolean"]
["nil" "(type nil)" ""]
["char" "(type \\a)" ":char"]
# --- collections ---
["vector" "(type [1 2])" ":vector"]
["empty vector" "(type [])" ":vector"]
["map" "(type {:a 1})" ":map"]
["set" "(type #{1})" ":set"]
["list" "(type '(1 2))" ":seq"]
["empty list" "(type '())" ":seq"]
["map entry" "(type (first {:a 1}))" ":vector"]
["lazy map" "(type (map inc [1 2]))" ":seq"]
["lazy filter" "(type (filter odd? [1 2 3]))" ":seq"]
["lazy-seq" "(type (lazy-seq (cons 1 nil)))" ":seq"]
["take iterate" "(type (take 2 (iterate inc 0)))" ":seq"]
["fn" "(type inc)" ":fn"]
["sorted-map" "(type (sorted-map :a 1))" ":map"]
["sorted-set" "(type (sorted-set 1))" ":jolt/sorted-set"]
# --- :type meta override (the headline jolt-fmm4 case) ---
["meta override" "(type (with-meta [1] {:type :custom}))" ":custom"]
["meta override map" "(type (with-meta {:a 1} {:type :rec}))" ":rec"]
["meta no :type" "(type (with-meta [1] {:other 9}))" ":vector"]
# --- record -> ns-qualified class-name symbol ---
["record symbol" "(do (defrecord TyR [a]) (type (->TyR 1)))" "user.TyR"]
["record roundtrip" "(do (defrecord TyR [a]) (= (symbol (str (type (->TyR 1)))) (type (->TyR 1))))" "true"]
["record is symbol" "(do (defrecord TyR [a]) (symbol? (type (->TyR 1))))" "true"]
# --- exotic host wrappers (seed :jolt/* tags; total, never crash) ---
["atom" "(type (atom 1))" ":jolt/atom"]
["volatile" "(type (volatile! 1))" ":jolt/volatile"]
["regex" "(type #\"re\")" ":jolt/regex"]
["var" "(do (def vx 1) (type (var vx)))" ":jolt/var"]
["transient" "(type (transient []))" ":jolt/transient"]
["uuid" "(type (random-uuid))" ":jolt/uuid"]
["ex-info" "(type (ex-info \"x\" {}))" ":jolt/ex-info"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_type parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

45
test/chez/_var_meta.janet
View file

@ -1,45 +0,0 @@
# jolt-zikh — var def-time metadata capture (^:private / ^Type tag / docstring).
# (meta (var v)) must carry the def-time reader metadata + :ns/:name, matching the
# JVM-canonical reference. TDD harness: bin/joltc -e per case, last line ==
# expected.
#
# janet test/chez/_var_meta.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
# NOTE: ^{:map} metadata on a def name (e.g. (def ^{:doc "hi"} dv 1)) reads as
# (def (with-meta name m) v) and is uncompilable for the COMPILER generally
# (analyzer.clj rejects it) — out of subset, not a meta-capture gap. Shorthand
# ^:kw / ^Type
# and the docstring form keep the name a plain symbol, so they're in scope.
[["^:private on var" "(do (def ^:private pv 1) (:private (meta (var pv))))" "true"]
["^Type tag on var" "(do (def ^String tv \"a\") (:tag (meta (var tv))))" "String"]
["(def name doc val)" "(do (def dv2 \"hi\" 1) (:doc (meta (var dv2))))" "hi"]
["meta carries :name" "(do (def mv 1) (:name (meta (var mv))))" "mv"]
["meta carries :ns" "(do (def nv 1) (:ns (meta (var nv))))" "user"]
["plain def: no user meta" "(do (def pl 1) (nil? (:private (meta (var pl)))))" "true"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_var_meta parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

77
test/chez/_walk.janet
View file

@ -1,77 +0,0 @@
# jolt-75sv — list? (a list marker on cseq, since cseq backs both lists and
# realized/lazy seqs) + map-entry-as-vector + clojure.walk.
#
# janet test/chez/_walk.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
# -e reads only the FIRST form — wrap require + use in a single (do ...).
(defn w [body] (string "(do (require (quote [clojure.walk :as w])) " body ")"))
(def cases
[# --- list? : true for lists, cons/reverse/conj-on-list; false for seqs ---
["(list? (list 1 2))" "true"]
["(list? (list 1))" "true"]
["(list? '(1 2))" "true"]
["(list? '())" "true"]
["(list? (list))" "true"]
["(list? (cons 1 nil))" "true"]
["(list? (cons 1 [2]))" "true"]
["(list? (cons 1 '(2)))" "true"]
["(list? (conj (list 1) 0))" "true"]
["(list? (conj '() 1))" "true"]
["(list? (reverse [1 2]))" "true"]
["(list? (reverse '(1 2)))" "true"]
["(list? [1 2])" "false"]
["(list? {:a 1})" "false"]
["(list? (map inc [1 2]))" "false"]
["(list? (filter odd? [1 2 3]))" "false"]
["(list? (seq [1 2]))" "false"]
["(list? (rest (list 1 2)))" "false"]
["(list? (next (list 1 2)))" "false"]
["(list? (take 2 (list 1 2 3)))" "false"]
["(list? (concat '(1) '(2)))" "false"]
["(list? (rest [1 2]))" "false"]
["(list? 5)" "false"]
["(list? nil)" "false"]
# --- map-entry IS a vector (Clojure MapEntry; seed agrees) ---
["(vector? (first {:a 1}))" "true"]
["(vector? (first (seq {:a 1})))" "true"]
["(map-entry? (first {:a 1}))" "true"]
["(= (first {:a 1}) [:a 1])" "true"]
["(vector? [1 2])" "true"]
["(vector? (rest [1 2 3]))" "false"]
# --- clojure.walk ---
[(w "(w/postwalk (fn [x] (if (number? x) (inc x) x)) {:a 1})") "{:a 2}"]
[(w "(w/keywordize-keys {\"a\" 1})") "{:a 1}"]
[(w "(= {\"a\" 1} (w/stringify-keys {:a 1}))") "true"]
[(w "(w/postwalk-replace {'x 2} '(+ x x))") "(+ 2 2)"]
[(w "(w/postwalk (fn [n] (if (symbol? n) :a n)) '(x y))") "(:a :a)"]
[(w "(w/prewalk-replace {'* '* 'y 3} '(* y y))") "(* 3 3)"]
[(w "(w/postwalk-replace {:a 1 :b 2} '(:a [:b :a]))") "(1 [2 1])"]
[(w "(w/postwalk-replace {1 :one} [1 2 1])") "[:one 2 :one]"]
["(do (require (quote [clojure.template :as t])) (t/apply-template '[x y] '(+ x y) '(1 2)))" "(+ 1 2)"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_walk parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

102
test/chez/bench-pipeline.janet
View file

@ -1,102 +0,0 @@
# Phase 1 (jolt-cf1q.2) close-out bench — the compute benches run END TO END
# through the REAL pipeline (Clojure source -> Janet-hosted analyzer -> IR ->
# Scheme emitter -> Chez compile -> run), timed in-process (Chez startup
# excluded), and reported against the spike ceiling (spike/chez/RESULTS.md).
#
# This is the Phase 1 gate evidence: (1) compile-only is TOTAL for the compute
# subset — every form emits, no interpreter fallback (Chez has none); (2) the
# emitted code runs at ~the substrate ceiling, with the residual gap being
# exactly the typed fl*/fx* emission that Phase 4 owns.
#
# JOLT_CHEZ_BENCH=1 janet test/chez/bench-pipeline.janet
# Opt-in (like core-bench); skipped in the normal gate.
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as r)
(import ../../host/chez/driver :as d)
(import ../../host/chez/emit :as emit)
(unless (os/getenv "JOLT_CHEZ_BENCH")
(print "skip: set JOLT_CHEZ_BENCH=1 to run the Chez pipeline bench")
(os/exit 0))
(unless (d/chez-available?)
(print "skip: chez not on PATH")
(os/exit 0))
(def ctx (d/make-ctx))
# Emit a top-level program (one or more defns) through the real pipeline. Returns
# the concatenated Scheme for every form — each form must emit (compile-only is
# total) or this throws, which is itself the totality check.
(defn emit-program [src]
(def forms (map first (r/parse-all-positioned src)))
(string/join (map (fn [f] (emit/emit (backend/analyze-form ctx f))) forms) "\n"))
(def fib-src "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
# mandelbrot kernel: loop/recur + let + or-expansion + cross-var call, all flonum.
(def mandel-src ``
(defn count-point [cr ci cap]
(loop [i 0 zr 0.0 zi 0.0]
(if (or (>= i cap) (> (+ (* zr zr) (* zi zi)) 4.0))
i
(recur (inc i)
(+ (- (* zr zr) (* zi zi)) cr)
(+ (* 2.0 (* zr zi)) ci)))))
(defn run [n]
(let [cap 200 nd (* 1.0 n)]
(loop [y 0 acc 0]
(if (>= y n) acc
(let [ci (- (* 2.0 (/ (* 1.0 y) nd)) 1.0)
row (loop [x 0 a 0]
(if (>= x n) a
(let [cr (- (* 3.5 (/ (* 1.0 x) nd)) 2.5)]
(recur (inc x) (+ a (count-point cr ci cap))))))]
(recur (inc y) (+ acc row)))))))
``)
(def fib-scm (emit-program fib-src))
(def mandel-scm (emit-program mandel-src))
(print "compile-only total: fib + mandelbrot emitted with no fallback")
# One Chez program: load the RT, the emitted defns, a hand-written FLONUM fib
# reference (jolt's realistic ceiling given the all-double model), then time each
# end-to-end value (warm up first; exclude Chez startup via a monotonic clock).
(def prog
(string
"(import (chezscheme))\n(load \"host/chez/rt.ss\")\n"
fib-scm "\n" mandel-scm "\n"
"(define fib (var-deref \"user\" \"fib\"))\n"
"(define mrun (var-deref \"user\" \"run\"))\n"
# hand flonum fib — the substrate ceiling for jolt's number model
"(define (ffib n) (if (fl< n 2.0) n (fl+ (ffib (fl- n 1.0)) (ffib (fl- n 2.0)))))\n"
"(define (now-ns) (let ((t (current-time 'time-monotonic))) (+ (* (time-second t) 1000000000) (time-nanosecond t))))\n"
"(define (timed thunk) (let* ((t0 (now-ns)) (r (thunk)) (ms (/ (- (now-ns) t0) 1000000.0))) (cons r ms)))\n"
"(fib 24)(ffib 24.0)(mrun 30)\n" # warm up
"(let ((a (timed (lambda () (fib 30))))\n"
" (b (timed (lambda () (ffib 30.0))))\n"
" (c (timed (lambda () (mrun 200)))))\n"
" (printf \"~a ~a ~a ~a ~a ~a\\n\"\n"
" (jolt-pr-str (car a)) (exact->inexact (cdr a))\n"
" (jolt-pr-str (car b)) (exact->inexact (cdr b))\n"
" (jolt-pr-str (car c)) (exact->inexact (cdr c))))"))
(def path (string "/tmp/chez-bench-pipeline-" (os/getpid) ".ss"))
(spit path prog)
(def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe}))
(def out (string/trim (string (ev/read (proc :out) 0x100000))))
(def err (string/trim (string (or (ev/read (proc :err) 0x100000) ""))))
(def code (os/proc-wait proc))
(unless (= code 0) (printf "BENCH FAILED (code %d): %s" code err) (os/exit 1))
(def p (string/split " " out))
(defn num [i] (scan-number (get p i "0")))
(printf "\nReal-pipeline compute benches (Chez startup excluded):\n")
(printf " fib 30 (jolt, flonum) = %s in %6.2f ms" (get p 0) (num 1))
(printf " fib 30 (hand flonum ceiling) = %6.2f ms <- jolt's number-model ceiling" (num 3))
(printf " fib 30 (spike fixnum ceiling)= 5.20 ms <- Phase 4 fl/fx typed-emit target")
(printf " mandelbrot 200 (jolt) = %s in %6.2f ms" (get p 4) (num 5))
(printf " mandelbrot 200 (spike generic)= 98.10 ms <- generic-flonum ceiling")
(printf " mandelbrot 200 (spike typed) = 13.40 ms <- Phase 4 fl/fx typed-emit target")
(def fib-overhead (if (> (num 3) 0) (/ (num 1) (num 3)) 0))
(printf "\n jolt fib is %.2fx the hand-flonum ceiling (residual = truthy/dispatch; typed-emit closes the fixnum gap)." fib-overhead)
(os/exit 0)

72
test/chez/bootstrap-test.janet
View file

@ -1,72 +0,0 @@
# Chez Phase 3 inc9a (jolt-9phg) — the pure-Chez self-build (no Janet in the loop).
#
# inc8 proved the on-Chez compiler reproduces itself. inc9a makes that the actual
# build: host/chez/bootstrap.ss loads the CHECKED-IN seed (host/chez/seed/{prelude,
# image}.ss — the bootstrap compiler, minted once via the fixpoint) and rebuilds the
# clojure.core prelude + compiler image FROM SOURCE on Chez. No Janet is invoked in
# the compile path — this test only spawns `chez`; the read->analyze->emit is 100%
# Chez. So a fresh checkout + Chez (no Janet) yields a working jolt.
#
# The seed is a JOINT byte-fixpoint, so rebuilding from an up-to-date seed
# reproduces it exactly. If the seed SOURCES change (core tiers, the compiler, the
# host contract, the reader, emit-image.ss) the rebuilt artifacts will differ and
# this test fails — re-mint the seed with driver/mint-chez-seed* (see the failure
# message) and commit the refreshed seed.
#
# janet test/chez/bootstrap-test.janet
(import ../../host/chez/driver :as d)
(var total 0) (var fails 0)
(defn ok [name pred &opt extra]
(++ total)
(if pred (printf "ok: %s" name)
(do (++ fails) (printf "FAIL: %s %s" name (or extra "")))))
(unless (d/chez-available?)
(print "chez not on PATH — skipping bootstrap-test")
(os/exit 0))
(def seed-prelude "host/chez/seed/prelude.ss")
(def seed-image "host/chez/seed/image.ss")
(ok "checked-in seed prelude exists" (os/stat seed-prelude))
(ok "checked-in seed image exists" (os/stat seed-image))
(when (and (os/stat seed-prelude) (os/stat seed-image))
(def tmp (or (os/getenv "TMPDIR") "/tmp"))
(def out-prelude (string tmp "/jolt-bootstrap-pre-" (os/getpid) ".ss"))
(def out-image (string tmp "/jolt-bootstrap-img-" (os/getpid) ".ss"))
(def t0 (os/clock))
# PURE CHEZ: spawn `chez --script bootstrap.ss` — no Janet in the compile path.
(def [code out err] (d/run-bootstrap seed-prelude seed-image out-prelude out-image))
(printf "pure-Chez bootstrap pass: %.1fs" (- (os/clock) t0))
(ok "bootstrap.ss runs cleanly on Chez (no Janet)" (= code 0)
(string "exit " code " " (string/slice err 0 (min 300 (length err)))))
(defn- bytes= [a b] (and (os/stat a) (os/stat b)
(= (string (slurp a)) (string (slurp b)))))
(def remint "re-mint with driver/mint-chez-seed* and commit host/chez/seed/")
(when (= code 0)
(ok "rebuilt prelude == checked-in seed (joint fixpoint)" (bytes= out-prelude seed-prelude)
(string "seed is stale — " remint))
(ok "rebuilt image == checked-in seed (joint fixpoint)" (bytes= out-image seed-image)
(string "seed is stale — " remint))
# The rebuilt artifacts must be a WORKING compiler.
(def cases
[["(let [x 1 y 2] (+ x y))" "3"]
["(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 10)" "55"]
["(->> (range 10) (filter even?) (map #(* % %)) (reduce +))" "120"]
["(let [{:keys [a b] :or {b 9}} {:a 1}] [a b])" "[1 9]"]
["(require '[clojure.string :as s]) (s/join \",\" [1 2 3])" "1,2,3"]
["(loop [i 0 acc 0] (if (< i 5) (recur (inc i) (+ acc i)) acc))" "10"]])
(var pass 0)
(each [src want] cases
(def [c o _] (d/eval-zero-janet out-prelude out-image (string "(do " src ")")))
(when (and (= c 0) (= o want)) (++ pass)))
(ok "Chez-built artifacts compile+run real cases" (= pass (length cases))
(string pass "/" (length cases) " cases passed")))
(each p [out-prelude out-image] (when (os/stat p) (os/rm p))))
(printf "\nbootstrap-test: %d/%d checks passed" (- total fails) total)
(os/exit (if (zero? fails) 0 1))

96
test/chez/cli-test.janet
View file

@ -1,96 +0,0 @@
# Chez Phase 3 inc9b (jolt-9phg) — the pure-Chez runtime CLI (no Janet).
#
# bin/joltc execs `chez --script host/chez/cli.ss`, which loads the checked-in
# bootstrap seed (host/chez/seed/) + the zero-Janet spine and compiles+evals a
# Clojure -e expression entirely on Chez. This test drives bin/joltc and checks
# results: with only Chez installed, jolt runs end to end — no Janet at build or
# run time. (This harness is Janet only to spawn the process; the compile+eval is
# 100% Chez.)
#
# janet test/chez/cli-test.janet
(import ../../host/chez/driver :as d)
(var total 0) (var fails 0)
(defn ok [name pred &opt extra]
(++ total)
(if pred (printf "ok: %s" name)
(do (++ fails) (printf "FAIL: %s %s" name (or extra "")))))
(unless (d/chez-available?)
(print "chez not on PATH — skipping cli-test")
(os/exit 0))
(defn- joltc [expr]
(def proc (os/spawn ["bin/joltc" "-e" expr] :p {:out :pipe :err :pipe}))
(def out (string/trim (string (:read (proc :out) :all))))
(def err (string/trim (string (or (:read (proc :err) :all) ""))))
(def code (os/proc-wait proc))
[code out err])
(def cases
[["(+ 1 2)" "3"]
["(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 15)" "610"]
["(->> (range 10) (filter even?) (map #(* % %)) (reduce +))" "120"]
["(let [{:keys [a b] :or {b 99}} {:a 1}] [a b])" "[1 99]"]
["(require '[clojure.string :as s]) (s/upper-case \"hello\")" "HELLO"]
["(case 3 1 :a 2 :b :other)" ":other"]
["(reduce + (vals (reduce (fn [m k] (assoc m k (* k k))) {} [1 2 3])))" "14"]
["(map inc [1 2 3])" "(2 3 4)"]
["nil" ""]
# jolt-r8ku: runtime eval / load-string / defmacro on the Chez spine.
["(eval (quote (+ 1 2)))" "3"]
["(eval (list (quote +) 1 2 3))" "6"]
["(eval (quote (let [a 2 b 3] (* a b))))" "6"]
["(load-string \"(+ 1 2)\")" "3"]
["(load-string \"(def y 5) (* y y)\")" "25"]
["(load-string \"\")" ""]
["(map eval [(quote (+ 1 1)) (quote (* 3 3))])" "(2 9)"]
["(defmacro add1 [x] (list (quote +) x 1)) (add1 10)" "11"]
["(defmacro twice [x] `(do ~x ~x)) (twice (+ 2 3))" "5"]
["(defmacro m [x] `(+ ~x 1)) (m (m (m 0)))" "3"]
# jolt-byjr: concurrency — futures/pmap/promise on real OS threads (shared heap).
["(deref (future (+ 1 2)))" "3"]
["@(future (* 6 7))" "42"]
["(deref (future (mapv inc [1 2 3])))" "[2 3 4]"]
["(let [f (future (+ 1 1))] [(deref f) (deref f)])" "[2 2]"]
["(future? (future 1))" "true"]
["(future? 42)" "false"]
["(let [f (future 1)] (deref f) (future-done? f))" "true"]
["(let [f (future 1)] (deref f) (realized? f))" "true"]
["(let [f (future 42)] (deref f) (deref f 1000 :nope))" "42"]
["(vec (pmap inc [1 2 3]))" "[2 3 4]"]
["(vec (pmap + [1 2 3] [4 5 6]))" "[5 7 9]"]
["(vec (pcalls (fn [] 1) (fn [] 2)))" "[1 2]"]
["(vec (pvalues (+ 1 2) (+ 3 4)))" "[3 7]"]
# shared heap = JVM semantics (NOT Janet's isolated-heap snapshot): a captured
# atom is shared, so the future's swap! is visible to the parent.
["(let [a (atom 0)] (deref (future (swap! a inc))) @a)" "1"]
["(let [a (atom 0)] (dorun (pmap (fn [_] (swap! a inc)) [1 2 3 4])) @a)" "4"]
# promise blocks until delivered (JVM), unlike the Janet atom-shim.
["(let [p (promise)] (deliver p 7) @p)" "7"]
["(let [p (promise)] (future (deliver p :hi)) @p)" ":hi"]
# jolt-byjr: clojure.core.async on real-thread blocking channels.
["(require (quote [clojure.core.async :refer [chan go <! >! <!!]])) (def c (chan)) (go (>! c (+ 40 2))) (<!! c)" "42"]
["(require (quote [clojure.core.async :refer [chan go go-loop <! >! <!! close!]])) (def c (chan 5)) (go (>! c 1) (>! c 2) (>! c 3) (close! c)) (<!! (go-loop [o []] (let [v (<! c)] (if (nil? v) o (recur (conj o v))))))" "[1 2 3]"]
["(require (quote [clojure.core.async :refer [chan go <! >! <!!]])) (def x (chan)) (def y (chan)) (go (>! x 10)) (go (>! y 32)) (<!! (go (+ (<! x) (<! y))))" "42"]
["(require (quote [clojure.core.async :refer [chan go <! >! <!! alts!]])) (def x (chan)) (def y (chan)) (go (>! y :v)) (<!! (go (let [[v ch] (alts! [x y])] (and (= v :v) (= ch y)))))" "true"]
["(require (quote [clojure.core.async :refer [chan go go-loop <! >! <!! close!]])) (def c (chan 10 (map inc))) (go (>! c 1) (>! c 2) (>! c 3) (close! c)) (<!! (go-loop [o []] (let [v (<! c)] (if (nil? v) o (recur (conj o v))))))" "[2 3 4]"]
["(require (quote [clojure.core.async :refer [timeout <!!]])) (<!! (timeout 10)) :done" ":done"]
["(require (quote [clojure.core.async :refer [chan go <! >! <!!]])) (def ^:dynamic *x* 0) (<!! (binding [*x* 7] (go (<! (clojure.core.async/timeout 5)) *x*)))" "7"]
# jolt-byjr: async agents (serialized per-agent dispatch); await for determinism.
["(deref (agent 0))" "0"]
["(let [a (agent 0)] (send-off a + 5) (await a) (deref a))" "5"]
["(let [a (agent 1)] (send a + 6) (await a) (deref a))" "7"]
["(let [a (agent 0)] (dotimes [_ 100] (send a inc)) (await a) (deref a))" "100"]
["(agent-error (agent 0))" ""]
["(let [a (agent 0)] (send a (fn [_] (throw (ex-info \"boom\" {})))) (await a) (boolean (agent-error a)))" "true"]])
(each [src want] cases
(def [code out err] (joltc src))
(ok (string "joltc: " (if (> (length src) 48) (string (string/slice src 0 48) "...") src))
(and (= code 0) (= out want))
(string "[" code "] got " (string/format "%j" out) " want " (string/format "%j" want)
(if (= "" err) "" (string " err: " (string/slice err 0 (min 120 (length err))))))))
(printf "\ncli-test: %d/%d checks passed" (- total fails) total)
(os/exit (if (zero? fails) 0 1))

104
test/chez/core-prelude-probe.janet
View file

@ -1,104 +0,0 @@
# Phase 1 (jolt-cf1q.2, inc 3d) — clojure.core prelude emission probe.
#
# The path to an `-e`-capable jolt-chez: emit the clojure.core tiers
# (jolt-core/clojure/core/NN-*.clj) through the SAME live Janet analyzer ->
# host/chez/emit pipeline, as a Scheme PRELUDE of `def-var!` forms. User code's
# `(var-deref "clojure.core" "<fn>")` then resolves the fn at runtime.
#
# Most core fns are NOT native-ops, so they must be emitted; the ones that
# reference host interop / native Janet ops / unimplemented primitives can't be
# emitted yet (each a clean "out of subset" emit error). This probe reports how
# far the emit gets per tier and aggregates the gap list — the punch-list the
# next increments chase down. Measurement tool, gated out of the default suite.
# JOLT_CHEZ_PRELUDE=1 janet test/chez/core-prelude-probe.janet
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as r)
(import ../../src/jolt/types_ctx :as tctx)
(import ../../host/chez/emit :as emit)
(unless (os/getenv "JOLT_CHEZ_PRELUDE")
(print "skip: set JOLT_CHEZ_PRELUDE=1 to run the core-prelude emission probe")
(os/exit 0))
# load order — same as api/core-tiers (the kernel tier is bootstrap-compiled in
# the live system; here we just measure emit reach, so treat it like the rest).
(def tier-files
["00-syntax" "00-kernel" "10-seq" "20-coll" "25-sorted" "30-macros" "40-lazy" "50-io"])
(defn- parse-all [src]
(def out @[])
(var s src)
(while (> (length (string/trim s)) 0)
(def parsed (r/parse-next s))
(set s (in parsed 1))
(def f (in parsed 0))
(unless (nil? f) (array/push out f)))
out)
# jolt reader forms are arrays of jolt VALUES; a symbol is a struct
# {:jolt/type :symbol :name "..."} (jolt symbols aren't Janet symbols).
(defn- sym-name [x]
(when (and (struct? x) (= :symbol (get x :jolt/type))) (get x :name)))
# A short label for a top-level form: the defn/def name, or the form head.
(defn- form-label [f]
(if (and (indexed? f) (> (length f) 1))
(let [head (or (sym-name (in f 0)) "?") nm (sym-name (in f 1))]
(if nm (string head " " nm) head))
(string/slice (string/format "%p" f) 0 40)))
# Pull the unsupported fn/op name out of an emit error message for aggregation.
(defn- gap-key [msg]
(def m (string msg))
(cond
(string/find "stdlib fn" m) (let [i (string/find "`" m)] (string "stdlib: " (string/slice m (inc i) (string/find "`" m (inc i)))))
(string/find "stdlib ref" m) (let [i (string/find "`" m)] (string "stdlib: " (string/slice m (inc i) (string/find "`" m (inc i)))))
(string/find "host call" m) "host-call"
(string/find "host ref" m) "host-ref"
(string/find "unhandled op" m) (string/slice m (max 0 (- (length m) 30)))
(string/find "unsupported literal" m) "unsupported-literal"
(string/slice m 0 (min 50 (length m)))))
# Macros are analyze-time only (the Janet analyzer expands them away before emit),
# so they don't belong in a RUNTIME prelude — skip them, don't count as gaps.
(defn- macro-form? [f]
(and (indexed? f) (> (length f) 0)
(let [h (sym-name (in f 0))] (and h (or (= h "defmacro") (= h "definline"))))))
(emit/set-prelude-mode! true)
(def ctx (api/init {:compile? true}))
(tctx/ctx-set-current-ns ctx "clojure.core")
(var total 0) (var compiled 0)
(def gaps @{}) # gap-key -> count
(def gap-examples @{}) # gap-key -> first form label that hit it
(each tf tier-files
(def src (slurp (string "jolt-core/clojure/core/" tf ".clj")))
(def forms (parse-all src))
(var t-total 0) (var t-ok 0)
(each f forms
(unless (macro-form? f)
(++ total) (++ t-total)
(def res (protect (emit/emit (backend/analyze-form ctx f))))
(if (res 0)
(do (++ compiled) (++ t-ok))
(let [k (gap-key (res 1))]
(put gaps k (+ 1 (or (get gaps k) 0)))
(unless (get gap-examples k) (put gap-examples k (form-label f)))))))
(printf " %-10s %3d/%-3d forms emit" tf t-ok t-total))
(printf "\nCore prelude emit reach: %d/%d top-level forms compile to Scheme" compiled total)
(printf "%d distinct gaps (fn/op the emit back end can't lower yet):" (length gaps))
(def sorted-gaps (sort-by (fn [k] (- (get gaps k))) (keys gaps)))
(each k sorted-gaps
(printf " %4d x %-34s e.g. %s" (get gaps k) k (get gap-examples k)))
(flush)
# Regression floor (raise it as new IR ops / RT shims land, like the suite
# baseline). Fails if prelude emit reach drops below the recorded baseline.
(def reach-floor 355)
(when (< compiled reach-floor)
(printf "REGRESSION: prelude emit reach %d < floor %d" compiled reach-floor)
(os/exit 1))

8
test/chez/corpus.edn
View file

@ -596,7 +596,7 @@
{:suite "host-interop / java.io.File" :label "getName" :expected "\"c.txt\"" :actual "(do (require '[clojure.java.io :as io]) (.getName (io/file \"/a/b/c.txt\")))"}
{:suite "host-interop / java.io.File" :label "getPath joins" :expected "\"/a/b\"" :actual "(do (require '[clojure.java.io :as io]) (.getPath (io/file \"/a\" \"b\")))"}
{:suite "host-interop / java.io.File" :label "isDirectory of repo dir" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (.isDirectory (io/file \"docs\")))"}
{:suite "host-interop / java.io.File" :label "isFile of repo file" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (.isFile (io/file \"project.janet\")))"}
{:suite "host-interop / java.io.File" :label "isFile of repo file" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (.isFile (io/file \"README.md\")))"}
{:suite "host-interop / java.io.File" :label "exists is false off-disk" :expected "false" :actual "(do (require '[clojure.java.io :as io]) (.exists (io/file \"/no/such/path/xyz\")))"}
{:suite "host-interop / java.io.File" :label "file-seq yields File values" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (every? (fn [f] (instance? java.io.File f)) (file-seq (io/file \"docs\"))))"}
{:suite "host-interop / java.io.File" :label "file-seq finds files" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (pos? (count (filter (fn [f] (.isFile f)) (file-seq (io/file \"docs\"))))))"}
@ -2137,14 +2137,14 @@
{:suite "sorted / seq fn interop" :label "vec of sorted-set" :expected "[1 2 3]" :actual "(vec (sorted-set 3 1 2))"}
{:suite "sorted / seq fn interop" :label "into vec" :expected "[[1 :a] [2 :b]]" :actual "(into [] (sorted-map 2 :b 1 :a))"}
{:suite "sorted / seq fn interop" :label "sorted-map-by 3way cmp" :expected "[3 2 1]" :actual "(vec (keys (sorted-map-by (fn [a b] (- b a)) 1 :a 2 :b 3 :c)))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "slurp returns string" :expected "true" :actual "(string? (slurp \"project.janet\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "slurp content" :expected "true" :actual "(do (require (quote [clojure.string :as s])) (s/includes? (slurp \"project.janet\") \"jolt\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "slurp returns string" :expected "true" :actual "(string? (slurp \"README.md\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "slurp content" :expected "true" :actual "(do (require (quote [clojure.string :as s])) (s/includes? (slurp \"README.md\") \"jolt\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "spit + slurp round" :expected "\"hello\"" :actual "(do (spit \"/tmp/jolt-spit-test.txt\" \"hello\") (slurp \"/tmp/jolt-spit-test.txt\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "spit append" :expected "\"ab\"" :actual "(do (spit \"/tmp/jolt-spit-test.txt\" \"a\") (spit \"/tmp/jolt-spit-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-spit-test.txt\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "printf formats" :expected "\"x=1 y=a\"" :actual "(with-out-str (printf \"x=%d y=%s\" 1 \"a\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "printf no newline" :expected "false" :actual "(do (require (quote [clojure.string :as s])) (s/includes? (with-out-str (printf \"%d\" 1)) \"\\n\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "flush returns nil" :expected "nil" :actual "(flush)"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "file-seq finds files" :expected "true" :actual "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"project.janet\")) (file-seq \".\"))))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "file-seq finds files" :expected "true" :actual "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"README.md\")) (file-seq \".\"))))"}
{:suite "ns / ns-map, ns-unmap, ns-refers" :label "ns-map has var" :expected "true" :actual "(do (def nmv 1) (some? (get (ns-map (quote user)) (quote nmv))))"}
{:suite "ns / ns-map, ns-unmap, ns-refers" :label "ns-unmap removes" :expected "nil" :actual "(do (def nuv 1) (ns-unmap (quote user) (quote nuv)) (resolve (quote nuv)))"}
{:suite "ns / ns-map, ns-unmap, ns-refers" :label "ns-refers sees refer" :expected "true" :actual "(do (require (quote clojure.string)) (refer (quote clojure.string)) (some? (get (ns-refers (quote user)) (quote join))))"}

130
test/chez/extract-corpus.janet
View file

@ -1,130 +0,0 @@
# Extract the case LIST (suite, label, actual) from the spec sources into corpus.edn.
#
# corpus.edn :expected is sourced from reference JVM Clojure by
# test/conformance/regen-corpus.clj — this extractor's :expected column is a
# placeholder. Use it to (re)derive the case list when adding spec rows, then run
# regen-corpus.clj to fill :expected from the JVM. Do not commit its raw output.
#
# Parses every test/spec/*.janet as DATA (no eval), pulls each
# (defspec "suite" [label expected actual] ...) triple. Run from repo root:
# janet test/chez/extract-corpus.janet
(use ../../src/jolt/reader) # not needed for parse, but keeps paths obvious
(defn parse-all [src]
(def p (parser/new))
(parser/consume p src)
(parser/eof p)
(def out @[])
(while (parser/has-more p) (array/push out (parser/produce p)))
out)
(defn edn-str [s]
# escape a Clojure-source string into an EDN/Janet string literal
(def b @`"`)
(each c s
(cond
(= c (chr `"`)) (buffer/push b `\"`)
(= c (chr "\\")) (buffer/push b "\\\\")
(= c (chr "\n")) (buffer/push b "\\n")
(= c (chr "\t")) (buffer/push b "\\t")
(buffer/push-byte b c)))
(buffer/push b `"`)
(string b))
(defn triples-from [form]
# form is (defspec "suite" [l e a] ...) as a parsed tuple
(when (and (indexed? form) (> (length form) 0) (= (first form) 'defspec))
(def suite (in form 1))
(def rows @[])
(each case (slice form 2)
(when (and (indexed? case) (>= (length case) 3))
(def label (in case 0))
(def expected (in case 1))
(def actual (in case 2))
# expected is either a Clojure-source string or the :throws keyword;
# actual is always a Clojure-source string. Skip non-literal rows.
(when (and (string? label) (string? actual)
(or (string? expected) (keyword? expected)))
(array/push rows {:suite suite :label label
:expected expected :actual actual})))
)
rows))
(def spec-dir "test/spec")
(def all @[])
(each f (sort (os/dir spec-dir))
(when (string/has-suffix? "-spec.janet" f)
(def path (string spec-dir "/" f))
(each form (parse-all (slurp path))
(when-let [rows (triples-from form)]
(array/concat all rows)))))
# --- fold in the inline conformance cases (jolt-ohtd) -------------------------
# test/integration/conformance-test.janet carries ~355 hand-written cases as a
# (def cases [["label" "expected" "actual"] ...]) vector — historically invisible to
# the corpus because extract only reads test/spec/. Pull them in too, deduped by
# :actual against the spec rows, so the host-neutral corpus is the union of both.
# Suites come from the file's `### ---- section ----` headers via a line scan (the
# parser drops comments, so section structure is recovered from raw text).
(def conf-path "test/integration/conformance-test.janet")
(defn- section-map [src]
# label-string -> section-name, by scanning raw lines: track the most recent
# `### ---- NAME ----` / `### ==== NAME ====` header above each `["label" ...]`.
(def out @{})
(var section "misc")
(each line (string/split "\n" src)
(def tl (string/trim line))
(cond
(string/has-prefix? "###" tl)
(let [body (string/trim (string/trim (string/trim tl "#") " ") "-= ")]
(when (> (length body) 0) (set section body)))
(string/has-prefix? "[\"" tl)
(let [close (string/find "\"" tl 2)]
(when close (put out (string/slice tl 2 close) section)))))
out)
(def conf-src (slurp conf-path))
(def sections (section-map conf-src))
(def seen-actual (tabseq [r :in all] (r :actual) true))
(var conf-added 0)
(each form (parse-all conf-src)
(when (and (indexed? form) (>= (length form) 3)
(= (first form) 'def) (= (in form 1) 'cases))
(each c (in form 2)
(when (and (indexed? c) (= 3 (length c))
(string? (in c 0)) (string? (in c 1)) (string? (in c 2)))
(def [label expected actual] [(in c 0) (in c 1) (in c 2)])
(unless (seen-actual actual)
(put seen-actual actual true)
(++ conf-added)
(array/push all {:suite (string "conformance / " (get sections label "misc"))
:label label :expected expected :actual actual}))))))
(printf "folded %d unique conformance cases (deduped by :actual)" conf-added)
# emit EDN-and-Janet-valid corpus. [suite label] is the canonical case id, so make
# it unique: a duplicate label within a suite gets " (N)" appended (jolt-3447 — the
# conformance fold can repeat a label, e.g. two "str/replace regex" rows). Rows are
# immutable structs, so disambiguate the label here at emit time.
(def label-seen @{})
(def out @"[\n")
(each row all
(def k (string (row :suite) "\x00" (row :label)))
(def n (get label-seen k))
(put label-seen k (if n (+ n 1) 1))
(def label (if n (string (row :label) " (" (+ n 1) ")") (row :label)))
(buffer/push out
(string " {:suite " (edn-str (row :suite))
" :label " (edn-str label)
" :expected " (if (keyword? (row :expected)) ":throws" (edn-str (row :expected)))
" :actual " (edn-str (row :actual)) "}\n")))
(buffer/push out "]\n")
# corpus.edn is JVM-sourced (regen-corpus.clj); writing the Janet-extracted answers
# here would clobber it. Only write the case list to a separate path when explicitly
# asked (then re-source :expected with regen-corpus.clj). The test runner imports
# this file but never sets the flag, so it has no side effect.
(def out-path (os/getenv "JOLT_EXTRACT_CORPUS_OUT"))
(if out-path
(do (spit out-path out)
(printf "extracted %d cases from %s into %s" (length all) spec-dir out-path))
(print "extract-corpus: set JOLT_EXTRACT_CORPUS_OUT=<path> to write the case list (corpus.edn is JVM-sourced via regen-corpus.clj)"))

126
test/chez/fixpoint-test.janet
View file

@ -1,126 +0,0 @@
# Chez Phase 3 inc8 (jolt-bzni) — the self-hosting bootstrap fixpoint.
#
# The zero-Janet spine (spine-test / run-corpus-zero-janet) proves the ON-CHEZ
# analyzer+emitter compile arbitrary Clojure faithfully. This proves the stronger
# property from self-hosting-bootstrap-research §4: the emitted system reproduces
# ITSELF. Two artifacts are re-emitted ON CHEZ by the loaded compiler:
#
# COMPILER IMAGE (jolt.ir + jolt.analyzer + jolt.backend-scheme)
# stage1 = Janet analyzer/emitter cross-compiles the sources (the bootstrap input)
# stage2 = the on-Chez compiler (from stage1) re-emits them
# stage3 = the on-Chez compiler (from stage2) re-emits them
# FIXPOINT: stage2 == stage3 (stage1 differs only in gensym numbering — the
# Janet build allocates more gensyms before reaching the compiler emit).
#
# CORE PRELUDE (clojure.core tiers + clojure.string/walk/template/edn/set/pprint)
# pstage2 = on-Chez compiler re-emits the prelude with the JANET prelude loaded
# pstage3 = ... with pstage2 loaded
# pstage4 = ... with pstage3 loaded
# FIXPOINT: pstage3 == pstage4. The prelude converges one stage later than the
# compiler because its MACRO expanders bake an auto-gensym id (foo#) at emit
# time, so a macro emitted by Janet (pstage2's loaded prelude) carries a
# different baked id than one emitted by Chez — only once BOTH stages load a
# Chez-emitted prelude (pstage3 onward) does it stabilize.
#
# Finally we load the FULLY Chez-emitted system (Chez prelude + Chez compiler
# image, NO Janet-emitted artifact in the loop) and run real cases, proving the
# fixpoint is a working compiler, not a degenerate stable one.
#
# janet test/chez/fixpoint-test.janet
(import ../../host/chez/driver :as d)
(import ../../host/chez/jolt-chez :as jc)
(var total 0) (var fails 0)
(defn ok [name pred &opt extra]
(++ total)
(if pred (printf "ok: %s" name)
(do (++ fails) (printf "FAIL: %s %s" name (or extra "")))))
(unless (d/chez-available?)
(print "chez not on PATH — skipping fixpoint-test")
(os/exit 0))
(def ctx (d/make-ctx))
(def jprelude (jc/ensure-prelude ctx))
# stage1: the Janet cross-compiled compiler image, cached by source fingerprint
# (same scheme as spine-test / run-corpus-zero-janet).
(defn- image-fingerprint []
(string/slice (string (hash (string/join
(map slurp ["jolt-core/jolt/ir.clj" "jolt-core/jolt/analyzer.clj"
"jolt-core/jolt/backend_scheme.clj" "host/chez/host-contract.ss"
"host/chez/compile-eval.ss"])))) 0))
(def tmp (or (os/getenv "TMPDIR") "/tmp"))
(def stage1 (string tmp "/jolt-compiler-image-" (image-fingerprint) ".ss"))
(d/ensure-compiler-image ctx stage1)
(printf "stage1 compiler image (Janet cross-compile): %d bytes" (length (slurp stage1)))
(flush)
(defn- bytes= [a b] (= (string (slurp a)) (string (slurp b))))
(defn- first-diff [a b]
(def s (string (slurp a))) (def t (string (slurp b)))
(def n (min (length s) (length t)))
(var i 0) (while (and (< i n) (= (s i) (t i))) (++ i))
(string "sizes " (length s) " vs " (length t) ", first diff at " i))
# ---- compiler-image fixpoint: stage2 == stage3 -------------------------------
(def s2 (string tmp "/jolt-fixpoint-img2-" (os/getpid) ".ss"))
(def s3 (string tmp "/jolt-fixpoint-img3-" (os/getpid) ".ss"))
(def [c2 e2] (d/emit-image-on-chez jprelude stage1 s2))
(ok "compiler image stage2 emits cleanly on Chez" (and (= c2 0) (os/stat s2))
(string "exit " c2 " " (string/slice e2 0 (min 300 (length e2)))))
(def [c3 e3] (d/emit-image-on-chez jprelude s2 s3))
(ok "compiler image stage3 emits cleanly on Chez" (and (= c3 0) (os/stat s3))
(string "exit " c3 " " (string/slice e3 0 (min 300 (length e3)))))
(when (and (os/stat s2) (os/stat s3))
(ok "compiler image: stage2 == stage3 (byte-for-byte fixpoint)" (bytes= s2 s3)
(first-diff s2 s3))
(ok "compiler image is substantial (> 80KB)" (> (length (slurp s2)) 80000)))
# ---- prelude fixpoint: pstage3 == pstage4 ------------------------------------
(def p2 (string tmp "/jolt-fixpoint-prelude2-" (os/getpid) ".ss"))
(def p3 (string tmp "/jolt-fixpoint-prelude3-" (os/getpid) ".ss"))
(def p4 (string tmp "/jolt-fixpoint-prelude4-" (os/getpid) ".ss"))
(def [pc2 pe2] (d/emit-image-on-chez jprelude stage1 p2 "jolt-emit-prelude"))
(ok "prelude pstage2 emits cleanly on Chez (from Janet prelude)" (and (= pc2 0) (os/stat p2))
(string "exit " pc2 " " (string/slice pe2 0 (min 300 (length pe2)))))
(when (os/stat p2)
(def [pc3 pe3] (d/emit-image-on-chez p2 stage1 p3 "jolt-emit-prelude"))
(ok "prelude pstage3 emits cleanly on Chez (from pstage2)" (and (= pc3 0) (os/stat p3))
(string "exit " pc3 " " (string/slice pe3 0 (min 300 (length pe3)))))
(when (os/stat p3)
(def [pc4 pe4] (d/emit-image-on-chez p3 stage1 p4 "jolt-emit-prelude"))
(ok "prelude pstage4 emits cleanly on Chez (from pstage3)" (and (= pc4 0) (os/stat p4))
(string "exit " pc4 " " (string/slice pe4 0 (min 300 (length pe4)))))
(when (os/stat p4)
(ok "prelude: pstage3 == pstage4 (byte-for-byte fixpoint)" (bytes= p3 p4)
(first-diff p3 p4))
(ok "prelude is substantial (> 250KB)" (> (length (slurp p3)) 250000)))))
# ---- the fully Chez-emitted system is a working compiler ----------------------
# Chez-emitted prelude (pstage3) + Chez-emitted compiler image (s2): no Janet
# artifact in the loop. Drive real compile+eval through it.
(def verify-cases
[["(let [x 1 y 2] (+ x y))" "3"]
["(when (> 5 3) (-> 10 (- 1) (* 2)))" "18"]
["(defn f [a b] (* a b)) (f 6 7)" "42"]
["(map inc [1 2 3])" "(2 3 4)"]
["(reduce + 0 (range 5))" "10"]
["(let [{:keys [a b]} {:a 7 :b 8}] (+ a b))" "15"]
["(filter even? (range 10))" "(0 2 4 6 8)"]
["(require '[clojure.string :as s]) (s/upper-case \"hi\")" "HI"]
["(cond (= 1 2) :a (= 1 1) :b :else :c)" ":b"]])
(when (and (os/stat p3) (os/stat s2))
(var vpass 0)
(each [src want] verify-cases
(def [code out _] (d/eval-zero-janet p3 s2 (string "(do " src ")")))
(when (and (= code 0) (= out want)) (++ vpass)))
(ok "fully Chez-emitted system (Chez prelude + Chez image) compiles+runs real cases"
(= vpass (length verify-cases))
(string vpass "/" (length verify-cases) " cases passed")))
# cleanup temp stages
(each p [s2 s3 p2 p3 p4] (when (os/stat p) (os/rm p)))
(printf "\nfixpoint-test: %d/%d checks passed" (- total fails) total)
(os/exit (if (zero? fails) 0 1))

63
test/chez/nil-names-probe.janet
View file

@ -1,63 +0,0 @@
# Phase 2 (jolt-cf1q.3) — which clojure.core names resolve to jolt-nil on Chez?
#
# The parity gate buckets a missing native generically as "apply non-procedure
# jolt-nil" — it doesn't NAME the fn. This probe does: it assembles the prelude,
# enumerates every clojure.core var name, then runs ONE Chez program that
# var-derefs each name (after loading prelude + post-prelude) and prints the ones
# that are still nil. That list is the shim punch-list for the next increment.
# JOLT_CHEZ_NIL_PROBE=1 janet test/chez/nil-names-probe.janet
(import ../../host/chez/driver :as d)
(import ../../src/jolt/types_ctx :as tctx)
(unless (os/getenv "JOLT_CHEZ_NIL_PROBE")
(print "skip: set JOLT_CHEZ_NIL_PROBE=1 to run the nil-names probe")
(os/exit 0))
(unless (d/chez-available?)
(print "skip: chez not on PATH")
(os/exit 0))
(def ctx (d/make-ctx))
# Collect every clojure.core var name (mapping keys are symbol structs).
(def names @{})
(each ns (tctx/all-ns ctx)
(when (= (get ns :name) "clojure.core")
(eachk sym (get ns :mappings)
(def n (cond (struct? sym) (get sym :name)
(string? sym) sym
(symbol? sym) (string sym)
nil))
(when n (put names n true)))))
(def name-list (sort (keys names)))
(printf "clojure.core has %d interned names" (length name-list))
# Assemble the prelude once.
(def [prelude-scm emitted total] (d/emit-core-prelude ctx))
(def prelude-path (string "/tmp/jolt-nil-probe-prelude-" (os/getpid) ".ss"))
(spit prelude-path prelude-scm)
(printf "prelude: %d/%d non-macro core forms emitted" emitted total)
# Build a Chez program that derefs each name and prints the nil ones.
(def buf @"")
(buffer/push buf "(import (chezscheme))\n(load \"host/chez/rt.ss\")\n")
(buffer/push buf "(set-chez-ns! \"clojure.core\")\n")
(buffer/push buf (string "(load " (string/format "%j" prelude-path) ")\n"))
(buffer/push buf "(load \"host/chez/post-prelude.ss\")\n")
(buffer/push buf "(set-chez-ns! \"user\")\n")
(each n name-list
(buffer/push buf
(string "(when (jolt-nil? (var-deref \"clojure.core\" " (string/format "%j" n)
")) (display " (string/format "%j" n) ") (newline))\n")))
(def prog-path (string "/tmp/jolt-nil-probe-" (os/getpid) ".ss"))
(spit prog-path buf)
(def proc (os/spawn ["chez" "--script" prog-path] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def nils (filter (fn [s] (> (length s) 0)) (string/split "\n" (string/trim (if out (string out) "")))))
(printf "\n%d clojure.core names resolve to jolt-nil on Chez:" (length nils))
(each n (sort nils) (print " " n))
(when (and err (> (length (string/trim (string err))) 0))
(printf "\nstderr:\n%s" (string err)))
(printf "\n(probe exit %d)" code)

212
test/chez/run-corpus-zero-janet.janet
View file

@ -1,212 +0,0 @@
# Phase 3 inc7 (jolt-qjr0) — FULL corpus on the ZERO-JANET spine.
#
# run-corpus-prelude.janet measures RUNTIME parity: it analyzes each case with the
# JANET-hosted analyzer (the oracle) and runs the emitted Scheme on Chez. This
# runner closes the last gap: it analyzes each case with the CHEZ-HOSTED analyzer
# (jolt.analyzer cross-compiled to Scheme, run on Chez over host-contract.ss) —
# read -> analyze -> IR -> emit -> eval, NO Janet in the loop (eval-zero-janet).
#
# So this is the real test of self-hosting: where run-corpus-prelude proves the
# RUNTIME is faithful, this proves the COMPILER-on-Chez is faithful. A case that
# the Janet analyzer compiles but the Chez analyzer can't surfaces here as a crash
# (analyzer/emitter raised) or a divergence (ran, wrong value). The buckets form
# the inc7 punch-list; genuinely host-coupled cases (Java interop, runtime eval)
# are deferred to Phase 4 / jolt-r8ku and allowlisted, like the prelude gate.
#
# JOLT_CHEZ_ZEROJANET_CORPUS=1 janet test/chez/run-corpus-zero-janet.janet
# JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast iteration)
(import ../../host/chez/driver :as d)
(import ../../host/chez/jolt-chez :as jc)
(unless (os/getenv "JOLT_CHEZ_ZEROJANET_CORPUS")
(print "skip: set JOLT_CHEZ_ZEROJANET_CORPUS=1 to run the zero-Janet corpus gate")
(os/exit 0))
(unless (d/chez-available?)
(print "skip: chez not on PATH")
(os/exit 0))
(def ctx (d/make-ctx))
(def prelude-path (jc/ensure-prelude ctx))
# Compiler image (jolt.ir + jolt.analyzer + jolt.backend-scheme cross-compiled to
# Scheme), cached by the same source fingerprint the spine-test uses.
(defn- image-fingerprint []
(string/slice (string (hash (string/join
(map slurp ["jolt-core/jolt/ir.clj" "jolt-core/jolt/analyzer.clj"
"jolt-core/jolt/backend_scheme.clj" "host/chez/host-contract.ss"
"host/chez/compile-eval.ss"])))) 0))
(def image-path
(string (or (os/getenv "TMPDIR") "/tmp") "/jolt-compiler-image-" (image-fingerprint) ".ss"))
(def t0 (os/clock))
(d/ensure-compiler-image ctx image-path)
(printf "prelude + compiler image ready (%.1fs)" (- (os/clock) t0))
(flush)
(def corpus (parse (slurp "test/chez/corpus.edn")))
(def cases
(if-let [n (os/getenv "JOLT_CORPUS_LIMIT")]
(let [stride (max 1 (math/floor (/ (length corpus) (scan-number n))))]
(seq [i :range [0 (length corpus) stride]] (in corpus i)))
corpus))
# Known divergences/crashes: cases the Chez-hosted compiler can't yet handle that
# are tracked elsewhere (NOT analyzer-faithfulness bugs). Tolerated so the gate
# fails only on a NEW regression. Keyed by label.
# - host interop (Java classes / constructors / .method on host types): Phase 4
# jolt-cf1q.7. Same family the prelude gate buckets as crashes.
# - eval / load-string / read->eval: the jolt-r8ku tail (runtime compiler entry).
(def known-fail
# Conformance gaps vs the JVM spec: cases jolt does not match because it has no
# JVM host (no Class objects / Java arrays / BigDecimal), supports the :jolt
# reader-conditional feature, or prints its own forms for transients/atoms.
@{# --- host classes: a class token resolves to a name string, not a Class ------
"class name evaluates to canonical string" true
"class number" true "class string" true "class keyword" true
"definterface defines" true
"getMessage on a thrown string" true
"type of record" true "chunked-seq? always false" true
"^Type tag on var" true "symbol hint -> :tag" true
"lists extended type" true "seq of tags" true
"close on throw" true # duck-typed with-open close, no .close interop
"macroexpand-1" true # returns a value, not the JVM Cons form
"ns-imports empty user" true
"bean is the map" true "proxy resolves nil" true
"unchecked-char" true
# --- *in* is a map on Chez, not a JVM Reader --------------------------------
"*in* is bound" true "*in* bound" true
# --- no BigDecimal type -----------------------------------------------------
"bigdec" true "bigdec int M" true "bigdec suffix M" true
# --- printer: jolt renders its own forms (transient/atom/Infinity, no
# print-method multimethod integration) where the JVM prints #object ------
"transient vector" true "transient map" true
"atom override fires nested" true "inf inside coll" true "pr-str Infinity" true
"defmethod overrides a record, top level" true
"defmethod fires nested in a map" true "defmethod fires through prn" true
"direct builtin override" true "methods table inspectable" true
# --- reader: :jolt reader-conditional feature + syntax-quote literal collapse -
"reader conditional" true "reader cond :jolt" true "reader cond no match" true
"reader cond splice" true "reader cond splice no match" true
"nil nested" true "bool nested" true
"source order through syntax-quote" true # syntax-quote map: hash, not source, order
# --- Java arrays are distinct host objects, not seqs --------------------------
"make-array" true "into-array" true "to-array" true "aclone vec" true
"boolean-array" true "int-array" true "long-array" true "double-array" true
"float-array" true "short-array" true "doubles" true "floats" true
"reader over char[]" true
# --- atom class identity not mapped on Chez ---------------------------------
"atom?" true "instance? Atom" true
# --- future-cancel races completion (timing-dependent) -----------------------
"cancel an in-flight future returns true" true
"future-cancelled? after cancel" true
# --- (fn* foo) with no param vector throws; the JVM builds a fn object --------
"no param vector" true})
# Cases that BLOCK forever on a shared-heap / JVM host (profile.edn :bucket
# :timeout) — skip them, like :throws: a single hung case would stall the whole
# batched process. (deref of an undelivered promise blocks on the JVM and now on
# Chez; Janet's non-blocking atom-shim returned nil.)
(def skip-blocking @{"promise undelivered" true})
(var pass 0)
(def crashes @[]) # nonzero chez exit (analyzer/emitter raised, or runtime gap)
(def diverged @[]) # ran, wrong value (a real Chez-compiler divergence)
(def known-hit @[])
(def crash-keys @{})
(defn- bucket [tbl k] (put tbl k (+ 1 (or (get tbl k) 0))))
# Group a chez stderr message into a coarse reason for the punch-list.
(defn- crash-reason [m]
(def m (string/trim m))
(cond
(string/find "unsupported stdlib" m) "emit: unsupported stdlib fn"
(string/find "unsupported host" m) "emit: unsupported host call"
(string/find "host-static" m) "emit: host-static"
(string/find "syntax-quote" m) "form-syntax-quote-lower"
(string/find "uncompil" m) "analyzer: uncompilable"
(string/find "Unknown class" m) "runtime: unknown class"
(string/find "No constructor" m) "runtime: no constructor"
(string/find "No method" m) "runtime: no method"
(string/find "not a fn" m) "runtime: not a fn"
(string/find "not seqable" m) "runtime: not seqable"
(string/find "not a transient" m) "runtime: not a transient"
(string/find "integer->char" m) "runtime: integer->char"
(string/find "non-condition value" m)
(let [i (string/find "non-condition value" m)]
(string "raised: " (string/slice m (+ i 20) (min (length m) (+ i 60)))))
(string/slice m 0 (min 56 (length m)))))
(def t1 (os/clock))
(var throws 0)
# Build the evaluable case list (skip :throws), keyed by index (labels aren't
# unique across suites). Each pair carries EXPECTED + ACTUAL as SEPARATE source
# strings; the runner evaluates ACTUAL as its own top-level program (so its
# top-level `do` unrolls and a macro defined in the program is usable later —
# matching certify.clj's eval-isolated) and compares to EXPECTED with =. Wrapping
# in (= E A) would nest ACTUAL's do and break runtime defmacro (jolt-cf1q.7).
(def rows-by-idx @{})
(def pairs @[])
(eachp [i row] cases
(def {:expected e :actual a :label l} row)
(if (or (= e :throws) (get skip-blocking l))
(++ throws)
(let [key (string i)]
(put rows-by-idx key row)
(array/push pairs [key e a]))))
(defn- handle [key verdict]
(def row (get rows-by-idx key))
(def l (get row :label))
(case (first verdict)
:pass (++ pass)
:crash (let [k (crash-reason (get verdict 1))] (bucket crash-keys k) (array/push crashes [l k]))
:diverge (if (known-fail l) (array/push known-hit l)
(array/push diverged [l (string "got " (get verdict 1))]))))
(if (os/getenv "JOLT_ZJ_PERCASE")
# slow per-case path (each case its own chez process) — for isolating a hang/crash.
# Eval ACTUAL and EXPECTED top-level (separate processes), compare printed forms.
(each [key e a] pairs
(def [acode aout aerr] (d/eval-zero-janet prelude-path image-path a))
(def [_ eout _] (d/eval-zero-janet prelude-path image-path e))
(handle key (cond (not= acode 0) [:crash aerr] (= aout eout) [:pass] [:diverge aout])))
# fast batched path: one chez process loads the runtime once, runs all cases
(let [{:results r :code c :stderr se :count n} (d/eval-corpus-zero-janet prelude-path image-path pairs)]
(when (< n (length pairs))
(printf "WARNING: batched runner returned %d/%d results (chez exit %d): %s"
n (length pairs) c (string/slice se 0 (min 200 (length se)))))
(each [key _] pairs
(handle key (or (get r key) [:crash (string "no result (batch aborted) " se)])))))
(def n-eval (+ pass (length crashes) (length diverged) (length known-hit)))
(printf "\nZero-Janet corpus parity: %d/%d evaluated cases pass (%.1fs)" pass n-eval (- (os/clock) t1))
(printf " crash: %d NEW divergence: %d known: %d (throws skipped: %d)"
(length crashes) (length diverged) (length known-hit) throws)
(defn- report [title tbl]
(when (> (length tbl) 0)
(printf "\n%s:" title)
(each k (sort-by (fn [k] (- (get tbl k))) (keys tbl))
(printf " %4d x %s" (get tbl k) k))))
(report "crash reasons" crash-keys)
(when (os/getenv "JOLT_DUMP_CRASH_LABELS")
(printf "\nCRASH LABELS:")
(each [l k] (sort-by (fn [pair] (get pair 1)) crashes)
(printf " [%s] :: %s" k l))
(printf "\nKNOWN-HIT LABELS:")
(each l (sort known-hit) (printf " %s" l)))
(when (> (length diverged) 0)
(printf "\nNEW divergences (ran, wrong value) — gate FAILS:")
(each [l m] (slice diverged 0 (min 40 (length diverged)))
(printf " [%s] %s" l m)))
(when (> (length known-hit) 0)
(printf "\n%d known (allowlisted) failures tolerated." (length known-hit)))
(flush)
# Regression floor: cases that pass against the JVM corpus. The gate fails on any
# NEW divergence or if pass drops below the floor. Raise as host gaps close.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2678")))
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))
(os/exit (if (or (> (length diverged) 0) (< pass floor)) 1 0))

97
test/chez/spine-test.janet
View file

@ -1,97 +0,0 @@
# Chez Phase 3 inc6 (jolt-hs9n) — the zero-Janet spine.
#
# Validates that the analyzer + emitter, cross-compiled to Scheme and run ON CHEZ
# over the host contract (host-contract.ss), compile and run macro-free Clojure
# from source with NO Janet in the loop: read (reader.ss) -> analyze (jolt.analyzer
# on Chez) -> IR -> emit (jolt.backend-scheme on Chez) -> eval.
#
# Oracle = the Janet-hosted analyzer through the SAME Chez emitter/RT/printer
# (d/eval-e-with-prelude): the only difference under test is WHERE analysis runs
# (Janet vs Chez), so equal stdout means moving analysis onto Chez is behavior-
# preserving. Macros (let/when/->/defn) are inc6b (jolt-r8ku, runtime macros).
#
# janet test/chez/spine-test.janet
(import ../../src/jolt/api :as api)
(import ../../host/chez/driver :as d)
(import ../../host/chez/jolt-chez :as jc)
(var total 0) (var fails 0)
(defn ok [name pred &opt extra]
(++ total)
(if pred (printf "ok: %s" name)
(do (++ fails) (printf "FAIL: %s %s" name (or extra "")))))
(unless (d/chez-available?)
(print "chez not on PATH — skipping spine-test")
(os/exit 0))
(def ctx (d/make-ctx))
(def prelude-path (jc/ensure-prelude ctx))
# compiler image cache, keyed by the cross-compiled sources + the host contract.
(defn- image-fingerprint []
(string/slice (string (hash (string/join
(map slurp ["jolt-core/jolt/ir.clj" "jolt-core/jolt/analyzer.clj"
"jolt-core/jolt/backend_scheme.clj" "host/chez/host-contract.ss"
"host/chez/compile-eval.ss"])))) 0))
(def image-path
(string (or (os/getenv "TMPDIR") "/tmp") "/jolt-compiler-image-" (image-fingerprint) ".ss"))
(d/ensure-compiler-image ctx image-path)
# Each case: the Chez-hosted spine value must equal the Janet-hosted oracle value
# (both printed via jolt-final-str on Chez).
(defn check [src]
(def [ocode oout oerr] (d/eval-e-with-prelude ctx src prelude-path))
(def [acode aout aerr] (d/eval-zero-janet prelude-path image-path src))
(cond
(= ocode :emit-err) (ok src false (string "oracle emit-err: " oout))
(not (zero? acode)) (ok src false (string "zero-janet exit " acode ": " aerr " | out=" aout))
(ok src (= oout aout) (string "chez=" aout " oracle=" oout))))
# macro-free forms: handled specials (if/do/fn*), native ops, consts, invoke.
(each src
["(if true 10 20)"
"(if false 10 20)"
"(do 1 2 3)"
"(+ 1 2)"
"(- 10 3 2)"
"((fn* [x] (* x x)) 7)"
"((fn* [x] (+ x 1)) 5)"
"((fn* [a b] (+ a b)) 3 4)"
"(if (< 3 5) :yes :no)"
"(if (> 3 5) :yes :no)"
"((fn* [x] (if x :t :f)) true)"
"(do (if true 1 2) (* 6 7))"
"((fn* [n] (* n n n)) 4)"
"(< 1 2)"
"(= 5 5)"]
(check src))
# inc6b (jolt-r9lm): runtime macros — the on-Chez analyzer expands core macros
# (emitted into the prelude as expander fns + a macro flag). Same oracle: the
# Janet analyzer expands them at analyze time, the value must match.
(each src
["(when true 1)"
"(when false 1)"
"(when true 1 2 3)"
"(when-not false 5)"
"(let [a 1] (+ a 2))"
"(let [a 1 b 2] (+ a b))"
"(let [a 1 b (+ a 1)] (* a b))"
"(-> 1 inc inc)"
"(-> 5 (- 2))"
"(->> 3 (- 10))"
"(and 1 2 3)"
"(and 1 false 3)"
"(or nil 5)"
"(or false nil 7)"
"(cond false 1 true 2)"
"(cond false 1 :else 3)"
"(if-not false :a :b)"
"(do (defn f [x] (* x x)) (f 6))"
"(do (defn g [x y] (+ x y 1)) (g 3 4))"
"(let [a 1] (when (< a 5) (-> a inc inc)))"]
(check src))
(printf "\n%d/%d ok" (- total fails) total)
(when (> fails 0) (os/exit 1))

12
test/chez/unit.edn
View file

@ -114,27 +114,27 @@
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.getName (io/file \"/a/b/c.txt\")))" :expected "c.txt"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.getPath (io/file \"/a\" \"b\")))" :expected "/a/b"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.isDirectory (io/file \"docs\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.isFile (io/file \"project.janet\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.isFile (io/file \"README.md\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.isFile (io/file \"docs\")))" :expected "false"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.exists (io/file \"/no/such/path/xyz\")))" :expected "false"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.exists (io/file \"project.janet\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.exists (io/file \"README.md\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (instance? java.io.File (io/file \"/a/b\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (instance? java.io.File \"/a/b\"))" :expected "false"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (str (type (io/file \"/a\"))))" :expected ":jolt/file"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (every? (fn [f] (instance? java.io.File f)) (file-seq (io/file \"docs\"))))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (pos? (count (filter (fn [f] (.isFile f)) (file-seq (io/file \"docs\"))))))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"project.janet\")) (file-seq \".\"))))" :expected "true"}
{:suite "io" :expr "(string? (slurp \"project.janet\"))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"README.md\")) (file-seq \".\"))))" :expected "true"}
{:suite "io" :expr "(string? (slurp \"README.md\"))" :expected "true"}
{:suite "io" :expr "(do (spit \"/tmp/jolt-io-test.txt\" \"hello\") (slurp \"/tmp/jolt-io-test.txt\"))" :expected "hello"}
{:suite "io" :expr "(do (spit \"/tmp/jolt-io-test.txt\" \"a\") (spit \"/tmp/jolt-io-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-io-test.txt\"))" :expected "ab"}
{:suite "io" :expr "(flush)" :expected ""}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/file \"project.janet\"))))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/file \"README.md\"))))" :expected "true"}
{:suite "ioreader" :expr "(str (char-array \"abc\"))" :expected "(\\a \\b \\c)"}
{:suite "ioreader" :expr "(.read (StringReader. (apply str (char-array \"Qz\"))))" :expected "81"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.read (io/reader (char-array \"abc\"))))" :expected "97"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.read (io/reader (StringReader. \"k\"))))" :expected "107"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (slurp (io/reader (char-array \"xyz\"))))" :expected "xyz"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/reader \"project.janet\"))))" :expected "true"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/reader \"README.md\"))))" :expected "true"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.toString (.toURL (io/file \"/tmp/x\"))))" :expected "file:/tmp/x"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.toURI (io/file \"/tmp/x\")))" :expected "file:/tmp/x"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.getPath (.toURL (io/file \"/tmp/x\"))))" :expected "/tmp/x"}