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

Fix chained IO suspensions in value_to_js callback wrapper

Browse Source 
The resume callback in the value_to_js VmSuspended handler now catches
VmSuspended recursively, building a new suspension object and calling
_driveAsync for each iteration. Fixes repeat N times ... wait ... end
which produces N sequential suspensions.

Bounce works on repeated clicks. 4/4 regression tests pass.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-09 21:37:52 +00:00
parent cf10e9a2d6
commit 9982cd5926
3 changed files with 75 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
hosts/ocaml/browser/sx_browser.ml
View File

@@ -109,22 +109,35 @@ let rec value_to_js (v : value) : Js.Unsafe.any =
value_to_js result
with
| Sx_vm.VmSuspended (request, vm) ->
(* Build {suspended, request, resume} and hand to _driveAsync *)
let obj = Js.Unsafe.obj [||] in
Js.Unsafe.set obj (Js.string "suspended") (Js.Unsafe.inject Js._true);
Js.Unsafe.set obj (Js.string "request") (value_to_js request);
Js.Unsafe.set obj (Js.string "resume") (Js.wrap_callback (fun result_js ->
let result = js_to_value result_js in
try value_to_js (Sx_vm.resume_vm vm result)
with Eval_error msg ->
ignore (Js.Unsafe.meth_call
(Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
"error" [| Js.Unsafe.inject (Js.string ("[sx] resume: " ^ msg)) |]);
Js.Unsafe.inject Js.null));
(* Build {suspended, request, resume} and hand to _driveAsync.
The resume callback must also catch VmSuspended for chaining
(e.g. repeat 3 times ... wait ... end). *)
let rec make_suspension req v =
let obj = Js.Unsafe.obj [||] in
Js.Unsafe.set obj (Js.string "suspended") (Js.Unsafe.inject Js._true);
Js.Unsafe.set obj (Js.string "request") (value_to_js req);
Js.Unsafe.set obj (Js.string "resume") (Js.wrap_callback (fun result_js ->
let result = js_to_value result_js in
try value_to_js (Sx_vm.resume_vm v result)
with
| Sx_vm.VmSuspended (req2, vm2) ->
let s = make_suspension req2 vm2 in
let drive = Js.Unsafe.get Js.Unsafe.global (Js.string "_driveAsync") in
if not (Js.Unsafe.equals drive Js.undefined) then
ignore (Js.Unsafe.fun_call drive [| Js.Unsafe.inject s |]);
Js.Unsafe.inject s
| Eval_error msg ->
ignore (Js.Unsafe.meth_call
(Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
"error" [| Js.Unsafe.inject (Js.string ("[sx] resume: " ^ msg)) |]);
Js.Unsafe.inject Js.null));
obj
in
let s = make_suspension request vm in
let drive = Js.Unsafe.get Js.Unsafe.global (Js.string "_driveAsync") in
if not (Js.Unsafe.equals drive Js.undefined) then
ignore (Js.Unsafe.fun_call drive [| Js.Unsafe.inject obj |]);
Js.Unsafe.inject obj
ignore (Js.Unsafe.fun_call drive [| Js.Unsafe.inject s |]);
Js.Unsafe.inject s
| Eval_error msg ->
let fn_info = Printf.sprintf " [callback %s handle=%d]" (type_of v) handle in
ignore (Js.Unsafe.meth_call