Chez Phase 1 (increment 3j): assemble the clojure.core prelude, -e-capable jolt-chez
Emit every non-macro clojure.core form through the live analyzer -> Chez emit pipeline as a def-var! prelude (prelude mode, tier dependency order), load it before a user expression, and you get an -e-capable jolt-chez: analysis on Janet, execution on Chez. driver/emit-core-prelude assembles it (each form behind a silent load guard so the Phase-2 multimethod forms don't break the rest); bin/jolt-chez is the -e CLI, caching the prelude on disk keyed by source hash. run-corpus-prelude.janet is the full parity gate this opens, the prelude-backed sibling of run-corpus-chez. First baseline: 1220/2497 evaluated cases pass, 0 new divergences (10 allowlisted: dynamic vars, class names, eval-order — deferred Phase 2). The rest is the punch-list: ~360 emit-fail (real host interop, out of the analyzer subset) and ~900 runtime crashes, mostly core fns calling host-coupled seed natives with no Chez shim yet (str/format/vec, transients). Follow-ups jolt-t6cr/kl2l/q3w8/9ls5. Two shims landed to get the prelude to load and run. atoms.ss: atom/deref/swap!/ reset! (+ the compare/vals kernel) — needed at load time for global-hierarchy = (atom (make-hierarchy)). predicates.ss: the type predicates + name/namespace/boolean the overlay assumes are seed natives, matching the seed's strict semantics. post-prelude.ss re-asserts char?/atom? after the prelude: the overlay implements those by reading :jolt/type, which is false for Chez-native chars/atoms, so its def-var! would clobber the correct native versions. Per-case Scheme files are PID-unique so a foreground -e never reads a half-written file while the gate runs.
This commit is contained in:
parent
37c433bd4a
commit
0c9c7931fe
10 changed files with 512 additions and 0 deletions
7
bin/jolt-chez
Executable file
7
bin/jolt-chez
Executable file
|
|
@ -0,0 +1,7 @@
|
|||
#!/bin/sh
|
||||
# -e-capable jolt-chez launcher (jolt-9ziu). Runs from the repo root so the
|
||||
# assembled prelude can load host/chez/rt.ss by relative path.
|
||||
# JOLT_BIN=bin/jolt-chez janet test/chez/run-corpus.janet
|
||||
root="$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)"
|
||||
cd "$root" || exit 1
|
||||
exec janet host/chez/jolt-chez.janet "$@"
|
||||
57
host/chez/atoms.ss
Normal file
57
host/chez/atoms.ss
Normal file
|
|
@ -0,0 +1,57 @@
|
|||
;; atoms (jolt-9ziu) — host-coupled mutable reference cells for the Chez host.
|
||||
;;
|
||||
;; atom/deref/swap!/reset! stay in the Janet seed (not the clojure.core overlay),
|
||||
;; so the Chez runtime needs native shims, def-var!'d into clojure.core. They
|
||||
;; lower to var-deref in prelude mode. The hierarchy machinery
|
||||
;; (global-hierarchy = (atom (make-hierarchy))) calls `atom` at the prelude's
|
||||
;; LOAD time, so without this shim the whole prelude fails to load.
|
||||
;;
|
||||
;; compare-and-set!/swap-vals!/reset-vals! are overlay fns over the native kernel
|
||||
;; in the live system; provided here natively too so the Chez host is
|
||||
;; self-sufficient for atoms without the full prelude (the overlay versions, when
|
||||
;; the full prelude loads, override these but compose the same native kernel).
|
||||
|
||||
(define-record-type jolt-atom (fields (mutable val)) (nongenerative jolt-atom-v1))
|
||||
|
||||
;; (atom init) — extra :meta/:validator opts are accepted and ignored for now
|
||||
;; (watches/validators are overlay features layered via jolt.host/ref-put!).
|
||||
(define (jolt-atom-new v . _opts) (make-jolt-atom v))
|
||||
|
||||
(define (jolt-deref x)
|
||||
(if (jolt-atom? x)
|
||||
(jolt-atom-val x)
|
||||
(error #f "deref: unsupported reference type" x)))
|
||||
|
||||
;; (swap! a f arg*) -> (reset! a (f @a arg*)); f is invoked through jolt-invoke
|
||||
;; (a jolt fn value, keyword, or invokable collection).
|
||||
(define (jolt-swap! a f . args)
|
||||
(let ((nv (apply jolt-invoke f (jolt-atom-val a) args)))
|
||||
(jolt-atom-val-set! a nv)
|
||||
nv))
|
||||
|
||||
(define (jolt-reset! a v) (jolt-atom-val-set! a v) v)
|
||||
|
||||
(define (jolt-compare-and-set! a oldv newv)
|
||||
(if (jolt= (jolt-atom-val a) oldv)
|
||||
(begin (jolt-atom-val-set! a newv) #t)
|
||||
#f))
|
||||
|
||||
(define (jolt-swap-vals! a f . args)
|
||||
(let* ((old (jolt-atom-val a))
|
||||
(nv (apply jolt-invoke f old args)))
|
||||
(jolt-atom-val-set! a nv)
|
||||
(jolt-vector old nv)))
|
||||
|
||||
(define (jolt-reset-vals! a v)
|
||||
(let ((old (jolt-atom-val a)))
|
||||
(jolt-atom-val-set! a v)
|
||||
(jolt-vector old v)))
|
||||
|
||||
(def-var! "clojure.core" "atom" jolt-atom-new)
|
||||
(def-var! "clojure.core" "deref" jolt-deref)
|
||||
(def-var! "clojure.core" "swap!" jolt-swap!)
|
||||
(def-var! "clojure.core" "reset!" jolt-reset!)
|
||||
(def-var! "clojure.core" "compare-and-set!" jolt-compare-and-set!)
|
||||
(def-var! "clojure.core" "swap-vals!" jolt-swap-vals!)
|
||||
(def-var! "clojure.core" "reset-vals!" jolt-reset-vals!)
|
||||
(def-var! "clojure.core" "atom?" jolt-atom?)
|
||||
|
|
@ -14,6 +14,7 @@
|
|||
(import ../../src/jolt/backend :as backend)
|
||||
(import ../../src/jolt/reader :as r)
|
||||
(import ../../src/jolt/evaluator :as evlr)
|
||||
(import ../../src/jolt/types_ctx :as tctx)
|
||||
(import ./emit :as emit)
|
||||
|
||||
(defn chez-available?
|
||||
|
|
@ -71,3 +72,97 @@
|
|||
(def err (ev/read (proc :err) 0x100000))
|
||||
(def code (os/proc-wait proc))
|
||||
[code (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))])
|
||||
|
||||
# --- clojure.core prelude assembly (jolt-9ziu) --------------------------------
|
||||
# The -e-capable jolt-chez path: emit EVERY non-macro clojure.core form across
|
||||
# the dependency-ordered tiers as a def-var! in prelude mode, concatenated into
|
||||
# a Scheme prelude loaded before the user expression. var-deref then resolves any
|
||||
# core fn at runtime from the prelude's own def-var! cells. Macros are skipped
|
||||
# (analyze-time only — the Janet analyzer expands them before emit, so they have
|
||||
# no runtime value). Each form is wrapped in a tolerant load guard so a form that
|
||||
# fails to LOAD (currently only the Phase-2 multimethod defmulti/defmethod
|
||||
# print-method forms) doesn't break the rest of the prelude; it logs to stderr
|
||||
# and becomes a lazy gap rather than a hard prelude failure.
|
||||
|
||||
(def core-tier-files
|
||||
["00-syntax" "00-kernel" "10-seq" "20-coll" "25-sorted" "30-macros" "40-lazy" "50-io"])
|
||||
|
||||
(defn- sym-name [x]
|
||||
(when (and (struct? x) (= :symbol (get x :jolt/type))) (get x :name)))
|
||||
|
||||
(defn- macro-form? [f]
|
||||
(and (indexed? f) (> (length f) 0)
|
||||
(let [h (sym-name (in f 0))] (and h (or (= h "defmacro") (= h "definline"))))))
|
||||
|
||||
(defn- form-label [f]
|
||||
(if (and (indexed? f) (> (length f) 1))
|
||||
(let [h (or (sym-name (in f 0)) "?") n (sym-name (in f 1))] (if n (string h " " n) h))
|
||||
"?"))
|
||||
|
||||
(defn emit-core-prelude
|
||||
"Assemble the clojure.core prelude as a Scheme string. `ctx` must be a
|
||||
compile-mode ctx; its current ns is set to clojure.core for the duration.
|
||||
Returns [scheme emitted total skipped-load-guards-unknown]; `scheme` is the
|
||||
joined, guard-wrapped def-var! forms (no rt.ss load — add that at program
|
||||
assembly via emit/program or program-with-prelude)."
|
||||
[ctx &opt core-dir]
|
||||
(default core-dir "jolt-core/clojure/core/")
|
||||
(emit/set-prelude-mode! true)
|
||||
(def prev-ns (tctx/ctx-current-ns ctx))
|
||||
(tctx/ctx-set-current-ns ctx "clojure.core")
|
||||
(def out @[])
|
||||
(var total 0) (var emitted 0)
|
||||
(each tf core-tier-files
|
||||
(def src (slurp (string core-dir tf ".clj")))
|
||||
(each f (parse-all src)
|
||||
(unless (macro-form? f)
|
||||
(++ total)
|
||||
(def res (protect (emit/emit (backend/analyze-form ctx f))))
|
||||
(when (res 0)
|
||||
(++ emitted)
|
||||
# Tolerant load guard: a form that fails to LOAD (currently only the 8
|
||||
# Phase-2 multimethod print-method forms in 50-io) is swallowed so it
|
||||
# doesn't break the rest of the prelude — it becomes a lazy gap (the var
|
||||
# cell stays nil; calling it surfaces in the parity gate's crash bucket).
|
||||
# Silent to keep a real -e's stderr clean; the known set is documented.
|
||||
(array/push out
|
||||
(string "(guard (e (#t #f))\n " (res 1) ")"))))))
|
||||
(tctx/ctx-set-current-ns ctx prev-ns)
|
||||
(emit/set-prelude-mode! false)
|
||||
[(string/join out "\n") emitted total])
|
||||
|
||||
(defn program-with-prelude
|
||||
"Assemble a runnable Chez program that loads rt.ss, loads the assembled core
|
||||
prelude from `prelude-path` (a file written once), then prints `final-scm`."
|
||||
[prelude-path final-scm]
|
||||
(string
|
||||
"(import (chezscheme))\n"
|
||||
"(load \"host/chez/rt.ss\")\n"
|
||||
"(load " (string/format "%j" prelude-path) ")\n"
|
||||
# native-wins overrides for overlay predicates that read :jolt/type (char?,
|
||||
# atom?) — must load AFTER the prelude's own def-var! to take effect.
|
||||
"(load \"host/chez/post-prelude.ss\")\n"
|
||||
"(printf \"~a\\n\" (jolt-final-str " final-scm "))\n"))
|
||||
|
||||
(defn eval-e-with-prelude
|
||||
"Run a single user expression `src` on Chez with the full clojure.core prelude
|
||||
(loaded from `prelude-path`). Emits `src` in prelude mode so any core ref
|
||||
resolves via var-deref. Returns [code stdout stderr], or [:emit-err msg \"\"]
|
||||
if the user form itself can't be emitted."
|
||||
[ctx src prelude-path &opt scheme-out]
|
||||
(emit/set-prelude-mode! true)
|
||||
(def form (in (r/parse-next src) 0))
|
||||
(def res (protect (emit/emit (backend/analyze-form ctx form))))
|
||||
(emit/set-prelude-mode! false)
|
||||
(if (not (res 0))
|
||||
[:emit-err (string (res 1)) ""]
|
||||
(let [prog (program-with-prelude prelude-path (res 1))
|
||||
# PID-unique default so concurrent processes (a foreground -e while the
|
||||
# parity gate runs) never read each other's half-written program file.
|
||||
path (or scheme-out (string "/tmp/jolt-chez-e-" (os/getpid) ".ss"))]
|
||||
(spit path prog)
|
||||
(def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe}))
|
||||
(def out (ev/read (proc :out) 0x100000))
|
||||
(def err (ev/read (proc :err) 0x100000))
|
||||
(def code (os/proc-wait proc))
|
||||
[code (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))])))
|
||||
|
|
|
|||
49
host/chez/jolt-chez.janet
Normal file
49
host/chez/jolt-chez.janet
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
# -e-capable jolt-chez (jolt-9ziu): the Option-2 back end as a runnable CLI.
|
||||
#
|
||||
# Analysis runs on Janet (the portable analyzer); EXECUTION runs on Chez with the
|
||||
# full clojure.core assembled as a Scheme prelude (driver/emit-core-prelude). The
|
||||
# prelude is assembled once and cached on disk keyed by a fingerprint of the core
|
||||
# sources + the Chez RT/emitter, so repeated invocations (e.g. the run-corpus.janet
|
||||
# gate, one subprocess per case) reuse it.
|
||||
#
|
||||
# Usage (the run-corpus.janet boundary): jolt-chez -e "EXPR"
|
||||
# Run from the repo root (the prelude loads host/chez/rt.ss by relative path).
|
||||
(import ../../src/jolt/api :as api)
|
||||
(import ./driver :as d)
|
||||
|
||||
(defn- fingerprint []
|
||||
# Hash the inputs that shape the prelude: the core tiers + the emitter + the
|
||||
# Chez RT shims. Any change invalidates the cached prelude.
|
||||
(def parts @[])
|
||||
(each tf d/core-tier-files
|
||||
(array/push parts (slurp (string "jolt-core/clojure/core/" tf ".clj"))))
|
||||
(each f ["host/chez/emit.janet" "host/chez/driver.janet" "host/chez/rt.ss"
|
||||
"host/chez/values.ss" "host/chez/collections.ss" "host/chez/seq.ss"
|
||||
"host/chez/atoms.ss" "host/chez/predicates.ss" "host/chez/regex.ss"]
|
||||
(array/push parts (slurp f)))
|
||||
(string/slice (string (hash (string/join parts))) 0))
|
||||
|
||||
(defn- ensure-prelude [ctx]
|
||||
(def dir (or (os/getenv "JOLT_IMAGE_CACHE_DIR") (os/getenv "TMPDIR") "/tmp"))
|
||||
(def path (string dir "/jolt-chez-prelude-" (fingerprint) ".ss"))
|
||||
(unless (os/stat path)
|
||||
(def [scm _ _] (d/emit-core-prelude ctx))
|
||||
(spit path scm))
|
||||
path)
|
||||
|
||||
(defn main [& argv]
|
||||
# argv: [script "-e" EXPR]
|
||||
(def args (drop 1 argv))
|
||||
(unless (and (= (length args) 2) (= (first args) "-e"))
|
||||
(eprint "usage: jolt-chez -e EXPR")
|
||||
(os/exit 2))
|
||||
(def src (in args 1))
|
||||
(def ctx (api/init-cached {:compile? true}))
|
||||
(def prelude-path (ensure-prelude ctx))
|
||||
(def [code out err] (d/eval-e-with-prelude ctx src prelude-path))
|
||||
(when (= code :emit-err)
|
||||
(eprint "jolt-chez: cannot compile: " out)
|
||||
(os/exit 1))
|
||||
(unless (= "" out) (print out))
|
||||
(unless (= "" err) (eprint err))
|
||||
(os/exit code))
|
||||
15
host/chez/post-prelude.ss
Normal file
15
host/chez/post-prelude.ss
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
;; post-prelude overrides (jolt-9ziu) — loaded AFTER the assembled clojure.core
|
||||
;; prelude, so these win over the overlay's own def-var!.
|
||||
;;
|
||||
;; A few clojure.core predicates are implemented in the overlay by inspecting a
|
||||
;; Janet-host tagged value's :jolt/type key (e.g. (get x :jolt/type)). That key
|
||||
;; doesn't exist for Chez-native representations: a jolt char is a Scheme char,
|
||||
;; an atom is a Chez record. The overlay's def-var! loads after rt.ss, so it
|
||||
;; clobbers the correct native shims (predicates.ss / atoms.ss) with versions
|
||||
;; that return false on every Chez value. Re-assert the native versions here.
|
||||
;;
|
||||
;; (Long-term these predicates want a host-neutral implementation that calls a
|
||||
;; host primitive instead of reading :jolt/type; until then this is the Chez-host
|
||||
;; override.)
|
||||
(def-var! "clojure.core" "char?" jolt-char-pred?)
|
||||
(def-var! "clojure.core" "atom?" jolt-atom?)
|
||||
58
host/chez/predicates.ss
Normal file
58
host/chez/predicates.ss
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
;; type predicates + simple accessors (jolt-9ziu) — host-coupled seed natives.
|
||||
;;
|
||||
;; These are seed primitives (not clojure.core overlay fns), so they're never
|
||||
;; def-var!'d by the assembled prelude; the Chez host must provide them. Semantics
|
||||
;; match the Janet seed (src/jolt/core_types.janet): map?/vector?/set? are STRICT
|
||||
;; over the persistent-collection records, seq? is true only for real sequences,
|
||||
;; coll? is the union. Records (shape-recs) are Phase 2, so the record arms of the
|
||||
;; seed predicates are simply absent here for now.
|
||||
|
||||
(define (jolt-map? x) (pmap? x))
|
||||
(define (jolt-vector? x) (pvec? x))
|
||||
(define (jolt-set? x) (pset? x))
|
||||
(define (jolt-seq? x) (or (cseq? x) (empty-list-t? x)))
|
||||
(define (jolt-coll-pred? x)
|
||||
(or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x)))
|
||||
(define (jolt-number? x) (number? x))
|
||||
(define (jolt-string? x) (string? x))
|
||||
(define (jolt-char-pred? x) (char? x))
|
||||
;; finite integral number — Chez integer? already rejects the infinities and NaN.
|
||||
(define (jolt-integer? x) (and (number? x) (integer? x)))
|
||||
(define (jolt-fn? x) (procedure? x))
|
||||
(define (jolt-boolean-pred? x) (boolean? x))
|
||||
|
||||
;; (boolean x) coerces truthiness (nil/false -> false, else true).
|
||||
(define (jolt-boolean x) (if (jolt-truthy? x) #t #f))
|
||||
|
||||
;; (name x): keyword/symbol -> name string; string -> itself.
|
||||
(define (jolt-name x)
|
||||
(cond
|
||||
((keyword? x) (keyword-t-name x))
|
||||
((symbol-t? x) (symbol-t-name x))
|
||||
((string? x) x)
|
||||
(else (error #f "name: expected string/symbol/keyword" x))))
|
||||
|
||||
;; (namespace x): keyword/symbol ns string, or nil when unqualified.
|
||||
(define (jolt-namespace x)
|
||||
(let ((ns (cond ((keyword? x) (keyword-t-ns x))
|
||||
((symbol-t? x) (symbol-t-ns x))
|
||||
(else (error #f "namespace: expected symbol/keyword" x)))))
|
||||
(if (or (jolt-nil? ns) (not ns) (eq? ns '())) jolt-nil ns)))
|
||||
|
||||
(def-var! "clojure.core" "nil?" jolt-nil?)
|
||||
(def-var! "clojure.core" "number?" jolt-number?)
|
||||
(def-var! "clojure.core" "string?" jolt-string?)
|
||||
(def-var! "clojure.core" "char?" jolt-char-pred?)
|
||||
(def-var! "clojure.core" "integer?" jolt-integer?)
|
||||
(def-var! "clojure.core" "symbol?" jolt-symbol?)
|
||||
(def-var! "clojure.core" "keyword?" keyword?)
|
||||
(def-var! "clojure.core" "map?" jolt-map?)
|
||||
(def-var! "clojure.core" "vector?" jolt-vector?)
|
||||
(def-var! "clojure.core" "set?" jolt-set?)
|
||||
(def-var! "clojure.core" "seq?" jolt-seq?)
|
||||
(def-var! "clojure.core" "coll?" jolt-coll-pred?)
|
||||
(def-var! "clojure.core" "fn?" jolt-fn?)
|
||||
(def-var! "clojure.core" "boolean?" jolt-boolean-pred?)
|
||||
(def-var! "clojure.core" "boolean" jolt-boolean)
|
||||
(def-var! "clojure.core" "name" jolt-name)
|
||||
(def-var! "clojure.core" "namespace" jolt-namespace)
|
||||
|
|
@ -84,6 +84,16 @@
|
|||
;; renders a regex-t as #"source").
|
||||
(load "host/chez/regex.ss")
|
||||
|
||||
;; atoms (jolt-9ziu): host-coupled mutable cells; def-var!'d into clojure.core
|
||||
;; (atom/deref/swap!/reset! + the compare/vals kernel). Loads after def-var! and
|
||||
;; jolt-invoke (seq.ss) / jolt= (values.ss) / jolt-vector (collections.ss).
|
||||
(load "host/chez/atoms.ss")
|
||||
|
||||
;; type predicates + simple accessors (jolt-9ziu): seed natives the overlay
|
||||
;; assumes (map?/vector?/nil?/number?/.../name/namespace), def-var!'d into
|
||||
;; clojure.core. Loads after the value-model record predicates they wrap.
|
||||
(load "host/chez/predicates.ss")
|
||||
|
||||
;; --- jolt number printing ----------------------------------------------------
|
||||
;; jolt models every number as a Clojure double: integer-valued values print
|
||||
;; without a ".0" (the Janet host prints (* 1.0 5) as "5", (/ 1 2) as "0.5").
|
||||
|
|
|
|||
|
|
@ -88,6 +88,48 @@ Janet PEG). Prior incs: inc 3h `.method` → `:host-call` (`jolt-host-call` for
|
|||
`letfn` → `letrec*`, `declare`/def-no-init → reserved var cell. The probe has a
|
||||
regression floor (355) — every non-macro core form must keep emitting.
|
||||
|
||||
## Phase 1 — the assembled prelude: -e-capable jolt-chez (inc 3j, jolt-9ziu)
|
||||
Once the whole non-macro clojure.core emits (inc 3i), the milestone is to ASSEMBLE
|
||||
it: `driver/emit-core-prelude` emits every non-macro core form across the
|
||||
dependency-ordered tiers as a `def-var!` (prelude mode), concatenated into a
|
||||
Scheme prelude. `bin/jolt-chez -e EXPR` loads `rt.ss` + that prelude + a
|
||||
post-prelude override, emits the user expression in prelude mode, and runs it on
|
||||
Chez — an `-e`-capable jolt-chez (analysis on Janet, execution on Chez). The
|
||||
prelude is cached on disk keyed by a fingerprint of the core sources + the RT.
|
||||
|
||||
`run-corpus-prelude.janet` is the full parity gate this opens (the prelude-backed
|
||||
sibling of `run-corpus-chez.janet`): it assembles the prelude once, then runs every
|
||||
corpus case with all of core present, bucketing the result —
|
||||
|
||||
JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet
|
||||
JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast)
|
||||
|
||||
First parity baseline (inc 3j): **1220/2497** evaluated cases pass, 0 NEW
|
||||
divergences (10 allowlisted: dynamic vars `*ns*`/`*clojure-version*`/`*unchecked-math*`,
|
||||
class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps).
|
||||
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
|
||||
the analyzer's subset) and ~900 runtime crashes, dominated by core fns calling
|
||||
host-coupled seed natives with no Chez shim yet (`str`/`format`/`vec`/transients —
|
||||
inc 3k/3l, jolt-t6cr/jolt-kl2l), plus smaller buckets (`##Inf`/`##NaN` literals →
|
||||
unbound `inf`/`nan`, seq-prim transducer arities — inc 3m jolt-q3w8; multimethod
|
||||
dispatch — Phase 2 jolt-9ls5).
|
||||
|
||||
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
|
||||
overlay assumes are native; needed at the prelude's LOAD time
|
||||
(`global-hierarchy = (atom (make-hierarchy))`). `host/chez/predicates.ss`: the type
|
||||
predicates + `name`/`namespace`/`boolean` the overlay assumes are seed natives
|
||||
(`nil?`/`number?`/`string?`/`map?`/`vector?`/`set?`/`seq?`/`coll?`/`fn?`/…), matching
|
||||
the seed's strict semantics. `host/chez/post-prelude.ss` re-asserts `char?`/`atom?`
|
||||
AFTER the prelude — the overlay implements those two by reading a value's
|
||||
`:jolt/type` key (a Janet-host assumption that's false for Chez-native chars/atoms),
|
||||
and its `def-var!` would otherwise clobber the correct native shims.
|
||||
|
||||
The 8 print-method/print-dup `defmulti`/`defmethod` forms (50-io) can't LOAD yet
|
||||
(no multimethod runtime on Chez — Phase 2); a silent load guard in the assembled
|
||||
prelude lets the rest load and turns them into lazy gaps.
|
||||
|
||||
Prior, inc 3b (seq tier + dynamic IFn, jolt-5pso): 595/595 compiled, 0 divergences,
|
||||
2060/2655 out of subset. The seq tier brought up a list/lazy-seq type with
|
||||
first/rest/next/seq/cons/list, map/filter/reduce/into/remove,
|
||||
|
|
|
|||
|
|
@ -353,6 +353,51 @@
|
|||
(string/find "frequencies" (scm 1)))
|
||||
(string/format "%p" scm)))
|
||||
|
||||
# 3n) atoms (jolt-9ziu): atom/deref/swap!/reset! are host-coupled (stay in the
|
||||
# Janet seed, no overlay def-var!), so the Chez host needs an RT shim
|
||||
# (host/chez/atoms.ss). They lower to var-deref in prelude mode. The hierarchy
|
||||
# machinery (global-hierarchy = (atom (make-hierarchy))) needs `atom` at the
|
||||
# prelude's LOAD time, so this is a load blocker, not just a lazy gap. swap!
|
||||
# invokes its fn through jolt-invoke; compare-and-set!/swap-vals!/reset-vals!
|
||||
# are overlay fns that compose the native kernel.
|
||||
(each src ["(deref (atom 42))"
|
||||
"@(atom 99)"
|
||||
"(let [a (atom 0)] (reset! a 7) (deref a))"
|
||||
"(let [a (atom 0)] (swap! a inc) (swap! a inc) (deref a))"
|
||||
"(let [a (atom 10)] (swap! a + 5) (deref a))"
|
||||
"(let [a (atom 1)] (reset! a 2) [(deref a) @a])"
|
||||
"(let [a (atom 0)] (compare-and-set! a 0 5) (deref a))"
|
||||
"(let [a (atom 0)] (compare-and-set! a 9 5) (deref a))"]
|
||||
(let [[code out err] (run-prelude src) want (cli-oracle src)]
|
||||
(ok (string "atom: " src) (and (= code 0) (= out want))
|
||||
(string "chez=" out " janet=" want " | " err))))
|
||||
|
||||
# 3o) type predicates + name/namespace (jolt-9ziu): seed natives the overlay
|
||||
# assumes; the Chez host shims them (host/chez/predicates.ss) and def-var!s them
|
||||
# into clojure.core, so they resolve in prelude mode. Semantics match the seed
|
||||
# (core_types.janet): map?/vector?/set? strict over the persistent records,
|
||||
# seq? only for real sequences, coll? the union. Parity vs the CLI oracle.
|
||||
(each src ["(nil? nil)" "(nil? 0)"
|
||||
"(number? 3)" "(number? :a)" "(string? \"x\")" "(string? 1)"
|
||||
"(integer? 3)" "(integer? 3.5)"
|
||||
"(symbol? 'x)" "(keyword? :x)" "(keyword? 'x)"
|
||||
"(map? {:a 1})" "(map? [1 2])"
|
||||
"(vector? [1 2])" "(vector? '(1 2))"
|
||||
"(set? #{1 2})" "(set? [1])"
|
||||
# NB: (seq? (seq [1 2])) is true on Chez (Clojure-correct — a seq IS a
|
||||
# seq) but the seed oracle returns false (non-canonical), so it's not a
|
||||
# like-for-like cli-oracle comparison; the corpus encodes the canonical
|
||||
# value, where Chez agrees. Test seq? on the unambiguous cases here.
|
||||
"(seq? [1 2])" "(seq? '(1 2))"
|
||||
"(coll? [1])" "(coll? {:a 1})" "(coll? 3)"
|
||||
"(fn? inc)" "(fn? 3)"
|
||||
"(boolean nil)" "(boolean 5)"
|
||||
"(name :foo)" "(name 'bar)" "(name \"baz\")"
|
||||
"(namespace :a/b)" "(namespace :x)"]
|
||||
(let [[code out err] (run-prelude src) want (cli-oracle src)]
|
||||
(ok (string "pred: " 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
|
||||
# track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the
|
||||
# jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers.
|
||||
|
|
|
|||
134
test/chez/run-corpus-prelude.janet
Normal file
134
test/chez/run-corpus-prelude.janet
Normal file
|
|
@ -0,0 +1,134 @@
|
|||
# Phase 1 (jolt-cf1q.2, inc 3j) — FULL parity against the -e-capable jolt-chez.
|
||||
#
|
||||
# run-corpus-chez.janet measures parity for the SUBSET the back end can compile
|
||||
# without any clojure.core present (most cases are "out of subset" because they
|
||||
# call core fns). This runner closes that gap: it assembles the ENTIRE non-macro
|
||||
# clojure.core as a Scheme prelude (driver/emit-core-prelude — def-var! forms in
|
||||
# tier dependency order), loads it before each case, and emits the case in
|
||||
# prelude mode so every core ref resolves via var-deref. That is exactly the
|
||||
# -e-capable jolt-chez the milestone calls for, measured in-process (one ctx,
|
||||
# prelude assembled once) rather than via a spawned binary per case.
|
||||
#
|
||||
# With all of core available, "out of subset" collapses to genuine emit failures
|
||||
# (host interop / unsupported IR). The new signal is RUNTIME parity: a case that
|
||||
# emits but crashes (a missing/blank runtime prim — a lazy gap) or returns a
|
||||
# wrong value (a divergence). The report buckets these so the gaps form a
|
||||
# punch-list for the next increments.
|
||||
# JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet
|
||||
# JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast)
|
||||
(import ../../host/chez/driver :as d)
|
||||
|
||||
(unless (os/getenv "JOLT_CHEZ_PRELUDE_CORPUS")
|
||||
(print "skip: set JOLT_CHEZ_PRELUDE_CORPUS=1 to run the prelude parity gate")
|
||||
(os/exit 0))
|
||||
(unless (d/chez-available?)
|
||||
(print "skip: chez not on PATH")
|
||||
(os/exit 0))
|
||||
|
||||
(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: cases that emit + run on Chez but yield a non-canonical
|
||||
# value because of a gap beyond this increment. The gate fails only on a NEW
|
||||
# (un-allowlisted) divergence — a real Chez correctness regression. Each here is
|
||||
# a deferred Phase-2 / dynamic-var / eval-order gap, NOT a wrong shim:
|
||||
# - class names ((class x), .getName) — no Chez class system yet (Phase 2)
|
||||
# - *ns* / *clojure-version* / *unchecked-math* — dynamic vars not bound on Chez
|
||||
# - eval-order probes — assert left-to-right side-effect order via host state
|
||||
# the emitted Scheme doesn't yet reproduce
|
||||
# - close on throw — with-open/finally resource close semantics
|
||||
(def known-divergences
|
||||
{"class name evaluates to canonical string" true
|
||||
"dispatch-only class name" true
|
||||
"inside class" true
|
||||
"values evaluate in source order" true
|
||||
"keys evaluate before their values, pairwise" true
|
||||
"source order with a nil value (phm form)" true
|
||||
"close on throw" true
|
||||
"ns-name of *ns*" true
|
||||
"*clojure-version* major" true
|
||||
"*unchecked-math*" true})
|
||||
|
||||
(def ctx (d/make-ctx))
|
||||
|
||||
# Assemble the prelude once and write it to a file the per-case programs `load`.
|
||||
(def t0 (os/clock))
|
||||
(def [prelude-scm emitted total] (d/emit-core-prelude ctx))
|
||||
(def prelude-path (string "/tmp/jolt-chez-prelude-" (os/getpid) ".ss"))
|
||||
(spit prelude-path prelude-scm)
|
||||
(printf "prelude: %d/%d non-macro core forms emitted (%.1fs, %d bytes) -> %s"
|
||||
emitted total (- (os/clock) t0) (length prelude-scm) prelude-path)
|
||||
(flush)
|
||||
|
||||
(var pass 0)
|
||||
(def emit-errs @[]) # user form can't emit (host interop / unsupported IR)
|
||||
(def crashes @[]) # emitted, chez exited non-zero (lazy runtime gap or bug)
|
||||
(def diverged @[]) # emitted + ran, NEW wrong value (fails the gate)
|
||||
(def known-hit @[]) # emitted + ran, allowlisted wrong value (tolerated)
|
||||
(def crash-keys @{}) # grouped crash reason -> count
|
||||
(def emit-keys @{}) # grouped emit-failure reason -> count
|
||||
|
||||
(defn- bucket [tbl k] (put tbl k (+ 1 (or (get tbl k) 0))))
|
||||
(defn- crash-reason [err]
|
||||
(def e (string err))
|
||||
(if-let [i (string/find "Exception" e)]
|
||||
(string/slice e i (min (length e) (+ i 70)))
|
||||
(string/slice e 0 (min 60 (length e)))))
|
||||
(defn- emit-reason [msg]
|
||||
(def m (string msg))
|
||||
(cond
|
||||
(string/find "out of subset" m) (let [i (string/find "`" m)]
|
||||
(if i (string "core fn: " (string/slice m (inc i) (or (string/find "`" m (inc i)) (length m)))) "out-of-subset"))
|
||||
(string/find "host" m) "host-interop"
|
||||
(string/find "unhandled op" m) (string/slice m (max 0 (- (length m) 28)))
|
||||
(string/slice m 0 (min 48 (length m)))))
|
||||
|
||||
(def t1 (os/clock))
|
||||
(each row cases
|
||||
(def {:expected e :actual a :label l} row)
|
||||
(if (= e :throws)
|
||||
nil # :throws error-semantics aren't modeled here; skip (counted out of run)
|
||||
(let [src (string "(= " e " " a ")")
|
||||
res (d/eval-e-with-prelude ctx src prelude-path)]
|
||||
(cond
|
||||
(= (get res 0) :emit-err)
|
||||
(let [k (emit-reason (get res 1))] (bucket emit-keys k) (array/push emit-errs [l k]))
|
||||
(not= (get res 0) 0)
|
||||
(let [k (crash-reason (get res 2))] (bucket crash-keys k) (array/push crashes [l k]))
|
||||
(= (get res 1) "true") (++ pass)
|
||||
(known-divergences l) (array/push known-hit l)
|
||||
(array/push diverged [l (string "got " (get res 1))])))))
|
||||
|
||||
(def n-eval (+ pass (length emit-errs) (length crashes) (length diverged) (length known-hit)))
|
||||
(printf "\nPrelude parity: %d/%d evaluated cases pass (%.1fs)" pass n-eval (- (os/clock) t1))
|
||||
(printf " emit-fail (out of subset): %d runtime crash: %d NEW divergence: %d known divergence: %d"
|
||||
(length emit-errs) (length crashes) (length diverged) (length known-hit))
|
||||
|
||||
(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 "emit-failure reasons" emit-keys)
|
||||
(report "runtime-crash reasons" crash-keys)
|
||||
(when (> (length diverged) 0)
|
||||
(printf "\nNEW divergences (emit+ran, wrong value) — gate FAILS:")
|
||||
(each [l m] (slice diverged 0 (min 30 (length diverged)))
|
||||
(printf " [%s] %s" l m)))
|
||||
(when (> (length known-hit) 0)
|
||||
(printf "\n%d known (allowlisted) divergences tolerated." (length known-hit)))
|
||||
(flush)
|
||||
|
||||
# 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
|
||||
# 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.
|
||||
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1220")))
|
||||
(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