Chez inc 3k: converter + string-op RT shims

str/subs/vec/keyword/symbol/compare/int/double/gensym — host-coupled seed natives
the overlay assumes, now def-var!'d into clojure.core via host/chez/converters.ss
(loaded last, str reuses jolt-pr-str). Semantics match the seed: str-render-one
for str (nil->"", bare chars, regex source), the 3-way core-compare port, int
truncates. The symbol no-ns sentinel is #f to match emit's quoted-symbol lowering
(jolt-symbol #f "x"), so (= 'x (symbol "x")) holds — jolt= compares ns with strict
equal?, and jolt-nil vs #f would otherwise diverge.

Prelude parity 1220 -> 1326/2497, 0 new divergences. Floor raised to 1326; three
newly-reached *ns*/var-rendering cases added to the allowlist (Phase 2). run-prelude
and the per-case program file are now PID-unique so concurrent chez runs don't read
each other's half-written files.
This commit is contained in:
Yogthos 2026-06-17 21:36:42 -04:00
parent 0c9c7931fe
commit bb8b2d201c
5 changed files with 175 additions and 12 deletions

120
host/chez/converters.ss Normal file
View file

@ -0,0 +1,120 @@
;; converters + string ops (jolt-t6cr) — host-coupled seed natives the Chez host
;; must provide; def-var!'d into clojure.core, resolved in prelude mode. Loaded
;; last (after jolt-pr-str), since `str` reuses the printer. Semantics match the
;; Janet seed (core_print.janet str-render-one, core_io.janet core-compare,
;; core_refs.janet int/double). jolt is all-flonum, so numeric results are
;; flonums (int truncates toward zero, compare returns -1.0/0.0/1.0).
;; str: nil -> "", string raw, char bare (not \c), regex -> raw source, else the
;; printer (which renders collections with readable elements).
(define (jolt-str-render-one v)
(cond
((jolt-nil? v) "")
((string? v) v)
((char? v) (string v))
((regex-t? v) (regex-t-source v))
(else (jolt-pr-str v))))
(define (jolt-str . xs)
(let loop ((xs xs) (acc '()))
(if (null? xs)
(apply string-append (reverse acc))
(loop (cdr xs) (cons (jolt-str-render-one (car xs)) acc)))))
;; jolt indices are flonums; substring etc. need exact ints.
(define (jolt->idx n) (exact (truncate n)))
(define (jolt-subs s start . end)
(substring s (jolt->idx start)
(if (null? end) (string-length s) (jolt->idx (car end)))))
;; vec: a pvec from any seqable (already-pvec returns itself).
(define (jolt-vec coll)
(cond
((jolt-nil? coll) (jolt-vector))
((pvec? coll) coll)
((string? coll) (apply jolt-vector (string->list coll)))
(else (apply jolt-vector (seq->list coll)))))
(define (jolt-keyword . args)
(cond
((= (length args) 1)
(let ((a (car args)))
(cond
((jolt-nil? a) jolt-nil)
((keyword? a) a)
((string? a) (keyword #f a))
((jolt-symbol? a)
(let ((ns (symbol-t-ns a)))
(keyword (if (or (jolt-nil? ns) (not ns) (eq? ns '())) #f ns) (symbol-t-name a))))
(else (error #f "keyword: requires string/symbol/keyword" a)))))
((= (length args) 2)
(keyword (let ((ns (car args))) (if (jolt-nil? ns) #f ns)) (cadr args)))
(else (error #f "keyword: wrong arity"))))
(define (jolt-symbol-new . args)
(cond
((= (length args) 1)
(let ((a (car args)))
(cond
((jolt-symbol? a) a)
;; no-ns sentinel is #f — matches emit's quoted-symbol lowering
;; (jolt-symbol #f "x"), so (= 'x (symbol "x")) holds (jolt= compares ns
;; with strict equal?; jolt-nil vs #f would otherwise differ).
((string? a) (jolt-symbol #f a))
((keyword? a) (jolt-symbol (keyword-t-ns a) (keyword-t-name a)))
(else (error #f "symbol: requires string/symbol" a)))))
((= (length args) 2) (jolt-symbol (car args) (cadr args)))
(else (error #f "symbol: wrong arity"))))
;; gensym: per-process counter, like the seed's gensym_counter.
(define jolt-gensym-counter 0)
(define (jolt-gensym . prefix)
(let ((p (if (null? prefix) "G__" (car prefix))))
(set! jolt-gensym-counter (+ jolt-gensym-counter 1))
(jolt-symbol #f
(string-append (if (string? p) p (jolt-str-render-one p))
(number->string jolt-gensym-counter)))))
(define (jolt-int x) (if (char? x) (exact->inexact (char->integer x)) (truncate x)))
(define (jolt-double x) (if (char? x) (exact->inexact (char->integer x)) (exact->inexact x)))
;; compare: 3-way, ported from core_io.janet core-compare.
(define (jolt-cmp3 x y) (cond ((< x y) -1.0) ((> x y) 1.0) (else 0.0)))
(define (jolt-strcmp a b) (cond ((string<? a b) -1.0) ((string>? a b) 1.0) (else 0.0)))
(define (jolt-kw->string k)
(let ((ns (keyword-t-ns k))) (if ns (string-append ns "/" (keyword-t-name k)) (keyword-t-name k))))
(define (jolt-sym-ns-string s)
(let ((n (symbol-t-ns s))) (if (or (jolt-nil? n) (not n) (eq? n '())) "" n)))
(define (jolt-compare a b)
(cond
((and (jolt-nil? a) (jolt-nil? b)) 0.0)
((jolt-nil? a) -1.0)
((jolt-nil? b) 1.0)
((and (number? a) (number? b)) (jolt-cmp3 a b))
((and (string? a) (string? b)) (jolt-strcmp a b))
((and (keyword? a) (keyword? b)) (jolt-strcmp (jolt-kw->string a) (jolt-kw->string b)))
((and (jolt-symbol? a) (jolt-symbol? b))
(let ((r (jolt-strcmp (jolt-sym-ns-string a) (jolt-sym-ns-string b))))
(if (= r 0.0) (jolt-strcmp (symbol-t-name a) (symbol-t-name b)) r)))
((and (boolean? a) (boolean? b)) (cond ((eq? a b) 0.0) ((eq? a #f) -1.0) (else 1.0)))
((and (char? a) (char? b)) (jolt-cmp3 (char->integer a) (char->integer b)))
((and (pvec? a) (pvec? b))
(let ((la (pvec-count a)) (lb (pvec-count b)))
(if (not (= la lb))
(jolt-cmp3 la lb)
(let loop ((i 0))
(if (>= i la)
0.0
(let ((r (jolt-compare (pvec-nth-d a i jolt-nil) (pvec-nth-d b i jolt-nil))))
(if (= r 0.0) (loop (+ i 1)) r)))))))
(else (error #f "compare: cannot compare these types" a b))))
(def-var! "clojure.core" "str" jolt-str)
(def-var! "clojure.core" "subs" jolt-subs)
(def-var! "clojure.core" "vec" jolt-vec)
(def-var! "clojure.core" "keyword" jolt-keyword)
(def-var! "clojure.core" "symbol" jolt-symbol-new)
(def-var! "clojure.core" "gensym" jolt-gensym)
(def-var! "clojure.core" "int" jolt-int)
(def-var! "clojure.core" "double" jolt-double)
(def-var! "clojure.core" "compare" jolt-compare)

View file

@ -144,3 +144,8 @@
(if (jolt-nil? s) (reverse acc) (if (jolt-nil? s) (reverse acc)
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")")) (loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")"))
(else (format "~a" x)))) (else (format "~a" x))))
;; converters + string ops (jolt-t6cr): str/subs/vec/keyword/symbol/compare/int/
;; double/gensym — host-coupled seed natives def-var!'d into clojure.core. Loaded
;; LAST because `str` reuses jolt-pr-str (defined just above).
(load "host/chez/converters.ss")

View file

@ -104,16 +104,21 @@ corpus case with all of core present, bucketing the result —
JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet
JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast) JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast)
First parity baseline (inc 3j): **1220/2497** evaluated cases pass, 0 NEW Parity baseline: inc 3j **1220/2497**; inc 3k (converters, jolt-t6cr) **1326/2497**,
divergences (10 allowlisted: dynamic vars `*ns*`/`*clojure-version*`/`*unchecked-math*`, 0 NEW divergences (13 allowlisted: dynamic vars `*ns*`/`*clojure-version*`/
class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps). `*unchecked-math*`, var/`*ns*` rendering, class names, eval-order, with-open — all
deferred Phase-2 / dynamic-var gaps). inc 3k added `host/chez/converters.ss`:
`str`/`subs`/`vec`/`keyword`/`symbol`/`compare`/`int`/`double`/`gensym` (seed natives,
matching `core_print.janet`/`core_io.janet` semantics — `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).
The remaining buckets are the punch-list the next increments chase: ~360 emit-fail The remaining buckets are the punch-list the next increments chase: ~360 emit-fail
(genuine host interop — qualified Java/Janet refs, runtime `defmacro`/`eval`, out of (genuine host interop — qualified Java/Janet refs, runtime `defmacro`/`eval`, out of
the analyzer's subset) and ~900 runtime crashes, dominated by core fns calling the analyzer's subset) and ~800 runtime crashes, dominated by core fns calling
host-coupled seed natives with no Chez shim yet (`str`/`format`/`vec`/transients — host-coupled seed natives with no Chez shim yet (transients — inc 3l jolt-kl2l),
inc 3k/3l, jolt-t6cr/jolt-kl2l), plus smaller buckets (`##Inf`/`##NaN` literals → plus smaller buckets (`##Inf`/`##NaN` literals → unbound `inf`/`nan`, seq-prim
unbound `inf`/`nan`, seq-prim transducer arities — inc 3m jolt-q3w8; multimethod transducer arities — inc 3m jolt-q3w8; multimethod dispatch — Phase 2 jolt-9ls5).
dispatch — Phase 2 jolt-9ls5).
Two host shims landed with the prelude. `host/chez/atoms.ss`: atom/deref/swap!/ 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 reset! (+ compare-and-set!/swap-vals!/reset-vals!) — host-coupled mutable cells the

View file

@ -312,8 +312,11 @@
(emit/set-prelude-mode! false) (emit/set-prelude-mode! false)
(if (not (r 0)) [:emit-err (r 1) ""] (if (not (r 0)) [:emit-err (r 1) ""]
(do (do
(spit "/tmp/chez-regex-prelude.ss" (emit/program @[] (r 1))) # PID-unique path: two emit-test processes (or a foreground -e) must not
(def proc (os/spawn ["chez" "--script" "/tmp/chez-regex-prelude.ss"] :p {:out :pipe :err :pipe})) # 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 out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000)) (def err (ev/read (proc :err) 0x100000))
[(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))]))) [(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))])))
@ -398,6 +401,32 @@
(ok (string "pred: " src) (and (= code 0) (= out want)) (ok (string "pred: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err)))) (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))))
# 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to # 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to
# track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the # track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the
# jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers. # jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers.

View file

@ -50,6 +50,9 @@
"source order with a nil value (phm form)" true "source order with a nil value (phm form)" true
"close on throw" true "close on throw" true
"ns-name of *ns*" true "ns-name of *ns*" true
"str of *ns*" true
"*ns* user" true
"str of a var" true
"*clojure-version* major" true "*clojure-version* major" true
"*unchecked-math*" true}) "*unchecked-math*" true})
@ -126,8 +129,9 @@
# Regression floor (inc 3j baseline): raise as runtime gaps close, like the probe # Regression floor (inc 3j baseline): raise as runtime gaps close, like the probe
# reach-floor and the suite baseline. The gate fails if parity drops below it, or # reach-floor and the suite baseline. The gate fails if parity drops below it, or
# on any NEW (un-allowlisted) divergence — a real Chez correctness regression. # on any NEW (un-allowlisted) divergence — a real Chez correctness regression.
# Full-corpus baseline at inc 3j: 1220/2497. Strided runs scale the floor down. # Full-corpus baseline: inc 3j 1220/2497; inc 3k (converters) 1326. Strided runs
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1220"))) # scale the floor down.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1326")))
(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)))