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

Move the Chez test oracle off Janet

Browse source 
The unit tests in test/chez/_*.janet now drive bin/joltc (the zero-Janet
spine) and judge against baked expected values instead of a live build/jolt
run. Ten of them captured the oracle from build/jolt per case; their values
are now literals (one env-dependent javastatic case became a predicate so it
stays portable). The rest already had literal expecteds with a redundant
build/jolt sanity check, now dropped.

Retire emit-test/emit-parity/reader-parity: they compared the Chez/Clojure
path against a live Janet evaluation, emitter, or reader. That migration check
is done, and run-corpus-zero-janet (Chez analyzer vs the JVM corpus) plus
certify.clj cover correctness now.

Rewrite the README for the current zero-Janet gate.

jolt-5oci
This commit is contained in:
Yogthos 2026-06-21 09:48:49 -04:00
parent 8d4f83e0f7
commit 9a273e71cd
21 changed files with 205 additions and 1510 deletions
Download patch file Download diff file Expand all files Collapse all files

280
test/chez/README.md
View file

@ -1,248 +1,60 @@
# Chez port — Phase 0 test contract harness
# Chez test harness
The host-neutral correctness gate for the Chez re-host (epic jolt-cf1q). The
spec corpus is data, so the SAME contract validates every host.
The correctness gate for jolt on Chez (epic jolt-cf1q). Correctness is judged
against the JVM-sourced conformance spec — no Janet decides pass/fail. The spec
itself lives in `test/conformance/` (see its `SPEC.md`); this directory holds the
Chez runners and unit tests.
## Files
- `extract-corpus.janet` — parses `test/spec/*.janet` `(defspec …)` tables as
data and writes `corpus.edn` (2655 `[label expected actual]` cases). The file
is valid as BOTH EDN (a future Chez-jolt runner) and Janet data (the runner
below). Regenerate: `janet test/chez/extract-corpus.janet`.
- `corpus.edn` — the extracted contract (generated; checked in for convenience).
- `run-corpus.janet` — drives a TARGET jolt binary, one fresh subprocess per case
(fresh ctx = per-case isolation), checking `(= expected actual)` prints `true`
at the CLI, or that a `:throws` case exits non-zero. Pluggable target:
- `janet test/chez/run-corpus.janet` # default build/jolt
- `JOLT_BIN=build/jolt-chez janet test/chez/run-corpus.janet` # Phase 1+
- `JOLT_CORPUS_LIMIT=400 …` # every-Nth stride, fast
- `known-divergences.edn` — allowlist of cases that diverge at the CLI boundary.
The gate fails only on a NEW divergence; known ones are reported but tolerated.
- `values-test.ss` / `../../host/chez/values.ss` — Phase 0a value model + tests.
## The spec corpus
## The reference baseline (2026-06-17, Janet `build/jolt`, compile mode)
2641/2655 pass; 14 known divergences. They split into:
- **interpret-vs-compile leniency** — `:throws` cases where interpret mode raises
but compile mode returns (`< nil`, `> with nil`, `neg? keyword`, `max`/`min-key`
on non-numbers). Several are also non-canonical vs JVM Clojure.
- **invoke-collection-as-fn** — the `transient / invokable lookup` suite invokes
transients/collections as fns (`((transient {:x 7}) :x)`); compile mode (and
JVM Clojure) reject it.
- **`xml-seq walks`** — one structural case.
- `corpus.edn` — the contract: ~2920 rows `{:suite :label :expected :actual}`,
with `:expected` sourced from reference JVM Clojure. Valid as both EDN and Janet
data. Generated by `test/conformance/regen-corpus.clj` (the answers) over the
case list from `extract-corpus.janet` (the `:actual` strings, pulled from
`test/spec/*.janet` and `conformance-test.janet`).
- `extract-corpus.janet` — re-derives the case list when spec rows change. Writes
only when `JOLT_EXTRACT_CORPUS_OUT` is set, so a gate run never clobbers the
JVM-sourced `corpus.edn`. After re-deriving, re-source the answers with
`regen-corpus.clj`.
The compile-only Chez host (JVM-canonical oracle) should MATCH OR FIX these. The
gate's job is to catch *regressions* the port introduces, not to bless these.
## The standing gate
## Why the CLI boundary
The runner tests through `jolt -e`, exactly how the Chez host will be exercised —
not the in-process `eval-string` the Janet `defspec` harness uses. The two differ
on a handful of cases (the allowlist), and the CLI boundary is the portable one.
`run-corpus-zero-janet.janet` runs every corpus case through the zero-Janet
spine: read → analyze → IR → emit → eval, all on Chez (the analyzer is
`jolt.analyzer` cross-compiled to Scheme over `host-contract.ss`). Each result is
compared by value-equality against the JVM `:expected`. A `known-fail` allowlist
covers cases jolt can't match because Chez has no JVM host (Java classes, arrays,
`BigDecimal`, opaque host-object printers, …); the gate fails only on a NEW
divergence or if the pass count drops below the floor.
## Phase 1 — first parity number (subset probe)
The full `run-corpus.janet` gate drives an `-e`-capable jolt binary; the Chez
host can't answer arbitrary `-e` until all of clojure.core is bootstrapped onto
Chez (Phase 2). Until then, `run-corpus-chez.janet` reports parity for the subset
the Phase-1 back end (`host/chez/emit.janet`) can already compile: each case is
run through the live analyzer → Scheme emitter → Chez via `host/chez/driver`.
Cases that reference unimplemented stdlib/host fns fail to EMIT (a clean
compile-time signal) and are counted "out of subset", not as divergences.
JOLT_CHEZ_ZEROJANET_CORPUS=1 janet test/chez/run-corpus-zero-janet.janet
JOLT_CORPUS_LIMIT=200 … # every-Nth stride, fast iteration
JOLT_CHEZ_CORPUS=1 janet test/chez/run-corpus-chez.janet
Floor: 2678 (`JOLT_CHEZ_ZJ_FLOOR` overrides). Raise it as host gaps close.
Baseline after inc 3g (letfn + declare): **672/672 compiled cases pass**, 0
divergences; 1986/2658 out of subset (await clojure.core on Chez). Inc 3e
(throw/try + ex-info) was 632/632; inc 3f's quote support + a seq.ss fix (empty
`map`/`filter` results are `()` not nil, matching Clojure) reached 664/664; inc 3g
(letfn -> Scheme `letrec*`, declare/def-no-init -> a reserved var cell) pulled 8
more corpus cases into the subset. `emit-fn` lowers multi-arity fns to a Scheme
`case-lambda` and variadic fns to a rest-arg lambda (rest list coerced to a jolt
seq, nil when empty).
## Unit tests
## Phase 1 — clojure.core prelude emission (inc 3d, jolt-ocvi)
The `-e`-capable jolt-chez path: emit the clojure.core tiers
(`jolt-core/clojure/core/NN-*.clj`) through the same analyzer → emit pipeline as a
Scheme PRELUDE of `def-var!` forms, so user code's `(var-deref "clojure.core" …)`
resolves the fn at runtime. `emit/set-prelude-mode!` flips a switch: in the default
(subset) mode a non-native `clojure.core` ref is rejected ("out of subset"); in
prelude mode it lowers to a runtime `var-deref` so core fns chain through each
other. Host interop (`:host`) and unhandled IR ops still error in both modes —
those are the real gaps that need a hand-written RT shim or new emit support.
`_*.janet` drive `bin/joltc` (the pure-Chez CLI; `JOLT_BIN` overrides) one
subprocess per case and compare the last stdout line against a baked expected
value. `:throws` asserts a non-zero exit. Each file targets one area —
`_type`/`_class`/`_seqpred` (taxonomy + predicates), `_str`/`_strns`/`_reader`
(strings + reader), `_io`/`_ioreader`/`_insttime`/`_javastatic` (host interop),
`_dynbind`/`_var_meta`/`_ns` (vars + namespaces), `_atomwatch`/`_walk`/`_dotform`
/`_stdlib` (refs, walk, dot-forms, stdlib). Run one with
`janet test/chez/_type.janet`.
`core-prelude-probe.janet` (gated behind `JOLT_CHEZ_PRELUDE=1`) measures reach and
catalogs the gaps; macros are skipped (analyze-time only, not a runtime value):
## Self-host gates
JOLT_CHEZ_PRELUDE=1 janet test/chez/core-prelude-probe.janet
- `spine-test.janet` — the zero-Janet compile/eval spine end to end.
- `cli-test.janet` — `bin/joltc -e` behavior.
- `bootstrap-test.janet` — `host/chez/bootstrap.ss` rebuilds the prelude + image
from source on Chez and matches the checked-in seed (`host/chez/seed/`).
- `fixpoint-test.janet` — the on-Chez compiler reproduces itself (stage2 == stage3,
prelude pstage3 == pstage4).
Baseline after inc 3i (regex): **355/355 non-macro core forms emit** to Scheme —
the whole non-macro clojure.core now lowers. inc 3i closed the last gap, the regex
literal in `parse-uuid`: a `#"…"` literal lowers to a `:regex` IR node and the Chez
emitter emits a `jolt-regex` value over **vendored irregex** (Alex Shinn, BSD,
`vendor/irregex` submodule) — a portable Scheme regex with PCRE/Java-style string
patterns. `re-pattern`/`re-matches`/`re-find`/`re-seq`/`regex?` are `def-var!`'d
into clojure.core (`host/chez/regex.ss`); they stay OUT of the subset native-ops
(irregex's Unicode/property-class semantics differ from the seed's byte-PEG
approximation), so they resolve in prelude mode — the path the assembled prelude
takes — without dragging engine-difference divergences into the subset corpus. The
Janet back end punts `:regex` to the interpreter (the seed compiles `#"…"` to a
Janet PEG). Prior incs: inc 3h `.method` → `:host-call` (`jolt-host-call` for
`.write`/`.isDirectory`/`.listFiles`); `:quote`, `:throw`, `:try`, `ex-info`,
`letfn` → `letrec*`, `declare`/def-no-init → reserved var cell. The probe has a
regression floor (355) — every non-macro core form must keep emitting.
## Bench
## Phase 1 — the assembled prelude: -e-capable jolt-chez (inc 3j, jolt-9ziu)
Once the whole non-macro clojure.core emits (inc 3i), the milestone is to ASSEMBLE
it: `driver/emit-core-prelude` emits every non-macro core form across the
dependency-ordered tiers as a `def-var!` (prelude mode), concatenated into a
Scheme prelude. `bin/jolt-chez -e EXPR` loads `rt.ss` + that prelude + a
post-prelude override, emits the user expression in prelude mode, and runs it on
Chez — an `-e`-capable jolt-chez (analysis on Janet, execution on Chez). The
prelude is cached on disk keyed by a fingerprint of the core sources + the RT.
`bench-pipeline.janet` (opt-in via `JOLT_CHEZ_BENCH=1`) times fib + mandelbrot
through the real pipeline against the spike ceiling. Skipped in the gate.
`run-corpus-prelude.janet` is the full parity gate this opens (the prelude-backed
sibling of `run-corpus-chez.janet`): it assembles the prelude once, then runs every
corpus case with all of core present, bucketing the result —
JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet
JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast)
Parity baseline: inc 3j **1220/2497**; 3k (converters, jolt-t6cr) **1326**;
3l (transients, jolt-kl2l) **1382**; 3m (numeric-edge emit + variadic assoc!,
jolt-q3w8) **1407/2497**, 0 NEW divergences (14 allowlisted:
dynamic vars `*ns*`/`*clojure-version*`/`*unchecked-math*`, var/`*ns*` rendering,
class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps).
- inc 3k `host/chez/converters.ss`: `str`/`subs`/`vec`/`keyword`/`symbol`/`compare`/
`int`/`double`/`gensym` (seed natives — `str` reuses the printer, `compare` is the
3-way port, the symbol no-ns sentinel is `#f` to match emit's quoted-symbol
lowering so `(= 'x (symbol "x"))` holds).
- inc 3l `host/chez/transients.ss`: `transient`/`persistent!`/`conj!`/`assoc!`/
`dissoc!`/`disj!`/`pop!` as copy-on-write over the persistent collections (correct
semantics, no in-place perf), plus persistent `disj`. `get`/`count`/`contains?`
are redefined to see THROUGH a transient (frequencies/group-by do `(get tm k)` on a
transient map); `vector?` on a transient vector is false, which group-by relies on.
- inc 3m: `##Inf`/`##-Inf`/`##NaN` emitted to bare `inf`/`nan` (unbound in Chez);
emit-const now lowers them to `+inf.0`/`-inf.0`/`+nan.0`, the `-e` printer renders
`inf`/`-inf`/`nan` and `str` renders `Infinity`/`-Infinity`/`NaN` (Clojure). Plus
variadic `assoc!`. (`str` of inf *inside a collection* still wants the long form —
the Phase-2 recursive str renderer — so `[inf inside coll]` is allowlisted.)
- inc 3n `host/chez/natives-seq.ss` (jolt-y6mv): the dominant prelude-parity crash
bucket was `apply non-procedure jolt-nil` — core fns calling seed-native seq fns
(`src/jolt/core_coll.janet`) that have no Chez shim, so `var-deref` yields
jolt-nil. A static scan of the assembled prelude found 52 referenced-but-undefined
`clojure.core` names; this increment shims the safe, high-value seq fns: `mapcat`/
`take-while`/`drop-while`/`partition` (collection arities — the 1-arg transducer
forms are jolt-kxsr), `sort` (compare default; a comparator may return a 3-way
number or a boolean less-than), and `reduced`/`reduced?` — a `jolt-reduced` record
in `seq.ss` that `reduce` short-circuits on and `deref` unwraps (so `unreduced`
works). `identical?` = `jolt=` (the seed's definition). `list?` was deferred: a
Chez lazy seq and a list are both `cseq`, so it can't be told apart without a
distinct list type (a real divergence risk).
- inc 3o transducer arities (jolt-kxsr): the 1-arg `map`/`filter`/`remove`/`take`/
`drop`/`take-while`/`drop-while`/`mapcat` return a transducer `(fn [rf] rf')`, and
`into` gets a 3-arg `(into to xform from)`. These were the `cdr () is not a pair` /
`incorrect number of arguments` crash bucket: the emitter lowers `(map f)` /
`(into to xf from)` at the wrong arity to the bare native procedure (the
value-position path), so the fix is RT-side — `case-lambda` the seq procedures and
`jolt-into`. The `td-*` factories are ported from the seed (core_coll.janet); a
`reduced` step stops the fold via reduce-seq's short-circuit. `transduce`/`comp`/
`completing` are overlay and compose over these for free.
- inc 3p misc seq/regex gaps (jolt-y1zq): 0-arg `(conj)` -> `[]`, 0-arg `(conj!)` ->
a fresh transient vector, `nth` sees through a transient (like get/count/contains?),
and irregex `\p{...}`/`\P{...}` property classes translate to the seed's ASCII char
classes (regex.ss; `\p{L}`->`[a-zA-Z]`, `\p{N}`->`[0-9]`, `\p{Ps}`->`[([{]`, …) —
ASCII-only (the seed counts UTF-8 high bytes as letters, which a Unicode-char Scheme
string can't reproduce; the corpus tests ASCII, where they agree) and
`clojure.math/PI` (missing ns).
Two pre-existing bugs surfaced here, since fixed (inc 3x / 3y below).
- inc 3q multimethod dispatch + late-bind (jolt-9ls5, Phase 2): `host/chez/
multimethods.ss` implements the multimethod runtime — `defmulti`/`defmethod`
expand to `defmulti-setup`/`defmethod-setup` calls (+ `get-method`/`methods`/
`remove-method`/`prefer-method`/`prefers`). A `jolt-multifn` record carries its
dispatch fn and a `jolt=`-keyed method table; `jolt-invoke` dispatches it (exact
match, then isa?/hierarchy with `prefer-method`, then `:default`), reusing the
overlay's `isa?`/`derive`/`make-hierarchy`. The multifn's ns is set via a runtime
`chez-current-ns` (default "user"; the prelude load sets "clojure.core").
Two emit-side changes made this work:
- **late-bind** (`:late-bind-unresolved?` ctx flag, default OFF): `defmulti`
expands to a bare-symbol setup *call*, so the analyzer doesn't intern the name
and a forward reference (`(area …)` after `(defmulti area …)` in one form) was
"Unable to resolve symbol". The strict compiler punts these to the interpreter;
the Chez back end has none, so the flag makes an unresolved symbol lower to a
`var-ref` against the compile ns — the open-world semantics of `-e`. Set only by
the Chez `make-ctx`/`jolt-chez`; the main compiler keeps its strict behavior.
- a `:var` call head now routes through `jolt-invoke` (not a direct application),
since a late-bound var can hold a multifn (or a keyword/coll IFn), not just a
procedure. Transparent for procedures; the hot self-recursive call is a `:local`
known-proc, so it stays direct. (Class-based dispatch — `(class x)`/`String` — is
deferred; it needs the deftype/class subsystem.)
- inc 3r dynamic-var constants (jolt-9ls5): `host/chez/dynamic-vars.ss` binds the seed
natives `*clojure-version*` (the `{:major 1 :minor 11 …}` map) and `*unchecked-math*`
(false), removing their two parity allowlist entries. `*ns*` is deferred (jolt-b4kl):
it needs a namespace value that is not a map (`map?` false) yet answers
`(get ns :name)` for the overlay `ns-name`, plus `str`/`find-ns` support.
- inc 3x non-ASCII string literals (jolt-x0os): `emit.janet`'s `chez-str-lit` replaces
the `%j` string encoder. Janet's `%j` renders a non-ASCII char as raw UTF-8 bytes
(`\xC3\xA9`) and a control char / DEL as `\xHH` with NO terminating semicolon — both
forms Chez's reader rejects. `chez-str-lit` UTF-8-decodes each char and emits a
codepoint hex escape `\x<cp>;` (`é`->`\xe9;`, `日`->`\x65e5;`), keeping `\n`/`\t`/`\r`/
`\"`/`\\` and being byte-identical to `%j` for printable ASCII. Applied to every
string-content site (string/keyword/symbol/var-name/regex-source). This unblocks the
`p{L} utf-8` corpus case (the `\p{L}` translation was already correct). Note: `count`/
`subs`/`nth` over a multibyte string index by BYTES in the seed but by codepoints on
Chez — a separate semantic gap, not addressed here.
- inc 3y seed assoc! odd-args (jolt-ea9k): `core-assoc!` (src/jolt/core_extra.janet) now
throws on an odd key/val count, like plain `assoc` and Clojure's `assoc!` — the former
lenient nil-fill was non-Clojure and inconsistent with the seed's own `assoc`. The 4
`assoc! odd args` spec rows became 3 `:throws` + 1 even-args positive; corpus.edn
regenerated. The Chez host already threw, so this only realigns the corpus contract.
- Phase 1 close-out (jolt-nkcb): truthy? elision + end-to-end compute bench. `emit.janet`
now drops the redundant `jolt-truthy?` wrapper on an `:if` test that provably yields a
Scheme boolean (a native comparison/`not`, or a boolean const) — sound because
`jolt-truthy?` of `#t`/`#f` is identity; the hot fib/mandelbrot tests are all
comparisons, so this is a direct ceiling lever (fib 30 end-to-end 24.0 -> 14.4 ms).
`bench-pipeline.janet` (JOLT_CHEZ_BENCH=1, opt-in) times fib(30) + mandelbrot(200)
through the real pipeline vs the spike ceiling: mandelbrot 87 ms runs AT the
generic-flonum ceiling (98 ms); fib is 2x its hand-flonum ceiling, the residual being
jolt's all-double number model (typed fl*/fx* emission = Phase 4). Compile-only is
total for the compute subset (every form emits; Chez has no interpreter fallback).
The remaining buckets are the punch-list the next increments chase: ~361 emit-fail
(genuine host interop — qualified Java/Janet refs, runtime `defmacro`/`eval`, out of
the analyzer's subset) and the runtime crashes still dominated by `apply jolt-nil`
(more host-coupled natives without a shim: `meta`/`with-meta`, `format`, the
`clojure.string` natives, bit ops, `var`/`volatile`/`future`/thread-binding ops),
plus the small jolt-y1zq tail (0-arg `conj`, `\p{}` regex classes, a few one-offs)
and multimethod dispatch (Phase 2 jolt-9ls5).
Two host shims landed with the prelude. `host/chez/atoms.ss`: atom/deref/swap!/
reset! (+ compare-and-set!/swap-vals!/reset-vals!) — host-coupled mutable cells the
overlay assumes are native; needed at the prelude's LOAD time
(`global-hierarchy = (atom (make-hierarchy))`). `host/chez/predicates.ss`: the type
predicates + `name`/`namespace`/`boolean` the overlay assumes are seed natives
(`nil?`/`number?`/`string?`/`map?`/`vector?`/`set?`/`seq?`/`coll?`/`fn?`/…), matching
the seed's strict semantics. `host/chez/post-prelude.ss` re-asserts `char?`/`atom?`
AFTER the prelude — the overlay implements those two by reading a value's
`:jolt/type` key (a Janet-host assumption that's false for Chez-native chars/atoms),
and its `def-var!` would otherwise clobber the correct native shims.
The 8 print-method/print-dup `defmulti`/`defmethod` forms (50-io) can't LOAD yet
(no multimethod runtime on Chez — Phase 2); a silent load guard in the assembled
prelude lets the rest load and turns them into lazy gaps.
Prior, inc 3b (seq tier + dynamic IFn, jolt-5pso): 595/595 compiled, 0 divergences,
2060/2655 out of subset. The seq tier brought up a list/lazy-seq type with
first/rest/next/seq/cons/list, map/filter/reduce/into/remove,
range/take/drop/concat/apply, keys/vals, and nth/peek/pop over seqs; dynamic IFn
dispatch (a keyword/vector/coll held in a local and called as a fn) routes through
the `jolt-invoke` fallback, closing the 3 ex-known divergences. The probe exits
non-zero on any NEW divergence.
(Prior, inc 3a: 433/436 compiled, 3 known IFn divergences, 2219 out of subset.
Inc 2: 182/182 compiled, 0 divergences, 2473 out of subset.)
It's a slow report (a Chez subprocess per case), so it's gated behind
`JOLT_CHEZ_CORPUS` out of the default suite, like the benches.
`test/chez/emit-test.janet` is the fast Phase-1 unit gate (real analyzer → Chez
parity for fib/mandelbrot + collections + regressions); both skip cleanly when
`chez` isn't on PATH.
All Chez runners skip cleanly when `chez` is not on PATH.

42
test/chez/_atomwatch.janet
View file

@ -1,24 +1,24 @@
# 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). Oracle = build/jolt.
# 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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
# [expr throws?] — when throws? the case is expected to exit non-zero on both
# (the corpus :throws contract; the exception message text may differ).
# [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)" false]
["(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)" false]
["(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)" false]
["(let [a (atom 0)] (set-validator! a number?) (reset! a 5) @a)" false]
["(let [a (atom 5)] (set-validator! a pos?) (swap! a inc) @a)" false]
["(let [a (atom 0)] (set-validator! a number?) (fn? (get-validator a)))" false]
["(let [a (atom 0)] (nil? (get-validator a)))" false]
["(let [a (atom 0)] (set-validator! a pos?) (reset! a -1))" true]
["(let [a (atom 5)] (set-validator! a pos?) (swap! a (fn [_] -1)) @a)" true]
["(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)" false]])
[["(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}))
@ -31,17 +31,15 @@
(var pass 0)
(def fails @[])
(each [expr throws?] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
throws?
(if (and (not= ocode 0) (not= code 0)) (++ pass)
(array/push fails [expr (string "expected both throw; oracle exit " ocode ", chez exit " code)]))
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(= 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 oracle) (++ pass)
(array/push fails [expr (string "want `" oracle "`, got `" got "`")])))
(= 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)

10
test/chez/_class.janet
View file

@ -2,12 +2,11 @@
# 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
# src/jolt/eval_resolve.janet's class-canonical-names + core-class (scalar arms).
# Oracle = build/jolt. Collection (class ...) is host-taxonomy-dependent (the seed
# leaks the Janet host type "table"/"struct") and is NOT compared here.
# 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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- bare class tokens evaluate to canonical strings ---
@ -46,11 +45,8 @@
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))

68
test/chez/_dotform.janet
View file

@ -2,45 +2,45 @@
# 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.
# Expectations are the build/jolt (seed) oracle, captured per case.
# Each case carries its expected printed value.
#
# janet test/chez/_dotform.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def exprs
(def cases
[# strings: method calls via the String surface
"(. \"HI\" toLowerCase)"
"(. \"abc\" length)"
"(. \"abc\" toUpperCase)"
["(. \"HI\" toLowerCase)" "hi"]
["(. \"abc\" length)" "3"]
["(. \"abc\" toUpperCase)" "ABC"]
# vectors / maps: collection interop (count/nth/get/containsKey)
"(. [1 2 3] count)"
"(. [10 20 30] nth 1)"
"(. {:a 1 :b 2} count)"
"(. {:a 1 :b 2} get :b)"
"(. {:a 1} containsKey :a)"
"(. {:count 99} count)"
["(. [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)"
"(. {:greet (fn [self n] (str \"Hello \" n))} greet \"Alice\")"
"(. {:value 41} 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})"
"(.-x {:x 7 :y 9})"
["(.-value {:value 41})" "41"]
["(.-x {:x 7 :y 9})" "7"]
# field access via (. obj -field)
"(. {:value 41} -value)"
["(. {:value 41} -value)" "41"]
# records: .-field reads a field, .method dispatches the protocol method
"(do (defrecord Rf [x]) (.-x (->Rf 7)))"
"(do (defrecord Rg [a b]) (.-b (->Rg 1 2)))"
"(do (defprotocol Greet (hi [_])) (defrecord Rh [nm] Greet (hi [_] (str \"hi \" nm))) (. (->Rh \"x\") hi))"
["(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)))"
"(try (throw (ex-info \"bad\" {:k 1})) (catch Throwable e (.getMessage e)))"
"(try (throw \"boom\") (catch Throwable e (.getMessage e)))"
"(try (throw (Exception. \"boom\")) (catch Throwable e (.getMessage e)))"
"(try (throw (IllegalArgumentException. \"bad\")) (catch Exception e (.getMessage e)))"
"(.equals \"a\" \"a\")"
"(.equals \"a\" \"b\")"
"(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)"])
["(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}))
@ -53,16 +53,14 @@
(var pass 0)
(def fails @[])
(each expr exprs
(def [ocode oracle _] (run-capture "build/jolt" expr))
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got oracle) (++ pass)
(array/push fails [expr (string "want `" oracle "`, got `" got "`")])))
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_dotform parity [%s]: %d/%d passed" jolt-bin pass (length exprs))
(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)))

10
test/chez/_dynbind.janet
View file

@ -1,10 +1,10 @@
# 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 build/jolt values. TDD harness: bin/jolt-chez
# 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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- binding: install / restore / seen across a fn call ---
@ -26,10 +26,8 @@
["thread-bound? in scope" "(do (def ^:dynamic *tc* 1) (binding [*tc* 2] (thread-bound? (var *tc*))))" "true"]
# --- with-bindings* / bound-fn* / get-thread-bindings ---
# NOTE: build/jolt (the seed) returns 1 here — its persistent-hash-map can't
# find a var key, which is why the seed's `binding` macro uses array-map. On
# Chez array-map IS hash-map and frames look up by cell identity, so this is
# the correct Clojure value 7 (a place Chez is more correct than the seed).
# 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"]

13
test/chez/_insttime.janet
View file

@ -1,13 +1,13 @@
# 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) ports java_base.janet.
# Mirrors the :regex IR-leaf precedent: Janet back end punts to the interpreter's
# data-readers, Chez emits the runtime value (host/chez/inst-time.ss).
# Oracle = build/jolt.
# 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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- #inst reading + identity ---
@ -60,11 +60,8 @@
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))

12
test/chez/_io.janet
View file

@ -1,12 +1,11 @@
# 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). io.clj is a Janet-backed shim (janet.*),
# so this is a Chez-native implementation, not a port of it. Reader/StringReader-
# coupled cases (line-seq, slurp over a reader, toURL) are deferred to jolt-at0a.
# Oracle = build/jolt.
# 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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")"))
@ -48,11 +47,8 @@
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))

7
test/chez/_ioreader.janet
View file

@ -4,10 +4,10 @@
# 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.
# Oracle = build/jolt.
#
#
# janet test/chez/_ioreader.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")"))
@ -47,11 +47,8 @@
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))

120
test/chez/_javastatic.janet
View file

@ -1,67 +1,67 @@
# 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).
# Expectations are the build/jolt (seed) oracle, captured per case.
# 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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
# [label expr] — expected is whatever build/jolt prints (captured at runtime).
(def exprs
["(Math/sqrt 16)"
"(Math/abs -3)"
"(Math/max 2 7)"
"(pos? Long/MAX_VALUE)"
"(String/valueOf 42)"
"(String/valueOf \"hi\")"
"(String/valueOf :k)"
"(String/valueOf nil)"
"(Long/parseLong \"42\")"
"(Long/valueOf \"42\")"
"(Integer/parseInt \"ff\" 16)"
"(.byteValue (Integer/valueOf \"ff\" 16))"
"(Boolean/parseBoolean \"true\")"
"(Boolean/parseBoolean \"yes\")"
"(Character/isUpperCase \\A)"
"(Character/isLowerCase \\a)"
"(Character/isUpperCase \\a)"
"(Thread/interrupted)"
"(System/getProperty \"os.name\")"
"(string? (get (System/getenv) \"HOME\"))"
"(string? (System/getenv \"HOME\"))"
"(fn? System/exit)"
"(string? (get (System/getProperties) \"os.name\"))"
"(pos? (count (seq (System/getenv))))"
"(let [es (map (fn [[k v]] [k v]) (System/getenv))] (and (pos? (count es)) (every? vector? es)))"
(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\"))"
"(.toString (-> (StringBuilder.) (.append \"a\") (.append \\b) (.append 1)))"
"(.toString (.append (StringBuilder. 16) \"x\"))"
"(let [sb (StringBuilder.)] (.append sb \"abcd\") (.setLength sb 2) (.toString sb))"
"(let [w (StringWriter.)] (.write w \"a\") (.append w \\b) (.toString w))"
"(let [r (StringReader. \"ab\")] [(.read r) (.read r) (.read r)])"
"(let [r (StringReader. \"ab\")] (.mark r 1) [(.read r) (do (.reset r) (.read r))])"
"(let [r (java.io.PushbackReader. (java.io.StringReader. \"ab\"))] [(.read r) (.read r)])"
"(let [r (PushbackReader. (StringReader. \"ab\")) a (.read r)] (.unread r a) [a (.read r) (.read r)])"
"(let [r (PushbackReader. (StringReader. \"a\"))] (.unread r \\x) [(.read r) (.read r)])"
"(BigInteger. \"123\")"
"(let [m (HashMap. {:a 1 :b 2})] (.get m :b))"
"(let [m (HashMap. {})] (.put m :x 1) (.put m :y 2) (.size m))"
"(let [t (StringTokenizer. \"a=1&b=2\" \"&\")] [(.nextToken t) (.nextToken t)])"
"(.toString (StringBuilder. \"x\"))"
["(.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\")"
"(URLDecoder/decode (URLEncoder/encode \"x &=%?\"))"
"(String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))"
"(String. (.decode (Base64/getDecoder) (String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))))"
"(Integer/parseInt \"ff\" 16)"
["(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\"))"
"(.split (Pattern/compile \",\") \"a,b,c\")"
"(do (require '[clojure.string :as s]) (s/replace \"a1b2\" (Pattern/compile \"[0-9]\") \"\"))"
"(boolean (re-find (Pattern/compile \"^x\" Pattern/MULTILINE) \"y\\nx\"))"
"(boolean (re-find (re-pattern (Pattern/quote \"a.c\")) \"za.cy\"))"
"(boolean (re-find (re-pattern (Pattern/quote \"a.c\")) \"zabcy\"))"])
["(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}))
@ -74,16 +74,14 @@
(var pass 0)
(def fails @[])
(each expr exprs
(def [ocode oracle _] (run-capture "build/jolt" expr))
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got oracle) (++ pass)
(array/push fails [expr (string "want `" oracle "`, got `" got "`")])))
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_javastatic parity [%s]: %d/%d passed" jolt-bin pass (length exprs))
(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)))

6
test/chez/_ns.janet
View file

@ -1,10 +1,10 @@
# jolt-yxqm — namespace value model (find-ns/ns-name/all-ns/resolve/ns-publics/
# in-ns/*ns* …). TDD harness: drives bin/jolt-chez -e per case (fresh subprocess
# 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 (build/jolt), captured up front.
# values are the JVM-canonical reference, baked per case.
#
# janet test/chez/_ns.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
# [label expr expected-last-line]
(def cases

11
test/chez/_reader.janet
View file

@ -1,14 +1,14 @@
# 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 the same jolt forms the Janet reader yields; the *in* family and
# 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 legitimately differs from build/jolt — doesn't masquerade as a
# divergence. Oracle = build/jolt.
# 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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- scalars + collections (value equality, order-independent) ---
@ -81,11 +81,8 @@
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))

6
test/chez/_seqpred.janet
View file

@ -3,14 +3,14 @@
# 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 build/jolt (JVM-canonical) values.
# Expectations are the JVM-canonical values.
#
# janet test/chez/_seqpred.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- seq? over lazy seqs ---
# (NB: not (seq? (range 3)) — the seed makes range an eager vector, chez a lazy
# (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"]

11
test/chez/_stdlib.janet
View file

@ -11,11 +11,11 @@
# through the host seam).
#
# Outputs are order-stable (value-equality / scalars) so set/map iteration order
# — which legitimately differs from build/jolt — never masquerades as a divergence.
# Oracle = build/jolt.
# — which is host-dependent — never masquerades as a divergence.
#
#
# janet test/chez/_stdlib.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- clojure.math (jolt-22vo / jolt-h79) ---
@ -31,7 +31,7 @@
["(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
# the seed's C log10 in the last ulp (3 vs 2.9999…); range-check, don't pin.
# 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]"]
@ -63,11 +63,8 @@
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))

6
test/chez/_str.janet
View file

@ -1,11 +1,11 @@
# 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. Ported from the seed's string-methods surface
# (src/jolt/eval_resolve.janet). Expectations are the build/jolt (seed) oracle.
# .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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[["toLowerCase" "(.toLowerCase \"HI\")" "hi"]

4
test/chez/_strns.janet
View file

@ -2,10 +2,10 @@
# 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. Expectations are the build/jolt (seed) oracle.
# primitives. Each case carries its expected value.
#
# janet test/chez/_strns.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(defn- with-req [body] (string "(do (require (quote [clojure.string :as s])) " body ")"))

9
test/chez/_type.janet
View file

@ -1,12 +1,11 @@
# 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). Expectations are the build/jolt (seed) oracle.
# Producers that the seed makes eager (range) are avoided: (type (range 3)) is
# :vector on the seed (eager) but :seq on chez (lazy) — a range-container
# divergence unrelated to `type`, covered elsewhere.
# 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/jolt-chez"))
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- scalars ---

8
test/chez/_var_meta.janet
View file

@ -1,16 +1,16 @@
# 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 build/jolt. TDD harness: bin/jolt-chez -e per case, last line ==
# 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/jolt-chez"))
(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; the Janet back end punts to its interpreter, which
# Chez lacks) — out of subset, not a meta-capture gap. Shorthand ^:kw / ^Type
# (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"]

7
test/chez/_walk.janet
View file

@ -1,8 +1,8 @@
# jolt-75sv — list? (a list marker on cseq, since cseq backs both lists and
# realized/lazy seqs) + map-entry-as-vector + clojure.walk. Oracle = build/jolt.
# realized/lazy seqs) + map-entry-as-vector + clojure.walk.
#
# janet test/chez/_walk.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
(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 ")"))
@ -63,11 +63,8 @@
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))

210
test/chez/emit-parity.janet
View file

@ -1,210 +0,0 @@
# Chez Phase 3 inc 1 (jolt-hg7z) — value-parity gate for the PORTABLE Clojure
# emitter (jolt.backend-scheme) vs the Janet host oracle.
#
# The new emitter is jolt-core Clojure; here it runs interpreted ON THE JANET HOST
# (loaded via bootstrap-load-source) as a drop-in for host/chez/emit.janet. Each
# case is analyzed to IR, emitted to Scheme by the CLOJURE emitter, run on Chez,
# and compared to the same program evaluated by the Janet host (jolt's own oracle).
# This isolates "is the translation correct" from "does it run on Chez" — the
# emitter's logic is validated before it has to execute on Chez itself.
#
# janet test/chez/emit-parity.janet (from repo root)
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as r)
(import ../../src/jolt/evaluator :as evlr)
(import ../../host/chez/driver :as d)
(import ../../host/chez/emit :as emit)
(import ../../src/jolt/types_ctx :as tctx)
(import ../../src/jolt/types_ns :as tns)
(import ../../src/jolt/types_var :as tvar)
(unless (d/chez-available?)
(print "skip: chez not on PATH")
(os/exit 0))
(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 "")))))
# ctx with the analyzer pipeline + late-bind (same as the driver), plus the
# Clojure emitter loaded interpreted so we can call jolt.backend-scheme/emit.
(def ctx (d/make-ctx))
(def bs-src (get (get (ctx :env) :embedded-sources) "jolt.backend-scheme"))
(assert bs-src "jolt.backend-scheme not embedded — check stdlib_embed collect")
(backend/bootstrap-load-source ctx "jolt.backend-scheme" bs-src)
(def emit-clj-var (tns/ns-find (tctx/ctx-find-ns ctx "jolt.backend-scheme") "emit"))
(assert emit-clj-var "jolt.backend-scheme/emit not found after load")
(defn emit-clj [ir] (string ((tvar/var-get emit-clj-var) ir)))
# Janet host oracle, via the real CLI (-e), exactly like run-corpus.janet: take the
# last non-empty stdout line so collection values use jolt's real printer.
(defn cli-oracle [src]
(def proc (os/spawn ["build/jolt" "-e" src] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(ev/read (proc :err) 0x100000)
(os/proc-wait proc)
(def lines (filter (fn [l] (not (empty? l))) (string/split "\n" (string/trim (if out (string out) "")))))
(if (empty? lines) "" (last lines)))
(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)
# Drain a pipe to EOF (a stdout side effect can flush in >1 write).
(defn- drain [pipe]
(def b @"")
(var c (ev/read pipe 0x10000))
(while c (buffer/push b c) (set c (ev/read pipe 0x10000)))
(string b))
# Compile `src` to a Chez program using the CLOJURE emitter, run it, return
# [code stdout stderr]. Mirrors driver/compile-program + run-on-chez but swaps
# emit/emit -> emit-clj.
(defn run-clj [src]
(def forms (parse-all src))
(def n (length forms))
(def def-scm @[])
(for i 0 (- n 1)
(def f (in forms i))
(array/push def-scm (emit-clj (backend/analyze-form ctx f)))
(evlr/eval-form ctx @{} f))
(def final-scm (emit-clj (backend/analyze-form ctx (in forms (- n 1)))))
(def prog (emit/program def-scm final-scm))
(def path (string "/tmp/jolt-chez-parity-" (os/getpid) ".ss"))
(spit path prog)
(def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe}))
(def out (drain (proc :out)))
(def err (drain (proc :err)))
(def code (os/proc-wait proc))
[code (string/trim out) (string/trim err)])
# A case passes when the Clojure emitter's Chez output equals the Janet oracle.
# An emit-time throw (out-of-subset op) is a clean FAIL, not a crash.
(defn check [name src]
(def want (cli-oracle src))
(def res (protect (run-clj src)))
(if (not (res 0))
(ok name false (string "emit/run threw: " (res 1)))
(let [[code out err] (res 1)]
(ok name (and (= code 0) (= out want))
(string "chez=" out " oracle=" want " code=" code " | " err)))))
# For cases where the Janet oracle carries a known latent bug (e.g. quoted-set
# literals don't reconstruct, jolt-tg9s) but Chez is correct: assert Chez output
# against the hand-verified real-Clojure value directly.
(defn check-exact [name src want]
(def res (protect (run-clj src)))
(if (not (res 0))
(ok name false (string "emit/run threw: " (res 1)))
(let [[code out err] (res 1)]
(ok name (and (= code 0) (= out want))
(string "chez=" out " want=" want " code=" code " | " err)))))
# --- inc 1 subset: const/local/var/if/do/let/loop/recur/invoke/fn/def ----------
(check "(+ 1 2)" "(+ 1 2)")
(check "arith mixed" "(- (* 3 4) (/ 10 2))")
(check "nested let" "(let [a 1 b (+ a 10) c (* b 2)] (- c a))")
(check "let sequential" "(loop [a 1 b (+ a 10)] (+ a b))")
(check "if comparison" "(if (< 3 5) 100 200)")
(check "if =" "(if (= 2 2) :y :n)")
(check "do side-effect ret" "(do 1 2 3)")
(check "fib 30" "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 30)")
(check "factorial loop" "(defn fact [n] (loop [i n acc 1] (if (< i 2) acc (recur (- i 1) (* acc i))))) (fact 10)")
(check "multi-arity" "(defn g ([x] (g x 10)) ([x y] (+ x y))) (g 5)")
(check "variadic" "(defn s [& xs] (reduce + 0 xs)) (s 1 2 3 4)")
(check "higher-order inc" "(reduce + 0 (map inc (range 5)))")
(check "anon fn invoke" "((fn [x] (* x x)) 7)")
(check "shorthand fn" "(#(+ %1 %2) 3 4)")
(check "truthy local" "(defn t [x] (if x 1 2)) (t false)")
(check "mod rem quot" "(+ (mod 17 5) (rem 17 5) (quot 17 5))")
(check "min max" "(+ (min 3 1 2) (max 3 1 2))")
# --- inc 2 subset: collection literals (vector/map/set) + quote -----------------
(check "vector literal" "[1 2 3]")
(check "nested vector" "[1 [2 3] [4 [5 6]]]")
(check "vector of exprs" "[(+ 1 2) (* 3 4)]")
(check "map literal eq" "(= {:a 1 :b 2} {:a 1 :b 2})")
(check "map get" "(get {:a 1 :b 2} :b)")
(check "set literal eq" "(= #{1 2 3} #{3 2 1})")
(check "set contains" "(contains? #{1 2 3} 2)")
(check "vector count" "(count [10 20 30 40])")
(check "conj vector" "(conj [1 2] 3 4)")
(check "assoc map" "(get (assoc {:a 1} :b 2) :b)")
(check "coll as fn" "({:a 1 :b 2} :a)")
(check "kw as fn" "(:b {:a 1 :b 2})")
(check "kw as fn default" "(:z {:a 1} 99)")
(check "quote list" "(count (quote (a b c d)))")
(check "quote vector eq" "(= (quote [1 2 3]) [1 2 3])")
(check "quote symbol eq" "(= (quote foo) (quote foo))")
(check "quote ns symbol eq" "(= (quote my.ns/bar) (quote my.ns/bar))")
(check "quote nested count" "(count (quote (a [1 2] {:k v})))")
(check "quote keyword in list" "(first (quote (:a :b :c)))")
(check "quote map" "(get (quote {:x 1 :y 2}) :y)")
# Janet oracle is buggy here (jolt-tg9s): quoted-set doesn't reconstruct. Chez is
# correct (real Clojure: true) — assert against the verified value.
(check-exact "quote set contains" "(contains? (quote #{:p :q}) :p)" "true")
(check-exact "quote set eq literal" "(= (quote #{1 2 3}) #{1 2 3})" "true")
(check "vector map filter" "(into [] (filter even? (map inc [1 2 3 4 5])))")
(check "map over literal" "(reduce + (vals {:a 1 :b 2 :c 3}))")
# --- inc 3 subset: try/throw + def-meta + quoted-sym-meta + inst/uuid + regex ----
(check "try catch" `(try (throw (ex-info "boom" {})) (catch Throwable e 42))`)
(check "try catch value" `(+ (try (throw (ex-info "" {})) (catch Throwable e 10)) 5)`)
(check "try no throw" `(try 7 (catch Throwable e 0))`)
(check "try finally" `(try 1 (finally 2))`)
(check "try finally side" `(try (throw (ex-info "" {})) (catch Throwable e 3) (finally 9))`)
(check "def private runs" `(do (defn ^:private secret [] 99) (secret))`)
(check "def tagged runs" `(do (def ^:dynamic *q* 5) *q*)`)
(check "quoted sym meta eq" `(do (def x (quote ^:foo bar)) (= x x))`)
(check "inst eq" `(= #inst "2020-01-01" #inst "2020-01-01")`)
(check "uuid eq" `(= #uuid "00000000-0000-0000-0000-000000000000" #uuid "00000000-0000-0000-0000-000000000000")`)
(check "regex smoke" `(do (def r #"[0-9]+") true)`)
(check "char eq" `(= \a \a)`)
(check "char int" `(do (def c \newline) (= c \newline))`)
(check "quoted char" `(= (quote \z) \z)`)
(check "mandelbrot run(20)"
(string ``
(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)
(let [ci (- (/ (* 2.0 y) nd) 1.0)
row (loop [x 0 a 0]
(if (< x n)
(let [cr (- (/ (* 2.0 x) nd) 1.5)]
(recur (inc x) (+ a (count-point cr ci cap))))
a))]
(recur (inc y) (+ acc row)))
acc))))
`` "\n(run 20)"))
# Structural: a ^:private def must now take the def-var-with-meta! path (the meta
# is a portable struct after the h-sym-meta fix; before, map?/count failed on the
# raw table and it silently fell back to the lean def-var!, dropping the meta).
(let [scm (emit-clj (backend/analyze-form ctx (in (r/parse-next "(def ^:private p 1)") 0)))]
(ok "def ^:private emits def-var-with-meta!"
(truthy? (string/find "def-var-with-meta!" scm)) scm))
(let [scm (emit-clj (backend/analyze-form ctx (in (r/parse-next "(def plain 1)") 0)))]
(ok "plain def stays lean def-var!"
(and (truthy? (string/find "(def-var! " scm))
(not (string/find "with-meta" scm))) scm))
(printf "\n%d/%d ok" (- total fails) total)
(when (> fails 0) (os/exit 1))

721
test/chez/emit-test.janet
View file

@ -1,721 +0,0 @@
# Phase 1 (jolt-cf1q.2) — REAL pipeline end to end: actual Clojure source ->
# Janet-hosted analyzer -> host-neutral IR -> Scheme emitter -> run on Chez.
# Correctness is checked by parity against the SAME program evaluated by the
# Janet host (jolt's own oracle), so a divergence is the back end's, not the
# program's.
# janet test/chez/emit-test.janet (from repo root)
(import ../../src/jolt/api :as api)
(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 (d/chez-available?)
(print "skip: chez not on PATH")
(os/exit 0))
(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 "")))))
# Janet-host oracle: evaluate the same program, stringify its value the way jolt
# prints it at the CLI (so "832040" not "832040.0", "0.5" not 1/2, etc.).
(def oracle-ctx (api/init {:compile? true}))
(defn oracle [src] (string (api/load-string oracle-ctx src)))
# Canonical CLI oracle (the run-corpus gate's boundary): collection values don't
# round-trip through (string value) — they need jolt's real `-e` printer. Take
# the last non-empty stdout line, exactly like run-corpus.janet.
(defn cli-oracle [src]
(def proc (os/spawn ["build/jolt" "-e" src] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(ev/read (proc :err) 0x100000)
(os/proc-wait proc)
(def lines (filter (fn [l] (not (empty? l))) (string/split "\n" (string/trim (if out (string out) "")))))
(if (empty? lines) "" (last lines)))
(def ctx (d/make-ctx))
# 1) constant-folded arithmetic: (+ 1 2) -> the analyzer folds to const 3.
(let [[code out err] (d/run-on-chez ctx "(+ 1 2)")]
(ok "(+ 1 2) = 3" (and (= code 0) (= out "3") (= out (oracle "(+ 1 2)"))) (string out " | " err)))
# 2) fib: var-cell def + named-fn self-recursion + native arith, via real IR.
(let [src "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 30)"
[code out err] (d/run-on-chez ctx src)]
(ok "(fib 30) = 832040" (and (= code 0) (= out "832040") (= out (oracle src))) (string out " | " err)))
# 3) mandelbrot kernel: loop/recur, let, or-expansion, cross-var call
# (run -> count-point), flonum compute. Parity vs the Janet host on run(40).
(def mandel-defs ``
(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)
(let [ci (- (/ (* 2.0 y) nd) 1.0)
row (loop [x 0 a 0]
(if (< x n)
(let [cr (- (/ (* 2.0 x) nd) 1.5)]
(recur (inc x) (+ a (count-point cr ci cap))))
a))]
(recur (inc y) (+ acc row)))
acc))))
``)
(let [src (string mandel-defs "\n(run 40)")
[code out err] (d/run-on-chez ctx src)]
(ok "mandelbrot run(40) parity" (and (= code 0) (= out (oracle src)))
(string "chez=" out " janet=" (oracle src) " | " err)))
# 3a2) truthy? elision (jolt-nkcb): an :if test that provably yields a Scheme
# boolean (native comparison/not, or a boolean const) needs no jolt-truthy?
# wrapper — (if (jolt-truthy? (< a b)) …) === (if (< a b) …). Sound because
# jolt-truthy? of #t/#f is identity. The hot fib/mandelbrot tests are all
# comparisons, so this is a direct ceiling lever. Inspect the emitted Scheme.
(defn- emit-scm [src] (d/scheme-emit ctx (backend/analyze-form ctx (in (r/parse-next src) 0))))
(each [label src wrapped?] [["if < elides wrapper" "(fn [n] (if (< n 2) 1 2))" false]
["if > elides wrapper" "(fn [n] (if (> n 2) 1 2))" false]
["if = elides wrapper" "(fn [n] (if (= n 2) 1 2))" false]
["if <= elides wrapper" "(fn [n] (if (<= n 2) 1 2))" false]
["if not elides wrapper" "(fn [x] (if (not x) 1 2))" false]
["if true const elides" "(fn [] (if true 1 2))" false]
["if local keeps wrapper" "(fn [x] (if x 1 2))" true]
["if + keeps wrapper" "(fn [n] (if (+ n 1) 1 2))" true]]
(let [scm (emit-scm src) has (truthy? (string/find "jolt-truthy?" scm))]
(ok (string "truthy elision: " label) (= has wrapped?)
(string "wrapped?=" has " want " wrapped? " | " scm))))
# 3b) regressions found via the corpus probe:
# - loop binds SEQUENTIALLY (Scheme named-let is parallel); b must see a.
# - #(...) shorthand gensyms params with a trailing `#` (invalid in Scheme).
(each [label src] [["loop sequential init" "(loop [a 1 b (+ a 10)] (+ a b))"]
["#() shorthand" "(#(+ %1 %2) 1 2)"]]
(let [[code out err] (d/run-on-chez ctx src)]
(ok label (and (= code 0) (= out (oracle src))) (string "chez=" out " janet=" (oracle src) " | " err))))
# 3c) persistent collections (jolt-wgbz): vector/map/set literals + leaf ops.
# Maps/sets print in jolt's INTERNAL hash order, which a Scheme HAMT won't
# reproduce — so unordered cases are checked via `(= ...)` (prints true/false,
# exactly how the run-corpus gate compares them), and only ORDERED vectors are
# compared by printed form. Parity is still vs the Janet oracle in both shapes.
(each src [# ordered: direct printed-form parity
"[1 2 3]"
"(conj [1 2] 3)"
"(count [1 2 3])"
"(nth [10 20 30] 1)"
"(get [10 20 30] 0)"
"(peek [1 2 3])"
"(pop [1 2 3])"
# unordered / boolean: equality-wrapped, order-independent
"(= {:a 1 :b 2} {:b 2 :a 1})"
"(= {:a 1 :b 2} (assoc {:a 1} :b 2))"
"(= 1 (get {:a 1} :a))"
"(= 2 (count {:a 1 :b 2}))"
"(= 99 (get {:a 1} :z 99))"
"(= {:a 1} (dissoc {:a 1 :b 2} :b))"
"(= #{1 2 3} (conj #{1 2} 3))"
"(= #{1 2} (conj #{1 2} 2))"
"(contains? #{1 2} 1)"
"(contains? #{1 2} 9)"
"(contains? {:a 1} :a)"
"(empty? [])"
"(empty? [1])"
"(empty? {})"
"(= [1 2] [1 2])"
"(= [1 2] [1 3])"
"(= #{1 2} #{2 1})"
"(= {1 2} {1 3})"]
(let [[code out err] (d/run-on-chez ctx src)
want (cli-oracle src)]
(ok (string "coll: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3d) dynamic IFn dispatch (inc 3b): a keyword/vector/coll held in a LOCAL (let
# binding or fn param) and called as a fn. The 3 ex-known-divergences. The
# callee is a :local that's NOT the fn's self-name, so emit routes it through
# the jolt-invoke fallback (procedure? -> apply; keyword/coll -> lookup).
(each [src want] [["(let [v [10 20 30]] (v 1))" "20"]
["(let [k :a] (k {:a 7}))" "7"]
["((fn [f] (f {:a 1})) :a)" "1"]]
(let [[code out err] (d/run-on-chez ctx src)]
(ok (string "ifn: " src) (and (= code 0) (= out want))
(string "chez=" out " want=" want " | " err))))
# 3e) seq tier (inc 3b): jolt list type, first/rest/next/seq/cons/list, lazy-seq
# (range/take over an infinite seq), map/filter/reduce/into/remove, keys/vals.
# Lists and lazy seqs print as (...) and are sequential-= to vectors. Ordered
# shapes -> printed-form parity vs the CLI oracle.
(each src ["(first [1 2 3])"
"(rest [1 2 3])"
"(rest [1])"
"(rest [])"
"(next [1 2 3])"
"(next [1])"
"(cons 0 [1 2 3])"
"(cons 1 nil)"
"(list 1 2 3)"
"(list)"
"(seq [])"
"(conj (list 2 3) 1)"
"(conj nil 1 2)"
"(map inc [1 2 3])"
"(map + [1 2 3] [10 20 30])"
"(map :a [{:a 1} {:a 2}])"
"(filter even? [1 2 3 4])"
"(remove even? [1 2 3 4])"
"(reduce + 0 [1 2 3])"
"(reduce + [1 2 3])"
"(reduce + (map inc (range 4)))"
"(into [] [1 2 3])"
"(into [1] (list 2 3))"
"(take 3 (range))"
"(reverse [1 2 3])"
"(apply + [1 2 3])"
"(count (map inc [1 2 3]))"]
(let [[code out err] (d/run-on-chez ctx src)
want (cli-oracle src)]
(ok (string "seq: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3f) seq tier — unordered / cross-type, equality-wrapped (prints true/false):
# keys/vals order is HAMT order, into-map / into-set unordered; sequential =
# across vector and list.
(each src ["(= 2 (count (keys {:a 1 :b 2})))"
"(= 3 (reduce + (vals {:a 1 :b 2})))"
"(= {:a 1 :b 2} (into {} [[:a 1] [:b 2]]))"
"(= #{1 2 3} (into #{} [1 2 3]))"
"(= [1 2 3] (list 1 2 3))"
"(= [1 2 3] (map inc [0 1 2]))"
# jolt returns a vector for (seq vec) / bounded (range); Chez returns a
# Clojure-canonical lazy seq. Values are sequential-=, printed forms differ.
"(= [1 2 3] (seq [1 2 3]))"
"(= [0 1 2 3 4] (range 5))"]
(let [[code out err] (d/run-on-chez ctx src)]
(ok (string "seq=: " src) (and (= code 0) (= out "true"))
(string "chez=" out " | " err))))
# 3g) multi-arity + variadic fns (inc 3c): case-lambda dispatch, a Scheme rest
# arg collected into a jolt seq (nil when empty), recur within an arity and a
# self-call across arities. Value parity vs the CLI oracle.
(each src ["((fn ([x] (* x 2)) ([x y] (+ x y))) 5)"
"((fn ([x] (* x 2)) ([x y] (+ x y))) 3 4)"
"(defn g ([x] x) ([x y] (+ x y))) (g 10)"
"(defn g ([x] x) ([x y] (+ x y))) (g 10 20)"
"(defn h [a & more] (count more)) (h 1 2 3 4)"
# empty rest is nil (Clojure): count 0, first nil (prints "")
"(defn h [a & more] (count more)) (h 1)"
"(defn h [a & more] (first more)) (h 1)"
"(defn h [a & more] (first more)) (h 1 2 3)"
"(defn h [a & more] (reduce + a more)) (h 1 2 3 4)"
"(defn h [a & more] (reduce + a more)) (apply h [1 2 3 4])"
# self-call from one arity to another, then recur within it
"(defn f ([n] (f n 0)) ([n acc] (if (zero? n) acc (recur (- n 1) (+ acc n))))) (f 5)"
"((fn r [& xs] (if (seq xs) (+ (first xs) (apply r (rest xs))) 0)) 1 2 3)"]
(let [[code out err] (d/run-on-chez ctx src)
want (cli-oracle src)]
(ok (string "arity: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3i) throw / try / catch / finally + ex-info (inc 3e). Value parity vs the CLI
# oracle for caught throws; an uncaught throw must exit non-zero.
(each src [# jolt catch syntax is (catch Class binding body); the class is dropped
# in the IR (catch-all). catch binds the thrown value raw.
"(try (throw 42) (catch Exception e e))"
"(try (+ 1 (throw 7)) (catch Exception e (* e 10)))"
# finally runs and its value is discarded (try returns the body value)
"(try 5 (finally 99))"
"(try (throw 3) (catch Exception e (+ e 1)) (finally 99))"
# body value passes through when nothing throws
"(try (+ 2 3) (catch Exception e :nope))"
# ex-info builds a real jolt map: read message/data via get (native-op)
"(get (ex-info \"boom\" {:a 1}) :message)"
"(get (ex-info \"boom\" {:a 1}) :data)"
"(try (throw (ex-info \"boom\" {:a 1})) (catch Exception e (get e :message)))"
"(try (throw (ex-info \"boom\" {:a 7})) (catch Exception e (get (get e :data) :a)))"
# nested try: inner rethrows, outer catches
"(try (try (throw 1) (catch Exception e (throw (+ e 1)))) (catch Exception e (* e 100)))"]
(let [[code out err] (d/run-on-chez ctx src)
want (cli-oracle src)]
(ok (string "throw/try: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# an uncaught throw aborts the program (non-zero exit) — matches the corpus
# `:throws` semantics (interpret/compile both bail).
(let [[code out err] (d/run-on-chez ctx "(throw (ex-info \"unhandled\" {}))")]
(ok "throw: uncaught exits non-zero" (not= code 0)
(string "code=" code " out=" out)))
# 3j) quoted literals (inc 3f): a :quote node reconstructs the reader form as RT
# values — symbols, lists, vectors, maps, sets, nested. Value parity vs the CLI.
(each src ["'foo"
"'foo/bar"
"':kw"
"'(1 2 3)"
"'[1 2 3]"
"'(a b c)"
"'{:a 1}"
"'(1 (2 3) 4)"
"(first '(10 20 30))"
"(count '[1 2 3])"
"(rest '(1 2 3))"
"(= 'foo 'foo)"
"(= 'a 'b)"
"(map inc '(1 2 3))"
"(conj '[1 2] 3)"
"(get '{:a 7} :a)"]
(let [[code out err] (d/run-on-chez ctx src)
want (cli-oracle src)]
(ok (string "quote: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3k) letfn + declare/def-no-init (inc 3g). letfn lowers to a Scheme `letrec*`
# (mutual recursion between the named local fns — a plain let* can't forward-
# ref a sibling). declare/(def x) with no init pre-creates the var cell so a
# forward reference resolves; the real def runs before any call.
(each src [# single local fn
"(letfn [(twice [x] (* x 2))] (twice 5))"
# self-recursion within a local fn
"(letfn [(fact [n] (if (zero? n) 1 (* n (fact (dec n)))))] (fact 5))"
# MUTUAL recursion — the letrec semantics a sequential let* lacks
"(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 10))"
"(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (od? 7))"
# local fn passed to a higher-order fn
"(letfn [(sq [x] (* x x))] (map sq [1 2 3]))"
# declare + forward reference (the canonical mutually-recursive top-level use)
"(declare is-ev) (defn is-od [n] (if (zero? n) false (is-ev (dec n)))) (defn is-ev [n] (if (zero? n) true (is-od (dec n)))) (is-ev 10)"
# declare then redefine: the real def overwrites the reserved cell
"(declare foo) (def foo 10) foo"]
(let [[code out err] (d/run-on-chez ctx src)
want (cli-oracle src)]
(ok (string "letfn/declare: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3l) host interop method calls (inc 3h). (.method target arg*) analyzes to a
# :host-call IR node and lowers to a dispatch. The Janet back end PUNTS these
# (no interop model -> interpreter); the Chez RT shims the File methods
# jolt-core's io tier uses via jolt-host-call (.isDirectory -> file-directory?,
# .listFiles -> directory-list). All OTHER methods (.write/.append/.read/... on
# a StringWriter/StringReader/record) route through record-method-dispatch
# (jolt-avt6 removed .write from the jolt-host-call fast-path so a StringWriter
# jhost handles it). Interop has no portable oracle (the Janet host models it
# differently), so these are emit-shape checks plus one deterministic runtime
# probe (the root "/" is always a directory).
(each [label src needle]
[["emit .write -> record-method-dispatch" "(fn [w x] (.write w x))" "record-method-dispatch"]
["emit .write keeps method name" "(fn [w x] (.write w x))" "\"write\""]
["emit .isDirectory -> jolt-host-call" "(fn [f] (.isDirectory f))" "isDirectory"]
["emit .listFiles -> jolt-host-call" "(fn [f] (.listFiles f))" "listFiles"]]
(let [scm (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))]
(ok label (and (scm 0) (string/find needle (scm 1))) (string/format "%p" scm))))
(let [[code out err] (d/run-on-chez ctx "(.isDirectory \"/\")")]
(ok "runtime .isDirectory \"/\" = true" (and (= code 0) (= out "true"))
(string "chez=" out " | " err)))
# 3l') host class statics + constructors (jolt-avt6). Class/member lowers to a
# :host-static node (host-static-ref in value position, host-static-call as a
# call head); (Class. ...) / (new Class ...) lower to :host-new. The Janet back
# end punts all three; the Chez RT resolves them from the class-statics /
# class-ctors / jhost-method registries (host/chez/host-static.ss). Emit-shape
# checks; the registry behaviour is covered by test/chez/_javastatic.janet.
(each [label src needle]
[["emit Class/field -> host-static-ref" "(fn [] Long/MAX_VALUE)" "(host-static-ref \"Long\" \"MAX_VALUE\")"]
["emit Class/method call -> host-static-call" "(fn [] (System/getenv))" "(host-static-call \"System\" \"getenv\")"]
["emit static call passes args" "(fn [x] (Long/parseLong x))" "(host-static-call \"Long\" \"parseLong\""]
["emit (Class.) -> host-new" "(fn [] (StringBuilder.))" "(host-new \"StringBuilder\")"]
["emit (new Class ...) -> host-new" "(fn [s] (new java.io.StringReader s))" "(host-new \"java.io.StringReader\""]]
(let [scm (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))]
(ok label (and (scm 0) (string/find needle (scm 1))) (string/format "%p" scm))))
# 3l'') the `.` special form + `.-field` desugar (jolt-kuic). (. target member
# arg*) and (.-field target) lower to a :host-call routed through
# record-method-dispatch (a non-shimmed method); the dash on a field member
# survives in the method name so dot-forms.ss reads it as a field access. The
# Janet back end punts :host-call (interpreter re-runs the original `.` form);
# runtime behaviour is covered by test/chez/_dotform.janet.
(each [label src needle]
[["emit (. obj method) -> record-method-dispatch" "(fn [o] (. o frob))" "record-method-dispatch"]
["emit (. obj method) keeps method name" "(fn [o] (. o frob))" "\"frob\""]
["emit (. obj method arg) passes args" "(fn [o a] (. o frob a))" "record-method-dispatch"]
["emit (.-field obj) keeps dash" "(fn [o] (.-value o))" "\"-value\""]
["emit (. obj -field) keeps dash" "(fn [o] (. o -value))" "\"-value\""]]
(let [scm (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))]
(ok label (and (scm 0) (string/find needle (scm 1))) (string/format "%p" scm))))
# 3m) regex (jolt-i0s3): the #"…" literal lowers to a jolt-regex value over the
# vendored irregex; re-pattern/re-matches/re-find/re-seq/regex? are def-var!'d
# into clojure.core (not subset native-ops — irregex's Unicode/property
# semantics differ from the seed's byte-PEG), so they resolve in PRELUDE mode,
# the path the assembled prelude takes. Parity vs the CLI oracle on standard
# PCRE patterns both engines agree on.
(defn run-prelude [src]
(emit/set-prelude-mode! true)
(def r (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0)))))
(emit/set-prelude-mode! false)
(if (not (r 0)) [:emit-err (r 1) ""]
(do
# PID-unique path: two emit-test processes (or a foreground -e) must not
# read each other's half-written program file.
(def path (string "/tmp/chez-prelude-" (os/getpid) ".ss"))
(spit path (emit/program @[] (r 1)))
(def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
[(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))])))
# bare #"…" literal runs in plain subset mode (the :regex node needs no core fn).
(each src ["#\"\\d+\"" "(do #\"a.c\")"]
(let [[code out err] (d/run-on-chez ctx src) want (cli-oracle src)]
(ok (string "regex literal: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# re-* surface via prelude mode (def-var!'d fns), parity vs the CLI oracle.
(each src ["(re-matches #\"\\d+\" \"123\")"
"(re-matches #\"\\d+\" \"12a\")"
"(re-find #\"\\d+\" \"abc123def\")"
"(re-find #\"([a-z])(\\d)\" \"--a1--\")"
"(re-seq #\"\\d+\" \"a1b22c333\")"
"(regex? #\"\\d+\")"
"(re-matches #\"[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}\" \"550e8400-e29b-41d4-a716-446655440000\")"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "regex: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3h) prelude mode (inc 3d): emitting clojure.core ITSELF, a core->core ref must
# lower to a runtime var-deref instead of being rejected as "out of subset".
# `frequencies` is a core fn but not a native-op, so it exercises the switch.
(let [ir (backend/analyze-form ctx (in (r/parse-next "(fn [x] (frequencies x))") 0))]
# subset mode (the default): a non-native core ref is rejected at emit time.
(ok "prelude: subset mode rejects non-native core ref"
(let [r (protect (emit/emit ir))] (not (r 0))))
# prelude mode: the same ref lowers to (var-deref "clojure.core" "frequencies").
(emit/set-prelude-mode! true)
(def scm (protect (emit/emit ir)))
(emit/set-prelude-mode! false)
(ok "prelude: mode lowers non-native core ref to var-deref"
(and (scm 0)
(string/find "var-deref" (scm 1))
(string/find "frequencies" (scm 1)))
(string/format "%p" scm)))
# 3n) atoms (jolt-9ziu): atom/deref/swap!/reset! are host-coupled (stay in the
# Janet seed, no overlay def-var!), so the Chez host needs an RT shim
# (host/chez/atoms.ss). They lower to var-deref in prelude mode. The hierarchy
# machinery (global-hierarchy = (atom (make-hierarchy))) needs `atom` at the
# prelude's LOAD time, so this is a load blocker, not just a lazy gap. swap!
# invokes its fn through jolt-invoke; compare-and-set!/swap-vals!/reset-vals!
# are overlay fns that compose the native kernel.
(each src ["(deref (atom 42))"
"@(atom 99)"
"(let [a (atom 0)] (reset! a 7) (deref a))"
"(let [a (atom 0)] (swap! a inc) (swap! a inc) (deref a))"
"(let [a (atom 10)] (swap! a + 5) (deref a))"
"(let [a (atom 1)] (reset! a 2) [(deref a) @a])"
"(let [a (atom 0)] (compare-and-set! a 0 5) (deref a))"
"(let [a (atom 0)] (compare-and-set! a 9 5) (deref a))"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "atom: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3o) type predicates + name/namespace (jolt-9ziu): seed natives the overlay
# assumes; the Chez host shims them (host/chez/predicates.ss) and def-var!s them
# into clojure.core, so they resolve in prelude mode. Semantics match the seed
# (core_types.janet): map?/vector?/set? strict over the persistent records,
# seq? only for real sequences, coll? the union. Parity vs the CLI oracle.
(each src ["(nil? nil)" "(nil? 0)"
"(number? 3)" "(number? :a)" "(string? \"x\")" "(string? 1)"
"(integer? 3.5)"
"(symbol? 'x)" "(keyword? :x)" "(keyword? 'x)"
"(map? {:a 1})" "(map? [1 2])"
"(vector? [1 2])" "(vector? '(1 2))"
"(set? #{1 2})" "(set? [1])"
# NB: (seq? (seq [1 2])) is true on Chez (Clojure-correct — a seq IS a
# seq) but the seed oracle returns false (non-canonical), so it's not a
# like-for-like cli-oracle comparison; the corpus encodes the canonical
# value, where Chez agrees. Test seq? on the unambiguous cases here.
"(seq? [1 2])" "(seq? '(1 2))"
"(coll? [1])" "(coll? {:a 1})" "(coll? 3)"
"(fn? inc)" "(fn? 3)"
"(boolean nil)" "(boolean 5)"
"(name :foo)" "(name 'bar)" "(name \"baz\")"
"(namespace :a/b)" "(namespace :x)"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "pred: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3p) converters + string ops (jolt-t6cr): str/subs/vec/keyword/symbol/compare/
# int/double/gensym are host-coupled seed natives (host/chez/converters.ss),
# def-var!'d into clojure.core, resolved in prelude mode. Semantics match the
# seed (str-render-one for str, the 3-way core-compare, truncating int). Parity
# vs the CLI oracle.
(each src ["(str)" "(str \"a\")" "(str \"a\" \"b\" \"c\")" "(str 1 2)"
"(str :k)" "(str nil)" "(str \"x\" nil \"y\")" "(str \\a)"
"(str 'sym)" "(str [1 2])" "(str (* 1.0 5))"
"(subs \"hello\" 1)" "(subs \"hello\" 1 3)"
"(vec (list 1 2 3))" "(vec (range 3))" "(vec \"ab\")" "(count (vec (range 4)))"
"(keyword \"foo\")" "(keyword \"ns\" \"bar\")" "(keyword 'sym)"
"(name (keyword \"a\" \"b\"))" "(namespace (keyword \"a\" \"b\"))"
"(symbol \"x\")" "(str (symbol \"ns\" \"y\"))" "(name (symbol \"z\"))"
"(compare 1 2)" "(compare 2 1)" "(compare 1 1)" "(compare \"a\" \"b\")"
"(compare :a :b)" "(compare [1 2] [1 3])" "(compare nil nil)" "(compare nil 1)"
"(int 3.7)" "(int \\A)" "(double 5)" "(double \\A)"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "conv: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# gensym uses a per-process counter, so only the PREFIX is stable across the
# Chez run vs the Janet oracle; the numeric suffix legitimately differs.
(each src ["(symbol? (gensym))" "(subs (name (gensym \"foo_\")) 0 4)" "(string? (name (gensym)))"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "conv: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3q) transients (jolt-kl2l): transient/persistent!/conj!/assoc!/dissoc!/disj!/
# pop! as copy-on-write over the persistent collections (host/chez/transients.ss),
# plus persistent disj. get/count/contains? see THROUGH a transient (frequencies
# and group-by do (get tm k) on a transient map). vector? on a transient vector
# is false. Map/set print order isn't canonical, so assert via get/count/contains?.
(each src ["(persistent! (conj! (transient []) 1 2 3))"
"(count (conj! (conj! (transient []) 1) 2))"
"(get (assoc! (transient {}) :a 5) :a)"
"(get (transient {:x 9}) :x)"
"(contains? (assoc! (transient {}) :k 1) :k)"
"(count (persistent! (dissoc! (assoc! (assoc! (transient {}) :a 1) :b 2) :a)))"
"(vector? (transient []))"
"(persistent! (pop! (conj! (transient [1 2 3]) 4)))"
"(count (persistent! (disj! (transient #{1 2 3}) 2)))"
"(contains? (disj #{1 2 3} 2) 2)"
"(count (disj #{1 2 3} 2))"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "transient: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# frequencies/group-by/into are OVERLAY fns built on transients — they need the
# full assembled prelude, so exercise them end-to-end through the jolt-chez -e
# binary (which loads rt.ss + the prelude). This doubles as a smoke test of the
# assembled -e-capable jolt-chez itself.
(defn run-jolt-chez [src]
(def proc (os/spawn ["bin/jolt-chez" "-e" src] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
[(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))])
(when (os/stat "bin/jolt-chez")
(each src ["(get (frequencies [1 1 2 3 3 3]) 3)"
"(get (frequencies [:a :b :a]) :a)"
"(get (group-by even? [1 2 3 4 5]) true)"
"(count (get (group-by even? (range 10)) false))"
"(into [] (range 5))"
"(count (into #{} [1 2 2 3]))"]
(let [[code out err] (run-jolt-chez src) want (cli-oracle src)]
(ok (string "jolt-chez -e: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err)))))
# 3r) numeric-edge literals (jolt-q3w8): ##Inf/##-Inf/##NaN emitted to bare
# inf/nan (unbound on Chez) — fix emit-const to +inf.0/-inf.0/+nan.0, the
# -e printer to inf/-inf/nan, and str to Infinity/-Infinity/NaN (Clojure).
# Value/print cases are pure literals -> subset path (d/run-on-chez).
(each src ["(< 5 ##Inf)" "(> 5 ##-Inf)" "(= ##Inf ##Inf)"
"##Inf" "##-Inf" "##NaN" "[##Inf]" "[##NaN ##-Inf]"]
(let [[code out err] (d/run-on-chez ctx src) want (cli-oracle src)]
(ok (string "numedge: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# str of inf/nan needs the prelude (str is a converter shim).
(each src ["(str ##Inf)" "(str ##-Inf)" "(str ##NaN)"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "numedge: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# variadic assoc! (jolt-q3w8): (assoc! t k v & kvs).
(each src ["(count (persistent! (assoc! (transient {}) :a 1 :b 2 :c 3)))"
"(get (persistent! (assoc! (transient {}) :a 1 :b 2)) :b)"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "numedge: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3s) seq-native shims + reduced (jolt-y6mv): the dominant prelude-parity crash
# bucket was 'apply jolt-nil' — core fns calling seed-native seq fns with no Chez
# shim. host/chez/natives-seq.ss shims the safe, high-value ones (mapcat/
# take-while/drop-while/partition collection arities, sort) over the seq layer,
# plus reduced/reduced? (reduce short-circuits on a reduced; deref unwraps it)
# and identical?. They lower to var-deref in prelude mode. Asserted as
# (= expected (expr)) -> "true" so seq-vs-vector equality (not print form) is the
# contract, exactly like the corpus gate.
(each src [# reduced
"(reduced? (reduced 1))" "(reduced? 1)" "(deref (reduced 9))"
"(reduce (fn [a x] (if (> a 2) (reduced a) (+ a x))) 0 [1 2 3 4 5])"
"(= [1 1 2 2] (mapcat (fn [x] [x x]) [1 2]))"
"(= [1 3 2 4] (mapcat vector [1 2] [3 4]))"
"(= [1 2 3] (mapcat identity [[1 2] [3]]))"
"(= () (mapcat vector [] [1 2]))"
"(= [1 2] (take-while (fn [x] (< x 3)) [1 2 3 1]))"
"(= [3 1] (drop-while (fn [x] (< x 3)) [1 2 3 1]))"
"(= () (take-while pos? []))"
"(= [[1 2] [3 4]] (partition 2 [1 2 3 4 5]))"
"(= [[1 2] [4 5]] (partition 2 3 [1 2 3 4 5 6]))"
"(= [[1 2] [3 :p]] (partition 2 2 [:p] [1 2 3]))"
"(= [1 2 3] (sort [3 1 2]))"
"(= [3 2 1] (sort > [1 3 2]))"
"(= [nil 1 3] (sort compare [3 nil 1]))"
"(= () (sort []))"
"(identical? :a :a)" "(identical? :a :b)"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "seq-native: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# reduce-kv honors reduced is an OVERLAY fn over the native reduce — exercise it
# end-to-end through the assembled -e binary.
(when (os/stat "bin/jolt-chez")
(each src ["(= [:a] (reduce-kv (fn [a i v] (if (= i 1) (reduced a) (conj a v))) [] [:a :b :c]))"
"(= 9 (unreduced (reduced 9)))" "(= 9 (unreduced 9))"]
(let [[code out err] (run-jolt-chez src) want (cli-oracle src)]
(ok (string "seq-native -e: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err)))))
# 3t) transducer arities (jolt-kxsr): the 1-arg map/filter/take/drop/remove/
# take-while/drop-while/mapcat return a transducer (fn [rf] rf'), and into gets a
# 3-arg (into to xform from). These lowered to the bare native procedure at the
# wrong arity (the 'cdr () not a pair' / 'incorrect number of arguments' bucket),
# so the fix is RT-side: case-lambda the seq fns + jolt-into. (map inc)/into are
# native, so into+single-xform runs in run-prelude; transduce/comp are overlay,
# so those go through the -e binary.
(each src ["(= [2 3 4] (into [] (map inc) [1 2 3]))"
"(= #{2 3 4} (into #{} (map inc) [1 2 3]))"
"(= [2 4] (into [] (filter even?) [1 2 3 4 5]))"
"(= [1 3 5] (into [] (remove even?) [1 2 3 4 5]))"
"(= [1 2] (into [] (take 2) [1 2 3 4]))"
"(= [3 4] (into [] (drop 2) [1 2 3 4]))"
"(= [1 2] (into [] (take-while (fn [x] (< x 3))) [1 2 3 1]))"
"(= [3 1] (into [] (drop-while (fn [x] (< x 3))) [1 2 3 1]))"
"(= [1 1 2 2] (into [] (mapcat (fn [x] [x x])) [1 2]))"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "transducer: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
(when (os/stat "bin/jolt-chez")
(each src ["(= 6 (transduce (map inc) + [0 1 2]))"
"(= 5 (transduce (map inc) + [1 2]))"
"(= 6 (transduce (map inc) (completing +) 0 [0 1 2]))"
"(= [4 6] (into [] (comp (map inc) (filter even?)) [2 3 4 5]))"
"(= 3 (reduce (fn [a x] (if (> a 2) (reduced a) (+ a x))) 0 (range 100)))"
"(into #{} (map inc) [1 2 3])"]
(let [[code out err] (run-jolt-chez src) want (cli-oracle src)]
(ok (string "transducer -e: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err)))))
# 3u) misc seq/regex gaps (jolt-y1zq): 0-arg (conj) -> []; 0-arg (conj!) -> a
# fresh transient vector; nth sees through a transient; and irregex \p{...} /
# \P{...} unicode property classes translate to the seed's ASCII char classes
# (regex.ss). Deferred: the assoc!-odd-args seed quirk (non-Clojure, trailing key
# gets nil) and clojure.math/PI (missing ns). \p/conj!/nth run in run-prelude;
# halt-when (overlay, exercises conj 0-arg as the transduce init) via the binary.
(each src ["(= [] (conj))" "(= [1] (conj nil 1))"
"(= [] (persistent! (conj!)))"
"(= 2 (nth (transient [1 2 3]) 1))"
"(re-matches #\"^\\p{L}+$\" \"hello\")"
"(boolean (re-matches #\"^\\p{L}+$\" \"ab1\"))"
"(re-seq #\"\\p{N}+\" \"a12b345\")"
"(re-matches #\"^\\P{N}+$\" \"abc\")"
"(re-matches #\"^\\p{Ll}\\p{Lu}$\" \"aB\")"
"(re-matches #\"^\\p{Ps}x\\p{Pe}$\" \"(x)\")"
# \p{} INSIDE a [...] class emits the class content, not a nested [...]
"(= \" \" (re-matches #\"(?u)^[\\s\\p{Z}]+$\" \" \"))"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "y1zq: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
(when (os/stat "bin/jolt-chez")
(each src ["(= 7 (transduce (halt-when (fn [x] (> x 5))) conj [1 2 7 3]))"
"(= [1 2 3] (transduce (halt-when (fn [x] (> x 5))) conj [1 2 3]))"]
(let [[code out err] (run-jolt-chez src) want (cli-oracle src)]
(ok (string "y1zq -e: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err)))))
# 3v) multimethod dispatch (jolt-9ls5): defmulti/defmethod expand to
# defmulti-setup/defmethod-setup (+ get-method/methods/remove-method/
# prefer-method/prefers); host/chez/multimethods.ss provides the runtime. A
# jolt-multifn record carries its dispatch fn + method table; jolt-invoke
# dispatches it (direct match, then isa?/hierarchy + prefers, then :default).
# Dispatch uses the overlay isa?/derive/make-hierarchy, so these need the full
# prelude -> the -e binary. (Class-based dispatch — (class x)/String — is
# deferred; it needs the deftype/class subsystem.)
(when (os/stat "bin/jolt-chez")
(each src ["(= \"two\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f 2 [_] \"two\") (f 2)))"
"(= \"circle\" (do (defmulti area :shape) (defmethod area :circle [_] \"circle\") (area {:shape :circle})))"
"(= \"other\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f :default [_] \"other\") (f 99)))"
"(= 5 (do (defmulti g (fn [a b] a)) (defmethod g :add [_ b] b) (g :add 5)))"
"(= :is-shape (do (derive :hsq :hshape) (defmulti hmm identity) (defmethod hmm :hshape [_] :is-shape) (hmm :hsq)))"
"(= :parent (do (def hh (atom (derive (make-hierarchy) :c :p))) (defmulti cmm identity :hierarchy hh) (defmethod cmm :p [_] :parent) (cmm :c)))"
"(= :exact (do (derive :de1 :de2) (defmulti emm identity) (defmethod emm :de2 [_] :parent) (defmethod emm :de1 [_] :exact) (emm :de1)))"
"(= \"one\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") ((get-method f 1) 1)))"
"(= \"one\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") ((get (methods f) 1) 1)))"
"(= 2 (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f 2 [_] \"two\") (count (methods f))))"]
(let [[code out err] (run-jolt-chez src) want (cli-oracle src)]
(ok (string "multimethod: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# no-match throws (exits non-zero), like the corpus :throws row.
(let [[code out err] (run-jolt-chez "(do (defmulti f identity) (defmethod f 1 [_] \"one\") (f 99))")]
(ok "multimethod: no match throws" (not= code 0) (string "code=" code))))
# 3w) dynamic-var constants (jolt-9ls5): *clojure-version* (a map) and
# *unchecked-math* (false) are seed natives, def-var!'d by host/chez/dynamic-vars.ss.
# (*ns* needs a namespace value with get-see-through and map?=false — deferred.)
# (map? *clojure-version*) is intentionally NOT asserted: the seed stores it as a
# mutable table, so its map? is false (a seed quirk); Chez models it as a real map
# (map? true). Not a corpus contract, so the divergence is moot.
(each src ["(== 1 (:major *clojure-version*))" "(== 11 (:minor *clojure-version*))"
"(= false *unchecked-math*)"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "dynvar: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 3x) non-ASCII / control-char string literals (jolt-x0os): Janet's %j renders
# a non-ASCII char as raw UTF-8 bytes (\xC3\xA9) and a control char as \xHH
# with NO terminating semicolon — both forms Chez's reader rejects ("invalid
# character \ in string hex escape"). emit-const must emit a Chez string with
# codepoint escapes (\x<cp>;) so a literal that just passes through (str/=)
# round-trips. (count/subs/nth over a multibyte string index by BYTES in the
# seed but by codepoints on Chez — a separate semantic gap, not tested here.)
(each src ["(str \"h\xC3\xA9llo\")"
"\"h\xC3\xA9llo\""
"(str \"na\xC3\xAFve caf\xC3\xA9\")"
"(str \"\xE6\x97\xA5\xE6\x9C\xAC\xE8\xAA\x9E\")"
"(str \"\xCE\xB1\xCE\xB2\xCE\xB3 \xCE\xB4\xCE\xB5\xCE\xB6\")"
"(= \"h\xC3\xA9llo\" (str \"h\xC3\xA9llo\"))"
"(str \"a\x01b\")"
"(str \"tab\tend\")"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "non-ascii str: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
# 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to
# track against the spike ceiling (hand-Scheme fixnum fib ~5ms). Informational
# — the truthy? wrapper is now elided (jolt-nkcb); the residual gap is jolt's
# all-flonum number model vs the spike's fixnum fib (typed fl*/fx* = Phase 4).
# The full timed bench (fib + mandelbrot vs ceilings) is bench-pipeline.janet.
(let [fib-ir (backend/analyze-form ctx (in (r/parse-next "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))") 0))
fib-scm (emit/emit fib-ir)
timed (string "(import (chezscheme))\n(load \"host/chez/rt.ss\")\n"
fib-scm "\n"
"(define fib (var-deref \"user\" \"fib\"))\n"
"(define (now-ns) (let ((t (current-time 'time-monotonic))) (+ (* (time-second t) 1000000000) (time-nanosecond t))))\n"
"(fib 24)(fib 24)\n"
"(let* ((t0 (now-ns)) (r (fib 30)) (ms (/ (- (now-ns) t0) 1000000.0)))\n"
" (printf \"~a ~a\\n\" (jolt-pr-str r) (exact->inexact ms)))")]
(spit "/tmp/chez-jolt-fib-timed.ss" timed)
(def proc (os/spawn ["chez" "--script" "/tmp/chez-jolt-fib-timed.ss"] :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))
(def parts (string/split " " out))
(def result (get parts 0))
(def ms (scan-number (or (get parts 1) "999")))
(ok "timed fib(30) correct" (and (= code 0) (= result "832040")) (string out " | " err))
(printf " emitted fib(30): %s in %.2f ms (hand-Scheme spike ~5ms)" result ms))
(printf "\nemit-test: %d/%d passed" (- total fails) total)
(os/exit (if (> fails 0) 1 0))

154
test/chez/reader-parity.janet
View file

@ -1,154 +0,0 @@
# Chez Phase 3 inc 5a (jolt-50xx) — value-parity gate for the PORTABLE Clojure
# reader (jolt.reader) vs the Janet seed reader (src/jolt/reader.janet, oracle).
#
# jolt.reader holds the lexing/parsing LOGIC in portable Clojure and delegates
# form construction + number parsing to the jolt.host contract. Here it runs
# interpreted ON THE JANET HOST (loaded via bootstrap-load-source); each input is
# read by BOTH readers and the resulting FORMS compared with jolt's own = (so the
# representation, host-built either way, matches structurally). Positions differ
# (char vs byte indices) and are not compared.
#
# janet test/chez/reader-parity.janet (from repo root)
(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 ../../src/jolt/types_ns :as tns)
(import ../../src/jolt/types_var :as tvar)
(import ../../src/jolt/core :as core)
(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 "")))))
(def ctx (api/init {:compile? true}))
(def src (get (get (ctx :env) :embedded-sources) "jolt.reader"))
(assert src "jolt.reader not embedded (check stdlib_embed collect)")
(backend/bootstrap-load-source ctx "jolt.reader" src)
(def read-one (tvar/var-get (tns/ns-find (tctx/ctx-find-ns ctx "jolt.reader") "read-one")))
(assert read-one "jolt.reader/read-one not found")
# jolt's own value equality (the host =), the same comparator the corpus gate uses.
(defn jeq [a b] (core/jolt-equal? a b))
(defn check [input]
(def w (protect (in (r/parse-next input) 0))) # Janet seed reader (oracle)
(def g (protect (read-one input))) # portable Clojure reader
(cond
# both readers throw on the same input = faithful parity (safety net for
# genuinely-invalid input). We FIX latent bugs rather than reproduce them
# (fix-bugs-dont-reproduce), so this should be rare.
(and (not (w 0)) (not (g 0))) (ok input true)
(not (w 0)) (ok input false (string "janet threw, clj didn't: clj=" (string/format "%p" (g 1))))
(not (g 0)) (ok input false (string "clj threw, janet ok: " (string (g 1))))
(ok input (jeq (w 1) (g 1))
(string "clj=" (string/format "%p" (g 1)) " janet=" (string/format "%p" (w 1))))))
# For inputs where the Janet seed reader is a BUGGY oracle (a latent bug we FIX in
# the port rather than reproduce, fix-bugs-dont-reproduce), assert the portable
# reader against the hand-verified correct value. The Janet seed isn't fixed —
# it's deleted in Phase 5 — so we don't compare against it here.
(defn check-correct [input expected]
(def g (protect (read-one input)))
(if (not (g 0))
(ok input false (string "clj threw: " (string (g 1))))
(ok input (jeq expected (g 1))
(string "clj=" (string/format "%p" (g 1)) " want=" (string/format "%p" expected)))))
# --- inc 5a: atoms -------------------------------------------------------------
# nil / bool
(each i ["nil" "true" "false"] (check i))
# symbols (plain, ns'd, punctuation, special chars)
(each i ["foo" "foo-bar" "my.ns/bar" "+" "-" "*" "->" "<=" "some?" "a1" "x'" "ns/+"] (check i))
# keywords
(each i [":a" ":foo-bar" ":my.ns/key" "::auto" ":a1" ":+"] (check i))
# strings (escapes)
(each i [`"hello"` `"with space"` `"tab\there"` `"nl\nhere"` `"q\"q"` `"back\\slash"` `""`] (check i))
# integers / signs / hex / radix
(each i ["0" "42" "-7" "123456" "0xFF" "0x10" "-0xff" "2r1010" "16rFF" "36rZ" "8r17"] (check i))
# floats / exponent / ratio / N|M suffix
(each i ["3.14" "-2.5" "0.0" "1e10" "1.5e-3" "2E5" "10N" "3.14M" "1/2" "-3/4" "22/7"] (check i))
# leading + reads as the positive number (jolt-if19 fixed in the port; the Janet
# seed reader still errors on these, so assert against the correct value).
(check-correct "+5" 5)
(check-correct "+42" 42)
(check-correct "+0xff" 255)
(check-correct "+3.5" 3.5)
# characters
(each i [`\a` `\Z` `\0` `\newline` `\tab` `\space` `\return` `\\` `\(` `\{` `\%` `A` `\o101`] (check i))
# For #() forms the two readers gensym DIFFERENT param names, so compare modulo
# gensyms: canonicalize each "#"-suffixed symbol to G__<first-occurrence-order>.
(defn- gsym? [nm] (and (> (length nm) 0) (= (in nm (- (length nm) 1)) (chr "#"))))
(defn normalize [form mp]
(cond
(and (struct? form) (= :symbol (form :jolt/type)) (gsym? (form :name)))
(do (when (nil? (get mp (form :name))) (put mp (form :name) (string "G__" (length mp))))
{:jolt/type :symbol :ns nil :name (get mp (form :name))})
(and (struct? form) (= :symbol (form :jolt/type))) form
(array? form) (map |(normalize $ mp) form)
(tuple? form) (tuple/slice (tuple ;(map |(normalize $ mp) form)))
(and (struct? form) (= :jolt/set (form :jolt/type)))
{:jolt/type :jolt/set :value (tuple/slice (tuple ;(map |(normalize $ mp) (form :value))))}
(struct? form) (let [order (r/form-kv-order form)]
(if order (r/reader-map (array ;(map |(normalize $ mp) order))) form))
form))
(defn check-anon [input]
(def w (in (r/parse-next input) 0))
(def g (protect (read-one input)))
(if (not (g 0))
(ok input false (string "clj threw: " (string (g 1))))
(ok input (core/jolt-equal? (normalize w @{}) (normalize (g 1) @{}))
(string "clj=" (string/format "%p" (normalize (g 1) @{})) " janet=" (string/format "%p" (normalize w @{}))))))
# --- inc 5b: collections + quote/deref/meta -----------------------------------
# lists
(each i ["(1 2 3)" "(a b c)" "()" "(foo (bar baz) qux)" "(+ 1 (* 2 3))"] (check i))
(check "(1 ; c\n 2 3)") # comment inside a list
# vectors
(each i ["[1 2 3]" "[]" "[a [b c]]" "[1 [2 [3]]]" "[:a :b :c]"] (check i))
# maps
(each i ["{:a 1 :b 2}" "{}" "{:a {:b 1}}" "{:x [1 2] :y {:z 3}}" "{1 2 3 4}"] (check i))
(check "{:a 1 ; c\n :b 2}") # comment inside a map (key/value slots)
# mixed / nested forms (real code shapes)
(each i ["(defn f [x] (+ x 1))" "{:list (1 2) :vec [3 4]}" "(let [a 1 b 2] (+ a b))"] (check i))
# quote / syntax-quote / unquote / deref
(each i ["'foo" "'(1 2 3)" "''x" "'[a b]" "'{:a 1}"] (check i))
(each i ["`foo" "`(a b c)" "`[x y]"] (check i))
(check "`\"meow\"") # syntax-quote of a literal collapses
(each i ["~x" "~@xs" "@x" "@(atom 1)"] (check i))
(check "`(a ~b ~@c)")
# metadata
(each i ["^:dynamic x" "^String s" "^:private foo" "^{:a 1} v" "^t/Ray r"] (check i))
(check "(defn ^:private g [x] x)")
# --- inc 5c: dispatch (#) ------------------------------------------------------
# sets
(each i ["#{1 2 3}" "#{}" "#{:a :b}" "#{[1 2] {:k 1}}"] (check i))
# var-quote
(each i ["#'foo" "#'my.ns/bar"] (check i))
# regex (tagged :regex form — compared by source string)
(each i [`#"[0-9]+"` `#"\d+"` `#"a.c"` `#"(?i)foo"`] (check i))
# tagged literals (#inst / #uuid / arbitrary #tag)
(each i [`#inst "2020-01-01"` `#uuid "00000000-0000-0000-0000-000000000000"`
`#foo bar` `#foo [1 2]` `#my.ns/Tag {:a 1}`] (check i))
# #_ discard (in collections + top-level + map slots)
(each i ["[1 #_2 3]" "(a #_b c)" "#_ x y" "{:a #_1 2 :b 3}" "[#_#_1 2 3]"] (check i))
# #? reader-conditional (jolt + default active; cljs inactive)
(each i ["#?(:jolt 1 :clj 2)" "#?(:clj 1 :default 2)" "[#?(:cljs 1) 2]"
"#?(:jolt :yes :default :no)"] (check i))
# #?@ splice
(each i ["[#?@(:jolt [1 2]) 3]" "[#?@(:cljs [9]) 4]" "(0 #?@(:default [1 2 3]) 4)"] (check i))
# ## symbolic (Inf/-Inf comparable; NaN checked by property)
(each i ["##Inf" "##-Inf"] (check i))
(let [g (read-one "##NaN")] (ok "##NaN" (not= g g) (string "got " (string/format "%p" g))))
# #^ deprecated metadata reader macro (= ^)
(each i ["#^String x" "#^:dynamic y"] (check i))
# #() anonymous fns (gensym-normalized)
(each i ["#(+ %1 %2)" "#(* % %)" "#(do %2 %&)" "#(foo)" "#(vector %1 %2 %3)"
"#(%)" "#(apply + %&)" "#(get {:a %} :a)" "#(conj #{%1} %2)" "#(inc %)"] (check-anon i))
(printf "\n%d/%d ok" (- total fails) total)
(when (> fails 0) (os/exit 1))