Chez Phase 0a+0b: value model + host-neutral contract gate

0a (host/chez/values.ss): Jolt value model on Chez — nil sentinel distinct from
#f/'(), interned keywords, ns+meta symbols, exactness-aware = and consistent
hash. Chez numeric tower gives ratios/bignums free. 33/33 tests.

0b (test/chez/): extract test/spec/*.janet defspec tables into corpus.edn (2655
cases, valid as both EDN and Janet data), and a runner that drives ANY jolt
binary via the CLI boundary with per-case subprocess isolation. Pluggable target
(JOLT_BIN) so the same corpus gates every host. Baseline vs Janet build/jolt:
2641/2655, 14 known CLI divergences allowlisted; gate fails only on NEW ones.
This commit is contained in:
Yogthos 2026-06-17 13:06:35 -04:00
parent b60177b03a
commit c9316dd372
7 changed files with 2965 additions and 0 deletions

74
host/chez/values.ss Normal file
View file

@ -0,0 +1,74 @@
;; Jolt value model on Chez Scheme — Phase 0a (jolt-cf1q.1).
;;
;; The irreducible value layer the self-hosted RT rests on. Maps Clojure's value
;; types onto Chez natives where possible, and adds records only where Chez lacks
;; a distinct type (nil sentinel, keywords, ns-bearing symbols). Loaded into an
;; env that has already (import (chezscheme)); becomes a real library in Phase 1.
;;
;; Design notes:
;; - nil is a UNIQUE sentinel, distinct from #f and '() (the classic Lisp-on-Lisp
;; trap). jolt false -> Chez #f, jolt true -> #t.
;; - Chez's numeric tower IS Clojure's: long->exact integer, double->flonum,
;; ratio->exact rational, bigint->bignum. A windfall vs Janet (ratios/bignums
;; for free). Clojure `=` is exactness-aware: (= 1 1.0) is FALSE.
;; --- nil ---------------------------------------------------------------------
(define-record-type jolt-nil-t (fields) (nongenerative jolt-nil-v1))
(define jolt-nil (make-jolt-nil-t))
(define (jolt-nil? x) (jolt-nil-t? x))
;; --- truthiness: only nil and false are falsey -------------------------------
(define (jolt-truthy? x) (not (or (jolt-nil? x) (eq? x #f))))
;; --- keywords: interned so identity works; optional namespace ----------------
(define-record-type keyword-t (fields ns name khash) (nongenerative keyword-v1))
(define keyword-table (make-hashtable string-hash string=?))
(define (keyword-intern-key ns name) (string-append (or ns "") "/" name))
(define (keyword ns name)
(let ((k (keyword-intern-key ns name)))
(or (hashtable-ref keyword-table k #f)
(let ((kw (make-keyword-t ns name (equal-hash k))))
(hashtable-set! keyword-table k kw)
kw))))
(define (keyword? x) (keyword-t? x))
;; --- symbols: ns + name + meta; NOT interned (meta varies), = by ns/name ------
(define-record-type symbol-t (fields ns name meta) (nongenerative symbol-v1))
(define (jolt-symbol ns name) (make-symbol-t ns name jolt-nil))
(define (jolt-symbol/meta ns name meta) (make-symbol-t ns name meta))
(define (jolt-symbol? x) (symbol-t? x))
;; chars/strings: Chez natives (strings treated immutable).
;; --- jolt equality (Clojure =) — scalars; collections land in Phase 2 --------
(define (jolt=2 a b)
(cond
((and (jolt-nil? a) (jolt-nil? b)) #t)
((or (jolt-nil? a) (jolt-nil? b)) #f)
((and (number? a) (number? b)) ; exactness-aware
(and (eq? (exact? a) (exact? b)) (= a b)))
((and (keyword-t? a) (keyword-t? b)) (eq? a b)) ; interned
((and (symbol-t? a) (symbol-t? b))
(and (equal? (symbol-t-ns a) (symbol-t-ns b))
(string=? (symbol-t-name a) (symbol-t-name b))))
((and (char? a) (char? b)) (char=? a b))
((and (string? a) (string? b)) (string=? a b))
((and (boolean? a) (boolean? b)) (eq? a b))
(else (eq? a b))))
(define (jolt= a . rest)
(let loop ((a a) (rest rest))
(cond ((null? rest) #t)
((jolt=2 a (car rest)) (loop (car rest) (cdr rest)))
(else #f))))
;; --- jolt hash — consistent with jolt= (for the HAMT in 0c / Phase 2) ---------
(define (jolt-hash x)
(cond
((jolt-nil? x) 0)
((keyword-t? x) (keyword-t-khash x))
((symbol-t? x) (equal-hash (cons (symbol-t-ns x) (symbol-t-name x))))
((number? x) (if (exact? x) (equal-hash x) (equal-hash (cons 'inexact (inexact->exact x)))))
((string? x) (string-hash x))
((char? x) (char->integer x))
((boolean? x) (if x 1 2))
(else (equal-hash x))))

38
test/chez/README.md Normal file
View file

@ -0,0 +1,38 @@
# Chez port — Phase 0 test contract 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.
## 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 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.
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.
## 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.

2657
test/chez/corpus.edn Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,69 @@
# Phase 0b — extract the spec corpus into a host-neutral contract file.
#
# Parses every test/spec/*.janet as DATA (no eval), pulls each
# (defspec "suite" [label expected actual] ...) triple, and writes a corpus that
# is valid BOTH as EDN (a future Chez-jolt runner reads it) and as Janet data
# (the current runner reads it via `parse`). Run from repo root:
# janet test/chez/extract-corpus.janet
(use ../../src/jolt/reader) # not needed for parse, but keeps paths obvious
(defn parse-all [src]
(def p (parser/new))
(parser/consume p src)
(parser/eof p)
(def out @[])
(while (parser/has-more p) (array/push out (parser/produce p)))
out)
(defn edn-str [s]
# escape a Clojure-source string into an EDN/Janet string literal
(def b @`"`)
(each c s
(cond
(= c (chr `"`)) (buffer/push b `\"`)
(= c (chr "\\")) (buffer/push b "\\\\")
(= c (chr "\n")) (buffer/push b "\\n")
(= c (chr "\t")) (buffer/push b "\\t")
(buffer/push-byte b c)))
(buffer/push b `"`)
(string b))
(defn triples-from [form]
# form is (defspec "suite" [l e a] ...) as a parsed tuple
(when (and (indexed? form) (> (length form) 0) (= (first form) 'defspec))
(def suite (in form 1))
(def rows @[])
(each case (slice form 2)
(when (and (indexed? case) (>= (length case) 3))
(def label (in case 0))
(def expected (in case 1))
(def actual (in case 2))
# expected is either a Clojure-source string or the :throws keyword;
# actual is always a Clojure-source string. Skip non-literal rows.
(when (and (string? label) (string? actual)
(or (string? expected) (keyword? expected)))
(array/push rows {:suite suite :label label
:expected expected :actual actual})))
)
rows))
(def spec-dir "test/spec")
(def all @[])
(each f (sort (os/dir spec-dir))
(when (string/has-suffix? "-spec.janet" f)
(def path (string spec-dir "/" f))
(each form (parse-all (slurp path))
(when-let [rows (triples-from form)]
(array/concat all rows)))))
# emit EDN-and-Janet-valid corpus
(def out @"[\n")
(each row all
(buffer/push out
(string " {:suite " (edn-str (row :suite))
" :label " (edn-str (row :label))
" :expected " (if (keyword? (row :expected)) ":throws" (edn-str (row :expected)))
" :actual " (edn-str (row :actual)) "}\n")))
(buffer/push out "]\n")
(spit "test/chez/corpus.edn" out)
(printf "extracted %d cases from %s into test/chez/corpus.edn" (length all) spec-dir)

View file

@ -0,0 +1,14 @@
["max non-number throws"
"min-key keys nonnum"
"neg? keyword"
"< nil"
"> with nil"
"max non-number"
"neg? throws"
"vector index"
"map key as fn"
"map key default"
"set membership"
"set miss default"
"collection key"
"xml-seq walks"]

View file

@ -0,0 +1,53 @@
# Phase 0b — host-neutral parity runner.
#
# Feeds each corpus case to a TARGET jolt binary as a fresh subprocess (fresh
# ctx = the per-case isolation the in-process harness gives), checking
# (= expected actual) prints `true`, or that a :throws case exits non-zero. The
# target is pluggable so the SAME corpus gates every host:
# JOLT_BIN=build/jolt janet test/chez/run-corpus.janet # Janet ref
# JOLT_BIN=build/jolt-chez ... (Phase 1+) # Chez host
# Env: JOLT_CORPUS_LIMIT=N caps the run (every-Nth stride) for fast iteration.
(def corpus (parse (slurp "test/chez/corpus.edn")))
(def jolt-bin (or (os/getenv "JOLT_BIN") "build/jolt"))
(def known (let [k @{}] (each l (parse (slurp "test/chez/known-divergences.edn")) (put k l true)) k))
(def cases
(if-let [n (os/getenv "JOLT_CORPUS_LIMIT")]
(let [stride (max 1 (math/floor (/ (length corpus) (scan-number n))))]
(seq [i :range [0 (length corpus) stride]] (in corpus i)))
corpus))
(defn run-capture [args]
(def proc (os/spawn [jolt-bin ;args] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(ev/read (proc :err) 0x100000)
(def code (os/proc-wait proc))
# take the LAST non-empty line: a case may print side effects before its value
(def lines (filter (fn [l] (not (empty? l))) (string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines))])
(var pass 0)
(def fails @[]) # NEW divergences — these fail the gate
(def known-hit @[]) # expected (allowlisted) divergences
(defn record-fail [l m]
(if (known l) (array/push known-hit l) (array/push fails [l m])))
(each row cases
(def {:expected e :actual a :label l} row)
(if (= e :throws)
(let [[code _] (run-capture ["-e" a])]
(if (not= code 0) (++ pass)
(record-fail l "expected an error, exited 0")))
(let [[code out] (run-capture ["-e" (string "(= " e " " a ")")])]
(cond
(not= code 0) (record-fail l (string "errored (exit " code ")"))
(= out "true") (++ pass)
(record-fail l (string "want true, got " out))))))
(printf "\ncorpus parity [%s]: %d/%d passed (%d known divergences)"
jolt-bin pass (length cases) (length known-hit))
(when (> (length fails) 0)
(printf "%d NEW divergence(s) — gate FAILED:" (length fails))
(each [l m] (slice fails 0 (min 20 (length fails)))
(printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (> (length fails) 0) 1 0))

60
test/chez/values-test.ss Normal file
View file

@ -0,0 +1,60 @@
;; Phase 0a tests — Jolt value model on Chez. Run from repo root:
;; chez --script test/chez/values-test.ss
(import (chezscheme))
(load "host/chez/values.ss")
(define total 0)
(define fails 0)
(define (ok name pred)
(set! total (+ total 1))
(unless pred (set! fails (+ fails 1)) (printf "FAIL: ~a\n" name)))
;; nil distinct from #f and '()
(ok "nil not #f" (not (eq? jolt-nil #f)))
(ok "nil not '()" (not (eq? jolt-nil '())))
(ok "nil? jolt-nil" (jolt-nil? jolt-nil))
(ok "nil? not on #f" (not (jolt-nil? #f)))
;; truthiness: only nil and false falsey
(ok "nil falsey" (not (jolt-truthy? jolt-nil)))
(ok "false falsey" (not (jolt-truthy? #f)))
(ok "true truthy" (jolt-truthy? #t))
(ok "0 truthy" (jolt-truthy? 0))
(ok "empty-str truthy" (jolt-truthy? ""))
(ok "empty-list truthy" (jolt-truthy? '()))
;; keywords interned -> identity
(ok "kw eq" (eq? (keyword #f "foo") (keyword #f "foo")))
(ok "kw ns eq" (eq? (keyword "a" "foo") (keyword "a" "foo")))
(ok "kw diff ns" (not (eq? (keyword "a" "foo") (keyword #f "foo"))))
(ok "kw?" (keyword? (keyword #f "x")))
(ok "kw not sym" (not (jolt-symbol? (keyword #f "x"))))
;; symbols NOT interned but jolt= by ns/name
(ok "sym not eq" (not (eq? (jolt-symbol #f "x") (jolt-symbol #f "x"))))
(ok "sym jolt=" (jolt= (jolt-symbol #f "x") (jolt-symbol #f "x")))
(ok "sym diff name" (not (jolt= (jolt-symbol #f "x") (jolt-symbol #f "y"))))
(ok "sym?" (jolt-symbol? (jolt-symbol "ns" "n")))
;; numbers: exactness-aware = (Clojure semantics)
(ok "1 = 1" (jolt= 1 1))
(ok "1 not= 1.0" (not (jolt= 1 1.0)))
(ok "1.0 = 1.0" (jolt= 1.0 1.0))
(ok "ratio =" (jolt= 1/2 1/2))
(ok "bigint=int exact" (jolt= 2 (expt 2 1)))
(ok "= variadic" (jolt= 3 3 3))
(ok "= variadic false" (not (jolt= 3 3 4)))
;; strings / chars
(ok "str =" (jolt= "ab" "ab"))
(ok "str !=" (not (jolt= "ab" "ac")))
(ok "char =" (jolt= #\a #\a))
;; hashing consistent with =
(ok "hash kw stable" (= (jolt-hash (keyword #f "k")) (jolt-hash (keyword #f "k"))))
(ok "hash sym stable" (= (jolt-hash (jolt-symbol #f "k")) (jolt-hash (jolt-symbol #f "k"))))
(ok "hash 1 != 1.0" (not (= (jolt-hash 1) (jolt-hash 1.0))))
(ok "hash str stable" (= (jolt-hash "abc") (jolt-hash "abc")))
(printf "values-test: ~a/~a passed\n" (- total fails) total)
(exit (if (> fails 0) 1 0))