From 133edd4c5e9b908c316e8ab587f4e4266389ee82 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 16 Apr 2026 16:14:20 +0000 Subject: [PATCH] =?UTF-8?q?WIP:=20IO=20suspension=20diagnosis=20=E2=80=94?= =?UTF-8?q?=20call-lambda=20CALL=5FPRIM=20converts=20VmSuspended=E2=86=92E?= =?UTF-8?q?val=5Ferror?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/browser/sx-platform.js | 7 ++++++- hosts/ocaml/browser/sx_browser.ml | 10 ++++++++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/hosts/ocaml/browser/sx-platform.js b/hosts/ocaml/browser/sx-platform.js index 64817559..02c210d4 100644 --- a/hosts/ocaml/browser/sx-platform.js +++ b/hosts/ocaml/browser/sx-platform.js @@ -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() {}; }); diff --git a/hosts/ocaml/browser/sx_browser.ml b/hosts/ocaml/browser/sx_browser.ml index c4ddcab9..3263a785 100644 --- a/hosts/ocaml/browser/sx_browser.ml +++ b/hosts/ocaml/browser/sx_browser.ml @@ -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