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

Chez inc7: batched runner handles multi-line case sources

Browse source 
The batched zero-Janet runner wrote one case per TSV line, so a multi-line
source (e.g. a ;comment\n inside a map literal) split the line and the case was
truncated -> a false "apply non-procedure" crash. Escape \n/\t/\\ when writing
the cases file and unescape in the runner before eval.

Zero-Janet corpus parity 2288 -> 2293 (the 5 comment-in-map cases), 0
divergences — now within 2 of the Janet-hosted oracle (2295). Floor 2293.
This commit is contained in:
Yogthos 2026-06-20 02:01:42 -04:00
parent 7d0070d873
commit 28bb950efe
2 changed files with 21 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

22
host/chez/driver.janet
View file

@ -429,7 +429,20 @@
"(define (zj-clean s)\n" # strip tabs/newlines from a message so it stays one TSV line
" (list->string (map (lambda (c) (if (or (char=? c #\\tab) (char=? c #\\newline)) #\\space c))\n"
" (string->list s))))\n"
"(define (zj-run label src)\n"
# cases are stored one-per-line with \\n / \\t / \\\\ escaped (a source may be
# multi-line — e.g. a ;comment\\n inside a map literal); unescape before eval.
"(define (zj-unescape s)\n"
" (let ((out (open-output-string)) (n (string-length s)))\n"
" (let loop ((i 0))\n"
" (if (>= i n) (get-output-string out)\n"
" (let ((c (string-ref s i)))\n"
" (if (and (char=? c #\\\\) (< (+ i 1) n))\n"
" (let ((d (string-ref s (+ i 1))))\n"
" (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"
" (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"
@ -455,7 +468,12 @@
[prelude-path image-path cases &opt scheme-out cases-out]
(def tsv-path (or cases-out (string "/tmp/jolt-zj-cases-" (os/getpid) ".tsv")))
(def buf @"")
(each [label src] cases (buffer/push buf label "\t" src "\n"))
# escape so each case is one TSV line even if its source is multi-line; the
# runner's zj-unescape reverses it. Backslash first, then newline/tab.
(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"))
(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")))

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

@ -163,7 +163,7 @@
# Regression floor: raise as the Chez-hosted compiler closes gaps. The gate fails
# on any NEW divergence or if pass drops below the floor. Strided runs scale to 0.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2288")))
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2293")))
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))