da775802d6
corpus.edn :expected is now the value reference JVM Clojure produces, set by the new test/conformance/regen-corpus.clj (one JVM process, per-row thread watchdog). 167 rows moved to the JVM value: ratios (/ 1 2)=>1/2, doubles (double 3)=>3.0, shared-heap concurrency (the future/pmap/agent cases), clojure.math doubles. The JVM is the spec; jolt is measured against it. known-divergences.edn shrinks to the rows whose JVM value is an opaque host object that can't round-trip to source (Java arrays, transients, atoms, beans, proxies, chunks all print as #object[..@addr]) plus (fn* foo) and a few racy concurrency cases (:flaky). The zero-janet gate's allowlist becomes the set of host gaps vs the JVM spec (no Class/array/BigDecimal, :jolt reader, jolt's own printing). Math/clojure.math sqrt/pow/floor/trig now return doubles (Chez returns exact for exact args, e.g. (sqrt 9)=>3); JVM always returns a double. extract-corpus.janet no longer writes corpus.edn unless asked (the test runner imported it and was silently overwriting the JVM corpus with the spec sources' placeholder answers). The prelude parity gate is deleted — the zero-janet spine + certify.clj are the oracles. zero-janet 2678 (0 new divergences), certify 0 new / 0 stale, emit-test 330/330.
212 lines
11 KiB
Text
212 lines
11 KiB
Text
# 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
|
|
# Conformance gaps vs the JVM spec: cases jolt does not match because it has no
|
|
# JVM host (no Class objects / Java arrays / BigDecimal), supports the :jolt
|
|
# reader-conditional feature, or prints its own forms for transients/atoms.
|
|
@{# --- host classes: a class token resolves to a name string, not a Class ------
|
|
"class name evaluates to canonical string" true
|
|
"class number" true "class string" true "class keyword" true
|
|
"definterface defines" true
|
|
"getMessage on a thrown string" true
|
|
"type of record" true "chunked-seq? always false" true
|
|
"^Type tag on var" true "symbol hint -> :tag" true
|
|
"lists extended type" true "seq of tags" true
|
|
"close on throw" true # duck-typed with-open close, no .close interop
|
|
"macroexpand-1" true # returns a value, not the JVM Cons form
|
|
"ns-imports empty user" true
|
|
"bean is the map" true "proxy resolves nil" true
|
|
"unchecked-char" true
|
|
# --- *in* is a map on Chez, not a JVM Reader --------------------------------
|
|
"*in* is bound" true "*in* bound" true
|
|
# --- no BigDecimal type -----------------------------------------------------
|
|
"bigdec" true "bigdec int M" true "bigdec suffix M" true
|
|
# --- printer: jolt renders its own forms (transient/atom/Infinity, no
|
|
# print-method multimethod integration) where the JVM prints #object ------
|
|
"transient vector" true "transient map" true
|
|
"atom override fires nested" true "inf inside coll" true "pr-str Infinity" true
|
|
"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
|
|
# --- reader: :jolt reader-conditional feature + syntax-quote literal collapse -
|
|
"reader conditional" true "reader cond :jolt" true "reader cond no match" true
|
|
"reader cond splice" true "reader cond splice no match" true
|
|
"nil nested" true "bool nested" true
|
|
"source order through syntax-quote" true # syntax-quote map: hash, not source, order
|
|
# --- Java arrays are distinct host objects, not seqs --------------------------
|
|
"make-array" true "into-array" true "to-array" true "aclone vec" true
|
|
"boolean-array" true "int-array" true "long-array" true "double-array" true
|
|
"float-array" true "short-array" true "doubles" true "floats" true
|
|
"reader over char[]" true
|
|
# --- atom class identity not mapped on Chez ---------------------------------
|
|
"atom?" true "instance? Atom" true
|
|
# --- future-cancel races completion (timing-dependent) -----------------------
|
|
"cancel an in-flight future returns true" true
|
|
"future-cancelled? after cancel" true
|
|
# --- (fn* foo) with no param vector throws; the JVM builds a fn object --------
|
|
"no param vector" true})
|
|
|
|
# Cases that BLOCK forever on a shared-heap / JVM host (profile.edn :bucket
|
|
# :timeout) — skip them, like :throws: a single hung case would stall the whole
|
|
# batched process. (deref of an undelivered promise blocks on the JVM and now on
|
|
# Chez; Janet's non-blocking atom-shim returned nil.)
|
|
(def skip-blocking @{"promise undelivered" 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). Each pair carries EXPECTED + ACTUAL as SEPARATE source
|
|
# strings; the runner evaluates ACTUAL as its own top-level program (so its
|
|
# top-level `do` unrolls and a macro defined in the program is usable later —
|
|
# matching certify.clj's eval-isolated) and compares to EXPECTED with =. Wrapping
|
|
# in (= E A) would nest ACTUAL's do and break runtime defmacro (jolt-cf1q.7).
|
|
(def rows-by-idx @{})
|
|
(def pairs @[])
|
|
(eachp [i row] cases
|
|
(def {:expected e :actual a :label l} row)
|
|
(if (or (= e :throws) (get skip-blocking l))
|
|
(++ throws)
|
|
(let [key (string i)]
|
|
(put rows-by-idx key row)
|
|
(array/push pairs [key 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.
|
|
# Eval ACTUAL and EXPECTED top-level (separate processes), compare printed forms.
|
|
(each [key e a] pairs
|
|
(def [acode aout aerr] (d/eval-zero-janet prelude-path image-path a))
|
|
(def [_ eout _] (d/eval-zero-janet prelude-path image-path e))
|
|
(handle key (cond (not= acode 0) [:crash aerr] (= aout eout) [:pass] [:diverge aout])))
|
|
# 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 (os/getenv "JOLT_DUMP_CRASH_LABELS")
|
|
(printf "\nCRASH LABELS:")
|
|
(each [l k] (sort-by (fn [pair] (get pair 1)) crashes)
|
|
(printf " [%s] :: %s" k l))
|
|
(printf "\nKNOWN-HIT LABELS:")
|
|
(each l (sort known-hit) (printf " %s" l)))
|
|
(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: cases that pass against the JVM corpus. The gate fails on any
|
|
# NEW divergence or if pass drops below the floor. Raise as host gaps close.
|
|
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2678")))
|
|
(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))
|