Fix WASM browser: broken links (&rest bytecode) + broken reactive counter (ListRef mutation)

Two bugs fixed:

1. Links: bytecode compiler doesn't handle &rest params — treats them as
   positional, so (first rest) gets a raw string instead of a list.
   Replaced &rest with explicit optional params in all bytecode-compiled
   web SX files (dom-query, dom-add-listener, browser-push-state, etc.).
   The VM already pads missing args with Nil.

2. Reactive counter: signal-remove-sub! used (filter ...) which returns
   immutable List, but signal-add-sub! uses (append!) which only mutates
   ListRef. Subscribers silently vanished after first effect re-run.
   Fixed by adding remove! primitive that mutates ListRef in-place.

Also:
- Added evalVM API to WASM kernel (compile + run through bytecode VM)
- Added scope tracing (scope-push!/pop!/peek/context instrumentation)
- Added Playwright reactive mode for debugging island signal/DOM state
- Replaced cek-call with direct calls in core-signals.sx effect/computed
- Recompiled all 23 bytecode modules

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-27 14:08:49 +00:00
parent 553bbf123e
commit 8d3ab040ef
18 changed files with 42899 additions and 3236 deletions

View File

@@ -247,6 +247,34 @@ let api_eval src_js =
| Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
| Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))
(** evalVM: compile SX source to bytecode and run through the VM.
Globals defined with `define` are visible to subsequent evalVM/eval calls.
This tests the exact same code path as island hydration and click handlers. *)
let api_eval_vm src_js =
let src = Js.to_string src_js in
try
let exprs = Sx_parser.parse_all src in
let compile_fn = match Hashtbl.find_opt _vm_globals "compile-module" with
| Some v -> v
| None -> env_get global_env "compile-module" in
let code_val = Sx_runtime.trampoline (Sx_runtime.sx_call compile_fn [List exprs]) in
let code = Sx_vm.code_from_value code_val in
let result = Sx_vm.execute_module code _vm_globals in
(* Sync VM globals → CEK env so subsequent eval() calls see defines *)
Hashtbl.iter (fun name v ->
let id = intern name in
if not (Hashtbl.mem global_env.bindings id) then
Hashtbl.replace global_env.bindings id v
else (match Hashtbl.find global_env.bindings id, v with
| VmClosure _, VmClosure _ | _, VmClosure _ -> Hashtbl.replace global_env.bindings id v
| _ -> ())
) _vm_globals;
return_via_side_channel (value_to_js result)
with
| Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
| Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))
| Not_found -> Js.Unsafe.inject (Js.string "Error: compile-module not loaded")
let api_eval_expr expr_js _env_js =
let expr = js_to_value expr_js in
try
@@ -427,12 +455,11 @@ let () =
bind "cek-call" (fun args ->
match args with
| [f; Nil] -> Sx_ref.eval_expr (List [f]) (Env global_env)
| [f; List al] -> Sx_ref.eval_expr (List (f :: al)) (Env global_env)
| [f; a] -> Sx_ref.eval_expr (List [f; a]) (Env global_env)
| [f] -> Sx_ref.eval_expr (List [f]) (Env global_env)
| f :: rest -> Sx_ref.eval_expr (List (f :: rest)) (Env global_env)
| _ -> raise (Eval_error "cek-call: expected function and args"));
| [f; a] when is_callable f ->
let arg_list = match a with List l -> l | Nil -> [] | v -> [v] in
Sx_runtime.trampoline (Sx_runtime.sx_call f arg_list)
| [f; _] -> raise (Eval_error ("cek-call: not callable: " ^ type_of f))
| _ -> raise (Eval_error "cek-call: expected (fn args)"));
bind "sx-parse" (fun args ->
match args with
@@ -481,6 +508,15 @@ let () =
match args with
| [ListRef r; v] -> r := !r @ [v]; ListRef r
| [List items; v] -> List (items @ [v])
| _ -> raise (Eval_error "append!: expected list and value"));
(* remove! — mutate ListRef in-place, removing by identity (==) *)
bind "remove!" (fun args ->
match args with
| [ListRef r; target] ->
r := List.filter (fun x -> x != target) !r; ListRef r
| [List items; target] ->
List (List.filter (fun x -> x != target) items)
| _ -> raise (Eval_error "append!: list and value"));
(* --- Environment ops --- *)
@@ -602,11 +638,17 @@ let () =
match args with [mac; raw; Env e] -> Sx_ref.expand_macro mac raw (Env e) | [mac; raw] -> Sx_ref.expand_macro mac raw (Env global_env) | _ -> Nil);
bind "call-lambda" (fun args ->
match args with
| [fn_val; call_args; Env _e] -> Sx_ref.cek_call fn_val call_args
| [fn_val; call_args] -> Sx_ref.cek_call fn_val call_args
| [f; a; _] | [f; a] when is_callable f ->
let arg_list = match a with List l -> l | Nil -> [] | v -> [v] in
Sx_runtime.trampoline (Sx_runtime.sx_call f arg_list)
| _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
bind "cek-call" (fun args ->
match args with [f; a] -> Sx_ref.cek_call f a | _ -> raise (Eval_error "cek-call"));
match args with
| [f; a] when is_callable f ->
let arg_list = match a with List l -> l | Nil -> [] | v -> [v] in
Sx_runtime.trampoline (Sx_runtime.sx_call f arg_list)
| [f; _] -> raise (Eval_error ("cek-call: not callable: " ^ type_of f))
| _ -> raise (Eval_error "cek-call: expected (fn args)"));
bind "cek-eval" (fun args ->
match args with [expr] -> Sx_ref.eval_expr expr (Env global_env) | [expr; e] -> Sx_ref.eval_expr expr e | _ -> Nil);
bind "qq-expand-runtime" (fun args ->
@@ -720,6 +762,7 @@ let () =
Js.Unsafe.set sx (Js.string "parse") (Js.wrap_callback api_parse);
Js.Unsafe.set sx (Js.string "stringify") (Js.wrap_callback api_stringify);
Js.Unsafe.set sx (Js.string "eval") (wrap api_eval);
Js.Unsafe.set sx (Js.string "evalVM") (wrap api_eval_vm);
Js.Unsafe.set sx (Js.string "evalExpr") (wrap api_eval_expr);
Js.Unsafe.set sx (Js.string "renderToHtml") (Js.wrap_callback api_render_to_html);
Js.Unsafe.set sx (Js.string "load") (Js.wrap_callback api_load);
@@ -737,4 +780,13 @@ let () =
Js.Unsafe.set sx (Js.string "fnArity") (Js.wrap_callback api_fn_arity);
Js.Unsafe.set sx (Js.string "debugEnv") (Js.wrap_callback api_debug_env);
(* Scope tracing API *)
Js.Unsafe.set sx (Js.string "scopeTraceOn") (Js.wrap_callback (fun () ->
Sx_scope.scope_trace_enable (); Js.Unsafe.inject Js.null));
Js.Unsafe.set sx (Js.string "scopeTraceOff") (Js.wrap_callback (fun () ->
Sx_scope.scope_trace_disable (); Js.Unsafe.inject Js.null));
Js.Unsafe.set sx (Js.string "scopeTraceDrain") (Js.wrap_callback (fun () ->
let log = Sx_scope.scope_trace_drain () in
Js.Unsafe.inject (Js.array (Array.of_list (List.map (fun s -> Js.Unsafe.inject (Js.string s)) log)))));
Js.Unsafe.set Js.Unsafe.global (Js.string "SxKernel") sx

View File

@@ -12,6 +12,16 @@ open Sx_types
Used by aser for spread/provide/emit patterns, CSSX collect/flush, etc. *)
let scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8
(** Debug trace for scope operations — enabled from JS *)
let _scope_trace = ref false
let _scope_log : string list ref = ref []
let scope_trace_enable () = _scope_trace := true; _scope_log := []
let scope_trace_disable () = _scope_trace := false
let scope_trace_drain () =
let log = List.rev !_scope_log in
_scope_log := [];
log
(** Request cookies — set by the Python bridge before each render.
get-cookie reads from here; set-cookie is a no-op on the server. *)
let request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8
@@ -40,6 +50,8 @@ let () =
match args with
| [String name; value] ->
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
if !_scope_trace then
_scope_log := Printf.sprintf "PUSH %s depth=%d->%d" name (List.length stack) (List.length stack + 1) :: !_scope_log;
Hashtbl.replace scope_stacks name (value :: stack); Nil
| _ -> Nil);
@@ -47,6 +59,8 @@ let () =
match args with
| [String name] ->
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
if !_scope_trace then
_scope_log := Printf.sprintf "POP %s depth=%d->%d" name (List.length stack) (max 0 (List.length stack - 1)) :: !_scope_log;
(match stack with _ :: rest -> Hashtbl.replace scope_stacks name rest | [] -> ()); Nil
| _ -> Nil);
@@ -54,6 +68,8 @@ let () =
match args with
| [String name] ->
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
if !_scope_trace then
_scope_log := Printf.sprintf "PEEK %s depth=%d found=%b" name (List.length stack) (stack <> []) :: !_scope_log;
(match stack with v :: _ -> v | [] -> Nil)
| _ -> Nil);
@@ -63,6 +79,8 @@ let () =
match args with
| [String name] | [String name; _] ->
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
if !_scope_trace then
_scope_log := Printf.sprintf "CTX %s depth=%d found=%b" name (List.length stack) (stack <> []) :: !_scope_log;
(match stack, args with
| v :: _, _ -> v
| [], [_; default_val] -> default_val

File diff suppressed because it is too large Load Diff

File diff suppressed because one or more lines are too long

View File

@@ -1,227 +1,221 @@
;; ==========================================================================
;; browser.sx — Browser API library functions
;;
;; Location, history, storage, cookies, timers, fetch — all expressed
;; using the host FFI primitives. Library functions, not primitives.
;; ==========================================================================
(define
browser-location-href
(fn () (host-get (host-get (dom-window) "location") "href")))
(define
browser-location-pathname
(fn () (host-get (host-get (dom-window) "location") "pathname")))
;; --------------------------------------------------------------------------
;; Location & navigation
;; --------------------------------------------------------------------------
(define
browser-location-origin
(fn () (host-get (host-get (dom-window) "location") "origin")))
(define browser-location-href
(fn ()
(host-get (host-get (dom-window) "location") "href")))
(define
browser-same-origin?
(fn (url) (starts-with? url (browser-location-origin))))
(define browser-location-pathname
(fn ()
(host-get (host-get (dom-window) "location") "pathname")))
(define browser-location-origin
(fn ()
(host-get (host-get (dom-window) "location") "origin")))
(define browser-same-origin?
(fn (url)
(starts-with? url (browser-location-origin))))
;; Extract pathname from a URL string using the URL API
(define url-pathname
(fn (url)
(define
url-pathname
(fn
(url)
(host-get (host-new "URL" url (browser-location-origin)) "pathname")))
(define browser-push-state
(fn (url-or-state &rest rest)
(if (empty? rest)
;; Single arg: just URL
(host-call (host-get (dom-window) "history") "pushState" nil "" url-or-state)
;; Three args: state, title, url
(host-call (host-get (dom-window) "history") "pushState" url-or-state (first rest) (nth rest 1)))))
(define
browser-push-state
(fn
(url-or-state title url)
(if
(nil? title)
(host-call
(host-get (dom-window) "history")
"pushState"
nil
""
url-or-state)
(host-call
(host-get (dom-window) "history")
"pushState"
url-or-state
title
url))))
(define browser-replace-state
(fn (url-or-state &rest rest)
(if (empty? rest)
(host-call (host-get (dom-window) "history") "replaceState" nil "" url-or-state)
(host-call (host-get (dom-window) "history") "replaceState" url-or-state (first rest) (nth rest 1)))))
(define
browser-replace-state
(fn
(url-or-state title url)
(if
(nil? title)
(host-call
(host-get (dom-window) "history")
"replaceState"
nil
""
url-or-state)
(host-call
(host-get (dom-window) "history")
"replaceState"
url-or-state
title
url))))
(define browser-reload
(fn ()
(host-call (host-get (dom-window) "location") "reload")))
(define
browser-reload
(fn () (host-call (host-get (dom-window) "location") "reload")))
(define browser-navigate
(fn (url)
(host-set! (host-get (dom-window) "location") "href" url)))
(define
browser-navigate
(fn (url) (host-set! (host-get (dom-window) "location") "href" url)))
;; --------------------------------------------------------------------------
;; Storage
;; --------------------------------------------------------------------------
(define local-storage-get
(fn (key)
(define
local-storage-get
(fn
(key)
(host-call (host-get (dom-window) "localStorage") "getItem" key)))
(define local-storage-set
(fn (key val)
(define
local-storage-set
(fn
(key val)
(host-call (host-get (dom-window) "localStorage") "setItem" key val)))
(define local-storage-remove
(fn (key)
(define
local-storage-remove
(fn
(key)
(host-call (host-get (dom-window) "localStorage") "removeItem" key)))
;; --------------------------------------------------------------------------
;; Timers
;; --------------------------------------------------------------------------
(define set-timeout
(fn (fn-val ms)
(define
set-timeout
(fn
(fn-val ms)
(host-call (dom-window) "setTimeout" (host-callback fn-val) ms)))
(define set-interval
(fn (fn-val ms)
(define
set-interval
(fn
(fn-val ms)
(host-call (dom-window) "setInterval" (host-callback fn-val) ms)))
(define clear-timeout
(fn (id)
(host-call (dom-window) "clearTimeout" id)))
(define clear-timeout (fn (id) (host-call (dom-window) "clearTimeout" id)))
(define clear-interval
(fn (id)
(host-call (dom-window) "clearInterval" id)))
(define
clear-interval
(fn (id) (host-call (dom-window) "clearInterval" id)))
(define request-animation-frame
(fn (fn-val)
(define
request-animation-frame
(fn
(fn-val)
(host-call (dom-window) "requestAnimationFrame" (host-callback fn-val))))
(define
fetch-request
(fn (url opts) (host-call (dom-window) "fetch" url opts)))
;; --------------------------------------------------------------------------
;; Fetch
;; --------------------------------------------------------------------------
(define new-abort-controller (fn () (host-new "AbortController")))
(define fetch-request
(fn (url opts)
(host-call (dom-window) "fetch" url opts)))
(define controller-signal (fn (controller) (host-get controller "signal")))
(define new-abort-controller
(fn ()
(host-new "AbortController")))
(define controller-abort (fn (controller) (host-call controller "abort")))
(define controller-signal
(fn (controller)
(host-get controller "signal")))
(define controller-abort
(fn (controller)
(host-call controller "abort")))
;; --------------------------------------------------------------------------
;; Promises
;; --------------------------------------------------------------------------
(define promise-then
(fn (p on-resolve on-reject)
(let ((cb-resolve (host-callback on-resolve))
(cb-reject (if on-reject (host-callback on-reject) nil)))
(if cb-reject
(define
promise-then
(fn
(p on-resolve on-reject)
(let
((cb-resolve (host-callback on-resolve))
(cb-reject (if on-reject (host-callback on-reject) nil)))
(if
cb-reject
(host-call (host-call p "then" cb-resolve) "catch" cb-reject)
(host-call p "then" cb-resolve)))))
(define promise-resolve
(fn (val)
(host-call (host-global "Promise") "resolve" val)))
(define
promise-resolve
(fn (val) (host-call (host-global "Promise") "resolve" val)))
(define promise-delayed
(fn (ms val)
(host-new "Promise" (host-callback
(fn (resolve)
(set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
(define
promise-delayed
(fn
(ms val)
(host-new
"Promise"
(host-callback
(fn
(resolve)
(set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
(define browser-confirm (fn (msg) (host-call (dom-window) "confirm" msg)))
;; --------------------------------------------------------------------------
;; Dialogs & media
;; --------------------------------------------------------------------------
(define
browser-prompt
(fn (msg default) (host-call (dom-window) "prompt" msg default)))
(define browser-confirm
(fn (msg) (host-call (dom-window) "confirm" msg)))
(define browser-prompt
(fn (msg default)
(host-call (dom-window) "prompt" msg default)))
(define browser-media-matches?
(fn (query)
(define
browser-media-matches?
(fn
(query)
(host-get (host-call (dom-window) "matchMedia" query) "matches")))
(define json-parse (fn (s) (host-call (host-global "JSON") "parse" s)))
;; --------------------------------------------------------------------------
;; JSON
;; --------------------------------------------------------------------------
(define
log-info
(fn (msg) (host-call (host-global "console") "log" (str "[sx] " msg))))
(define json-parse
(fn (s)
(host-call (host-global "JSON") "parse" s)))
(define
log-warn
(fn (msg) (host-call (host-global "console") "warn" (str "[sx] " msg))))
(define
console-log
(fn (msg) (host-call (host-global "console") "log" (str "[sx] " msg))))
;; --------------------------------------------------------------------------
;; Console
;; --------------------------------------------------------------------------
(define now-ms (fn () (host-call (host-global "Date") "now")))
(define log-info
(fn (msg)
(host-call (host-global "console") "log" (str "[sx] " msg))))
(define log-warn
(fn (msg)
(host-call (host-global "console") "warn" (str "[sx] " msg))))
(define console-log
(fn (&rest args)
(host-call (host-global "console") "log"
(join " " (cons "[sx]" (map str args))))))
(define now-ms
(fn ()
(host-call (host-global "Date") "now")))
;; --------------------------------------------------------------------------
;; Scheduling
;; --------------------------------------------------------------------------
(define schedule-idle
(fn (f)
(let ((cb (host-callback (fn (_deadline) (f)))))
(if (host-get (dom-window) "requestIdleCallback")
(define
schedule-idle
(fn
(f)
(let
((cb (host-callback (fn (_deadline) (f)))))
(if
(host-get (dom-window) "requestIdleCallback")
(host-call (dom-window) "requestIdleCallback" cb)
(set-timeout cb 0)))))
(define
set-cookie
(fn
(name value days)
(let
((d (or days 365))
(expires
(host-call
(host-new
"Date"
(+ (host-call (host-global "Date") "now") (* d 86400000)))
"toUTCString")))
(host-set!
(dom-document)
"cookie"
(str
name
"="
(host-call nil "encodeURIComponent" value)
";expires="
expires
";path=/;SameSite=Lax")))))
;; --------------------------------------------------------------------------
;; Cookies
;; --------------------------------------------------------------------------
(define set-cookie
(fn (name value days)
(let ((d (or days 365))
(expires (host-call
(host-new "Date"
(+ (host-call (host-global "Date") "now")
(* d 864e5)))
"toUTCString")))
(host-set! (dom-document) "cookie"
(str name "="
(host-call nil "encodeURIComponent" value)
";expires=" expires ";path=/;SameSite=Lax")))))
(define get-cookie
(fn (name)
(let ((cookies (host-get (dom-document) "cookie"))
(match (host-call cookies "match"
(host-new "RegExp"
(str "(?:^|;\\s*)" name "=([^;]*)")))))
(if match
(host-call nil "decodeURIComponent" (host-get match 1))
nil))))
(define
get-cookie
(fn
(name)
(let
((cookies (host-get (dom-document) "cookie"))
(match
(host-call
cookies
"match"
(host-new "RegExp" (str "(?:^|;\\s*)" name "=([^;]*)")))))
(if match (host-call nil "decodeURIComponent" (host-get match 1)) nil))))

File diff suppressed because one or more lines are too long

View File

@@ -1,4 +1,8 @@
(define make-signal (fn (value) (dict "__signal" true "value" value "subscribers" (list) "deps" (list))))
(define
make-signal
(fn
(value)
(dict "__signal" true "value" value "subscribers" (list) "deps" (list))))
(define signal? (fn (x) (and (dict? x) (has-key? x "__signal"))))
@@ -8,38 +12,179 @@
(define signal-subscribers (fn (s) (get s "subscribers")))
(define signal-add-sub! (fn (s f) (when (not (contains? (get s "subscribers") f)) (append! (get s "subscribers") f))))
(define
signal-add-sub!
(fn
(s f)
(when
(not (contains? (get s "subscribers") f))
(append! (get s "subscribers") f))))
(define signal-remove-sub! (fn (s f) (dict-set! s "subscribers" (filter (fn (sub) (not (identical? sub f))) (get s "subscribers")))))
(define
signal-remove-sub!
(fn (s f) (let ((subs (get s "subscribers"))) (remove! subs f))))
(define signal-deps (fn (s) (get s "deps")))
(define signal-set-deps! (fn (s deps) (dict-set! s "deps" deps)))
(define signal :effects () (fn ((initial-value :as any)) (make-signal initial-value)))
(define
signal
:effects ()
(fn ((initial-value :as any)) (make-signal initial-value)))
(define deref :effects () (fn ((s :as any)) (if (not (signal? s)) s (let ((ctx (context "sx-reactive" nil))) (when ctx (let ((dep-list (get ctx "deps")) (notify-fn (get ctx "notify"))) (when (not (contains? dep-list s)) (append! dep-list s) (signal-add-sub! s notify-fn)))) (signal-value s)))))
(define
deref
:effects ()
(fn
((s :as any))
(if
(not (signal? s))
s
(let
((ctx (context "sx-reactive" nil)))
(when
ctx
(let
((dep-list (get ctx "deps")) (notify-fn (get ctx "notify")))
(when
(not (contains? dep-list s))
(append! dep-list s)
(signal-add-sub! s notify-fn))))
(signal-value s)))))
(define reset! :effects (mutation) (fn ((s :as signal) value) (when (signal? s) (let ((old (signal-value s))) (when (not (identical? old value)) (signal-set-value! s value) (notify-subscribers s))))))
(define
reset!
:effects (mutation)
(fn
((s :as signal) value)
(when
(signal? s)
(let
((old (signal-value s)))
(when
(not (identical? old value))
(signal-set-value! s value)
(notify-subscribers s))))))
(define swap! :effects (mutation) (fn ((s :as signal) (f :as lambda) &rest args) (when (signal? s) (let ((old (signal-value s)) (new-val (trampoline (apply f (cons old args))))) (when (not (identical? old new-val)) (signal-set-value! s new-val) (notify-subscribers s))))))
(define
swap!
:effects (mutation)
(fn
((s :as signal) (f :as lambda) &rest args)
(when
(signal? s)
(let
((old (signal-value s))
(new-val (trampoline (apply f (cons old args)))))
(when
(not (identical? old new-val))
(signal-set-value! s new-val)
(notify-subscribers s))))))
(define computed :effects (mutation) (fn ((compute-fn :as lambda)) (let ((s (make-signal nil)) (deps (list)) (compute-ctx nil)) (let ((recompute (fn () (for-each (fn ((dep :as signal)) (signal-remove-sub! dep recompute)) (signal-deps s)) (signal-set-deps! s (list)) (let ((ctx (dict "deps" (list) "notify" recompute))) (scope-push! "sx-reactive" ctx) (let ((new-val (cek-call compute-fn nil))) (scope-pop! "sx-reactive") (signal-set-deps! s (get ctx "deps")) (let ((old (signal-value s))) (signal-set-value! s new-val) (when (not (identical? old new-val)) (notify-subscribers s)))))))) (recompute) (register-in-scope (fn () (dispose-computed s))) s))))
(define
computed
:effects (mutation)
(fn
((compute-fn :as lambda))
(let
((s (make-signal nil)) (deps (list)) (compute-ctx nil))
(let
((recompute (fn () (for-each (fn ((dep :as signal)) (signal-remove-sub! dep recompute)) (signal-deps s)) (signal-set-deps! s (list)) (let ((ctx (dict "deps" (list) "notify" recompute))) (scope-push! "sx-reactive" ctx) (let ((new-val (compute-fn))) (scope-pop! "sx-reactive") (signal-set-deps! s (get ctx "deps")) (let ((old (signal-value s))) (signal-set-value! s new-val) (when (not (identical? old new-val)) (notify-subscribers s))))))))
(recompute)
(register-in-scope (fn () (dispose-computed s)))
s))))
(define effect :effects (mutation) (fn ((effect-fn :as lambda)) (let ((deps (list)) (disposed false) (cleanup-fn nil)) (let ((run-effect (fn () (when (not disposed) (when cleanup-fn (cek-call cleanup-fn nil)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list)) (let ((ctx (dict "deps" (list) "notify" run-effect))) (scope-push! "sx-reactive" ctx) (let ((result (cek-call effect-fn nil))) (scope-pop! "sx-reactive") (set! deps (get ctx "deps")) (when (callable? result) (set! cleanup-fn result)))))))) (run-effect) (let ((dispose-fn (fn () (set! disposed true) (when cleanup-fn (cek-call cleanup-fn nil)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list))))) (register-in-scope dispose-fn) dispose-fn)))))
(define
effect
:effects (mutation)
(fn
((effect-fn :as lambda))
(let
((deps (list)) (disposed false) (cleanup-fn nil))
(let
((run-effect (fn () (when (not disposed) (when cleanup-fn (cleanup-fn)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list)) (let ((ctx (dict "deps" (list) "notify" run-effect))) (scope-push! "sx-reactive" ctx) (let ((result (effect-fn))) (scope-pop! "sx-reactive") (set! deps (get ctx "deps")) (when (callable? result) (set! cleanup-fn result))))))))
(run-effect)
(let
((dispose-fn (fn () (set! disposed true) (when cleanup-fn (cleanup-fn)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list)))))
(register-in-scope dispose-fn)
dispose-fn)))))
(define *batch-depth* 0)
(define *batch-queue* (list))
(define batch :effects (mutation) (fn ((thunk :as lambda)) (set! *batch-depth* (+ *batch-depth* 1)) (cek-call thunk nil) (set! *batch-depth* (- *batch-depth* 1)) (when (= *batch-depth* 0) (let ((queue *batch-queue*)) (set! *batch-queue* (list)) (let ((seen (list)) (pending (list))) (for-each (fn ((s :as signal)) (for-each (fn ((sub :as lambda)) (when (not (contains? seen sub)) (append! seen sub) (append! pending sub))) (signal-subscribers s))) queue) (for-each (fn ((sub :as lambda)) (sub)) pending))))))
(define
batch
:effects (mutation)
(fn
((thunk :as lambda))
(set! *batch-depth* (+ *batch-depth* 1))
(thunk)
(set! *batch-depth* (- *batch-depth* 1))
(when
(= *batch-depth* 0)
(let
((queue *batch-queue*))
(set! *batch-queue* (list))
(let
((seen (list)) (pending (list)))
(for-each
(fn
((s :as signal))
(for-each
(fn
((sub :as lambda))
(when
(not (contains? seen sub))
(append! seen sub)
(append! pending sub)))
(signal-subscribers s)))
queue)
(for-each (fn ((sub :as lambda)) (sub)) pending))))))
(define notify-subscribers :effects (mutation) (fn ((s :as signal)) (if (> *batch-depth* 0) (when (not (contains? *batch-queue* s)) (append! *batch-queue* s)) (flush-subscribers s))))
(define
notify-subscribers
:effects (mutation)
(fn
((s :as signal))
(if
(> *batch-depth* 0)
(when (not (contains? *batch-queue* s)) (append! *batch-queue* s))
(flush-subscribers s))))
(define flush-subscribers :effects (mutation) (fn ((s :as signal)) (for-each (fn ((sub :as lambda)) (sub)) (signal-subscribers s))))
(define
flush-subscribers
:effects (mutation)
(fn
((s :as signal))
(for-each (fn ((sub :as lambda)) (sub)) (signal-subscribers s))))
(define dispose-computed :effects (mutation) (fn ((s :as signal)) (when (signal? s) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep nil)) (signal-deps s)) (signal-set-deps! s (list)))))
(define
dispose-computed
:effects (mutation)
(fn
((s :as signal))
(when
(signal? s)
(for-each
(fn ((dep :as signal)) (signal-remove-sub! dep nil))
(signal-deps s))
(signal-set-deps! s (list)))))
(define with-island-scope :effects (mutation) (fn ((scope-fn :as lambda) (body-fn :as lambda)) (scope-push! "sx-island-scope" scope-fn) (let ((result (body-fn))) (scope-pop! "sx-island-scope") result)))
(define
with-island-scope
:effects (mutation)
(fn
((scope-fn :as lambda) (body-fn :as lambda))
(scope-push! "sx-island-scope" scope-fn)
(let ((result (body-fn))) (scope-pop! "sx-island-scope") result)))
(define register-in-scope :effects (mutation) (fn ((disposable :as lambda)) (let ((collector (scope-peek "sx-island-scope"))) (when collector (cek-call collector (list disposable))))))
(define
register-in-scope
:effects (mutation)
(fn
((disposable :as lambda))
(let
((collector (scope-peek "sx-island-scope")))
(when collector (cek-call collector (list disposable))))))

File diff suppressed because one or more lines are too long

View File

@@ -9,13 +9,11 @@
(define
dom-create-element
(fn
(tag &rest ns-arg)
(let
((ns (if (and ns-arg (not (empty? ns-arg))) (first ns-arg) nil)))
(if
ns
(host-call (dom-document) "createElementNS" ns tag)
(host-call (dom-document) "createElement" tag)))))
(tag ns)
(if
ns
(host-call (dom-document) "createElementNS" ns tag)
(host-call (dom-document) "createElement" tag))))
(define
create-text-node
@@ -128,11 +126,11 @@
(define
dom-query
(fn
(root-or-sel &rest rest)
(root-or-sel sel)
(if
(empty? rest)
(nil? sel)
(host-call (dom-document) "querySelector" root-or-sel)
(host-call root-or-sel "querySelector" (first rest)))))
(host-call root-or-sel "querySelector" sel))))
(define
dom-query-all
@@ -342,12 +340,12 @@
(define
dom-add-listener
(fn
(el event-name handler &rest opts)
(el event-name handler opts)
(let
((cb (host-callback handler)))
(if
(and opts (not (empty? opts)))
(host-call el "addEventListener" event-name cb (first opts))
opts
(host-call el "addEventListener" event-name cb opts)
(host-call el "addEventListener" event-name cb))
(fn () (host-call el "removeEventListener" event-name cb)))))

File diff suppressed because one or more lines are too long

View File

@@ -1,21 +1,110 @@
(define assert-signal-value :effects () (fn ((sig :as any) expected) (let ((actual (deref sig))) (assert= actual expected (str "Expected signal value " expected ", got " actual)))))
(define
assert-signal-value
:effects ()
(fn
((sig :as any) expected)
(let
((actual (deref sig)))
(assert=
actual
expected
(str "Expected signal value " expected ", got " actual)))))
(define assert-signal-has-subscribers :effects () (fn ((sig :as any)) (assert (> (len (signal-subscribers sig)) 0) "Expected signal to have subscribers")))
(define
assert-signal-has-subscribers
:effects ()
(fn
((sig :as any))
(assert
(> (len (signal-subscribers sig)) 0)
"Expected signal to have subscribers")))
(define assert-signal-no-subscribers :effects () (fn ((sig :as any)) (assert (= (len (signal-subscribers sig)) 0) "Expected signal to have no subscribers")))
(define
assert-signal-no-subscribers
:effects ()
(fn
((sig :as any))
(assert
(= (len (signal-subscribers sig)) 0)
"Expected signal to have no subscribers")))
(define assert-signal-subscriber-count :effects () (fn ((sig :as any) (n :as number)) (let ((actual (len (signal-subscribers sig)))) (assert= actual n (str "Expected " n " subscribers, got " actual)))))
(define
assert-signal-subscriber-count
:effects ()
(fn
((sig :as any) (n :as number))
(let
((actual (len (signal-subscribers sig))))
(assert= actual n (str "Expected " n " subscribers, got " actual)))))
(define simulate-signal-set! :effects (mutation) (fn ((sig :as any) value) (reset! sig value)))
(define
simulate-signal-set!
:effects (mutation)
(fn ((sig :as any) value) (reset! sig value)))
(define simulate-signal-swap! :effects (mutation) (fn ((sig :as any) (f :as lambda) &rest args) (apply swap! (cons sig (cons f args)))))
(define
simulate-signal-swap!
:effects (mutation)
(fn ((sig :as any) (f :as lambda)) (swap! sig f)))
(define assert-computed-dep-count :effects () (fn ((sig :as any) (n :as number)) (let ((actual (len (signal-deps sig)))) (assert= actual n (str "Expected " n " deps, got " actual)))))
(define
assert-computed-dep-count
:effects ()
(fn
((sig :as any) (n :as number))
(let
((actual (len (signal-deps sig))))
(assert= actual n (str "Expected " n " deps, got " actual)))))
(define assert-computed-depends-on :effects () (fn ((computed-sig :as any) (dep-sig :as any)) (assert (contains? (signal-deps computed-sig) dep-sig) "Expected computed to depend on the given signal")))
(define
assert-computed-depends-on
:effects ()
(fn
((computed-sig :as any) (dep-sig :as any))
(assert
(contains? (signal-deps computed-sig) dep-sig)
"Expected computed to depend on the given signal")))
(define count-effect-runs :effects (mutation) (fn ((thunk :as lambda)) (let ((count (signal 0))) (effect (fn () (deref count))) (let ((run-count 0) (tracker (effect (fn () (set! run-count (+ run-count 1)) (cek-call thunk nil))))) run-count))))
(define
count-effect-runs
:effects (mutation)
(fn
((thunk :as lambda))
(let
((count (signal 0)))
(effect (fn () (deref count)))
(let
((run-count 0)
(tracker
(effect
(fn () (set! run-count (+ run-count 1)) (cek-call thunk nil)))))
run-count))))
(define make-test-signal :effects (mutation) (fn (initial-value) (let ((sig (signal initial-value)) (history (list))) (effect (fn () (append! history (deref sig)))) {:signal sig :history history})))
(define
make-test-signal
:effects (mutation)
(fn
(initial-value)
(let
((sig (signal initial-value)) (history (list)))
(effect (fn () (append! history (deref sig))))
{:signal sig :history history})))
(define assert-batch-coalesces :effects (mutation) (fn ((thunk :as lambda) (expected-notify-count :as number)) (let ((notify-count 0) (sig (signal 0))) (effect (fn () (deref sig) (set! notify-count (+ notify-count 1)))) (set! notify-count 0) (batch thunk) (assert= notify-count expected-notify-count (str "Expected " expected-notify-count " notifications, got " notify-count)))))
(define
assert-batch-coalesces
:effects (mutation)
(fn
((thunk :as lambda) (expected-notify-count :as number))
(let
((notify-count 0) (sig (signal 0)))
(effect (fn () (deref sig) (set! notify-count (+ notify-count 1))))
(set! notify-count 0)
(batch thunk)
(assert=
notify-count
expected-notify-count
(str
"Expected "
expected-notify-count
" notifications, got "
notify-count)))))

View File

@@ -1 +1 @@
{"magic":"SXBC","version":1,"hash":"93780bb9539e858f","module":{"bytecode":[51,1,0,128,0,0,5,51,3,0,128,2,0,5,51,5,0,128,4,0,5,51,7,0,128,6,0,5,51,9,0,128,8,0,5,51,11,0,128,10,0,5,51,13,0,128,12,0,5,51,15,0,128,14,0,5,51,17,0,128,16,0,5,51,19,0,128,18,0,5,51,21,0,128,20,0,50],"constants":[{"t":"s","v":"assert-signal-value"},{"t":"code","v":{"bytecode":[20,0,0,16,0,48,1,17,2,20,1,0,16,2,16,1,1,3,0,16,1,1,4,0,16,2,52,2,0,4,49,3,50],"constants":[{"t":"s","v":"deref"},{"t":"s","v":"assert="},{"t":"s","v":"str"},{"t":"s","v":"Expected signal value "},{"t":"s","v":", got "}],"arity":2}},{"t":"s","v":"assert-signal-has-subscribers"},{"t":"code","v":{"bytecode":[20,0,0,20,3,0,16,0,48,1,52,2,0,1,1,4,0,52,1,0,2,1,5,0,49,2,50],"constants":[{"t":"s","v":"assert"},{"t":"s","v":">"},{"t":"s","v":"len"},{"t":"s","v":"signal-subscribers"},{"t":"n","v":0},{"t":"s","v":"Expected signal to have subscribers"}],"arity":1}},{"t":"s","v":"assert-signal-no-subscribers"},{"t":"code","v":{"bytecode":[20,0,0,20,3,0,16,0,48,1,52,2,0,1,1,4,0,52,1,0,2,1,5,0,49,2,50],"constants":[{"t":"s","v":"assert"},{"t":"s","v":"="},{"t":"s","v":"len"},{"t":"s","v":"signal-subscribers"},{"t":"n","v":0},{"t":"s","v":"Expected signal to have no subscribers"}],"arity":1}},{"t":"s","v":"assert-signal-subscriber-count"},{"t":"code","v":{"bytecode":[20,1,0,16,0,48,1,52,0,0,1,17,2,20,2,0,16,2,16,1,1,4,0,16,1,1,5,0,16,2,52,3,0,4,49,3,50],"constants":[{"t":"s","v":"len"},{"t":"s","v":"signal-subscribers"},{"t":"s","v":"assert="},{"t":"s","v":"str"},{"t":"s","v":"Expected "},{"t":"s","v":" subscribers, got "}],"arity":2}},{"t":"s","v":"simulate-signal-set!"},{"t":"code","v":{"bytecode":[20,0,0,16,0,16,1,49,2,50],"constants":[{"t":"s","v":"reset!"}],"arity":2}},{"t":"s","v":"simulate-signal-swap!"},{"t":"code","v":{"bytecode":[20,1,0,16,0,16,1,16,2,52,2,0,2,52,2,0,2,52,0,0,2,50],"constants":[{"t":"s","v":"apply"},{"t":"s","v":"swap!"},{"t":"s","v":"cons"}],"arity":3}},{"t":"s","v":"assert-computed-dep-count"},{"t":"code","v":{"bytecode":[20,1,0,16,0,48,1,52,0,0,1,17,2,20,2,0,16,2,16,1,1,4,0,16,1,1,5,0,16,2,52,3,0,4,49,3,50],"constants":[{"t":"s","v":"len"},{"t":"s","v":"signal-deps"},{"t":"s","v":"assert="},{"t":"s","v":"str"},{"t":"s","v":"Expected "},{"t":"s","v":" deps, got "}],"arity":2}},{"t":"s","v":"assert-computed-depends-on"},{"t":"code","v":{"bytecode":[20,0,0,20,2,0,16,0,48,1,16,1,52,1,0,2,1,3,0,49,2,50],"constants":[{"t":"s","v":"assert"},{"t":"s","v":"contains?"},{"t":"s","v":"signal-deps"},{"t":"s","v":"Expected computed to depend on the given signal"}],"arity":2}},{"t":"s","v":"count-effect-runs"},{"t":"code","v":{"bytecode":[20,0,0,1,1,0,48,1,17,1,20,2,0,51,3,0,1,1,48,1,5,1,1,0,17,2,20,2,0,51,4,0,1,2,1,0,48,1,17,3,16,2,50],"constants":[{"t":"s","v":"signal"},{"t":"n","v":0},{"t":"s","v":"effect"},{"t":"code","v":{"bytecode":[20,0,0,18,0,49,1,50],"constants":[{"t":"s","v":"deref"}],"upvalue-count":1}},{"t":"code","v":{"bytecode":[18,0,1,1,0,52,0,0,2,19,0,5,20,2,0,18,1,2,49,2,50],"constants":[{"t":"s","v":"+"},{"t":"n","v":1},{"t":"s","v":"cek-call"}],"upvalue-count":2}}],"arity":1}},{"t":"s","v":"make-test-signal"},{"t":"code","v":{"bytecode":[20,0,0,16,0,48,1,17,1,52,1,0,0,17,2,20,2,0,51,3,0,1,2,1,1,48,1,5,1,0,0,16,1,1,4,0,16,2,65,2,0,50],"constants":[{"t":"s","v":"signal"},{"t":"s","v":"list"},{"t":"s","v":"effect"},{"t":"code","v":{"bytecode":[20,0,0,18,0,20,1,0,18,1,48,1,49,2,50],"constants":[{"t":"s","v":"append!"},{"t":"s","v":"deref"}],"upvalue-count":2}},{"t":"s","v":"history"}],"arity":1}},{"t":"s","v":"assert-batch-coalesces"},{"t":"code","v":{"bytecode":[1,0,0,17,2,20,1,0,1,0,0,48,1,17,3,20,2,0,51,3,0,1,3,1,2,48,1,5,1,0,0,17,2,5,20,4,0,16,0,48,1,5,20,5,0,16,2,16,1,1,7,0,16,1,1,8,0,16,2,52,6,0,4,49,3,50],"constants":[{"t":"n","v":0},{"t":"s","v":"signal"},{"t":"s","v":"effect"},{"t":"code","v":{"bytecode":[20,0,0,18,0,48,1,5,18,1,1,2,0,52,1,0,2,19,1,50],"constants":[{"t":"s","v":"deref"},{"t":"s","v":"+"},{"t":"n","v":1}],"upvalue-count":2}},{"t":"s","v":"batch"},{"t":"s","v":"assert="},{"t":"s","v":"str"},{"t":"s","v":"Expected "},{"t":"s","v":" notifications, got "}],"arity":2}}]}}
{"magic":"SXBC","version":1,"hash":"57726b5b82c1a3cb","module":{"bytecode":[51,1,0,128,0,0,5,51,3,0,128,2,0,5,51,5,0,128,4,0,5,51,7,0,128,6,0,5,51,9,0,128,8,0,5,51,11,0,128,10,0,5,51,13,0,128,12,0,5,51,15,0,128,14,0,5,51,17,0,128,16,0,5,51,19,0,128,18,0,5,51,21,0,128,20,0,50],"constants":[{"t":"s","v":"assert-signal-value"},{"t":"code","v":{"bytecode":[20,0,0,16,0,48,1,17,2,20,1,0,16,2,16,1,1,3,0,16,1,1,4,0,16,2,52,2,0,4,49,3,50],"constants":[{"t":"s","v":"deref"},{"t":"s","v":"assert="},{"t":"s","v":"str"},{"t":"s","v":"Expected signal value "},{"t":"s","v":", got "}],"arity":2}},{"t":"s","v":"assert-signal-has-subscribers"},{"t":"code","v":{"bytecode":[20,0,0,20,3,0,16,0,48,1,52,2,0,1,1,4,0,52,1,0,2,1,5,0,49,2,50],"constants":[{"t":"s","v":"assert"},{"t":"s","v":">"},{"t":"s","v":"len"},{"t":"s","v":"signal-subscribers"},{"t":"n","v":0},{"t":"s","v":"Expected signal to have subscribers"}],"arity":1}},{"t":"s","v":"assert-signal-no-subscribers"},{"t":"code","v":{"bytecode":[20,0,0,20,3,0,16,0,48,1,52,2,0,1,1,4,0,52,1,0,2,1,5,0,49,2,50],"constants":[{"t":"s","v":"assert"},{"t":"s","v":"="},{"t":"s","v":"len"},{"t":"s","v":"signal-subscribers"},{"t":"n","v":0},{"t":"s","v":"Expected signal to have no subscribers"}],"arity":1}},{"t":"s","v":"assert-signal-subscriber-count"},{"t":"code","v":{"bytecode":[20,1,0,16,0,48,1,52,0,0,1,17,2,20,2,0,16,2,16,1,1,4,0,16,1,1,5,0,16,2,52,3,0,4,49,3,50],"constants":[{"t":"s","v":"len"},{"t":"s","v":"signal-subscribers"},{"t":"s","v":"assert="},{"t":"s","v":"str"},{"t":"s","v":"Expected "},{"t":"s","v":" subscribers, got "}],"arity":2}},{"t":"s","v":"simulate-signal-set!"},{"t":"code","v":{"bytecode":[20,0,0,16,0,16,1,49,2,50],"constants":[{"t":"s","v":"reset!"}],"arity":2}},{"t":"s","v":"simulate-signal-swap!"},{"t":"code","v":{"bytecode":[20,0,0,16,0,16,1,49,2,50],"constants":[{"t":"s","v":"swap!"}],"arity":2}},{"t":"s","v":"assert-computed-dep-count"},{"t":"code","v":{"bytecode":[20,1,0,16,0,48,1,52,0,0,1,17,2,20,2,0,16,2,16,1,1,4,0,16,1,1,5,0,16,2,52,3,0,4,49,3,50],"constants":[{"t":"s","v":"len"},{"t":"s","v":"signal-deps"},{"t":"s","v":"assert="},{"t":"s","v":"str"},{"t":"s","v":"Expected "},{"t":"s","v":" deps, got "}],"arity":2}},{"t":"s","v":"assert-computed-depends-on"},{"t":"code","v":{"bytecode":[20,0,0,20,2,0,16,0,48,1,16,1,52,1,0,2,1,3,0,49,2,50],"constants":[{"t":"s","v":"assert"},{"t":"s","v":"contains?"},{"t":"s","v":"signal-deps"},{"t":"s","v":"Expected computed to depend on the given signal"}],"arity":2}},{"t":"s","v":"count-effect-runs"},{"t":"code","v":{"bytecode":[20,0,0,1,1,0,48,1,17,1,20,2,0,51,3,0,1,1,48,1,5,1,1,0,17,2,20,2,0,51,4,0,1,2,1,0,48,1,17,3,16,2,50],"constants":[{"t":"s","v":"signal"},{"t":"n","v":0},{"t":"s","v":"effect"},{"t":"code","v":{"bytecode":[20,0,0,18,0,49,1,50],"constants":[{"t":"s","v":"deref"}],"upvalue-count":1}},{"t":"code","v":{"bytecode":[18,0,1,1,0,52,0,0,2,19,0,5,20,2,0,18,1,2,49,2,50],"constants":[{"t":"s","v":"+"},{"t":"n","v":1},{"t":"s","v":"cek-call"}],"upvalue-count":2}}],"arity":1}},{"t":"s","v":"make-test-signal"},{"t":"code","v":{"bytecode":[20,0,0,16,0,48,1,17,1,52,1,0,0,17,2,20,2,0,51,3,0,1,2,1,1,48,1,5,1,0,0,16,1,1,4,0,16,2,65,2,0,50],"constants":[{"t":"s","v":"signal"},{"t":"s","v":"list"},{"t":"s","v":"effect"},{"t":"code","v":{"bytecode":[20,0,0,18,0,20,1,0,18,1,48,1,49,2,50],"constants":[{"t":"s","v":"append!"},{"t":"s","v":"deref"}],"upvalue-count":2}},{"t":"s","v":"history"}],"arity":1}},{"t":"s","v":"assert-batch-coalesces"},{"t":"code","v":{"bytecode":[1,0,0,17,2,20,1,0,1,0,0,48,1,17,3,20,2,0,51,3,0,1,3,1,2,48,1,5,1,0,0,17,2,5,20,4,0,16,0,48,1,5,20,5,0,16,2,16,1,1,7,0,16,1,1,8,0,16,2,52,6,0,4,49,3,50],"constants":[{"t":"n","v":0},{"t":"s","v":"signal"},{"t":"s","v":"effect"},{"t":"code","v":{"bytecode":[20,0,0,18,0,48,1,5,18,1,1,2,0,52,1,0,2,19,1,50],"constants":[{"t":"s","v":"deref"},{"t":"s","v":"+"},{"t":"n","v":1}],"upvalue-count":2}},{"t":"s","v":"batch"},{"t":"s","v":"assert="},{"t":"s","v":"str"},{"t":"s","v":"Expected "},{"t":"s","v":" notifications, got "}],"arity":2}}]}}

File diff suppressed because one or more lines are too long

View File

@@ -575,10 +575,17 @@ async function modeHydrate(browser, url) {
// ---------------------------------------------------------------------------
async function modeEval(page, url, expr) {
// Capture ALL console during page load (before goto)
const bootLog = [];
page.on('console', msg => {
bootLog.push({ type: msg.type(), text: msg.text().slice(0, 300) });
});
await page.goto(BASE_URL + url, { waitUntil: 'networkidle', timeout: 15000 });
await waitForHydration(page);
const result = await page.evaluate(expr);
return { url, expr, result };
// Include boot log: errors always, all [sx] lines on request
const issues = bootLog.filter(l => l.type === 'error' || l.type === 'warning' || l.text.includes('FAIL') || l.text.includes('Error') || l.text.startsWith('[sx]'));
return { url, expr, result, bootLog: issues.length > 0 ? issues : undefined };
}
// ---------------------------------------------------------------------------
@@ -589,6 +596,12 @@ async function modeInteract(page, url, actionsStr) {
await page.goto(BASE_URL + url, { waitUntil: 'networkidle', timeout: 15000 });
await waitForHydration(page);
// Capture console during interaction
const consoleLogs = [];
page.on('console', msg => {
consoleLogs.push({ type: msg.type(), text: msg.text().slice(0, 300) });
});
const actions = actionsStr.split(';').map(a => a.trim()).filter(Boolean);
const results = [];
@@ -661,7 +674,9 @@ async function modeInteract(page, url, actionsStr) {
}
}
return { url, results };
// Include console errors/warnings in output
const errors = consoleLogs.filter(l => l.type === 'error' || l.type === 'warning');
return { url, results, console: errors.length > 0 ? errors : undefined };
}
// ---------------------------------------------------------------------------
@@ -685,9 +700,353 @@ async function modeScreenshot(page, url, selector) {
}
// ---------------------------------------------------------------------------
// Main
// Mode: listeners — CDP event listener inspection
// ---------------------------------------------------------------------------
async function modeListeners(page, url, selector) {
await page.goto(BASE_URL + url, { waitUntil: 'networkidle', timeout: 15000 });
await waitForHydration(page);
const cdp = await page.context().newCDPSession(page);
const results = {};
// Helper: get listeners for a JS expression
async function getListeners(expr, label) {
try {
const { result } = await cdp.send('Runtime.evaluate', { expression: expr });
if (!result?.objectId) return [];
const { listeners } = await cdp.send('DOMDebugger.getEventListeners', {
objectId: result.objectId, depth: 0,
});
return listeners.map(l => ({
type: l.type,
useCapture: l.useCapture,
passive: l.passive,
once: l.once,
handler: l.handler?.description?.slice(0, 200) || 'native',
scriptId: l.scriptId,
lineNumber: l.lineNumber,
columnNumber: l.columnNumber,
}));
} catch (e) { return [{ error: e.message }]; }
}
// Get listeners on the target element(s)
if (selector) {
const els = await page.$$(selector);
for (let i = 0; i < Math.min(els.length, 5); i++) {
const { result } = await cdp.send('Runtime.evaluate', {
expression: `document.querySelectorAll(${JSON.stringify(selector)})[${i}]`,
});
if (result?.objectId) {
const { listeners } = await cdp.send('DOMDebugger.getEventListeners', {
objectId: result.objectId, depth: 0,
});
const tag = await page.evaluate(
({sel, idx}) => {
const el = document.querySelectorAll(sel)[idx];
return el ? `<${el.tagName.toLowerCase()} ${el.getAttribute('href') || el.getAttribute('data-sx-island') || ''}>` : '?';
}, {sel: selector, idx: i});
results[`element[${i}] ${tag}`] = listeners.map(l => ({
type: l.type,
handler: l.handler?.description?.slice(0, 150) || 'native',
capture: l.useCapture,
}));
}
}
}
// Document listeners
results['document'] = (await getListeners('document', 'document'))
.filter(l => ['click', 'submit', 'input', 'change', 'keydown', 'keyup'].includes(l.type));
// Window listeners
results['window'] = (await getListeners('window', 'window'))
.filter(l => ['click', 'popstate', 'hashchange', 'beforeunload', 'load', 'DOMContentLoaded'].includes(l.type));
return { url, selector, listeners: results };
}
// ---------------------------------------------------------------------------
// Mode: trace — click and capture full execution trace
// ---------------------------------------------------------------------------
async function modeTrace(page, url, selector) {
await page.goto(BASE_URL + url, { waitUntil: 'networkidle', timeout: 15000 });
await waitForHydration(page);
const trace = {
console: [],
network: [],
pushState: [],
errors: [],
};
// Capture console
page.on('console', msg => {
trace.console.push({
type: msg.type(),
text: msg.text().slice(0, 300),
});
});
// Capture page errors
page.on('pageerror', err => {
trace.errors.push(err.message.slice(0, 300));
});
// Capture network requests
page.on('request', req => {
if (req.resourceType() === 'document' || req.resourceType() === 'xhr' || req.resourceType() === 'fetch') {
trace.network.push({
type: req.resourceType(),
method: req.method(),
url: req.url(),
isNav: req.isNavigationRequest(),
});
}
});
// Inject pushState/replaceState monitoring
await page.evaluate(() => {
for (const method of ['pushState', 'replaceState']) {
const orig = history[method];
history[method] = function() {
console.log(`[spa-trace] ${method}: ${arguments[2]}`);
return orig.apply(this, arguments);
};
}
});
// Snapshot before
const before = await page.evaluate(() => ({
url: location.href,
title: document.title,
}));
// Perform the action
if (!selector) {
return { error: 'trace mode requires a selector to click' };
}
const el = page.locator(selector).first();
const elInfo = await page.evaluate((sel) => {
const el = document.querySelector(sel);
return el ? { tag: el.tagName, text: el.textContent?.slice(0, 50), href: el.getAttribute('href') } : null;
}, selector);
let navigated = false;
page.once('framenavigated', () => { navigated = true; });
await el.click();
await page.waitForTimeout(2000);
// Snapshot after
const after = await page.evaluate(() => ({
url: location.href,
title: document.title,
}));
return {
url,
selector,
element: elInfo,
before,
after,
navigated,
urlChanged: before.url !== after.url,
trace,
};
}
// ---------------------------------------------------------------------------
// Mode: cdp — raw Chrome DevTools Protocol command
// ---------------------------------------------------------------------------
async function modeCdp(page, url, expr) {
await page.goto(BASE_URL + url, { waitUntil: 'networkidle', timeout: 15000 });
await waitForHydration(page);
const cdp = await page.context().newCDPSession(page);
// expr format: "Domain.method {json params}" e.g. "Runtime.evaluate {\"expression\":\"1+1\"}"
const spaceIdx = expr.indexOf(' ');
const method = spaceIdx > 0 ? expr.slice(0, spaceIdx) : expr;
const params = spaceIdx > 0 ? JSON.parse(expr.slice(spaceIdx + 1)) : {};
try {
const result = await cdp.send(method, params);
return { method, params, result };
} catch (e) {
return { method, params, error: e.message };
}
}
// ---------------------------------------------------------------------------
// Mode: reactive — debug reactive island signal/DOM state across interactions
//
// Instruments the live WASM kernel's signal system via global set! hooks,
// tags island DOM elements for stability tracking, then runs a sequence of
// actions. After each action, captures:
// - DOM text of reactive elements
// - Node stability (same/replaced/new)
// - Signal trace: swap!, set!, flush, add-sub, remove-sub, deref context
// - Console errors
//
// Hook strategy: SX-defined globals (swap!, deref, signal-set-value!, etc.)
// can be wrapped via set! because bytecode calls them through GLOBAL_GET.
// OCaml-native primitives (scope-push!, scope-peek) use CALL_PRIM and
// bypass globals — those are observed indirectly via deref's context check.
// ---------------------------------------------------------------------------
const REACTIVE_HOOKS = `
(do
;; signal-set-value! — log every signal mutation
(let ((orig signal-set-value!))
(set! signal-set-value!
(fn (s v)
(log-info (str "RX:SIG:" (signal-value s) "->" v))
(orig s v))))
;; flush-subscribers — log subscriber count at flush time
(let ((orig flush-subscribers))
(set! flush-subscribers
(fn (s)
(log-info (str "RX:FLUSH:subs=" (len (signal-subscribers s)) ":val=" (signal-value s)))
(orig s))))
;; swap! — log the swap call (note: 2 explicit params, no &rest)
(let ((orig swap!))
(set! swap!
(fn (s f)
(log-info (str "RX:SWAP:old=" (signal-value s)))
(orig s f))))
;; signal-add-sub! — log re-subscriptions
(let ((orig signal-add-sub!))
(set! signal-add-sub!
(fn (s f)
(log-info (str "RX:ADD:subs=" (len (signal-subscribers s)) ":val=" (signal-value s)))
(orig s f))))
;; signal-remove-sub! — log unsubscriptions
(let ((orig signal-remove-sub!))
(set! signal-remove-sub!
(fn (s f)
(log-info (str "RX:RM:subs=" (len (signal-subscribers s)) ":val=" (signal-value s)))
(orig s f))))
;; deref — log whether reactive context is visible (the key diagnostic)
(let ((orig deref))
(set! deref
(fn (s)
(when (signal? s)
(let ((ctx (scope-peek "sx-reactive")))
(log-info (str "RX:DEREF:ctx=" (if (nil? ctx) "nil" "ok") ":val=" (signal-value s)))))
(orig s))))
true)
`;
async function modeReactive(page, url, island, actionsStr) {
await page.goto(BASE_URL + url, { waitUntil: 'networkidle', timeout: 15000 });
await waitForHydration(page);
const consoleLogs = [];
page.on('console', msg => {
consoleLogs.push({ type: msg.type(), text: msg.text().slice(0, 500) });
});
// Install hooks + tag elements
const setup = await page.evaluate(({ islandName, hooks }) => {
const K = window.SxKernel;
if (!K || !K.eval) return { ok: false, error: 'SxKernel not found' };
try { K.eval(hooks); }
catch (e) { return { ok: false, error: 'Hook install: ' + e.message }; }
const el = document.querySelector(`[data-sx-island="${islandName}"]`);
if (!el) return { ok: false, error: `Island "${islandName}" not found` };
const all = el.querySelectorAll('*');
for (let i = 0; i < all.length; i++) all[i].__rxId = i;
return { ok: true, tagged: all.length };
}, { islandName: island, hooks: REACTIVE_HOOKS });
if (!setup.ok) return { url, island, error: setup.error };
// --- Snapshot: DOM state + node stability ---
const snapshot = async () => {
return page.evaluate((name) => {
const root = document.querySelector(`[data-sx-island="${name}"]`);
if (!root) return { error: 'island gone' };
// Reactive element text
const dom = {};
for (const el of root.querySelectorAll('[data-sx-reactive-attrs]')) {
const tag = el.tagName.toLowerCase();
const cls = (el.className || '').split(' ').find(c => /^(text-|font-)/.test(c)) || '';
let key = tag + (cls ? '.' + cls : '');
while (dom[key] !== undefined) key += '+';
dom[key] = el.textContent?.trim().slice(0, 120);
}
// Node stability
const all = root.querySelectorAll('*');
let same = 0, fresh = 0;
for (const el of all) {
if (el.__rxId !== undefined) same++; else fresh++;
}
// Buttons
const buttons = Array.from(root.querySelectorAll('button')).map(b => ({
text: b.textContent?.trim(), same: b.__rxId !== undefined
}));
return { dom, nodes: { same, fresh, total: all.length }, buttons };
}, island);
};
// --- Drain console logs between steps ---
let cursor = consoleLogs.length;
const drain = () => {
const fresh = consoleLogs.slice(cursor);
cursor = consoleLogs.length;
const rx = fresh.filter(l => l.text.includes('RX:')).map(l => l.text.replace('[sx] ', ''));
const errors = fresh.filter(l => l.type === 'error').map(l => l.text);
return { rx, errors: errors.length ? errors : undefined };
};
// --- Run ---
const steps = [];
steps.push({ step: 'initial', ...await snapshot(), ...drain() });
for (const action of (actionsStr || '').split(';').map(s => s.trim()).filter(Boolean)) {
const [cmd, ...rest] = action.split(':');
const arg = rest.join(':');
try {
if (cmd === 'click') {
await page.locator(arg).first().click();
await page.waitForTimeout(150);
} else if (cmd === 'wait') {
await page.waitForTimeout(parseInt(arg) || 200);
} else {
steps.push({ step: action, error: 'unknown' });
continue;
}
} catch (e) {
steps.push({ step: action, error: e.message });
continue;
}
steps.push({ step: action, ...await snapshot(), ...drain() });
}
return { url, island, tagged: setup.tagged, steps };
}
// ---------------------------------------------------------------------------
// Main
async function main() {
const argsJson = process.argv[2] || '{}';
let args;
@@ -725,6 +1084,18 @@ async function main() {
case 'screenshot':
result = await modeScreenshot(page, url, args.selector);
break;
case 'listeners':
result = await modeListeners(page, url, args.selector || args.expr);
break;
case 'trace':
result = await modeTrace(page, url, args.selector || args.expr);
break;
case 'cdp':
result = await modeCdp(page, url, args.expr || '');
break;
case 'reactive':
result = await modeReactive(page, url, args.island || '', args.actions || '');
break;
default:
result = { error: `Unknown mode: ${mode}` };
}

View File

@@ -1,21 +1,110 @@
(define assert-signal-value :effects () (fn ((sig :as any) expected) (let ((actual (deref sig))) (assert= actual expected (str "Expected signal value " expected ", got " actual)))))
(define
assert-signal-value
:effects ()
(fn
((sig :as any) expected)
(let
((actual (deref sig)))
(assert=
actual
expected
(str "Expected signal value " expected ", got " actual)))))
(define assert-signal-has-subscribers :effects () (fn ((sig :as any)) (assert (> (len (signal-subscribers sig)) 0) "Expected signal to have subscribers")))
(define
assert-signal-has-subscribers
:effects ()
(fn
((sig :as any))
(assert
(> (len (signal-subscribers sig)) 0)
"Expected signal to have subscribers")))
(define assert-signal-no-subscribers :effects () (fn ((sig :as any)) (assert (= (len (signal-subscribers sig)) 0) "Expected signal to have no subscribers")))
(define
assert-signal-no-subscribers
:effects ()
(fn
((sig :as any))
(assert
(= (len (signal-subscribers sig)) 0)
"Expected signal to have no subscribers")))
(define assert-signal-subscriber-count :effects () (fn ((sig :as any) (n :as number)) (let ((actual (len (signal-subscribers sig)))) (assert= actual n (str "Expected " n " subscribers, got " actual)))))
(define
assert-signal-subscriber-count
:effects ()
(fn
((sig :as any) (n :as number))
(let
((actual (len (signal-subscribers sig))))
(assert= actual n (str "Expected " n " subscribers, got " actual)))))
(define simulate-signal-set! :effects (mutation) (fn ((sig :as any) value) (reset! sig value)))
(define
simulate-signal-set!
:effects (mutation)
(fn ((sig :as any) value) (reset! sig value)))
(define simulate-signal-swap! :effects (mutation) (fn ((sig :as any) (f :as lambda) &rest args) (apply swap! (cons sig (cons f args)))))
(define
simulate-signal-swap!
:effects (mutation)
(fn ((sig :as any) (f :as lambda)) (swap! sig f)))
(define assert-computed-dep-count :effects () (fn ((sig :as any) (n :as number)) (let ((actual (len (signal-deps sig)))) (assert= actual n (str "Expected " n " deps, got " actual)))))
(define
assert-computed-dep-count
:effects ()
(fn
((sig :as any) (n :as number))
(let
((actual (len (signal-deps sig))))
(assert= actual n (str "Expected " n " deps, got " actual)))))
(define assert-computed-depends-on :effects () (fn ((computed-sig :as any) (dep-sig :as any)) (assert (contains? (signal-deps computed-sig) dep-sig) "Expected computed to depend on the given signal")))
(define
assert-computed-depends-on
:effects ()
(fn
((computed-sig :as any) (dep-sig :as any))
(assert
(contains? (signal-deps computed-sig) dep-sig)
"Expected computed to depend on the given signal")))
(define count-effect-runs :effects (mutation) (fn ((thunk :as lambda)) (let ((count (signal 0))) (effect (fn () (deref count))) (let ((run-count 0) (tracker (effect (fn () (set! run-count (+ run-count 1)) (cek-call thunk nil))))) run-count))))
(define
count-effect-runs
:effects (mutation)
(fn
((thunk :as lambda))
(let
((count (signal 0)))
(effect (fn () (deref count)))
(let
((run-count 0)
(tracker
(effect
(fn () (set! run-count (+ run-count 1)) (cek-call thunk nil)))))
run-count))))
(define make-test-signal :effects (mutation) (fn (initial-value) (let ((sig (signal initial-value)) (history (list))) (effect (fn () (append! history (deref sig)))) {:signal sig :history history})))
(define
make-test-signal
:effects (mutation)
(fn
(initial-value)
(let
((sig (signal initial-value)) (history (list)))
(effect (fn () (append! history (deref sig))))
{:signal sig :history history})))
(define assert-batch-coalesces :effects (mutation) (fn ((thunk :as lambda) (expected-notify-count :as number)) (let ((notify-count 0) (sig (signal 0))) (effect (fn () (deref sig) (set! notify-count (+ notify-count 1)))) (set! notify-count 0) (batch thunk) (assert= notify-count expected-notify-count (str "Expected " expected-notify-count " notifications, got " notify-count)))))
(define
assert-batch-coalesces
:effects (mutation)
(fn
((thunk :as lambda) (expected-notify-count :as number))
(let
((notify-count 0) (sig (signal 0)))
(effect (fn () (deref sig) (set! notify-count (+ notify-count 1))))
(set! notify-count 0)
(batch thunk)
(assert=
notify-count
expected-notify-count
(str
"Expected "
expected-notify-count
" notifications, got "
notify-count)))))

File diff suppressed because it is too large Load Diff

View File

@@ -1,227 +1,221 @@
;; ==========================================================================
;; browser.sx — Browser API library functions
;;
;; Location, history, storage, cookies, timers, fetch — all expressed
;; using the host FFI primitives. Library functions, not primitives.
;; ==========================================================================
(define
browser-location-href
(fn () (host-get (host-get (dom-window) "location") "href")))
(define
browser-location-pathname
(fn () (host-get (host-get (dom-window) "location") "pathname")))
;; --------------------------------------------------------------------------
;; Location & navigation
;; --------------------------------------------------------------------------
(define
browser-location-origin
(fn () (host-get (host-get (dom-window) "location") "origin")))
(define browser-location-href
(fn ()
(host-get (host-get (dom-window) "location") "href")))
(define
browser-same-origin?
(fn (url) (starts-with? url (browser-location-origin))))
(define browser-location-pathname
(fn ()
(host-get (host-get (dom-window) "location") "pathname")))
(define browser-location-origin
(fn ()
(host-get (host-get (dom-window) "location") "origin")))
(define browser-same-origin?
(fn (url)
(starts-with? url (browser-location-origin))))
;; Extract pathname from a URL string using the URL API
(define url-pathname
(fn (url)
(define
url-pathname
(fn
(url)
(host-get (host-new "URL" url (browser-location-origin)) "pathname")))
(define browser-push-state
(fn (url-or-state &rest rest)
(if (empty? rest)
;; Single arg: just URL
(host-call (host-get (dom-window) "history") "pushState" nil "" url-or-state)
;; Three args: state, title, url
(host-call (host-get (dom-window) "history") "pushState" url-or-state (first rest) (nth rest 1)))))
(define
browser-push-state
(fn
(url-or-state title url)
(if
(nil? title)
(host-call
(host-get (dom-window) "history")
"pushState"
nil
""
url-or-state)
(host-call
(host-get (dom-window) "history")
"pushState"
url-or-state
title
url))))
(define browser-replace-state
(fn (url-or-state &rest rest)
(if (empty? rest)
(host-call (host-get (dom-window) "history") "replaceState" nil "" url-or-state)
(host-call (host-get (dom-window) "history") "replaceState" url-or-state (first rest) (nth rest 1)))))
(define
browser-replace-state
(fn
(url-or-state title url)
(if
(nil? title)
(host-call
(host-get (dom-window) "history")
"replaceState"
nil
""
url-or-state)
(host-call
(host-get (dom-window) "history")
"replaceState"
url-or-state
title
url))))
(define browser-reload
(fn ()
(host-call (host-get (dom-window) "location") "reload")))
(define
browser-reload
(fn () (host-call (host-get (dom-window) "location") "reload")))
(define browser-navigate
(fn (url)
(host-set! (host-get (dom-window) "location") "href" url)))
(define
browser-navigate
(fn (url) (host-set! (host-get (dom-window) "location") "href" url)))
;; --------------------------------------------------------------------------
;; Storage
;; --------------------------------------------------------------------------
(define local-storage-get
(fn (key)
(define
local-storage-get
(fn
(key)
(host-call (host-get (dom-window) "localStorage") "getItem" key)))
(define local-storage-set
(fn (key val)
(define
local-storage-set
(fn
(key val)
(host-call (host-get (dom-window) "localStorage") "setItem" key val)))
(define local-storage-remove
(fn (key)
(define
local-storage-remove
(fn
(key)
(host-call (host-get (dom-window) "localStorage") "removeItem" key)))
;; --------------------------------------------------------------------------
;; Timers
;; --------------------------------------------------------------------------
(define set-timeout
(fn (fn-val ms)
(define
set-timeout
(fn
(fn-val ms)
(host-call (dom-window) "setTimeout" (host-callback fn-val) ms)))
(define set-interval
(fn (fn-val ms)
(define
set-interval
(fn
(fn-val ms)
(host-call (dom-window) "setInterval" (host-callback fn-val) ms)))
(define clear-timeout
(fn (id)
(host-call (dom-window) "clearTimeout" id)))
(define clear-timeout (fn (id) (host-call (dom-window) "clearTimeout" id)))
(define clear-interval
(fn (id)
(host-call (dom-window) "clearInterval" id)))
(define
clear-interval
(fn (id) (host-call (dom-window) "clearInterval" id)))
(define request-animation-frame
(fn (fn-val)
(define
request-animation-frame
(fn
(fn-val)
(host-call (dom-window) "requestAnimationFrame" (host-callback fn-val))))
(define
fetch-request
(fn (url opts) (host-call (dom-window) "fetch" url opts)))
;; --------------------------------------------------------------------------
;; Fetch
;; --------------------------------------------------------------------------
(define new-abort-controller (fn () (host-new "AbortController")))
(define fetch-request
(fn (url opts)
(host-call (dom-window) "fetch" url opts)))
(define controller-signal (fn (controller) (host-get controller "signal")))
(define new-abort-controller
(fn ()
(host-new "AbortController")))
(define controller-abort (fn (controller) (host-call controller "abort")))
(define controller-signal
(fn (controller)
(host-get controller "signal")))
(define controller-abort
(fn (controller)
(host-call controller "abort")))
;; --------------------------------------------------------------------------
;; Promises
;; --------------------------------------------------------------------------
(define promise-then
(fn (p on-resolve on-reject)
(let ((cb-resolve (host-callback on-resolve))
(cb-reject (if on-reject (host-callback on-reject) nil)))
(if cb-reject
(define
promise-then
(fn
(p on-resolve on-reject)
(let
((cb-resolve (host-callback on-resolve))
(cb-reject (if on-reject (host-callback on-reject) nil)))
(if
cb-reject
(host-call (host-call p "then" cb-resolve) "catch" cb-reject)
(host-call p "then" cb-resolve)))))
(define promise-resolve
(fn (val)
(host-call (host-global "Promise") "resolve" val)))
(define
promise-resolve
(fn (val) (host-call (host-global "Promise") "resolve" val)))
(define promise-delayed
(fn (ms val)
(host-new "Promise" (host-callback
(fn (resolve)
(set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
(define
promise-delayed
(fn
(ms val)
(host-new
"Promise"
(host-callback
(fn
(resolve)
(set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
(define browser-confirm (fn (msg) (host-call (dom-window) "confirm" msg)))
;; --------------------------------------------------------------------------
;; Dialogs & media
;; --------------------------------------------------------------------------
(define
browser-prompt
(fn (msg default) (host-call (dom-window) "prompt" msg default)))
(define browser-confirm
(fn (msg) (host-call (dom-window) "confirm" msg)))
(define browser-prompt
(fn (msg default)
(host-call (dom-window) "prompt" msg default)))
(define browser-media-matches?
(fn (query)
(define
browser-media-matches?
(fn
(query)
(host-get (host-call (dom-window) "matchMedia" query) "matches")))
(define json-parse (fn (s) (host-call (host-global "JSON") "parse" s)))
;; --------------------------------------------------------------------------
;; JSON
;; --------------------------------------------------------------------------
(define
log-info
(fn (msg) (host-call (host-global "console") "log" (str "[sx] " msg))))
(define json-parse
(fn (s)
(host-call (host-global "JSON") "parse" s)))
(define
log-warn
(fn (msg) (host-call (host-global "console") "warn" (str "[sx] " msg))))
(define
console-log
(fn (msg) (host-call (host-global "console") "log" (str "[sx] " msg))))
;; --------------------------------------------------------------------------
;; Console
;; --------------------------------------------------------------------------
(define now-ms (fn () (host-call (host-global "Date") "now")))
(define log-info
(fn (msg)
(host-call (host-global "console") "log" (str "[sx] " msg))))
(define log-warn
(fn (msg)
(host-call (host-global "console") "warn" (str "[sx] " msg))))
(define console-log
(fn (&rest args)
(host-call (host-global "console") "log"
(join " " (cons "[sx]" (map str args))))))
(define now-ms
(fn ()
(host-call (host-global "Date") "now")))
;; --------------------------------------------------------------------------
;; Scheduling
;; --------------------------------------------------------------------------
(define schedule-idle
(fn (f)
(let ((cb (host-callback (fn (_deadline) (f)))))
(if (host-get (dom-window) "requestIdleCallback")
(define
schedule-idle
(fn
(f)
(let
((cb (host-callback (fn (_deadline) (f)))))
(if
(host-get (dom-window) "requestIdleCallback")
(host-call (dom-window) "requestIdleCallback" cb)
(set-timeout cb 0)))))
(define
set-cookie
(fn
(name value days)
(let
((d (or days 365))
(expires
(host-call
(host-new
"Date"
(+ (host-call (host-global "Date") "now") (* d 86400000)))
"toUTCString")))
(host-set!
(dom-document)
"cookie"
(str
name
"="
(host-call nil "encodeURIComponent" value)
";expires="
expires
";path=/;SameSite=Lax")))))
;; --------------------------------------------------------------------------
;; Cookies
;; --------------------------------------------------------------------------
(define set-cookie
(fn (name value days)
(let ((d (or days 365))
(expires (host-call
(host-new "Date"
(+ (host-call (host-global "Date") "now")
(* d 864e5)))
"toUTCString")))
(host-set! (dom-document) "cookie"
(str name "="
(host-call nil "encodeURIComponent" value)
";expires=" expires ";path=/;SameSite=Lax")))))
(define get-cookie
(fn (name)
(let ((cookies (host-get (dom-document) "cookie"))
(match (host-call cookies "match"
(host-new "RegExp"
(str "(?:^|;\\s*)" name "=([^;]*)")))))
(if match
(host-call nil "decodeURIComponent" (host-get match 1))
nil))))
(define
get-cookie
(fn
(name)
(let
((cookies (host-get (dom-document) "cookie"))
(match
(host-call
cookies
"match"
(host-new "RegExp" (str "(?:^|;\\s*)" name "=([^;]*)")))))
(if match (host-call nil "decodeURIComponent" (host-get match 1)) nil))))

View File

@@ -9,13 +9,11 @@
(define
dom-create-element
(fn
(tag &rest ns-arg)
(let
((ns (if (and ns-arg (not (empty? ns-arg))) (first ns-arg) nil)))
(if
ns
(host-call (dom-document) "createElementNS" ns tag)
(host-call (dom-document) "createElement" tag)))))
(tag ns)
(if
ns
(host-call (dom-document) "createElementNS" ns tag)
(host-call (dom-document) "createElement" tag))))
(define
create-text-node
@@ -128,11 +126,11 @@
(define
dom-query
(fn
(root-or-sel &rest rest)
(root-or-sel sel)
(if
(empty? rest)
(nil? sel)
(host-call (dom-document) "querySelector" root-or-sel)
(host-call root-or-sel "querySelector" (first rest)))))
(host-call root-or-sel "querySelector" sel))))
(define
dom-query-all
@@ -342,12 +340,12 @@
(define
dom-add-listener
(fn
(el event-name handler &rest opts)
(el event-name handler opts)
(let
((cb (host-callback handler)))
(if
(and opts (not (empty? opts)))
(host-call el "addEventListener" event-name cb (first opts))
opts
(host-call el "addEventListener" event-name cb opts)
(host-call el "addEventListener" event-name cb))
(fn () (host-call el "removeEventListener" event-name cb)))))