Chez Phase 1 (increment 2): live analyzer -> Chez, var cells, RT, mandelbrot
Wire the real pipeline end to end: host/chez/driver.janet boots a compile-mode jolt ctx, runs the EXISTING Janet-hosted analyzer on actual Clojure source to real IR, feeds it to the Scheme emitter, and runs the result on Chez. Analysis stays on Janet (the analyzer ports to Chez in Phase 2); execution is on Chez. emit.janet now consumes live IR (pv/phm-normalized like the Janet backend) and covers what the analyzer actually emits, not the hand-built inc-1 shapes: - core ops arrive as :var clojure.core/+ etc., not :rt — lowered to native Scheme via a native-ops table (mirrors backend.janet's), `=` to jolt=. - var cells (host/chez/rt.ss): :def -> def-var!, :var -> var-deref. Late binding so cross-var calls (run -> count-point) and the entry crossing resolve at use. - named fns (defn / fn self-name) bind via letrec so self-recursion resolves. - unsupported stdlib/host refs (no core on Chez yet) are rejected at EMIT time (clean out-of-subset signal) instead of deref'ing to nil and failing at runtime. Number model: jolt is all-doubles (no ratios; (/ 1 2) is 0.5), so literals emit as flonums — matches the Janet host and keeps Chez out of exploding exact rationals (mandelbrot). jolt-num->string prints integer-valued without ".0". Two real bugs found via the corpus probe and fixed (regression rows added): - loop bound in parallel (Scheme named-let) but Clojure loop is sequential — a later init must see earlier bindings; wrap a let* around the loop. - #(...) shorthand gensyms params with a trailing `#`, invalid in Scheme — munge it to `_`. Gate: test/chez/emit-test.janet runs the real analyzer -> Chez for (+ 1 2), fib(30)=832040, mandelbrot run(40), and the two regressions, parity-checked against the Janet oracle (6/6). First parity number via the new subset probe (test/chez/run-corpus-chez.janet, JOLT_CHEZ_CORPUS=1): 182/182 compiled corpus cases pass, 0 divergences; 2473/2655 out of subset pending core on Chez. Full jpm/run-tests gate green (125 files). Chez tests skip cleanly without `chez`. Perf note (unchanged plan): emitted fib(30) ~23ms vs hand-Scheme ~5ms — the jolt-truthy? wrapper (~3x) plus flonum (not fixnum) arithmetic, both Phase-4 type-specialization levers.
This commit is contained in:
Yogthos
parent
874e3c7cf2
commit
9bbcc07c8f
6 changed files with 410 additions and 97 deletions
73
host/chez/driver.janet
Normal file
73
host/chez/driver.janet
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
# Phase 1 (jolt-cf1q.2) — live-analyzer -> Chez driver.
|
||||
#
|
||||
# Boots a real jolt ctx, runs the EXISTING Janet-hosted analyzer on actual
|
||||
# Clojure source to produce host-neutral IR, feeds that IR to the Scheme emitter
|
||||
# (emit.janet), and assembles a runnable Chez program. This is the Option-2
|
||||
# backend swap end to end: same front end, Scheme back end, run on Chez.
|
||||
#
|
||||
# Analysis still happens on Janet here (the analyzer is portable Clojure but not
|
||||
# yet bootstrapped onto Chez — that's Phase 2); EXECUTION happens on Chez. The
|
||||
# point of this increment is to validate that the real IR the analyzer emits
|
||||
# compiles to correct, fast Scheme.
|
||||
|
||||
(import ../../src/jolt/api :as api)
|
||||
(import ../../src/jolt/backend :as backend)
|
||||
(import ../../src/jolt/reader :as r)
|
||||
(import ../../src/jolt/evaluator :as evlr)
|
||||
(import ./emit :as emit)
|
||||
|
||||
(defn chez-available?
|
||||
"True when a `chez` binary is on PATH — lets the chez tests skip cleanly on
|
||||
hosts without it (CI without Chez), like the clojure-test-suite skips when its
|
||||
corpus dir is absent."
|
||||
[]
|
||||
(def r (protect (let [p (os/spawn ["chez" "--version"] :p {:out :pipe :err :pipe})]
|
||||
(ev/read (p :out) 1024)
|
||||
(ev/read (p :err) 1024)
|
||||
(os/proc-wait p))))
|
||||
(and (r 0) (zero? (r 1))))
|
||||
|
||||
(defn make-ctx []
|
||||
"A compile-mode jolt ctx (the analyzer pipeline is only built under :compile?)."
|
||||
(api/init {:compile? true}))
|
||||
|
||||
(defn- parse-all [src]
|
||||
(def out @[])
|
||||
(var s src)
|
||||
(while (> (length (string/trim s)) 0)
|
||||
(def parsed (r/parse-next s))
|
||||
(set s (in parsed 1))
|
||||
(def f (in parsed 0))
|
||||
(unless (nil? f) (array/push out f)))
|
||||
out)
|
||||
|
||||
(defn compile-program
|
||||
"Compile a Clojure program string to a runnable Chez program. Every top-level
|
||||
form is analyzed to real IR and emitted to Scheme; all but the LAST form are
|
||||
treated as defs (also interned in the ctx so later forms resolve their vars),
|
||||
and the last form is the expression whose value the program prints."
|
||||
[ctx src]
|
||||
(def forms (parse-all src))
|
||||
(assert (> (length forms) 0) "compile-program: empty program")
|
||||
(def n (length forms))
|
||||
(def def-scm @[])
|
||||
(for i 0 (- n 1)
|
||||
(def f (in forms i))
|
||||
# emit the def, then intern it (interpreted) so a later form's reference to
|
||||
# this var resolves to a :var node rather than an unresolved symbol.
|
||||
(array/push def-scm (emit/emit (backend/analyze-form ctx f)))
|
||||
(evlr/eval-form ctx @{} f))
|
||||
(def final-scm (emit/emit (backend/analyze-form ctx (in forms (- n 1)))))
|
||||
(emit/program def-scm final-scm))
|
||||
|
||||
(defn run-on-chez
|
||||
"Compile `src` and run it on Chez; returns [exit-code stdout stderr]."
|
||||
[ctx src &opt scheme-out]
|
||||
(def prog (compile-program ctx src))
|
||||
(def path (or scheme-out "/tmp/chez-jolt-prog.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) ""))])
|
||||
|
|
@ -1,29 +1,64 @@
|
|||
# Phase 1 — jolt IR -> Chez Scheme emitter (jolt-cf1q.2).
|
||||
#
|
||||
# The new back end: consumes the SAME host-neutral IR (jolt.ir, see
|
||||
# jolt-core/jolt/ir.clj) the analyzer produces and the Janet backend consumes,
|
||||
# but emits Scheme source text instead of Janet. `host/compile` (Chez `eval`)
|
||||
# turns that into a procedure. This increment covers the pure-functional subset
|
||||
# (const/local/var/rt/if/do/let/fn/invoke/def/loop/recur) — enough to run
|
||||
# fib/mandelbrot-shaped code through the REAL IR. Globals are early-bound here;
|
||||
# var-cell late binding is the next increment.
|
||||
# jolt-core/jolt/ir.clj) the live analyzer produces and the Janet backend
|
||||
# consumes, but emits Scheme source text instead of Janet. `host/compile` (Chez
|
||||
# `eval`) turns that into a procedure. Covers the pure-functional + numeric
|
||||
# subset (const/local/var/host/if/do/let/fn/invoke/def/loop/recur) — enough to
|
||||
# run fib/mandelbrot-shaped code through the REAL analyzer.
|
||||
#
|
||||
# IR nodes are plain :op-tagged structs/tables (keyword keys), matching ir.clj.
|
||||
# IR access mirrors the Janet backend: live IR fields are jolt VALUES — vectors
|
||||
# are persistent (pv), and a nil-valued node densifies to a phm. `nn`/`vv` below
|
||||
# normalize both into Janet structs/arrays, so the same code drives hand-built
|
||||
# IR (the unit tests) and live analyzer output (the driver).
|
||||
|
||||
(def rt-map
|
||||
# jolt RT primitive name -> Scheme. = is the exactness-aware jolt= from
|
||||
# values.ss; inc/dec/quot get preamble shims. Arithmetic/compare are native.
|
||||
(import ../../src/jolt/pv :as pv)
|
||||
(import ../../src/jolt/phm :as phm)
|
||||
|
||||
# Normalize a node (phm -> struct) and a vector field (pvec -> array view); both
|
||||
# pass plain Janet values through untouched, so hand-built IR still works.
|
||||
(defn- nn [n] (if (phm/phm? n) (phm/phm-to-struct n) n))
|
||||
(defn- vv [x] (if (pv/pvec? x) (pv/pv->array x) x))
|
||||
|
||||
# Hot clojure.core primitives lowered to native Scheme, mirroring the Janet
|
||||
# backend's native-ops (documented numbers-only relaxation). `=` is the
|
||||
# exactness-aware jolt= from values.ss; inc/dec/not are rt shims; mod/rem/quot
|
||||
# map to Scheme's (correct: Scheme has all three, unlike Janet which lacked quot).
|
||||
(def- native-ops
|
||||
{"+" "+" "-" "-" "*" "*" "/" "/"
|
||||
"<" "<" ">" ">" "<=" "<=" ">=" ">="
|
||||
"=" "jolt=" "inc" "jolt-inc" "dec" "jolt-dec"
|
||||
"mod" "modulo" "quot" "quotient" "rem" "remainder"})
|
||||
"=" "jolt=" "inc" "jolt-inc" "dec" "jolt-dec" "not" "jolt-not"
|
||||
"min" "min" "max" "max"
|
||||
"mod" "modulo" "rem" "remainder" "quot" "quotient"})
|
||||
|
||||
# Unary ops only legal at arity 1; binary at arity 2. Others (arith/compare) are
|
||||
# variadic in both Scheme and jolt, so any arity is fine.
|
||||
(def- unary-ops {"inc" true "dec" true "not" true})
|
||||
(def- binary-ops {"mod" true "rem" true "quot" true})
|
||||
|
||||
# If fnode is a clojure.core (or host) ref to a native-op primitive, return the
|
||||
# Scheme op string — only at an arity where the Scheme op and the jolt fn agree.
|
||||
(defn- native-op [fnode nargs]
|
||||
(def nm (case (get fnode :op)
|
||||
:var (when (= "clojure.core" (get fnode :ns)) (get fnode :name))
|
||||
:host (get fnode :name)
|
||||
nil))
|
||||
(def op (and nm (get native-ops nm)))
|
||||
(cond
|
||||
(nil? op) nil
|
||||
(and (get unary-ops nm) (not= nargs 1)) nil
|
||||
(and (get binary-ops nm) (not= nargs 2)) nil
|
||||
op))
|
||||
|
||||
(var- recur-target nil)
|
||||
(var- gensym-n 0)
|
||||
(defn- fresh-label [prefix] (string prefix (++ gensym-n)))
|
||||
|
||||
# MVP: jolt local/var names are valid Scheme identifiers (inc, even?, + all are).
|
||||
(defn- munge [name] name)
|
||||
# Most jolt names are already valid Scheme identifiers (inc, even?, +, ->str all
|
||||
# are — Scheme allows ! $ % & * + - . / : < = > ? @ ^ _ ~). The one that isn't is
|
||||
# `#`, which jolt auto-gensyms use as a suffix (e.g. p1__0000X4# from #(...)
|
||||
# shorthand) — `#` starts a datum in Scheme, so replace it with `_`.
|
||||
(defn- munge [name] (string/replace-all "#" "_" name))
|
||||
|
||||
(var emit nil) # forward declaration (mutual recursion with the helpers below)
|
||||
|
||||
|
|
@ -31,76 +66,126 @@
|
|||
(cond
|
||||
(nil? v) "jolt-nil"
|
||||
(boolean? v) (if v "#t" "#f")
|
||||
(number? v) (string v)
|
||||
# jolt models every number as a double (no ratios/bignums; see reader.janet).
|
||||
# Emit flonums so arithmetic matches the Janet host and Chez doesn't fall into
|
||||
# exploding exact rationals (mandelbrot). Integer-valued -> append ".0".
|
||||
(number? v) (let [s (string v)]
|
||||
(if (or (string/find "." s) (string/find "e" s) (string/find "n" s))
|
||||
s
|
||||
(string s ".0")))
|
||||
(string? v) (string/format "%j" v) # quoted+escaped string literal
|
||||
(errorf "emit-const: unsupported literal %p" v)))
|
||||
|
||||
(defn- emit-binding [b]
|
||||
(def b (vv b))
|
||||
(string "(" (munge (get b 0)) " " (emit (get b 1)) ")"))
|
||||
|
||||
(defn- emit-let [node]
|
||||
(string "(let* (" (string/join (map emit-binding (get node :bindings)) " ") ") "
|
||||
(string "(let* (" (string/join (map emit-binding (vv (get node :bindings))) " ") ") "
|
||||
(emit (get node :body)) ")"))
|
||||
|
||||
(defn- emit-loop [node]
|
||||
(def label (fresh-label "loop"))
|
||||
(def bs (string/join (map emit-binding (get node :bindings)) " "))
|
||||
(def pairs (map vv (vv (get node :bindings))))
|
||||
(def names (map |(munge (get $ 0)) pairs))
|
||||
# inits are evaluated in the OUTER scope (recur-target unchanged) and, like
|
||||
# Clojure loop/let, SEQUENTIALLY — a later init sees earlier bindings. Scheme's
|
||||
# named `let` binds in parallel, so wrap a sequential let* around the loop.
|
||||
(def inits (map |(emit (get $ 1)) pairs))
|
||||
(def seq-bs (string/join (map (fn [n i] (string "(" n " " i ")")) names inits) " "))
|
||||
(def rebinds (string/join (map (fn [n] (string "(" n " " n ")")) names) " "))
|
||||
(def prev recur-target)
|
||||
(set recur-target label)
|
||||
(def body (emit (get node :body)))
|
||||
(set recur-target prev)
|
||||
(string "(let " label " (" bs ") " body ")"))
|
||||
(string "(let* (" seq-bs ") (let " label " (" rebinds ") " body "))"))
|
||||
|
||||
(defn- emit-recur [node]
|
||||
(unless recur-target (error "emit: recur outside a loop/fn target"))
|
||||
(string "(" recur-target " " (string/join (map emit (get node :args)) " ") ")"))
|
||||
(string "(" recur-target " " (string/join (map emit (vv (get node :args))) " ") ")"))
|
||||
|
||||
(defn- emit-fn [node]
|
||||
(def arities (get node :arities))
|
||||
(def arities (map nn (vv (get node :arities))))
|
||||
(when (not= 1 (length arities)) (error "emit: multi-arity fn not in this increment"))
|
||||
(def a (first arities))
|
||||
(when (get a :rest) (error "emit: variadic fn not in this increment"))
|
||||
(def params (map munge (get a :params)))
|
||||
(def params (map munge (vv (get a :params))))
|
||||
# wrap the body in a named let so fn-level `recur` rebinds the params
|
||||
(def label (fresh-label "fnrec"))
|
||||
(def prev recur-target)
|
||||
(set recur-target label)
|
||||
(def body (emit (get a :body)))
|
||||
(set recur-target prev)
|
||||
(string "(lambda (" (string/join params " ") ") "
|
||||
"(let " label " (" (string/join (map (fn [p] (string "(" p " " p ")")) params) " ") ") "
|
||||
body "))"))
|
||||
(def lambda
|
||||
(string "(lambda (" (string/join params " ") ") "
|
||||
"(let " label " (" (string/join (map (fn [p] (string "(" p " " p ")")) params) " ") ") "
|
||||
body "))"))
|
||||
# A named fn (defn / (fn self [..])) references itself by name — the analyzer
|
||||
# binds that name as a :local in the body. letrec makes the name visible to the
|
||||
# lambda so self-calls resolve (recur stays a separate self-call to the arity).
|
||||
(if-let [nm (get node :name)]
|
||||
(let [m (munge nm)] (string "(letrec ((" m " " lambda ")) " m ")"))
|
||||
lambda))
|
||||
|
||||
# The Clojure stdlib (clojure.core, clojure.math, clojure.string, …) and host
|
||||
# interop (Math/sqrt etc.) have no implementation on Chez yet (Phase 2+). A
|
||||
# reference to one — except a clojure.core call lowered to a native op — is
|
||||
# genuinely uncompilable here. Reject it at emit time (a clean "out of subset"
|
||||
# signal) rather than emitting a var-deref that resolves to nil and fails
|
||||
# confusingly at runtime.
|
||||
(defn- stdlib-var? [n]
|
||||
(and (= :var (get n :op)) (string/has-prefix? "clojure." (or (get n :ns) ""))))
|
||||
|
||||
(defn- emit-invoke [node]
|
||||
(def fnode (nn (get node :fn)))
|
||||
(def args (map emit (vv (get node :args))))
|
||||
(def nop (native-op fnode (length args)))
|
||||
(cond
|
||||
# zero-arg + / * : Scheme's identity is the EXACT 0 / 1, but jolt models every
|
||||
# number as a double, so emit the flonum identity to keep (= 0 (+)) true.
|
||||
(and nop (empty? args) (= nop "+")) "0.0"
|
||||
(and nop (empty? args) (= nop "*")) "1.0"
|
||||
nop (string "(" nop " " (string/join args " ") ")")
|
||||
(stdlib-var? fnode)
|
||||
(errorf "emit: unsupported stdlib fn `%s/%s` (no core on Chez yet)" (get fnode :ns) (get fnode :name))
|
||||
(= :host (get fnode :op))
|
||||
(errorf "emit: unsupported host call `%s` (no host interop on Chez yet)" (get fnode :name))
|
||||
(string "(" (emit fnode) " " (string/join args " ") ")")))
|
||||
|
||||
(set emit (fn emit [node]
|
||||
(def node (nn node))
|
||||
(case (get node :op)
|
||||
:const (emit-const (get node :val))
|
||||
:local (munge (get node :name))
|
||||
:var (munge (get node :name)) # early-bound (MVP)
|
||||
:rt (or (get rt-map (get node :name))
|
||||
(errorf "emit: unmapped rt primitive %s" (get node :name)))
|
||||
:host (get node :name)
|
||||
# late-bound var: read the cell's current root at use time. A value-position
|
||||
# ref to a stdlib var (e.g. passing `inc` to (map inc xs)) needs a real fn,
|
||||
# which native-op lowering doesn't provide — so it's out of subset regardless.
|
||||
:var (if (stdlib-var? node)
|
||||
(errorf "emit: unsupported stdlib ref `%s/%s` (no core on Chez yet)" (get node :ns) (get node :name))
|
||||
(string "(var-deref " (string/format "%j" (get node :ns)) " "
|
||||
(string/format "%j" (get node :name)) ")"))
|
||||
:host (errorf "emit: unsupported host ref `%s` (no host interop on Chez yet)" (get node :name))
|
||||
:if (string "(if (jolt-truthy? " (emit (get node :test)) ") "
|
||||
(emit (get node :then)) " " (emit (get node :else)) ")")
|
||||
:do (string "(begin "
|
||||
(string/join (map emit (get node :statements)) " ")
|
||||
(if (empty? (get node :statements)) "" " ")
|
||||
(string/join (map emit (vv (get node :statements))) " ")
|
||||
(if (empty? (vv (get node :statements))) "" " ")
|
||||
(emit (get node :ret)) ")")
|
||||
:invoke (string "(" (emit (get node :fn)) " "
|
||||
(string/join (map emit (get node :args)) " ") ")")
|
||||
:invoke (emit-invoke node)
|
||||
:let (emit-let node)
|
||||
:loop (emit-loop node)
|
||||
:recur (emit-recur node)
|
||||
:fn (emit-fn node)
|
||||
:def (string "(define " (munge (get node :name)) " " (emit (get node :init)) ")")
|
||||
:def (string "(def-var! " (string/format "%j" (get node :ns)) " "
|
||||
(string/format "%j" (get node :name)) " " (emit (get node :init)) ")")
|
||||
(errorf "emit: unhandled op %p" (get node :op)))))
|
||||
|
||||
# Wrap emitted top-level forms into a runnable Chez program: preamble (value
|
||||
# model + rt shims) then the forms, then print `final` (a Scheme expr string).
|
||||
# Wrap emitted top-level forms into a runnable Chez program: load the RT, then
|
||||
# the def forms, then print `final` (an emitted Scheme expr string) via jolt's
|
||||
# number/value printing.
|
||||
(defn program [forms-scheme final]
|
||||
(string
|
||||
"(import (chezscheme))\n"
|
||||
"(load \"host/chez/values.ss\")\n"
|
||||
"(define (jolt-inc x) (+ x 1))\n"
|
||||
"(define (jolt-dec x) (- x 1))\n"
|
||||
"(load \"host/chez/rt.ss\")\n"
|
||||
(string/join forms-scheme "\n") "\n"
|
||||
"(printf \"~a\\n\" " final ")\n"))
|
||||
"(printf \"~a\\n\" (jolt-pr-str " final "))\n"))
|
||||
|
|
|
|||
52
host/chez/rt.ss
Normal file
52
host/chez/rt.ss
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
;; Phase 1 (jolt-cf1q.2) — the minimal Chez RT the emitted Scheme rests on.
|
||||
;;
|
||||
;; Sits above the value model (values.ss) and below an emitted program. Adds the
|
||||
;; two things the back end's output references that aren't in the value layer:
|
||||
;; 1. the var-cell late-binding registry (Clojure vars — a global root that a
|
||||
;; reference reads at call time, so redefinition / mutual recursion work);
|
||||
;; 2. the rt primitive shims the emitter names (jolt-inc/dec/not) and jolt's
|
||||
;; number printing (all jolt numbers model Clojure doubles; integer-valued
|
||||
;; print without a trailing ".0", matching the Janet host).
|
||||
;;
|
||||
;; Emitted programs do `(load "host/chez/rt.ss")`; this loads values.ss in turn.
|
||||
|
||||
(load "host/chez/values.ss")
|
||||
|
||||
;; --- rt arithmetic / logic shims (named in emit.janet's native-ops) ----------
|
||||
(define (jolt-inc x) (+ x 1))
|
||||
(define (jolt-dec x) (- x 1))
|
||||
;; jolt `not`: only nil and false are falsey.
|
||||
(define (jolt-not x) (if (jolt-truthy? x) #f #t))
|
||||
|
||||
;; --- var cells: late-bound global roots (Clojure vars) -----------------------
|
||||
;; A var is a mutable cell keyed by "ns/name". A `:def` sets the root; a `:var`
|
||||
;; reference reads it at use time (late binding), so a forward/mutually-recursive
|
||||
;; reference resolves to whatever the cell holds when the call actually runs.
|
||||
(define-record-type var-cell (fields ns name (mutable root)) (nongenerative var-cell-v1))
|
||||
(define var-table (make-hashtable string-hash string=?))
|
||||
(define (jolt-var ns name)
|
||||
(let ((k (string-append ns "/" name)))
|
||||
(or (hashtable-ref var-table k #f)
|
||||
(let ((c (make-var-cell ns name jolt-nil)))
|
||||
(hashtable-set! var-table k c)
|
||||
c))))
|
||||
(define (var-deref ns name) (var-cell-root (jolt-var ns name)))
|
||||
(define (def-var! ns name v) (var-cell-root-set! (jolt-var ns name) v) v)
|
||||
|
||||
;; --- 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").
|
||||
(define (jolt-num->string x)
|
||||
(if (and (rational? x) (integer? x))
|
||||
(number->string (exact x))
|
||||
(number->string x)))
|
||||
|
||||
;; Minimal pr-str for the program's final value (full printer is Phase 2).
|
||||
(define (jolt-pr-str x)
|
||||
(cond
|
||||
((jolt-nil? x) "nil")
|
||||
((eq? x #t) "true")
|
||||
((eq? x #f) "false")
|
||||
((number? x) (jolt-num->string x))
|
||||
((string? x) x)
|
||||
(else (format "~a" x))))
|
||||
|
|
@ -36,3 +36,21 @@ gate's job is to catch *regressions* the port introduces, not to bless these.
|
|||
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.
|
||||
|
||||
## Phase 1 — first parity number (subset probe)
|
||||
The full `run-corpus.janet` gate drives an `-e`-capable jolt binary; the Chez
|
||||
host can't answer arbitrary `-e` until all of clojure.core is bootstrapped onto
|
||||
Chez (Phase 2). Until then, `run-corpus-chez.janet` reports parity for the subset
|
||||
the Phase-1 back end (`host/chez/emit.janet`) can already compile: each case is
|
||||
run through the live analyzer → Scheme emitter → Chez via `host/chez/driver`.
|
||||
Cases that reference unimplemented stdlib/host fns fail to EMIT (a clean
|
||||
compile-time signal) and are counted "out of subset", not as divergences.
|
||||
|
||||
JOLT_CHEZ_CORPUS=1 janet test/chez/run-corpus-chez.janet
|
||||
|
||||
Baseline (2026-06-17): **182/182 compiled cases pass, 0 divergences**; 2473/2655
|
||||
out of subset (await core on Chez). It's a slow report (a Chez subprocess per
|
||||
case), so it's gated behind `JOLT_CHEZ_CORPUS` out of the default suite, like the
|
||||
benches. `test/chez/emit-test.janet` is the fast Phase-1 unit gate (real
|
||||
analyzer → Chez parity for fib/mandelbrot + regressions); both skip cleanly when
|
||||
`chez` isn't on PATH.
|
||||
|
|
|
|||
|
|
@ -1,73 +1,100 @@
|
|||
# Phase 1 — IR -> Scheme emitter tests. Hand-built IR in the real ir.clj shapes,
|
||||
# emitted to Scheme, compiled+run on Chez, results + fib speed checked.
|
||||
# Phase 1 (jolt-cf1q.2) — REAL pipeline end to end: actual Clojure source ->
|
||||
# Janet-hosted analyzer -> host-neutral IR -> Scheme emitter -> run on Chez.
|
||||
# Correctness is checked by parity against the SAME program evaluated by the
|
||||
# Janet host (jolt's own oracle), so a divergence is the back end's, not the
|
||||
# program's.
|
||||
# janet test/chez/emit-test.janet (from repo root)
|
||||
(import ../../host/chez/emit :as e)
|
||||
(import ../../src/jolt/api :as api)
|
||||
(import ../../src/jolt/backend :as backend)
|
||||
(import ../../src/jolt/reader :as r)
|
||||
(import ../../host/chez/driver :as d)
|
||||
(import ../../host/chez/emit :as emit)
|
||||
|
||||
(defn run-chez [src]
|
||||
(spit "/tmp/emit-prog.ss" src)
|
||||
(def proc (os/spawn ["chez" "--script" "/tmp/emit-prog.ss"] :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) ""))])
|
||||
(unless (d/chez-available?)
|
||||
(print "skip: chez not on PATH")
|
||||
(os/exit 0))
|
||||
|
||||
(var total 0) (var fails 0)
|
||||
(defn ok [name pred] (++ total) (unless pred (++ fails) (printf "FAIL: %s" name)))
|
||||
(defn ok [name pred &opt extra]
|
||||
(++ total)
|
||||
(if pred (printf "ok: %s" name)
|
||||
(do (++ fails) (printf "FAIL: %s %s" name (or extra "")))))
|
||||
|
||||
# --- IR builders (ir.clj shapes) ---
|
||||
(defn rt [name & args] {:op :invoke :fn {:op :rt :name name} :args args})
|
||||
(defn lcl [n] {:op :local :name n})
|
||||
(defn k [v] {:op :const :val v})
|
||||
# Janet-host oracle: evaluate the same program, stringify its value the way jolt
|
||||
# prints it at the CLI (so "832040" not "832040.0", "0.5" not 1/2, etc.).
|
||||
(def oracle-ctx (api/init {:compile? true}))
|
||||
(defn oracle [src] (string (api/load-string oracle-ctx src)))
|
||||
|
||||
# 1) (+ 1 2)
|
||||
(def add-ir (rt "+" (k 1) (k 2)))
|
||||
(let [[code out err] (run-chez (e/program [] (e/emit add-ir)))]
|
||||
(ok "(+ 1 2) = 3" (and (= code 0) (= out "3")))
|
||||
(when (not= code 0) (printf " err: %s" err)))
|
||||
(def ctx (d/make-ctx))
|
||||
|
||||
# 2) fib def + (fib 30)
|
||||
(defn fib-call [arg] {:op :invoke :fn {:op :var :ns "user" :name "fib"} :args [arg]})
|
||||
(def fib-def
|
||||
{:op :def :ns "user" :name "fib"
|
||||
:init {:op :fn :name "fib"
|
||||
:arities [{:params ["n"]
|
||||
:body {:op :if
|
||||
:test (rt "<" (lcl "n") (k 2))
|
||||
:then (lcl "n")
|
||||
:else (rt "+" (fib-call (rt "-" (lcl "n") (k 1)))
|
||||
(fib-call (rt "-" (lcl "n") (k 2))))}}]}})
|
||||
(let [prog (e/program [(e/emit fib-def)] (e/emit (fib-call (k 30))))
|
||||
[code out err] (run-chez prog)]
|
||||
(ok "(fib 30) = 832040" (and (= code 0) (= out "832040")))
|
||||
(when (not= code 0) (printf " err: %s" err)))
|
||||
# 1) constant-folded arithmetic: (+ 1 2) -> the analyzer folds to const 3.
|
||||
(let [[code out err] (d/run-on-chez ctx "(+ 1 2)")]
|
||||
(ok "(+ 1 2) = 3" (and (= code 0) (= out "3") (= out (oracle "(+ 1 2)"))) (string out " | " err)))
|
||||
|
||||
# 3) loop/recur sum 1..5 = 15
|
||||
(def loop-ir
|
||||
{:op :loop
|
||||
:bindings [["i" (k 1)] ["acc" (k 0)]]
|
||||
:body {:op :if
|
||||
:test (rt ">" (lcl "i") (k 5))
|
||||
:then (lcl "acc")
|
||||
:else {:op :recur :args [(rt "inc" (lcl "i")) (rt "+" (lcl "acc") (lcl "i"))]}}})
|
||||
(let [[code out err] (run-chez (e/program [] (e/emit loop-ir)))]
|
||||
(ok "loop/recur sum = 15" (and (= code 0) (= out "15")))
|
||||
(when (not= code 0) (printf " err: %s" err)))
|
||||
# 2) fib: var-cell def + named-fn self-recursion + native arith, via real IR.
|
||||
(let [src "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 30)"
|
||||
[code out err] (d/run-on-chez ctx src)]
|
||||
(ok "(fib 30) = 832040" (and (= code 0) (= out "832040") (= out (oracle src))) (string out " | " err)))
|
||||
|
||||
# 4) speed: emitted fib(30) should hit ~the spike ceiling (hand-Scheme ~5ms),
|
||||
# proving the IR->Scheme path adds no overhead vs hand-written Scheme.
|
||||
(def timed-fib
|
||||
(string (e/emit fib-def) "\n"
|
||||
"(define (now-ns) (let ((t (current-time 'time-monotonic))) (+ (* (time-second t) 1000000000) (time-nanosecond t))))\n"
|
||||
"(fib 24)(fib 24)\n"
|
||||
"(let* ((t0 (now-ns)) (r (fib 30)) (ms (/ (- (now-ns) t0) 1000000.0)))\n"
|
||||
" (printf \"~a ~a\\n\" r (exact->inexact ms)))"))
|
||||
(let [[code out err] (run-chez (string "(import (chezscheme))\n(load \"host/chez/values.ss\")\n(define (jolt-inc x) (+ x 1))\n" timed-fib))]
|
||||
# 3) mandelbrot kernel: loop/recur, let, or-expansion, cross-var call
|
||||
# (run -> count-point), flonum compute. Parity vs the Janet host on run(40).
|
||||
(def mandel-defs ``
|
||||
(defn count-point [cr ci cap]
|
||||
(loop [i 0 zr 0.0 zi 0.0]
|
||||
(if (or (>= i cap) (> (+ (* zr zr) (* zi zi)) 4.0))
|
||||
i
|
||||
(recur (inc i)
|
||||
(+ (- (* zr zr) (* zi zi)) cr)
|
||||
(+ (* 2.0 (* zr zi)) ci)))))
|
||||
(defn run [n]
|
||||
(let [cap 200
|
||||
nd (* 1.0 n)]
|
||||
(loop [y 0 acc 0]
|
||||
(if (< y n)
|
||||
(let [ci (- (/ (* 2.0 y) nd) 1.0)
|
||||
row (loop [x 0 a 0]
|
||||
(if (< x n)
|
||||
(let [cr (- (/ (* 2.0 x) nd) 1.5)]
|
||||
(recur (inc x) (+ a (count-point cr ci cap))))
|
||||
a))]
|
||||
(recur (inc y) (+ acc row)))
|
||||
acc))))
|
||||
``)
|
||||
(let [src (string mandel-defs "\n(run 40)")
|
||||
[code out err] (d/run-on-chez ctx src)]
|
||||
(ok "mandelbrot run(40) parity" (and (= code 0) (= out (oracle src)))
|
||||
(string "chez=" out " janet=" (oracle src) " | " err)))
|
||||
|
||||
# 3b) regressions found via the corpus probe:
|
||||
# - loop binds SEQUENTIALLY (Scheme named-let is parallel); b must see a.
|
||||
# - #(...) shorthand gensyms params with a trailing `#` (invalid in Scheme).
|
||||
(each [label src] [["loop sequential init" "(loop [a 1 b (+ a 10)] (+ a b))"]
|
||||
["#() shorthand" "(#(+ %1 %2) 1 2)"]]
|
||||
(let [[code out err] (d/run-on-chez ctx src)]
|
||||
(ok label (and (= code 0) (= out (oracle src))) (string "chez=" out " janet=" (oracle src) " | " 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.
|
||||
(let [fib-ir (backend/analyze-form ctx (in (r/parse-next "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))") 0))
|
||||
fib-scm (emit/emit fib-ir)
|
||||
timed (string "(import (chezscheme))\n(load \"host/chez/rt.ss\")\n"
|
||||
fib-scm "\n"
|
||||
"(define fib (var-deref \"user\" \"fib\"))\n"
|
||||
"(define (now-ns) (let ((t (current-time 'time-monotonic))) (+ (* (time-second t) 1000000000) (time-nanosecond t))))\n"
|
||||
"(fib 24)(fib 24)\n"
|
||||
"(let* ((t0 (now-ns)) (r (fib 30)) (ms (/ (- (now-ns) t0) 1000000.0)))\n"
|
||||
" (printf \"~a ~a\\n\" (jolt-pr-str r) (exact->inexact ms)))")]
|
||||
(spit "/tmp/chez-jolt-fib-timed.ss" timed)
|
||||
(def proc (os/spawn ["chez" "--script" "/tmp/chez-jolt-fib-timed.ss"] :p {:out :pipe :err :pipe}))
|
||||
(def out (string/trim (string (ev/read (proc :out) 0x100000))))
|
||||
(def err (string/trim (string (or (ev/read (proc :err) 0x100000) ""))))
|
||||
(def code (os/proc-wait proc))
|
||||
(def parts (string/split " " out))
|
||||
(def result (get parts 0))
|
||||
(def ms (scan-number (or (get parts 1) "999")))
|
||||
(ok "emitted fib(30) correct + fast" (and (= code 0) (= result "832040") (< ms 40)))
|
||||
(printf " emitted fib(30): %s in %.2f ms (hand-Scheme spike ~5ms)" result ms)
|
||||
(when (not= code 0) (printf " err: %s" err)))
|
||||
(ok "timed fib(30) correct" (and (= code 0) (= result "832040")) (string out " | " err))
|
||||
(printf " emitted fib(30): %s in %.2f ms (hand-Scheme spike ~5ms)" result ms))
|
||||
|
||||
(printf "\nemit-test: %d/%d passed" (- total fails) total)
|
||||
(os/exit (if (> fails 0) 1 0))
|
||||
|
|
|
|||
58
test/chez/run-corpus-chez.janet
Normal file
58
test/chez/run-corpus-chez.janet
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
# Phase 1 (jolt-cf1q.2) — FIRST parity number for the Chez back end.
|
||||
#
|
||||
# The full 0b gate (test/chez/run-corpus.janet) drives an `-e`-capable jolt
|
||||
# binary; that needs all of clojure.core bootstrapped onto Chez, which is Phase 2.
|
||||
# Until then, this probe reports parity for the subset the back end can ALREADY
|
||||
# compile: each corpus case `(= expected actual)` is run through the live
|
||||
# analyzer -> Scheme emitter -> Chez. Cases that reference unimplemented core fns
|
||||
# fail to EMIT (a clean compile-time signal) and are counted "out of subset",
|
||||
# not as divergences. The number to watch is parity WITHIN the compiled subset.
|
||||
# janet test/chez/run-corpus-chez.janet
|
||||
# JOLT_CORPUS_LIMIT=400 … (every-Nth stride, fast)
|
||||
(import ../../host/chez/driver :as d)
|
||||
|
||||
# Slow reporting tool (~20s: a Chez subprocess per compiled case), not a pass/fail
|
||||
# unit test — gate it out of the default suite like the benches (JOLT_BENCH).
|
||||
(unless (os/getenv "JOLT_CHEZ_CORPUS")
|
||||
(print "skip: set JOLT_CHEZ_CORPUS=1 to run the Chez subset parity probe")
|
||||
(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))
|
||||
|
||||
(def ctx (d/make-ctx))
|
||||
(var compiled 0) (var pass 0) (var out-of-subset 0)
|
||||
(def diverged @[])
|
||||
|
||||
(each row cases
|
||||
(def {:expected e :actual a :label l} row)
|
||||
# :throws cases need error-semantics we don't model yet — skip.
|
||||
(if (= e :throws)
|
||||
(++ out-of-subset)
|
||||
(let [src (string "(= " e " " a ")")
|
||||
# compile-program can throw (unsupported op/core fn) or the analyzer can
|
||||
# punt; either way the case is outside the compilable subset.
|
||||
res (try (d/run-on-chez ctx src) ([err] :uncompilable))]
|
||||
(if (= res :uncompilable)
|
||||
(++ out-of-subset)
|
||||
(let [[code out] res]
|
||||
(++ compiled)
|
||||
(cond
|
||||
(not= code 0) (array/push diverged [l (string "exit " code)])
|
||||
(= out "true") (++ pass)
|
||||
(array/push diverged [l (string "got " out)])))))))
|
||||
|
||||
(printf "\nChez subset parity: %d/%d compiled cases pass (%d/%d corpus out of subset)"
|
||||
pass compiled out-of-subset (length cases))
|
||||
(when (> (length diverged) 0)
|
||||
(printf "%d divergence(s) within the compiled subset:" (length diverged))
|
||||
(each [l m] (slice diverged 0 (min 25 (length diverged)))
|
||||
(printf " [%s] %s" l m)))
|
||||
(flush)
|
||||
Loading…
Add table
Add a link
Reference in a new issue