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 <noreply@anthropic.com>
This commit is contained in:
@@ -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
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
@@ -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 @@
|
||||
"</" tag ">"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 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 "<div data-sx-island=\"" (escape-attr island-name) "\""
|
||||
(if state-json
|
||||
(str " data-sx-state=\"" (escape-attr state-json) "\"")
|
||||
"")
|
||||
">"
|
||||
body-html
|
||||
"</div>"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 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
|
||||
|
||||
@@ -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)))))))))))
|
||||
|
||||
|
||||
|
||||
@@ -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.")
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
279
shared/sx/ref/signals.sx
Normal file
279
shared/sx/ref/signals.sx
Normal file
@@ -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))))
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user