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"
" (loop (+ i 2)))\n"
" (begin (write-char c out) (loop (+ i 1)))))))))\n"
"(define (zj-run label esrc)\n"
" (define src (zj-unescape esrc))\n"
# ACTUAL is compiled+eval'd as its OWN top-level program (jolt-compile-eval
# 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"
" (let ((v (jolt-compile-eval src \"user\")))\n"
" (if (string=? (jolt-final-str v) \"true\")\n"
" (let* ((av (jolt-compile-eval asrc \"user\")) (ev (jolt-compile-eval esrc \"user\")))\n"
" (if (jolt= ev av)\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"
"(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 loop ()\n"
" (let ((line (get-line p)))\n"
" (unless (eof-object? line)\n"
" (let find ((i 0))\n"
" (cond ((>= i (string-length line)) #f)\n"
" ((char=? (string-ref line i) #\\tab)\n"
" (zj-run (substring line 0 i) (substring line (+ i 1) (string-length line))))\n"
" (else (find (+ i 1)))))\n"
" (let* ((t1 (zj-tab line 0)) (t2 (and t1 (zj-tab line (+ t1 1)))))\n"
" (when (and t1 t2)\n"
" (zj-run (substring line 0 t1) (substring line (+ t1 1) t2)\n"
" (substring line (+ t2 1) (string-length line)))))\n"
" (loop)))))\n"))
(defn eval-corpus-zero-janet
@ -574,7 +582,7 @@
(defn- tsv-esc [s]
(->> s (string/replace-all "\\" "\\\\") (string/replace-all "\n" "\\n")
(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)
(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")))