e98afcad13
Elide the redundant jolt-truthy? wrapper on an :if test that provably yields a Scheme boolean (a native comparison/not, or a boolean const). Sound because jolt-truthy? of #t/#f is identity. The hot fib/mandelbrot tests are all comparisons, so this is a direct ceiling lever: fib(30) end-to-end 24.0 -> 14.4 ms. Add bench-pipeline.janet (JOLT_CHEZ_BENCH=1, opt-in) timing fib(30) + mandelbrot(200) through the real pipeline vs the spike ceiling. Mandelbrot 200 runs at 87 ms, at/below the 98 ms generic-flonum ceiling - the substrate ceiling is reached end-to-end. fib sits at 2x its hand-flonum ceiling; the residual is jolt's all-double number model (typed fl*/fx* emission is Phase 4). Compile-only is total for the compute subset (every form emits; Chez has no interpreter fallback). Full parity unchanged at 1534/2494, 0 new divergences.
102 lines
4.9 KiB
Text
102 lines
4.9 KiB
Text
# Phase 1 (jolt-cf1q.2) close-out bench — the compute benches run END TO END
|
|
# through the REAL pipeline (Clojure source -> Janet-hosted analyzer -> IR ->
|
|
# Scheme emitter -> Chez compile -> run), timed in-process (Chez startup
|
|
# excluded), and reported against the spike ceiling (spike/chez/RESULTS.md).
|
|
#
|
|
# This is the Phase 1 gate evidence: (1) compile-only is TOTAL for the compute
|
|
# subset — every form emits, no interpreter fallback (Chez has none); (2) the
|
|
# emitted code runs at ~the substrate ceiling, with the residual gap being
|
|
# exactly the typed fl*/fx* emission that Phase 4 owns.
|
|
#
|
|
# JOLT_CHEZ_BENCH=1 janet test/chez/bench-pipeline.janet
|
|
# Opt-in (like core-bench); skipped in the normal gate.
|
|
(import ../../src/jolt/backend :as backend)
|
|
(import ../../src/jolt/reader :as r)
|
|
(import ../../host/chez/driver :as d)
|
|
(import ../../host/chez/emit :as emit)
|
|
|
|
(unless (os/getenv "JOLT_CHEZ_BENCH")
|
|
(print "skip: set JOLT_CHEZ_BENCH=1 to run the Chez pipeline bench")
|
|
(os/exit 0))
|
|
(unless (d/chez-available?)
|
|
(print "skip: chez not on PATH")
|
|
(os/exit 0))
|
|
|
|
(def ctx (d/make-ctx))
|
|
|
|
# Emit a top-level program (one or more defns) through the real pipeline. Returns
|
|
# the concatenated Scheme for every form — each form must emit (compile-only is
|
|
# total) or this throws, which is itself the totality check.
|
|
(defn emit-program [src]
|
|
(def forms (map first (r/parse-all-positioned src)))
|
|
(string/join (map (fn [f] (emit/emit (backend/analyze-form ctx f))) forms) "\n"))
|
|
|
|
(def fib-src "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
|
|
|
|
# mandelbrot kernel: loop/recur + let + or-expansion + cross-var call, all flonum.
|
|
(def mandel-src ``
|
|
(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) acc
|
|
(let [ci (- (* 2.0 (/ (* 1.0 y) nd)) 1.0)
|
|
row (loop [x 0 a 0]
|
|
(if (>= x n) a
|
|
(let [cr (- (* 3.5 (/ (* 1.0 x) nd)) 2.5)]
|
|
(recur (inc x) (+ a (count-point cr ci cap))))))]
|
|
(recur (inc y) (+ acc row)))))))
|
|
``)
|
|
|
|
(def fib-scm (emit-program fib-src))
|
|
(def mandel-scm (emit-program mandel-src))
|
|
(print "compile-only total: fib + mandelbrot emitted with no fallback")
|
|
|
|
# One Chez program: load the RT, the emitted defns, a hand-written FLONUM fib
|
|
# reference (jolt's realistic ceiling given the all-double model), then time each
|
|
# end-to-end value (warm up first; exclude Chez startup via a monotonic clock).
|
|
(def prog
|
|
(string
|
|
"(import (chezscheme))\n(load \"host/chez/rt.ss\")\n"
|
|
fib-scm "\n" mandel-scm "\n"
|
|
"(define fib (var-deref \"user\" \"fib\"))\n"
|
|
"(define mrun (var-deref \"user\" \"run\"))\n"
|
|
# hand flonum fib — the substrate ceiling for jolt's number model
|
|
"(define (ffib n) (if (fl< n 2.0) n (fl+ (ffib (fl- n 1.0)) (ffib (fl- n 2.0)))))\n"
|
|
"(define (now-ns) (let ((t (current-time 'time-monotonic))) (+ (* (time-second t) 1000000000) (time-nanosecond t))))\n"
|
|
"(define (timed thunk) (let* ((t0 (now-ns)) (r (thunk)) (ms (/ (- (now-ns) t0) 1000000.0))) (cons r ms)))\n"
|
|
"(fib 24)(ffib 24.0)(mrun 30)\n" # warm up
|
|
"(let ((a (timed (lambda () (fib 30))))\n"
|
|
" (b (timed (lambda () (ffib 30.0))))\n"
|
|
" (c (timed (lambda () (mrun 200)))))\n"
|
|
" (printf \"~a ~a ~a ~a ~a ~a\\n\"\n"
|
|
" (jolt-pr-str (car a)) (exact->inexact (cdr a))\n"
|
|
" (jolt-pr-str (car b)) (exact->inexact (cdr b))\n"
|
|
" (jolt-pr-str (car c)) (exact->inexact (cdr c))))"))
|
|
|
|
(def path (string "/tmp/chez-bench-pipeline-" (os/getpid) ".ss"))
|
|
(spit path prog)
|
|
(def proc (os/spawn ["chez" "--script" path] :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))
|
|
(unless (= code 0) (printf "BENCH FAILED (code %d): %s" code err) (os/exit 1))
|
|
|
|
(def p (string/split " " out))
|
|
(defn num [i] (scan-number (get p i "0")))
|
|
(printf "\nReal-pipeline compute benches (Chez startup excluded):\n")
|
|
(printf " fib 30 (jolt, flonum) = %s in %6.2f ms" (get p 0) (num 1))
|
|
(printf " fib 30 (hand flonum ceiling) = %6.2f ms <- jolt's number-model ceiling" (num 3))
|
|
(printf " fib 30 (spike fixnum ceiling)= 5.20 ms <- Phase 4 fl/fx typed-emit target")
|
|
(printf " mandelbrot 200 (jolt) = %s in %6.2f ms" (get p 4) (num 5))
|
|
(printf " mandelbrot 200 (spike generic)= 98.10 ms <- generic-flonum ceiling")
|
|
(printf " mandelbrot 200 (spike typed) = 13.40 ms <- Phase 4 fl/fx typed-emit target")
|
|
(def fib-overhead (if (> (num 3) 0) (/ (num 1) (num 3)) 0))
|
|
(printf "\n jolt fib is %.2fx the hand-flonum ceiling (residual = truthy/dispatch; typed-emit closes the fixnum gap)." fib-overhead)
|
|
(os/exit 0)
|