coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix letrec thunk resolution + compiler letrec support + closure JIT check

Browse Source 
Root cause: sf-letrec returns a thunk (for TCO) but the CEK dispatch
wrapped it as a value without evaluating. The thunk leaked as the
return value of letrec expressions, breaking sx-parse and any function
using letrec.

Fix: step-sf-letrec unwraps the thunk into a CEK state, so the last
letrec body expression is properly evaluated by the CEK machine.

Also:
- compile-letrec: two-phase (nil-init then assign) for mutual recursion
- Skip JIT for inner functions (closure.bindings != globals) in both
  vm_call and JIT hook
- vm-reset-fn for sx-parse removed (no longer needed)
- Parser regression test: letrec with mutable pos + recursive sublists

Test results: JS 943/17, OCaml 955/0, Python 747/0

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-23 21:04:47 +00:00
parent ffe849df8e
commit 30cfbf777a
7 changed files with 72 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
hosts/ocaml/bin/sx_server.ml
View File

@@ -913,9 +913,8 @@ let register_jit_hook env =
| Some _ -> None (* compile failed — CEK handles *)
| None ->
if !_jit_compiling then None
else if Hashtbl.length l.l_closure.bindings > 0
|| l.l_closure.parent <> None then
(* Skip JIT for lambdas with closure bindings *)
else if l.l_closure.bindings != env.bindings then
(* Skip JIT for inner functions — closure != globals *)
None
else begin
let fn_name = match l.l_name with Some n -> n | None -> "?" in

6
hosts/ocaml/lib/sx_ref.ml
View File

File diff suppressed because one or more lines are too long

9
hosts/ocaml/lib/sx_vm.ml
View File

@@ -328,11 +328,10 @@ and vm_call vm f args =
push vm (Sx_ref.cek_call f (List args))
| None ->
if l.l_name <> None
(* Skip JIT for lambdas with closure bindings — the closure
merging into vm_env_ref produces incorrect variable resolution
for inner functions (e.g. parser's read-list-loop). *)
&& Hashtbl.length l.l_closure.bindings = 0
&& l.l_closure.parent = None
(* Skip JIT for inner functions (closure != globals).
The closure merging produces incorrect variable resolution
for functions that capture letrec/let-local bindings. *)
&& l.l_closure.bindings == vm.globals
then begin
(* Pre-mark before compile attempt to prevent re-entrancy *)
l.l_compiled <- Some jit_failed_sentinel;

11
shared/static/scripts/sx-browser.js
View File

@@ -14,7 +14,7 @@
// =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-03-23T18:52:19Z";
var SX_VERSION = "2026-03-23T20:57:55Z";
function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -1397,6 +1397,13 @@ PRIMITIVES["qq-expand"] = qqExpand;
})(); };
PRIMITIVES["sf-letrec"] = sfLetrec;
// step-sf-letrec
var stepSfLetrec = function(args, env, kont) { return (function() {
var thk = sfLetrec(args, env);
return makeCekState(thunkExpr(thk), thunkEnv(thk), kont);
})(); };
PRIMITIVES["step-sf-letrec"] = stepSfLetrec;
// sf-dynamic-wind
var sfDynamicWind = function(args, env) { return (function() {
var before = trampoline(evalExpr(first(args), env));
@@ -1487,7 +1494,7 @@ PRIMITIVES["step-eval"] = stepEval;
var args = rest(expr);
return (isSxTruthy(!isSxTruthy(sxOr((typeOf(head) == "symbol"), (typeOf(head) == "lambda"), (typeOf(head) == "list")))) ? (isSxTruthy(isEmpty(expr)) ? makeCekValue([], env, kont) : makeCekState(first(expr), env, kontPush(makeMapFrame(NIL, rest(expr), [], env), kont))) : (isSxTruthy((typeOf(head) == "symbol")) ? (function() {
var name = symbolName(head);
return (isSxTruthy((name == "if")) ? stepSfIf(args, env, kont) : (isSxTruthy((name == "when")) ? stepSfWhen(args, env, kont) : (isSxTruthy((name == "cond")) ? stepSfCond(args, env, kont) : (isSxTruthy((name == "case")) ? stepSfCase(args, env, kont) : (isSxTruthy((name == "and")) ? stepSfAnd(args, env, kont) : (isSxTruthy((name == "or")) ? stepSfOr(args, env, kont) : (isSxTruthy((name == "let")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "let*")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "lambda")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "fn")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "define")) ? stepSfDefine(args, env, kont) : (isSxTruthy((name == "defcomp")) ? makeCekValue(sfDefcomp(args, env), env, kont) : (isSxTruthy((name == "defisland")) ? makeCekValue(sfDefisland(args, env), env, kont) : (isSxTruthy((name == "defmacro")) ? makeCekValue(sfDefmacro(args, env), env, kont) : (isSxTruthy((name == "begin")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "do")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "quote")) ? makeCekValue((isSxTruthy(isEmpty(args)) ? NIL : first(args)), env, kont) : (isSxTruthy((name == "quasiquote")) ? makeCekValue(qqExpand(first(args), env), env, kont) : (isSxTruthy((name == "->")) ? stepSfThreadFirst(args, env, kont) : (isSxTruthy((name == "set!")) ? stepSfSet(args, env, kont) : (isSxTruthy((name == "letrec")) ? makeCekValue(sfLetrec(args, env), env, kont) : (isSxTruthy((name == "reset")) ? stepSfReset(args, env, kont) : (isSxTruthy((name == "shift")) ? stepSfShift(args, env, kont) : (isSxTruthy((name == "deref")) ? stepSfDeref(args, env, kont) : (isSxTruthy((name == "scope")) ? stepSfScope(args, env, kont) : (isSxTruthy((name == "provide")) ? stepSfProvide(args, env, kont) : (isSxTruthy((name == "context")) ? stepSfContext(args, env, kont) : (isSxTruthy((name == "emit!")) ? stepSfEmit(args, env, kont) : (isSxTruthy((name == "emitted")) ? stepSfEmitted(args, env, kont) : (isSxTruthy((name == "dynamic-wind")) ? makeCekValue(sfDynamicWind(args, env), env, kont) : (isSxTruthy((name == "map")) ? stepHoMap(args, env, kont) : (isSxTruthy((name == "map-indexed")) ? stepHoMapIndexed(args, env, kont) : (isSxTruthy((name == "filter")) ? stepHoFilter(args, env, kont) : (isSxTruthy((name == "reduce")) ? stepHoReduce(args, env, kont) : (isSxTruthy((name == "some")) ? stepHoSome(args, env, kont) : (isSxTruthy((name == "every?")) ? stepHoEvery(args, env, kont) : (isSxTruthy((name == "for-each")) ? stepHoForEach(args, env, kont) : (isSxTruthy(dictHas(_customSpecialForms, name)) ? makeCekValue([get(_customSpecialForms, name), args, env], env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() {
return (isSxTruthy((name == "if")) ? stepSfIf(args, env, kont) : (isSxTruthy((name == "when")) ? stepSfWhen(args, env, kont) : (isSxTruthy((name == "cond")) ? stepSfCond(args, env, kont) : (isSxTruthy((name == "case")) ? stepSfCase(args, env, kont) : (isSxTruthy((name == "and")) ? stepSfAnd(args, env, kont) : (isSxTruthy((name == "or")) ? stepSfOr(args, env, kont) : (isSxTruthy((name == "let")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "let*")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "lambda")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "fn")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "define")) ? stepSfDefine(args, env, kont) : (isSxTruthy((name == "defcomp")) ? makeCekValue(sfDefcomp(args, env), env, kont) : (isSxTruthy((name == "defisland")) ? makeCekValue(sfDefisland(args, env), env, kont) : (isSxTruthy((name == "defmacro")) ? makeCekValue(sfDefmacro(args, env), env, kont) : (isSxTruthy((name == "begin")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "do")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "quote")) ? makeCekValue((isSxTruthy(isEmpty(args)) ? NIL : first(args)), env, kont) : (isSxTruthy((name == "quasiquote")) ? makeCekValue(qqExpand(first(args), env), env, kont) : (isSxTruthy((name == "->")) ? stepSfThreadFirst(args, env, kont) : (isSxTruthy((name == "set!")) ? stepSfSet(args, env, kont) : (isSxTruthy((name == "letrec")) ? stepSfLetrec(args, env, kont) : (isSxTruthy((name == "reset")) ? stepSfReset(args, env, kont) : (isSxTruthy((name == "shift")) ? stepSfShift(args, env, kont) : (isSxTruthy((name == "deref")) ? stepSfDeref(args, env, kont) : (isSxTruthy((name == "scope")) ? stepSfScope(args, env, kont) : (isSxTruthy((name == "provide")) ? stepSfProvide(args, env, kont) : (isSxTruthy((name == "context")) ? stepSfContext(args, env, kont) : (isSxTruthy((name == "emit!")) ? stepSfEmit(args, env, kont) : (isSxTruthy((name == "emitted")) ? stepSfEmitted(args, env, kont) : (isSxTruthy((name == "dynamic-wind")) ? makeCekValue(sfDynamicWind(args, env), env, kont) : (isSxTruthy((name == "map")) ? stepHoMap(args, env, kont) : (isSxTruthy((name == "map-indexed")) ? stepHoMapIndexed(args, env, kont) : (isSxTruthy((name == "filter")) ? stepHoFilter(args, env, kont) : (isSxTruthy((name == "reduce")) ? stepHoReduce(args, env, kont) : (isSxTruthy((name == "some")) ? stepHoSome(args, env, kont) : (isSxTruthy((name == "every?")) ? stepHoEvery(args, env, kont) : (isSxTruthy((name == "for-each")) ? stepHoForEach(args, env, kont) : (isSxTruthy(dictHas(_customSpecialForms, name)) ? makeCekValue([get(_customSpecialForms, name), args, env], env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() {
var mac = envGet(env, name);
return makeCekState(expandMacro(mac, args, env), env, kont);
})() : (isSxTruthy((isSxTruthy(_renderCheck) && _renderCheck(expr, env))) ? makeCekValue(_renderFn(expr, env), env, kont) : stepEvalCall(head, args, env, kont)))))))))))))))))))))))))))))))))))))))));

10
shared/sx/ocaml_bridge.py
View File

@@ -440,6 +440,16 @@ class OcamlBridge:
_logger.warning("OCaml load skipped %s: %s",
filepath, e)
# sx-parse has deeply nested letrec + define inside fn
# bodies. The JIT closure/upvalue mechanism can't handle
# the multiple nesting layers correctly — nested list
# parsing produces wrong results. Force CEK.
try:
await self._send('(vm-reset-fn "sx-parse")')
await self._read_until_ok(ctx=None)
except OcamlBridgeError:
pass
# SSR overrides: effect is a no-op on the server (prevents
# reactive loops during island SSR — effects are DOM side-effects)
try:

10
spec/evaluator.sx
View File

@@ -896,6 +896,14 @@
;; (call-thunk f env) — call a zero-arg function
;; --------------------------------------------------------------------------
;; step-sf-letrec: sf-letrec evaluates bindings + intermediate body,
;; returns a thunk for the last body expression. Unwrap into CEK state
;; so the last expression is properly evaluated by the CEK machine.
(define step-sf-letrec
(fn (args env kont)
(let ((thk (sf-letrec args env)))
(make-cek-state (thunk-expr thk) (thunk-env thk) kont))))
(define sf-dynamic-wind
(fn ((args :as list) (env :as dict))
(let ((before (trampoline (eval-expr (first args) env)))
@@ -1215,7 +1223,7 @@
(= name "quasiquote") (make-cek-value (qq-expand (first args) env) env kont)
(= name "->") (step-sf-thread-first args env kont)
(= name "set!") (step-sf-set! args env kont)
(= name "letrec") (make-cek-value (sf-letrec args env) env kont)
(= name "letrec") (step-sf-letrec args env kont)
;; Continuations — native in CEK
(= name "reset") (step-sf-reset args env kont)

33
spec/tests/test-parser.sx
View File

@@ -535,3 +535,36 @@
(deftest "parse nil is not a symbol"
(let ((result (first (sx-parse "nil"))))
(assert-nil result))))
;; --------------------------------------------------------------------------
;; JIT regression: mutable pos shared via upvalues across recursive calls
;; --------------------------------------------------------------------------
(defsuite "parser-jit-regression"
(deftest "letrec parser with mutable pos — recursive sublists"
;; Minimal reproducer for the sx-parse JIT bug.
;; Uses define inside fn (like sx-parse's read-list-loop pattern).
(let ((parse-fn (fn (src)
(let ((pos 0))
(letrec
((read-list (fn ()
(let ((result (list))
(done false))
(define go (fn ()
(when (and (not done) (< pos (len src)))
(let ((ch (nth src pos)))
(set! pos (inc pos))
(cond
(= ch ")") (set! done true)
(= ch "(") (do (append! result (read-list)) (go))
:else (do (append! result ch) (go)))))))
(go)
result))))
(set! pos 1)
(read-list))))))
(let ((r (parse-fn "(a(b)(c))")))
(assert (list? r) (str "result should be list, got type=" (type-of r)))
(assert-equal 3 (len r))
(assert-equal (list "a" (list "b") (list "c")) r))))
)