Chez Phase 3 inc7: corpus on the Chez-hosted analyzer + a 50x-faster gate
Point the Chez-HOSTED analyzer at the full parity corpus (read -> analyze ->
emit -> eval, all on Chez, no Janet) and close the divergences so the
self-hosted compiler is faithful: 0 divergences, 2159/2494 pass.
Keystone: the on-Chez emitter ran with prelude-mode off, so every call to a
non-native clojure.core fn tripped the "unsupported stdlib fn" out-of-subset
guard. The zero-Janet spine always has the full prelude loaded, so turn
prelude mode on in compile-eval.ss (22% -> 84% pass on a sample).
Faithfulness fixes (each was the Chez host/reader diverging from the Janet
analyzer; fixed in the keeper, not the seed):
- emit-const read a char's codepoint via (get v :ch) — the Janet rep; on Chez a
char is native. Route through a new form-char-code host-contract fn (41 cases).
- next over a lazy seq returned the empty-list terminator (truthy), not nil, so
butlast and other (if (next s) ...) loops ran one step too far — broke
some->/some->>/cond->>.
- reader: radix literals (2r1010/16rFF/36rZ), #^ deprecated metadata, ^meta on
collections (lowers to a runtime with-meta form like the Janet reader),
map-literal source order (values eval left-to-right), and nested syntax-quote
over a literal collapses at read time.
- keyword "a/b" splits into ns/name like the seed (destructure {:keys [x/y]}).
- form-syntax-quote-lower implemented on Chez (was a throwing stub).
7 divergences allowlisted: the same print-method-multimethod / host-class set
the prelude gate defers. 328 crashes remain = shared runtime breadth (host
interop, missing core fns, eval/load-string) deferred to Phase 4 / jolt-r8ku,
not compiler faithfulness.
Gate + speedup: test/chez/run-corpus-zero-janet.janet (floor 2159). Its batched
runner (driver/eval-corpus-zero-janet) runs every case in ONE chez process —
load the runtime once, guard + reset the user namespace per case — instead of a
fresh process per case: 1379s -> 1.6s.
spine-test 35/35; Janet gate 151/0; prelude parity 2295/2494 unchanged, 0 new
divergences.
This commit is contained in:
Yogthos
parent
d165198969
commit
8b86174b91
9 changed files with 460 additions and 19 deletions
164
test/chez/run-corpus-zero-janet.janet
Normal file
164
test/chez/run-corpus-zero-janet.janet
Normal file
|
|
@ -0,0 +1,164 @@
|
|||
# Phase 3 inc7 (jolt-qjr0) — FULL corpus on the ZERO-JANET spine.
|
||||
#
|
||||
# run-corpus-prelude.janet measures RUNTIME parity: it analyzes each case with the
|
||||
# JANET-hosted analyzer (the oracle) and runs the emitted Scheme on Chez. This
|
||||
# runner closes the last gap: it analyzes each case with the CHEZ-HOSTED analyzer
|
||||
# (jolt.analyzer cross-compiled to Scheme, run on Chez over host-contract.ss) —
|
||||
# read -> analyze -> IR -> emit -> eval, NO Janet in the loop (eval-zero-janet).
|
||||
#
|
||||
# So this is the real test of self-hosting: where run-corpus-prelude proves the
|
||||
# RUNTIME is faithful, this proves the COMPILER-on-Chez is faithful. A case that
|
||||
# the Janet analyzer compiles but the Chez analyzer can't surfaces here as a crash
|
||||
# (analyzer/emitter raised) or a divergence (ran, wrong value). The buckets form
|
||||
# the inc7 punch-list; genuinely host-coupled cases (Java interop, runtime eval)
|
||||
# are deferred to Phase 4 / jolt-r8ku and allowlisted, like the prelude gate.
|
||||
#
|
||||
# JOLT_CHEZ_ZEROJANET_CORPUS=1 janet test/chez/run-corpus-zero-janet.janet
|
||||
# JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast iteration)
|
||||
(import ../../host/chez/driver :as d)
|
||||
(import ../../host/chez/jolt-chez :as jc)
|
||||
|
||||
(unless (os/getenv "JOLT_CHEZ_ZEROJANET_CORPUS")
|
||||
(print "skip: set JOLT_CHEZ_ZEROJANET_CORPUS=1 to run the zero-Janet corpus gate")
|
||||
(os/exit 0))
|
||||
(unless (d/chez-available?)
|
||||
(print "skip: chez not on PATH")
|
||||
(os/exit 0))
|
||||
|
||||
(def ctx (d/make-ctx))
|
||||
(def prelude-path (jc/ensure-prelude ctx))
|
||||
|
||||
# Compiler image (jolt.ir + jolt.analyzer + jolt.backend-scheme cross-compiled to
|
||||
# Scheme), cached by the same source fingerprint the spine-test uses.
|
||||
(defn- image-fingerprint []
|
||||
(string/slice (string (hash (string/join
|
||||
(map slurp ["jolt-core/jolt/ir.clj" "jolt-core/jolt/analyzer.clj"
|
||||
"jolt-core/jolt/backend_scheme.clj" "host/chez/host-contract.ss"
|
||||
"host/chez/compile-eval.ss"])))) 0))
|
||||
(def image-path
|
||||
(string (or (os/getenv "TMPDIR") "/tmp") "/jolt-compiler-image-" (image-fingerprint) ".ss"))
|
||||
(def t0 (os/clock))
|
||||
(d/ensure-compiler-image ctx image-path)
|
||||
(printf "prelude + compiler image ready (%.1fs)" (- (os/clock) t0))
|
||||
(flush)
|
||||
|
||||
(def corpus (parse (slurp "test/chez/corpus.edn")))
|
||||
(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))
|
||||
|
||||
# Known divergences/crashes: cases the Chez-hosted compiler can't yet handle that
|
||||
# are tracked elsewhere (NOT analyzer-faithfulness bugs). Tolerated so the gate
|
||||
# fails only on a NEW regression. Keyed by label.
|
||||
# - host interop (Java classes / constructors / .method on host types): Phase 4
|
||||
# jolt-cf1q.7. Same family the prelude gate buckets as crashes.
|
||||
# - eval / load-string / read->eval: the jolt-r8ku tail (runtime compiler entry).
|
||||
(def known-fail
|
||||
# Same deferred set the prelude (oracle) gate allowlists — NOT Chez-analyzer
|
||||
# faithfulness bugs, but runtime gaps tracked elsewhere:
|
||||
# - print-method multimethod integration: a user (defmethod print-method ...)
|
||||
# isn't consulted by the Chez printer, so pr-str/prn of an overridden type
|
||||
# uses the built-in form (Phase 2 deferred).
|
||||
# - atom?: (instance? clojure.lang.Atom (atom 0)) — host class not mapped on
|
||||
# Chez (Phase 4 host interop, jolt-cf1q.7).
|
||||
@{"defmethod overrides a record, top level" true
|
||||
"defmethod fires nested in a map" true
|
||||
"defmethod fires through prn" true
|
||||
"direct builtin override" true
|
||||
"methods table inspectable" true
|
||||
"atom override fires nested" true
|
||||
"atom?" true})
|
||||
|
||||
(var pass 0)
|
||||
(def crashes @[]) # nonzero chez exit (analyzer/emitter raised, or runtime gap)
|
||||
(def diverged @[]) # ran, wrong value (a real Chez-compiler divergence)
|
||||
(def known-hit @[])
|
||||
(def crash-keys @{})
|
||||
(defn- bucket [tbl k] (put tbl k (+ 1 (or (get tbl k) 0))))
|
||||
|
||||
# Group a chez stderr message into a coarse reason for the punch-list.
|
||||
(defn- crash-reason [m]
|
||||
(def m (string/trim m))
|
||||
(cond
|
||||
(string/find "unsupported stdlib" m) "emit: unsupported stdlib fn"
|
||||
(string/find "unsupported host" m) "emit: unsupported host call"
|
||||
(string/find "host-static" m) "emit: host-static"
|
||||
(string/find "syntax-quote" m) "form-syntax-quote-lower"
|
||||
(string/find "uncompil" m) "analyzer: uncompilable"
|
||||
(string/find "Unknown class" m) "runtime: unknown class"
|
||||
(string/find "No constructor" m) "runtime: no constructor"
|
||||
(string/find "No method" m) "runtime: no method"
|
||||
(string/find "not a fn" m) "runtime: not a fn"
|
||||
(string/find "not seqable" m) "runtime: not seqable"
|
||||
(string/find "not a transient" m) "runtime: not a transient"
|
||||
(string/find "integer->char" m) "runtime: integer->char"
|
||||
(string/find "non-condition value" m)
|
||||
(let [i (string/find "non-condition value" m)]
|
||||
(string "raised: " (string/slice m (+ i 20) (min (length m) (+ i 60)))))
|
||||
(string/slice m 0 (min 56 (length m)))))
|
||||
|
||||
(def t1 (os/clock))
|
||||
(var throws 0)
|
||||
|
||||
# Build the evaluable case list (skip :throws), keyed by index (labels aren't
|
||||
# unique across suites). idx -> row, idx -> "(= EXPECTED ACTUAL)".
|
||||
(def rows-by-idx @{})
|
||||
(def pairs @[])
|
||||
(eachp [i row] cases
|
||||
(def {:expected e :actual a} row)
|
||||
(if (= e :throws)
|
||||
(++ throws)
|
||||
(let [key (string i)]
|
||||
(put rows-by-idx key row)
|
||||
(array/push pairs [key (string "(= " e " " a ")")]))))
|
||||
|
||||
(defn- handle [key verdict]
|
||||
(def row (get rows-by-idx key))
|
||||
(def l (get row :label))
|
||||
(case (first verdict)
|
||||
:pass (++ pass)
|
||||
:crash (let [k (crash-reason (get verdict 1))] (bucket crash-keys k) (array/push crashes [l k]))
|
||||
:diverge (if (known-fail l) (array/push known-hit l)
|
||||
(array/push diverged [l (string "got " (get verdict 1))]))))
|
||||
|
||||
(if (os/getenv "JOLT_ZJ_PERCASE")
|
||||
# slow per-case path (each case its own chez process) — for isolating a hang/crash
|
||||
(each [key src] pairs
|
||||
(def [code out err] (d/eval-zero-janet prelude-path image-path src))
|
||||
(handle key (cond (not= code 0) [:crash err] (= out "true") [:pass] [:diverge out])))
|
||||
# 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)]
|
||||
(when (< n (length pairs))
|
||||
(printf "WARNING: batched runner returned %d/%d results (chez exit %d): %s"
|
||||
n (length pairs) c (string/slice se 0 (min 200 (length se)))))
|
||||
(each [key _] pairs
|
||||
(handle key (or (get r key) [:crash (string "no result (batch aborted) " se)])))))
|
||||
|
||||
(def n-eval (+ pass (length crashes) (length diverged) (length known-hit)))
|
||||
(printf "\nZero-Janet corpus parity: %d/%d evaluated cases pass (%.1fs)" pass n-eval (- (os/clock) t1))
|
||||
(printf " crash: %d NEW divergence: %d known: %d (throws skipped: %d)"
|
||||
(length crashes) (length diverged) (length known-hit) throws)
|
||||
|
||||
(defn- report [title tbl]
|
||||
(when (> (length tbl) 0)
|
||||
(printf "\n%s:" title)
|
||||
(each k (sort-by (fn [k] (- (get tbl k))) (keys tbl))
|
||||
(printf " %4d x %s" (get tbl k) k))))
|
||||
(report "crash reasons" crash-keys)
|
||||
(when (> (length diverged) 0)
|
||||
(printf "\nNEW divergences (ran, wrong value) — gate FAILS:")
|
||||
(each [l m] (slice diverged 0 (min 40 (length diverged)))
|
||||
(printf " [%s] %s" l m)))
|
||||
(when (> (length known-hit) 0)
|
||||
(printf "\n%d known (allowlisted) failures tolerated." (length known-hit)))
|
||||
(flush)
|
||||
|
||||
# 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") "2159")))
|
||||
(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)))
|
||||
(os/exit (if (or (> (length diverged) 0) (< pass floor)) 1 0))
|
||||
Loading…
Add table
Add a link
Reference in a new issue