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

WIP: IO suspension diagnosis — call-lambda CALL_PRIM converts VmSuspended→Eval_error

Browse Source 
Root cause found: when the click handler calls run-all → for-each → callback → hs-wait → perform,
the perform raises VmSuspended. But the call path goes through sx_apply_cek
(from the call-lambda CALL_PRIM) which converts VmSuspended → CekPerformRequest.
The inner CEK context has no IO handler, so it raises "IO suspension in non-IO context"
instead of propagating the suspension to the outer context.

Fix needed: either (a) make sx_apply_cek NOT convert VmSuspended when in a context
that supports IO suspension, or (b) ensure the inner CEK from call-lambda propagates
perform as a suspension state rather than erroring.

Debug logging still present in sx_browser.ml (js_to_value traces).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-16 16:14:20 +00:00
parent 98fbd5cf40
commit 133edd4c5e
2 changed files with 14 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
hosts/ocaml/browser/sx-platform.js
View File

@@ -57,6 +57,7 @@
var obj = args[0], method = args[1];
var callArgs = [];
for (var i = 2; i < args.length; i++) callArgs.push(args[i]);
if (method === "addEventListener") console.log("[host-call] addEventListener args:", callArgs.map(a => typeof a === "function" ? "fn:" + (a.__host_callback ? "HOST_CB" : "other") : typeof a));
if (obj == null) {
// Global function call
var fn = typeof globalThis !== "undefined" ? globalThis[method] : window[method];
@@ -157,12 +158,16 @@
if (typeof fn === "function") return fn;
// SX callable (has __sx_handle) — wrap as JS function
if (fn && fn.__sx_handle !== undefined) {
return function() {
var wrappedFn = function() {
var a = Array.prototype.slice.call(arguments);
console.log("[host-callback] FIRED handle=" + fn.__sx_handle);
var r = K.callFn(fn, a);
console.log("[host-callback] callFn returned suspended=" + !!(r && r.suspended));
if (window._driveAsync) window._driveAsync(r);
return r;
};
wrappedFn.__host_callback = true;
return wrappedFn;
}
return function() {};
});

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

@@ -91,7 +91,9 @@ let rec value_to_js (v : value) : Js.Unsafe.any =
| Dict d ->
(* Check for __host_handle — return original JS object *)
(match Hashtbl.find_opt d "__host_handle" with
| Some (Number n) -> host_get_js (int_of_float n)
| Some (Number n) ->
Printf.eprintf "[value_to_js] Dict→host_get_js handle=%d\n%!" (int_of_float n);
host_get_js (int_of_float n)
| _ ->
let obj = Js.Unsafe.obj [||] in
Js.Unsafe.set obj (Js.string "_type") (Js.string "dict");
@@ -168,7 +170,10 @@ and js_to_value (js : Js.Unsafe.any) : value =
| "string" -> String (Js.to_string (Js.Unsafe.coerce js))
| "function" ->
let h = Js.Unsafe.get js (Js.string "__sx_handle") in
if not (Js.Unsafe.equals h Js.undefined) then
let has_host_cb = Js.to_bool (Js.Unsafe.coerce (Js.Unsafe.get js (Js.string "__host_callback"))) in
if has_host_cb then
Printf.eprintf "[js_to_value] fn has __host_callback! Storing as host obj\n%!";
if not (Js.Unsafe.equals h Js.undefined) && not has_host_cb then
get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float)
else
(* Plain JS function — store as host object so value_to_js
@@ -176,6 +181,7 @@ and js_to_value (js : Js.Unsafe.any) : value =
This preserves wrappers like _driveAsync that host-callback
attaches for IO suspension handling. *)
let id = host_put js in
Printf.eprintf "[js_to_value] plain JS fn → host_object id=%d\n%!" id;
let d = Hashtbl.create 2 in
Hashtbl.replace d "__host_handle" (Number (float_of_int id));
Dict d