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

Chez corpus: eval ACTUAL top-level so runtime defmacro cases run (jolt-cf1q.7)

Browse source 
The zero-Janet runner wrapped each case as (= EXPECTED ACTUAL) and checked the
result was true. That nests ACTUAL's top-level (do ...), so a case like
(do (defmacro m ...) (m 1)) can't use the macro it just defined — the analyzer
punted defmacro -> "uncompilable" (35 cases).

Match certify.clj's eval-isolated instead: carry EXPECTED and ACTUAL as separate
sources and evaluate ACTUAL as its own top-level program (jolt-compile-eval unrolls
the top-level do, so a macro defined earlier is usable later), then compare to
EXPECTED with =. Evaluating ACTUAL from SOURCE (not (eval (quote A))) preserves the
reader's map-literal source order, so the eval-order cases still pass.

eval-corpus-zero-janet / program-corpus-zero-janet now use a 3-field TSV
(label/expected/actual); run-corpus-zero-janet's per-case debug path evals both
sides too. Only run-corpus-zero-janet uses these (the prelude gate is untouched).

zero-Janet 2642->2673 (analyzer "uncompilable" 35->4); 1 new allowlisted divergence
(`{:a ~x :b ~y} syntax-quote map construction doesn't preserve source eval order —
pmap is unordered). Janet gate + JVM cert green.

jolt-cf1q.7
This commit is contained in:
Yogthos 2026-06-20 16:53:20 -04:00
parent ccab89e1d5
commit 4b4d677fe4
2 changed files with 40 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

30
host/chez/driver.janet
View file

@ -542,23 +542,31 @@
" (write-char (cond ((char=? d #\\n) #\\newline) ((char=? d #\\t) #\\tab) (else d)) out)\n" " (write-char (cond ((char=? d #\\n) #\\newline) ((char=? d #\\t) #\\tab) (else d)) out)\n"
" (loop (+ i 2)))\n" " (loop (+ i 2)))\n"
" (begin (write-char c out) (loop (+ i 1)))))))))\n" " (begin (write-char c out) (loop (+ i 1)))))))))\n"
"(define (zj-run label esrc)\n" # ACTUAL is compiled+eval'd as its OWN top-level program (jolt-compile-eval
" (define src (zj-unescape esrc))\n" # unrolls a top-level do), so a macro defined earlier in the program is usable
# later (runtime defmacro) — matching certify.clj's eval-isolated. Then compare
# to EXPECTED with =. (Wrapping in (= E A) would nest ACTUAL's do; wrapping A in
# (eval (quote A)) would quote a map literal and lose its source eval-order.)
"(define (zj-run label e-esc a-esc)\n"
" (define esrc (zj-unescape e-esc))\n"
" (define asrc (zj-unescape a-esc))\n"
" (guard (e (#t (printf \"CRASH\\t~a\\t~a\\n\" label (zj-clean (zj-err->str e)))))\n" " (guard (e (#t (printf \"CRASH\\t~a\\t~a\\n\" label (zj-clean (zj-err->str e)))))\n"
" (let ((v (jolt-compile-eval src \"user\")))\n" " (let* ((av (jolt-compile-eval asrc \"user\")) (ev (jolt-compile-eval esrc \"user\")))\n"
" (if (string=? (jolt-final-str v) \"true\")\n" " (if (jolt= ev av)\n"
" (printf \"PASS\\t~a\\n\" label)\n" " (printf \"PASS\\t~a\\n\" label)\n"
" (printf \"DIVERGE\\t~a\\t~a\\n\" label (zj-clean (jolt-final-str v))))))\n" " (printf \"DIVERGE\\t~a\\t~a\\n\" label (zj-clean (jolt-final-str av))))))\n"
" (zj-reset!))\n" " (zj-reset!))\n"
"(define (zj-tab s from)\n"
" (let loop ((i from)) (cond ((>= i (string-length s)) #f)\n"
" ((char=? (string-ref s i) #\\tab) i) (else (loop (+ i 1))))))\n"
"(let ((p (open-input-file " (string/format "%j" cases-tsv) ")))\n" "(let ((p (open-input-file " (string/format "%j" cases-tsv) ")))\n"
" (let loop ()\n" " (let loop ()\n"
" (let ((line (get-line p)))\n" " (let ((line (get-line p)))\n"
" (unless (eof-object? line)\n" " (unless (eof-object? line)\n"
" (let find ((i 0))\n" " (let* ((t1 (zj-tab line 0)) (t2 (and t1 (zj-tab line (+ t1 1)))))\n"
" (cond ((>= i (string-length line)) #f)\n" " (when (and t1 t2)\n"
" ((char=? (string-ref line i) #\\tab)\n" " (zj-run (substring line 0 t1) (substring line (+ t1 1) t2)\n"
" (zj-run (substring line 0 i) (substring line (+ i 1) (string-length line))))\n" " (substring line (+ t2 1) (string-length line)))))\n"
" (else (find (+ i 1)))))\n"
" (loop)))))\n")) " (loop)))))\n"))
(defn eval-corpus-zero-janet (defn eval-corpus-zero-janet
@ -574,7 +582,7 @@
(defn- tsv-esc [s] (defn- tsv-esc [s]
(->> s (string/replace-all "\\" "\\\\") (string/replace-all "\n" "\\n") (->> s (string/replace-all "\\" "\\\\") (string/replace-all "\n" "\\n")
(string/replace-all "\t" "\\t"))) (string/replace-all "\t" "\\t")))
(each [label src] cases (buffer/push buf label "\t" (tsv-esc src) "\n")) (each [label e a] cases (buffer/push buf label "\t" (tsv-esc e) "\t" (tsv-esc a) "\n"))
(spit tsv-path buf) (spit tsv-path buf)
(def prog (program-corpus-zero-janet prelude-path image-path tsv-path)) (def prog (program-corpus-zero-janet prelude-path image-path tsv-path))
(def path (or scheme-out (string "/tmp/jolt-zj-runner-" (os/getpid) ".ss"))) (def path (or scheme-out (string "/tmp/jolt-zj-runner-" (os/getpid) ".ss")))

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

@ -105,7 +105,12 @@
"float-array" true "short-array" true "float-array" true "short-array" true
# StringReader over a char-array (.read on clojure.java.io/reader) — host interop, # StringReader over a char-array (.read on clojure.java.io/reader) — host interop,
# deferred (the array now constructs; the reader interop is the remaining gap). # deferred (the array now constructs; the reader interop is the remaining gap).
"reader over char[]" true}) "reader over char[]" true
# syntax-quote map construction `{:a ~x :b ~y} builds a pmap (unordered), so the
# unquoted value forms eval in hash order, not source order — a minor ordering
# gap (pmap has no insertion order; the reader's source-order table doesn't cover
# syntax-quote-built maps). 1 case; the non-syntax-quote map-order cases pass.
"source order through syntax-quote" true})
# Cases that BLOCK forever on a shared-heap / JVM host (profile.edn :bucket # Cases that BLOCK forever on a shared-heap / JVM host (profile.edn :bucket
# :timeout) — skip them, like :throws: a single hung case would stall the whole # :timeout) — skip them, like :throws: a single hung case would stall the whole
@ -145,7 +150,11 @@
(var throws 0) (var throws 0)
# Build the evaluable case list (skip :throws), keyed by index (labels aren't # Build the evaluable case list (skip :throws), keyed by index (labels aren't
# unique across suites). idx -> row, idx -> "(= EXPECTED ACTUAL)". # unique across suites). Each pair carries EXPECTED + ACTUAL as SEPARATE source
# strings; the runner evaluates ACTUAL as its own top-level program (so its
# top-level `do` unrolls and a macro defined in the program is usable later —
# matching certify.clj's eval-isolated) and compares to EXPECTED with =. Wrapping
# in (= E A) would nest ACTUAL's do and break runtime defmacro (jolt-cf1q.7).
(def rows-by-idx @{}) (def rows-by-idx @{})
(def pairs @[]) (def pairs @[])
(eachp [i row] cases (eachp [i row] cases
@ -154,7 +163,7 @@
(++ throws) (++ throws)
(let [key (string i)] (let [key (string i)]
(put rows-by-idx key row) (put rows-by-idx key row)
(array/push pairs [key (string "(= " e " " a ")")])))) (array/push pairs [key e a]))))
(defn- handle [key verdict] (defn- handle [key verdict]
(def row (get rows-by-idx key)) (def row (get rows-by-idx key))
@ -166,10 +175,12 @@
(array/push diverged [l (string "got " (get verdict 1))])))) (array/push diverged [l (string "got " (get verdict 1))]))))
(if (os/getenv "JOLT_ZJ_PERCASE") (if (os/getenv "JOLT_ZJ_PERCASE")
# slow per-case path (each case its own chez process) — for isolating a hang/crash # slow per-case path (each case its own chez process) — for isolating a hang/crash.
(each [key src] pairs # Eval ACTUAL and EXPECTED top-level (separate processes), compare printed forms.
(def [code out err] (d/eval-zero-janet prelude-path image-path src)) (each [key e a] pairs
(handle key (cond (not= code 0) [:crash err] (= out "true") [:pass] [:diverge out]))) (def [acode aout aerr] (d/eval-zero-janet prelude-path image-path a))
(def [_ eout _] (d/eval-zero-janet prelude-path image-path e))
(handle key (cond (not= acode 0) [:crash aerr] (= aout eout) [:pass] [:diverge aout])))
# fast batched path: one chez process loads the runtime once, runs all cases # fast batched path: one chez process loads the runtime once, runs all cases
(let [{:results r :code c :stderr se :count n} (d/eval-corpus-zero-janet prelude-path image-path pairs)] (let [{:results r :code c :stderr se :count n} (d/eval-corpus-zero-janet prelude-path image-path pairs)]
(when (< n (length pairs)) (when (< n (length pairs))
@ -203,8 +214,9 @@
# "send/send-off applies" sync-shim cases now match the JVM's async raciness and # "send/send-off applies" sync-shim cases now match the JVM's async raciness and
# are allowlisted) -> 2567. jolt-cf1q.7 parity batches (hash/rseq/cat/transient-as-fn # are allowlisted) -> 2567. jolt-cf1q.7 parity batches (hash/rseq/cat/transient-as-fn
# + ns runtime fns) -> 2600; arrays -> 2631; reader-features/reader-conditional/ # + ns runtime fns) -> 2600; arrays -> 2631; reader-features/reader-conditional/
# re-matcher/macroexpand/delay? -> 2642. # re-matcher/macroexpand/delay? -> 2642; runtime-defmacro cases via top-level eval
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2642"))) # of ACTUAL (matching certify.clj's eval-isolated) -> 2673.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2673")))
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor)) (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor)) (when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged))) (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))