simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Chez Phase 1 (increment 2): live analyzer -> Chez, var cells, RT, mandelbrot

Browse source 
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 2026-06-17 13:59:57 -04:00
parent 874e3c7cf2
commit 9bbcc07c8f
6 changed files with 410 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

143
test/chez/emit-test.janet
View file

@ -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))