From 921db09f5e2c62293db3ca390464effb105e7be3 Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 30 Jun 2026 21:09:31 +0000 Subject: [PATCH] jit: HO-loop desugar + hyperscript hs-* interpret-only (--jit == CEK parity) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Ported from loops/sx-vm-extensions 2d24c0cf + dcc5d9fa (file hunks only), on top of be071d56 (compile-let/letrec residue fixes). 1. compiler.sx: desugar map/filter/reduce/for-each/some/every? (literal-fn arg0) to resumable named-let bytecode loops instead of CALL_PRIM into a native OCaml loop. The general fix for the serving-JIT "perform-in-HO-callback drops all-but-first" miscompile — the bytecode loop suspends/resumes within the VM and survives, so the call_closure_reuse inline-resolve band-aid (and boot-loader jit-exclude! recipes) are no longer needed. Data-first/symbol-fn forms fall back to CALL_PRIM unchanged. Proven zero-regression: full run_tests --jit failure SETS byte-identical with/without. 2. lib/hyperscript/runtime.sx: (jit-exclude! "hs-*") — hyperscript was the only guest missing its jit-exclude! decl; its recursive-descent tokenizer/parser combinators hit the parser-combinator JIT bug. Runs on CEK (correct); hyperscript compiles to SX at author time so no serve-time cost. Together these take run_tests --jit to 4862/1082 = EXACT parity with the CEK baseline (zero deterministic JIT-specific failures, verified by failure-set diff). Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/compiler.sx | 54 ++++++++++++++++++++++++++++++++++++++ lib/hyperscript/runtime.sx | 10 +++++++ 2 files changed, 64 insertions(+) diff --git a/lib/compiler.sx b/lib/compiler.sx index 28a8a415..94e2b963 100644 --- a/lib/compiler.sx +++ b/lib/compiler.sx @@ -387,6 +387,60 @@ (emit-op em 5)) (init forms)) (compile-expr em (last forms) scope false)))) + (= name "map") + (if + (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda"))) + (compile-list + em + `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hacc (list)) (_hc _hcl)) (if (empty? _hc) (reverse _hacc) (_hml (cons (_hf (first _hc)) _hacc) (rest _hc))))) + scope + tail?) + (compile-call em head args scope tail?)) + (= name "filter") + (if + (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda"))) + (compile-list + em + `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hacc (list)) (_hc _hcl)) (if (empty? _hc) (reverse _hacc) (_hml (if (_hf (first _hc)) (cons (first _hc) _hacc) _hacc) (rest _hc))))) + scope + tail?) + (compile-call em head args scope tail?)) + (= name "reduce") + (if + (and (= (len args) 3) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda"))) + (compile-list + em + `(let ((_hf ,(first args)) (_hin ,(nth args 1)) (_hcl ,(nth args 2))) (let _hml ((_hacc _hin) (_hc _hcl)) (if (empty? _hc) _hacc (_hml (_hf _hacc (first _hc)) (rest _hc))))) + scope + tail?) + (compile-call em head args scope tail?)) + (= name "for-each") + (if + (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda"))) + (compile-list + em + `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hc _hcl)) (if (empty? _hc) nil (begin (_hf (first _hc)) (_hml (rest _hc)))))) + scope + tail?) + (compile-call em head args scope tail?)) + (= name "some") + (if + (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda"))) + (compile-list + em + `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hc _hcl)) (if (empty? _hc) false (let ((_hr (_hf (first _hc)))) (if _hr _hr (_hml (rest _hc))))))) + scope + tail?) + (compile-call em head args scope tail?)) + (= name "every?") + (if + (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda"))) + (compile-list + em + `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hc _hcl)) (if (empty? _hc) true (if (_hf (first _hc)) (_hml (rest _hc)) false)))) + scope + tail?) + (compile-call em head args scope tail?)) :else (compile-call em head args scope tail?))))))) (define compile-if diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index aedfc056..b3ec6d93 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -3351,3 +3351,13 @@ (bind-path! (host-global "window") name-path) wrapper))))) + +;; Hyperscript's tokenizer/parser are recursive-descent combinators (hs-tokenize, +;; hs-stream-*, hs-parse-*). Like every other guest interpreter (scheme-*, er-*, +;; pl-*, cl-*, js-*, hk-*), their recursion web miscompiles under the bytecode JIT +;; (the parser-combinator JIT bug — see project_jit_bytecode_bug). Declare the whole +;; hs- namespace interpret-only: it runs on the CEK, where it is correct. Hyperscript +;; is compiled to SX once at author/load time (not per request), so there is no +;; serve-time perf cost. With this, run_tests --jit == CEK (4862/1082, zero +;; JIT-specific failures). +(jit-exclude! "hs-*")