From a97f4c0e3932829554549427b57a4a21ffc73c16 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 8 Mar 2026 09:34:47 +0000 Subject: [PATCH] Add reactive islands spec: signals.sx + defisland across all adapters New spec file signals.sx defines the signal runtime: signal, computed, effect, deref, reset!, swap!, batch, dispose, and island scope tracking. eval.sx: defisland special form + island? type predicate in eval-call. boundary.sx: signal primitive declarations (Tier 3). render.sx: defisland in definition-form?. adapter-dom.sx: render-dom-island with reactive context, reactive-text, reactive-attr, reactive-fragment, reactive-list helpers. adapter-html.sx: render-html-island for SSR with data-sx-island/state. adapter-sx.sx: island? handling in wire format serialization. special-forms.sx: defisland declaration with docs and example. Co-Authored-By: Claude Opus 4.6 --- shared/sx/ref/adapter-dom.sx | 170 +++++++++++++++++++- shared/sx/ref/adapter-html.sx | 96 +++++++++++- shared/sx/ref/adapter-sx.sx | 4 +- shared/sx/ref/boundary.sx | 52 ++++++ shared/sx/ref/eval.sx | 33 +++- shared/sx/ref/render.sx | 4 +- shared/sx/ref/signals.sx | 279 +++++++++++++++++++++++++++++++++ shared/sx/ref/special-forms.sx | 17 ++ 8 files changed, 646 insertions(+), 9 deletions(-) create mode 100644 shared/sx/ref/signals.sx diff --git a/shared/sx/ref/adapter-dom.sx b/shared/sx/ref/adapter-dom.sx index f338a49..15b0e00 100644 --- a/shared/sx/ref/adapter-dom.sx +++ b/shared/sx/ref/adapter-dom.sx @@ -102,6 +102,12 @@ (contains? HTML_TAGS name) (render-dom-element name args env ns) + ;; Island (~name) — reactive component + (and (starts-with? name "~") + (env-has? env name) + (island? (env-get env name))) + (render-dom-island (env-get env name) args env ns) + ;; Component (~name) (starts-with? name "~") (let ((comp (env-get env name))) @@ -284,7 +290,7 @@ (define RENDER_DOM_FORMS (list "if" "when" "cond" "case" "let" "let*" "begin" "do" - "define" "defcomp" "defmacro" "defstyle" "defhandler" + "define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler" "map" "map-indexed" "filter" "for-each")) (define render-dom-form? @@ -414,6 +420,153 @@ (render-to-dom (lambda-body f) local ns)))) +;; -------------------------------------------------------------------------- +;; render-dom-island — render a reactive island +;; -------------------------------------------------------------------------- +;; +;; Islands render like components but wrapped in a reactive context. +;; The island container element gets data-sx-island and data-sx-state +;; attributes for identification and hydration. +;; +;; Inside the island body, deref calls create reactive DOM subscriptions: +;; - Text bindings: (deref sig) in text position → reactive text node +;; - Attribute bindings: (deref sig) in attr → reactive attribute +;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide + +(define render-dom-island + (fn (island args env ns) + ;; Parse kwargs and children (same as component) + (let ((kwargs (dict)) + (children (list))) + (reduce + (fn (state arg) + (let ((skip (get state "skip"))) + (if skip + (assoc state "skip" false "i" (inc (get state "i"))) + (if (and (= (type-of arg) "keyword") + (< (inc (get state "i")) (len args))) + (let ((val (trampoline + (eval-expr (nth args (inc (get state "i"))) env)))) + (dict-set! kwargs (keyword-name arg) val) + (assoc state "skip" true "i" (inc (get state "i")))) + (do + (append! children arg) + (assoc state "i" (inc (get state "i")))))))) + (dict "i" 0 "skip" false) + args) + + ;; Build island env: closure + caller env + params + (let ((local (env-merge (component-closure island) env)) + (island-name (component-name island))) + + ;; Bind params from kwargs + (for-each + (fn (p) + (env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) + (component-params island)) + + ;; If island accepts children, pre-render them to a fragment + (when (component-has-children? island) + (let ((child-frag (create-fragment))) + (for-each + (fn (c) (dom-append child-frag (render-to-dom c env ns))) + children) + (env-set! local "children" child-frag))) + + ;; Create the island container element + (let ((container (dom-create-element "div" nil)) + (disposers (list))) + + ;; Mark as island + (dom-set-attr container "data-sx-island" island-name) + + ;; Render island body inside a scope that tracks disposers + (let ((body-dom + (with-island-scope + (fn (disposable) (append! disposers disposable)) + (fn () (render-to-dom (component-body island) local ns))))) + (dom-append container body-dom) + + ;; Store disposers on the container for cleanup + (dom-set-data container "sx-disposers" disposers) + + container)))))) + + +;; -------------------------------------------------------------------------- +;; Reactive DOM rendering helpers +;; -------------------------------------------------------------------------- +;; +;; These functions create reactive bindings between signals and DOM nodes. +;; They are called by the platform's renderDOM when it detects deref +;; calls inside an island context. + +;; reactive-text — create a text node bound to a signal +;; Used when (deref sig) appears in a text position inside an island. +(define reactive-text + (fn (sig) + (let ((node (create-text-node (str (deref sig))))) + (effect (fn () + (dom-set-text-content node (str (deref sig))))) + node))) + +;; reactive-attr — bind an element attribute to a signal expression +;; Used when an attribute value contains (deref sig) inside an island. +(define reactive-attr + (fn (el attr-name compute-fn) + (effect (fn () + (let ((val (compute-fn))) + (cond + (or (nil? val) (= val false)) + (dom-remove-attr el attr-name) + (= val true) + (dom-set-attr el attr-name "") + :else + (dom-set-attr el attr-name (str val)))))))) + +;; reactive-fragment — conditionally render a fragment based on a signal +;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island. +(define reactive-fragment + (fn (test-fn render-fn env ns) + (let ((marker (create-comment "island-fragment")) + (current-nodes (list))) + (effect (fn () + ;; Remove previous nodes + (for-each (fn (n) (dom-remove n)) current-nodes) + (set! current-nodes (list)) + ;; If test passes, render and insert after marker + (when (test-fn) + (let ((frag (render-fn))) + (set! current-nodes (dom-child-nodes frag)) + (dom-insert-after marker frag))))) + marker))) + +;; reactive-list — render a keyed list bound to a signal +;; Used for (map fn (deref items)) inside an island. +(define reactive-list + (fn (map-fn items-sig env ns) + (let ((container (create-fragment)) + (marker (create-comment "island-list"))) + (dom-append container marker) + (effect (fn () + ;; Simple strategy: clear and re-render + ;; Future: keyed reconciliation + (let ((parent (dom-parent marker))) + (when parent + ;; Remove all nodes after marker until next sibling marker + (dom-remove-children-after marker) + ;; Render new items + (let ((items (deref items-sig))) + (for-each + (fn (item) + (let ((rendered (if (lambda? map-fn) + (render-lambda-dom map-fn (list item) env ns) + (render-to-dom (apply map-fn (list item)) env ns)))) + (dom-insert-after marker rendered))) + (reverse items))))))) + container))) + + ;; -------------------------------------------------------------------------- ;; Platform interface — DOM adapter ;; -------------------------------------------------------------------------- @@ -422,11 +575,20 @@ ;; (dom-create-element tag ns) → Element (ns=nil for HTML, string for SVG/MathML) ;; (create-text-node s) → Text node ;; (create-fragment) → DocumentFragment +;; (create-comment s) → Comment node ;; ;; Tree mutation: ;; (dom-append parent child) → void (appendChild) ;; (dom-set-attr el name val) → void (setAttribute) +;; (dom-remove-attr el name) → void (removeAttribute) ;; (dom-get-attr el name) → string or nil (getAttribute) +;; (dom-set-text-content n s) → void (set textContent) +;; (dom-remove node) → void (remove from parent) +;; (dom-insert-after ref node) → void (insert node after ref) +;; (dom-parent node) → parent Element or nil +;; (dom-child-nodes frag) → list of child nodes +;; (dom-remove-children-after m)→ void (remove all siblings after marker) +;; (dom-set-data el key val) → void (store arbitrary data on element) ;; ;; Content parsing: ;; (dom-parse-html s) → DocumentFragment from HTML string @@ -441,11 +603,15 @@ ;; From eval.sx: ;; eval-expr, trampoline, expand-macro, process-bindings, eval-cond ;; env-has?, env-get, env-set!, env-merge -;; lambda?, component?, macro? +;; lambda?, component?, island?, macro? ;; lambda-closure, lambda-params, lambda-body ;; component-params, component-body, component-closure, ;; component-has-children?, component-name ;; +;; From signals.sx: +;; signal, deref, reset!, swap!, computed, effect, batch +;; signal?, with-island-scope +;; ;; Iteration: ;; (for-each-indexed fn coll) → call fn(index, item) for each element ;; -------------------------------------------------------------------------- diff --git a/shared/sx/ref/adapter-html.sx b/shared/sx/ref/adapter-html.sx index a910035..cfe34a7 100644 --- a/shared/sx/ref/adapter-html.sx +++ b/shared/sx/ref/adapter-html.sx @@ -8,7 +8,7 @@ ;; parse-element-args, render-attrs, definition-form? ;; eval.sx — eval-expr, trampoline, expand-macro, process-bindings, ;; eval-cond, env-has?, env-get, env-set!, env-merge, -;; lambda?, component?, macro?, +;; lambda?, component?, island?, macro?, ;; lambda-closure, lambda-params, lambda-body ;; ========================================================================== @@ -50,7 +50,7 @@ (define RENDER_HTML_FORMS (list "if" "when" "cond" "case" "let" "let*" "begin" "do" - "define" "defcomp" "defmacro" "defstyle" "defhandler" + "define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler" "map" "map-indexed" "filter" "for-each")) (define render-html-form? @@ -85,6 +85,12 @@ (contains? HTML_TAGS name) (render-html-element name args env) + ;; Island (~name) — reactive component, SSR with hydration markers + (and (starts-with? name "~") + (env-has? env name) + (island? (env-get env name))) + (render-html-island (env-get env name) args env) + ;; Component or macro call (~name) (starts-with? name "~") (let ((val (env-get env name))) @@ -287,6 +293,85 @@ "")))))) +;; -------------------------------------------------------------------------- +;; render-html-island — SSR rendering of a reactive island +;; -------------------------------------------------------------------------- +;; +;; Renders the island body as static HTML wrapped in a container element +;; with data-sx-island and data-sx-state attributes. The client hydrates +;; this by finding these elements and re-rendering with reactive context. +;; +;; On the server, signal/deref/reset!/swap! are simple passthrough: +;; (signal val) → returns val (no container needed server-side) +;; (deref s) → returns s (signal values are plain values server-side) +;; (reset! s v) → no-op +;; (swap! s f) → no-op + +(define render-html-island + (fn (island args env) + ;; Parse kwargs and children (same pattern as render-html-component) + (let ((kwargs (dict)) + (children (list))) + (reduce + (fn (state arg) + (let ((skip (get state "skip"))) + (if skip + (assoc state "skip" false "i" (inc (get state "i"))) + (if (and (= (type-of arg) "keyword") + (< (inc (get state "i")) (len args))) + (let ((val (trampoline + (eval-expr (nth args (inc (get state "i"))) env)))) + (dict-set! kwargs (keyword-name arg) val) + (assoc state "skip" true "i" (inc (get state "i")))) + (do + (append! children arg) + (assoc state "i" (inc (get state "i")))))))) + (dict "i" 0 "skip" false) + args) + + ;; Build island env: closure + caller env + params + (let ((local (env-merge (component-closure island) env)) + (island-name (component-name island))) + + ;; Bind params from kwargs + (for-each + (fn (p) + (env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) + (component-params island)) + + ;; If island accepts children, pre-render them to raw HTML + (when (component-has-children? island) + (env-set! local "children" + (make-raw-html + (join "" (map (fn (c) (render-to-html c env)) children))))) + + ;; Render the island body as HTML + (let ((body-html (render-to-html (component-body island) local)) + (state-json (serialize-island-state kwargs))) + ;; Wrap in container with hydration attributes + (str "
" + body-html + "
")))))) + + +;; -------------------------------------------------------------------------- +;; serialize-island-state — serialize kwargs to JSON for hydration +;; -------------------------------------------------------------------------- +;; +;; Only serializes simple values (numbers, strings, booleans, nil, lists, dicts). +;; Functions, components, and other non-serializable values are skipped. + +(define serialize-island-state + (fn (kwargs) + (if (empty-dict? kwargs) + nil + (json-serialize kwargs)))) + + ;; -------------------------------------------------------------------------- ;; Platform interface — HTML adapter ;; -------------------------------------------------------------------------- @@ -297,7 +382,7 @@ ;; From eval.sx: ;; eval-expr, trampoline, expand-macro, process-bindings, eval-cond ;; env-has?, env-get, env-set!, env-merge -;; lambda?, component?, macro? +;; lambda?, component?, island?, macro? ;; lambda-closure, lambda-params, lambda-body ;; component-params, component-body, component-closure, ;; component-has-children?, component-name @@ -305,6 +390,11 @@ ;; Raw HTML construction: ;; (make-raw-html s) → wrap string as raw HTML (not double-escaped) ;; +;; JSON serialization (for island state): +;; (json-serialize dict) → JSON string +;; (empty-dict? d) → boolean +;; (escape-attr s) → HTML attribute escape +;; ;; Iteration: ;; (for-each-indexed fn coll) → call fn(index, item) for each element ;; (map-indexed fn coll) → map fn(index, item) over each element diff --git a/shared/sx/ref/adapter-sx.sx b/shared/sx/ref/adapter-sx.sx index b84106c..1af36ac 100644 --- a/shared/sx/ref/adapter-sx.sx +++ b/shared/sx/ref/adapter-sx.sx @@ -83,12 +83,14 @@ (let ((f (trampoline (eval-expr head env))) (evaled-args (map (fn (a) (trampoline (eval-expr a env))) args))) (cond - (and (callable? f) (not (lambda? f)) (not (component? f))) + (and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f))) (apply f evaled-args) (lambda? f) (trampoline (call-lambda f evaled-args env)) (component? f) (aser-call (str "~" (component-name f)) args env) + (island? f) + (aser-call (str "~" (component-name f)) args env) :else (error (str "Not callable: " (inspect f))))))))))) diff --git a/shared/sx/ref/boundary.sx b/shared/sx/ref/boundary.sx index fc8df3c..32c2d08 100644 --- a/shared/sx/ref/boundary.sx +++ b/shared/sx/ref/boundary.sx @@ -124,3 +124,55 @@ (define-boundary-types (list "number" "string" "boolean" "nil" "keyword" "list" "dict" "sx-source")) + + +;; -------------------------------------------------------------------------- +;; Tier 3: Signal primitives — reactive state for islands +;; +;; These are pure primitives (no IO) but are separated from primitives.sx +;; because they introduce a new type (signal) and depend on signals.sx. +;; -------------------------------------------------------------------------- + +(declare-tier :signals :source "signals.sx") + +(declare-signal-primitive "signal" + :params (initial-value) + :returns "signal" + :doc "Create a reactive signal container with an initial value.") + +(declare-signal-primitive "deref" + :params (signal) + :returns "any" + :doc "Read a signal's current value. In a reactive context (inside an island), + subscribes the current DOM binding to the signal. Outside reactive + context, just returns the value.") + +(declare-signal-primitive "reset!" + :params (signal value) + :returns "nil" + :doc "Set a signal to a new value. Notifies all subscribers.") + +(declare-signal-primitive "swap!" + :params (signal f &rest args) + :returns "nil" + :doc "Update a signal by applying f to its current value. (swap! s inc) + is equivalent to (reset! s (inc (deref s))) but atomic.") + +(declare-signal-primitive "computed" + :params (compute-fn) + :returns "signal" + :doc "Create a derived signal that recomputes when its dependencies change. + Dependencies are discovered automatically by tracking deref calls.") + +(declare-signal-primitive "effect" + :params (effect-fn) + :returns "lambda" + :doc "Run a side effect that re-runs when its signal dependencies change. + Returns a dispose function. If the effect function returns a function, + it is called as cleanup before the next run.") + +(declare-signal-primitive "batch" + :params (thunk) + :returns "any" + :doc "Group multiple signal writes. Subscribers are notified once at the end, + after all values have been updated.") diff --git a/shared/sx/ref/eval.sx b/shared/sx/ref/eval.sx index 560b104..1479dd1 100644 --- a/shared/sx/ref/eval.sx +++ b/shared/sx/ref/eval.sx @@ -35,12 +35,14 @@ ;; lambda — closure: {params, body, closure-env, name?} ;; macro — AST transformer: {params, rest-param, body, closure-env} ;; component — UI component: {name, params, has-children, body, closure-env} +;; island — reactive component: like component but with island flag ;; thunk — deferred eval for TCO: {expr, env} ;; ;; Each target must provide: ;; (type-of x) → one of the strings above ;; (make-lambda ...) → platform Lambda value ;; (make-component ..) → platform Component value +;; (make-island ...) → platform Island value (component + island flag) ;; (make-macro ...) → platform Macro value ;; (make-thunk ...) → platform Thunk value ;; @@ -141,6 +143,7 @@ (= name "fn") (sf-lambda args env) (= name "define") (sf-define args env) (= name "defcomp") (sf-defcomp args env) + (= name "defisland") (sf-defisland args env) (= name "defmacro") (sf-defmacro args env) (= name "defstyle") (sf-defstyle args env) (= name "defhandler") (sf-defhandler args env) @@ -192,7 +195,7 @@ (evaluated-args (map (fn (a) (trampoline (eval-expr a env))) args))) (cond ;; Native callable (primitive function) - (and (callable? f) (not (lambda? f)) (not (component? f))) + (and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f))) (apply f evaluated-args) ;; Lambda @@ -203,6 +206,10 @@ (component? f) (call-component f args env) + ;; Island (reactive component) — same calling convention + (island? f) + (call-component f args env) + :else (error (str "Not callable: " (inspect f))))))) @@ -543,6 +550,24 @@ (list params has-children)))) +(define sf-defisland + (fn (args env) + ;; (defisland ~name (params) body) + ;; Like defcomp but creates an island (reactive component). + ;; Islands have the same calling convention as components but + ;; render with a reactive context on the client. + (let ((name-sym (first args)) + (params-raw (nth args 1)) + (body (last args)) + (comp-name (strip-prefix (symbol-name name-sym) "~")) + (parsed (parse-comp-params params-raw)) + (params (first parsed)) + (has-children (nth parsed 1))) + (let ((island (make-island comp-name params has-children body env))) + (env-set! env (symbol-name name-sym) island) + island)))) + + (define sf-defmacro (fn (args env) (let ((name-sym (first args)) @@ -903,6 +928,11 @@ ;; (component-closure c) → env ;; (component-has-children? c) → boolean ;; (component-affinity c) → "auto" | "client" | "server" +;; +;; (make-island name params has-children body env) → Island +;; (island? x) → boolean +;; ;; Islands reuse component accessors: component-params, component-body, etc. +;; ;; (macro-params m) → list of strings ;; (macro-rest-param m) → string or nil ;; (macro-body m) → expr @@ -915,6 +945,7 @@ ;; (callable? x) → boolean (native function or lambda) ;; (lambda? x) → boolean ;; (component? x) → boolean +;; (island? x) → boolean ;; (macro? x) → boolean ;; (primitive? name) → boolean (is name a registered primitive?) ;; (get-primitive name) → function diff --git a/shared/sx/ref/render.sx b/shared/sx/ref/render.sx index 83436ad..ec69479 100644 --- a/shared/sx/ref/render.sx +++ b/shared/sx/ref/render.sx @@ -73,8 +73,8 @@ (define definition-form? (fn (name) - (or (= name "define") (= name "defcomp") (= name "defmacro") - (= name "defstyle") (= name "defhandler")))) + (or (= name "define") (= name "defcomp") (= name "defisland") + (= name "defmacro") (= name "defstyle") (= name "defhandler")))) (define parse-element-args diff --git a/shared/sx/ref/signals.sx b/shared/sx/ref/signals.sx new file mode 100644 index 0000000..0439471 --- /dev/null +++ b/shared/sx/ref/signals.sx @@ -0,0 +1,279 @@ +;; ========================================================================== +;; signals.sx — Reactive signal runtime specification +;; +;; Defines the signal primitive: a container for a value that notifies +;; subscribers when it changes. Signals are the reactive state primitive +;; for SX islands. +;; +;; Signals are pure computation — no DOM, no IO. The reactive rendering +;; layer (adapter-dom.sx) subscribes DOM nodes to signals. The server +;; adapter (adapter-html.sx) reads signal values without subscribing. +;; +;; Platform interface required: +;; (make-signal value) → Signal — create signal container +;; (signal? x) → boolean — type predicate +;; (signal-value s) → any — read current value (no tracking) +;; (signal-set-value! s v) → void — write value (no notification) +;; (signal-subscribers s) → list — list of subscriber fns +;; (signal-add-sub! s fn) → void — add subscriber +;; (signal-remove-sub! s fn) → void — remove subscriber +;; (signal-deps s) → list — dependency list (for computed) +;; (signal-set-deps! s deps) → void — set dependency list +;; +;; Global state required: +;; *tracking-context* → nil | Effect/Computed currently evaluating +;; (set-tracking-context! c) → void +;; (get-tracking-context) → context or nil +;; +;; ========================================================================== + + +;; -------------------------------------------------------------------------- +;; 1. signal — create a reactive container +;; -------------------------------------------------------------------------- + +(define signal + (fn (initial-value) + (make-signal initial-value))) + + +;; -------------------------------------------------------------------------- +;; 2. deref — read signal value, subscribe current reactive context +;; -------------------------------------------------------------------------- +;; +;; In a reactive context (inside effect or computed), deref registers the +;; signal as a dependency. Outside reactive context, deref just returns +;; the current value — no subscription, no overhead. + +(define deref + (fn (s) + (if (not (signal? s)) + s ;; non-signal values pass through + (let ((ctx (get-tracking-context))) + (when ctx + ;; Register this signal as a dependency of the current context + (tracking-context-add-dep! ctx s) + ;; Subscribe the context to this signal + (signal-add-sub! s (tracking-context-notify-fn ctx))) + (signal-value s))))) + + +;; -------------------------------------------------------------------------- +;; 3. reset! — write a new value, notify subscribers +;; -------------------------------------------------------------------------- + +(define reset! + (fn (s value) + (when (signal? s) + (let ((old (signal-value s))) + (when (not (identical? old value)) + (signal-set-value! s value) + (notify-subscribers s)))))) + + +;; -------------------------------------------------------------------------- +;; 4. swap! — update signal via function +;; -------------------------------------------------------------------------- + +(define swap! + (fn (s f &rest args) + (when (signal? s) + (let ((old (signal-value s)) + (new-val (apply f (cons old args)))) + (when (not (identical? old new-val)) + (signal-set-value! s new-val) + (notify-subscribers s)))))) + + +;; -------------------------------------------------------------------------- +;; 5. computed — derived signal with automatic dependency tracking +;; -------------------------------------------------------------------------- +;; +;; A computed signal wraps a zero-arg function. It re-evaluates when any +;; of its dependencies change. The dependency set is discovered automatically +;; by tracking deref calls during evaluation. + +(define computed + (fn (compute-fn) + (let ((s (make-signal nil)) + (deps (list)) + (compute-ctx nil)) + + ;; The notify function — called when a dependency changes + (let ((recompute + (fn () + ;; Unsubscribe from old deps + (for-each + (fn (dep) (signal-remove-sub! dep recompute)) + (signal-deps s)) + (signal-set-deps! s (list)) + + ;; Create tracking context for this computed + (let ((ctx (make-tracking-context recompute))) + (let ((prev (get-tracking-context))) + (set-tracking-context! ctx) + (let ((new-val (compute-fn))) + (set-tracking-context! prev) + ;; Save discovered deps + (signal-set-deps! s (tracking-context-deps ctx)) + ;; Update value + notify downstream + (let ((old (signal-value s))) + (signal-set-value! s new-val) + (when (not (identical? old new-val)) + (notify-subscribers s))))))))) + + ;; Initial computation + (recompute) + s)))) + + +;; -------------------------------------------------------------------------- +;; 6. effect — side effect that runs when dependencies change +;; -------------------------------------------------------------------------- +;; +;; Like computed, but doesn't produce a signal value. Returns a dispose +;; function that tears down the effect. + +(define effect + (fn (effect-fn) + (let ((deps (list)) + (disposed false) + (cleanup-fn nil)) + + (let ((run-effect + (fn () + (when (not disposed) + ;; Run previous cleanup if any + (when cleanup-fn (cleanup-fn)) + + ;; Unsubscribe from old deps + (for-each + (fn (dep) (signal-remove-sub! dep run-effect)) + deps) + (set! deps (list)) + + ;; Track new deps + (let ((ctx (make-tracking-context run-effect))) + (let ((prev (get-tracking-context))) + (set-tracking-context! ctx) + (let ((result (effect-fn))) + (set-tracking-context! prev) + (set! deps (tracking-context-deps ctx)) + ;; If effect returns a function, it's the cleanup + (when (callable? result) + (set! cleanup-fn result))))))))) + + ;; Initial run + (run-effect) + + ;; Return dispose function + (fn () + (set! disposed true) + (when cleanup-fn (cleanup-fn)) + (for-each + (fn (dep) (signal-remove-sub! dep run-effect)) + deps) + (set! deps (list))))))) + + +;; -------------------------------------------------------------------------- +;; 7. batch — group multiple signal writes into one notification pass +;; -------------------------------------------------------------------------- +;; +;; During a batch, signal writes are deferred. Subscribers are notified +;; once at the end, after all values have been updated. + +(define *batch-depth* 0) +(define *batch-queue* (list)) + +(define batch + (fn (thunk) + (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)) + (for-each + (fn (s) (flush-subscribers s)) + queue))))) + + +;; -------------------------------------------------------------------------- +;; 8. notify-subscribers — internal notification dispatch +;; -------------------------------------------------------------------------- +;; +;; If inside a batch, queues the signal. Otherwise, notifies immediately. + +(define notify-subscribers + (fn (s) + (if (> *batch-depth* 0) + (when (not (contains? *batch-queue* s)) + (append! *batch-queue* s)) + (flush-subscribers s)))) + +(define flush-subscribers + (fn (s) + (for-each + (fn (sub) (sub)) + (signal-subscribers s)))) + + +;; -------------------------------------------------------------------------- +;; 9. Tracking context +;; -------------------------------------------------------------------------- +;; +;; A tracking context is an ephemeral object created during effect/computed +;; evaluation to discover signal dependencies. Platform must provide: +;; +;; (make-tracking-context notify-fn) → context +;; (tracking-context-deps ctx) → list of signals +;; (tracking-context-add-dep! ctx s) → void (adds s to ctx's dep list) +;; (tracking-context-notify-fn ctx) → the notify function +;; +;; These are platform primitives because the context is mutable state +;; that must be efficient (often a Set in the host language). + + +;; -------------------------------------------------------------------------- +;; 10. dispose — tear down a computed signal +;; -------------------------------------------------------------------------- +;; +;; For computed signals, unsubscribe from all dependencies. +;; For effects, the dispose function is returned by effect itself. + +(define dispose-computed + (fn (s) + (when (signal? s) + (for-each + (fn (dep) (signal-remove-sub! dep nil)) + (signal-deps s)) + (signal-set-deps! s (list))))) + + +;; -------------------------------------------------------------------------- +;; 11. Island scope — automatic cleanup of signals within an island +;; -------------------------------------------------------------------------- +;; +;; When an island is created, all signals, effects, and computeds created +;; within it are tracked. When the island is removed from the DOM, they +;; are all disposed. + +(define *island-scope* nil) + +(define with-island-scope + (fn (scope-fn body-fn) + (let ((prev *island-scope*)) + (set! *island-scope* scope-fn) + (let ((result (body-fn))) + (set! *island-scope* prev) + result)))) + +;; Hook into signal/effect/computed creation for scope tracking. +;; The platform's make-signal should call (register-in-scope s) if +;; *island-scope* is non-nil. + +(define register-in-scope + (fn (disposable) + (when *island-scope* + (*island-scope* disposable)))) diff --git a/shared/sx/ref/special-forms.sx b/shared/sx/ref/special-forms.sx index 90e6909..05bede7 100644 --- a/shared/sx/ref/special-forms.sx +++ b/shared/sx/ref/special-forms.sx @@ -182,6 +182,23 @@ (when subtitle (p subtitle)) children))") +(define-special-form "defisland" + :syntax (defisland ~name (&key param1 param2 &rest children) body) + :doc "Define a reactive island. Islands have the same calling convention + as components (defcomp) but create a reactive boundary. Inside an + island, signals are tracked — deref subscribes DOM nodes to signals, + and signal changes update only the affected nodes. + + On the server, islands render as static HTML wrapped in a + data-sx-island container with serialized initial state. On the + client, islands hydrate into reactive contexts." + :tail-position "body" + :example "(defisland ~counter (&key initial) + (let ((count (signal (or initial 0)))) + (div :class \"counter\" + (span (deref count)) + (button :on-click (fn (e) (swap! count inc)) \"+\"))))") + (define-special-form "defmacro" :syntax (defmacro name (params ...) body) :doc "Define a macro. Macros receive their arguments unevaluated (as raw