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

Restore cek_run IO hooks and cek_step_loop error handling lost by bootstrap

Browse Source 
bootstrap.py regenerated cek_run as a simple "raise if suspended" without
the _cek_io_resolver and _cek_io_suspend_hook checks. Also lost the
CekPerformRequest catch in cek_step_loop and step_limit checks.

This was the direct cause of "IO suspension in non-IO context" when island
click handlers called perform (via hs-wait). The CEK had no way to propagate
the suspension to the VM/JS boundary.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-17 14:01:14 +00:00
parent aef92cc1f3
commit f276c4a56a
5 changed files with 78 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -576,11 +576,34 @@ and expand_macro mac raw_args env =
(* cek-step-loop *)
and cek_step_loop state =
(if sx_truthy ((let _or = (cek_terminal_p (state)) in if sx_truthy _or then _or else (cek_suspended_p (state)))) then state else (cek_step_loop ((cek_step (state)))))
if !step_limit > 0 then begin
step_count := !step_count + 1;
if !step_count > !step_limit then
raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded")
end;
(if sx_truthy ((let _or = (cek_terminal_p (state)) in if sx_truthy _or then _or else (cek_suspended_p (state)))) then state else begin
let next = (try cek_step (state)
with Sx_types.CekPerformRequest request ->
make_cek_suspended request (cek_env state) (cek_kont state))
in cek_step_loop next
end)
(* cek-run *)
(* cek-run — with IO suspension hooks for the OCaml host *)
and cek_run state =
(let final = (cek_step_loop (state)) in (if sx_truthy ((cek_suspended_p (final))) then (raise (Eval_error (value_to_str (String "IO suspension in non-IO context")))) else (cek_value (final))))
let rec run s =
let final = cek_step_loop s in
if sx_truthy (cek_suspended_p final) then
match !Sx_types._cek_io_resolver with
| Some resolver ->
let request = cek_io_request final in
let result = resolver request final in
run (cek_resume final result)
| None ->
(match !Sx_types._cek_io_suspend_hook with
| Some hook -> hook final
| None -> raise (Eval_error (value_to_str (String "IO suspension in non-IO context"))))
else cek_value final
in run state
(* cek-resume *)
and cek_resume suspended_state result' =

15
shared/static/wasm/sx-platform.js
View File

@@ -89,17 +89,10 @@
window._driveAsync = function driveAsync(result) {
if (!result || !result.suspended) return;
var req = result.request;
// Request can be dict {op, args} or list (op-name arg ...)
var opName, arg;
if (req && req._type === "dict" && req.op) {
opName = req.op;
arg = req.args && req.args.items ? req.args.items[0] : null;
} else {
var items = req && (req.items || req);
var op = items && items[0];
opName = typeof op === "string" ? op : (op && op.name) || String(op);
arg = items && items[1];
}
var items = req && (req.items || req);
var op = items && items[0];
var opName = typeof op === "string" ? op : (op && op.name) || String(op);
var arg = items && items[1];
if (opName === "io-sleep" || opName === "wait") {
setTimeout(function() {
try { driveAsync(result.resume(null)); } catch(e) { console.error("[sx] driveAsync:", e.message); }

2
shared/static/wasm/sx/hs-parser.sx
View File

@@ -1266,7 +1266,7 @@
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
(list (quote fetch-gql) gql-source url))))
(let
((url-atom (parse-atom)))
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (tp-type) "ident") (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
(let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let

61
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-a2e416eb",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-7cf00582",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-0610d883",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-7cf00582",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new