Island body: letrec instead of define (fixes render-to-dom), host-object JS fns

runner.sx: Converted define forms inside island body to letrec. Multiple
define forms in a let body cause render-to-dom to fall back to eval-expr
for the whole body, which evaluates (div ...) as a list instead of
rendering it to DOM. letrec keeps the last body expression (div) as the
render target.

sx_browser.ml: js_to_value now stores plain JS functions as host objects
(Dict with __host_handle) instead of wrapping as NativeFn. This preserves
the original JS function identity through the SX→JS round-trip, keeping
_driveAsync wrappers from host-callback intact when passed to
addEventListener via host-call.

Remaining: IO suspension in click handler is caught as "IO suspension in
non-IO context" instead of being driven by _driveAsync. The host-callback
wrapper creates the right JS function, but the event dispatch path doesn't
go through K.callFn.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-16 15:45:06 +00:00
parent 4981e9a32f
commit fec3194464
2 changed files with 174 additions and 164 deletions

View File

@@ -171,10 +171,14 @@ and js_to_value (js : Js.Unsafe.any) : value =
if not (Js.Unsafe.equals h Js.undefined) then if not (Js.Unsafe.equals h Js.undefined) then
get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float) get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float)
else else
(* Plain JS function — wrap as NativeFn *) (* Plain JS function — store as host object so value_to_js
NativeFn ("js-callback", fun args -> returns the ORIGINAL JS function when passed to host-call.
let js_args = args |> List.map value_to_js |> Array.of_list in This preserves wrappers like _driveAsync that host-callback
js_to_value (Js.Unsafe.fun_call js (Array.map Fun.id js_args))) attaches for IO suspension handling. *)
let id = host_put js in
let d = Hashtbl.create 2 in
Hashtbl.replace d "__host_handle" (Number (float_of_int id));
Dict d
| "object" -> | "object" ->
let h = Js.Unsafe.get js (Js.string "__sx_handle") in let h = Js.Unsafe.get js (Js.string "__sx_handle") in
if not (Js.Unsafe.equals h Js.undefined) then if not (Js.Unsafe.equals h Js.undefined) then

View File

@@ -7,11 +7,9 @@
(results (signal {})) (results (signal {}))
(running (signal false)) (running (signal false))
(current (signal "Ready"))) (current (signal "Ready")))
(define (letrec
get-doc ((get-doc (fn () (host-get (dom-query "#test-iframe") "contentDocument")))
(fn () (host-get (dom-query "#test-iframe") "contentDocument"))) (wait-boot
(define
wait-boot
(fn (fn
() ()
(let (let
@@ -26,8 +24,7 @@
"true")) "true"))
true true
(do (hs-wait 200) (wait-boot)))))) (do (hs-wait 200) (wait-boot))))))
(define (reload-frame
reload-frame
(fn (fn
() ()
(let (let
@@ -36,8 +33,7 @@
(hs-wait 1000) (hs-wait 1000)
(wait-boot) (wait-boot)
(hs-wait 500)))) (hs-wait 500))))
(define (run-action
run-action
(fn (fn
(action) (action)
(let (let
@@ -46,12 +42,16 @@
(= type :click) (= type :click)
(let (let
((el (host-call doc "querySelector" (nth action 1)))) ((el (host-call doc "querySelector" (nth action 1))))
(when (nil? el) (error (str "Not found: " (nth action 1)))) (when
(nil? el)
(error (str "Not found: " (nth action 1))))
(host-call el "click")) (host-call el "click"))
(= type :fill) (= type :fill)
(let (let
((el (host-call doc "querySelector" (nth action 1)))) ((el (host-call doc "querySelector" (nth action 1))))
(when (nil? el) (error (str "Not found: " (nth action 1)))) (when
(nil? el)
(error (str "Not found: " (nth action 1))))
(host-call el "focus") (host-call el "focus")
(dom-set-prop el "value" (nth action 2)) (dom-set-prop el "value" (nth action 2))
(dom-dispatch el "input" nil) (dom-dispatch el "input" nil)
@@ -61,7 +61,9 @@
(= type :assert-text) (= type :assert-text)
(let (let
((el (host-call doc "querySelector" (nth action 1)))) ((el (host-call doc "querySelector" (nth action 1))))
(when (nil? el) (error (str "Not found: " (nth action 1)))) (when
(nil? el)
(error (str "Not found: " (nth action 1))))
(let (let
((txt (host-get el "textContent")) ((txt (host-get el "textContent"))
(kw (nth action 2)) (kw (nth action 2))
@@ -69,7 +71,12 @@
(when (when
(and (= kw :contains) (not (contains? txt expected))) (and (= kw :contains) (not (contains? txt expected)))
(error (error
(str "Expected '" expected "' in '" (slice txt 0 60) "'"))) (str
"Expected '"
expected
"' in '"
(slice txt 0 60)
"'")))
(when (when
(and (= kw :not-contains) (contains? txt expected)) (and (= kw :not-contains) (contains? txt expected))
(error (str "Unexpected '" expected "'"))))) (error (str "Unexpected '" expected "'")))))
@@ -85,8 +92,7 @@
(error (str "Expected >=" expected " got " count))))) (error (str "Expected >=" expected " got " count)))))
true true
nil)))) nil))))
(define (run-all
run-all
(fn (fn
() ()
(reset! running true) (reset! running true)
@@ -108,7 +114,7 @@
(reset! results (assoc (deref results) name "pass"))))) (reset! results (assoc (deref results) name "pass")))))
tests) tests)
(reset! running false) (reset! running false)
(reset! current "Done"))) (reset! current "Done"))))
(div (div
(~tw :tokens "space-y-4") (~tw :tokens "space-y-4")
(div (div
@@ -170,7 +176,7 @@
:id "test-iframe" :id "test-iframe"
:src "/sx/(applications.(htmx))" :src "/sx/(applications.(htmx))"
(~tw :tokens "w-full border border-stone-200 rounded-lg mt-4") (~tw :tokens "w-full border border-stone-200 rounded-lg mt-4")
:style "height:600px")))) :style "height:600px")))))
;; Page component — passes test definitions to the island ;; Page component — passes test definitions to the island
(defcomp (defcomp