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:
File diff suppressed because it is too large
Load Diff
File diff suppressed because one or more lines are too long
@@ -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
@@ -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
@@ -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
@@ -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)))))
|
||||
|
||||
@@ -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
Reference in New Issue
Block a user