Add one-line comments to all defines in 5 spec files
parser.sx (3), render.sx (15), harness.sx (21), signals.sx (23), canonical.sx (12) — 74 comments total. Each define now has a ;; comment explaining its purpose. Combined with the evaluator.sx commit, all 215 defines across 6 spec files are now documented. primitives.sx and special-forms.sx already had :doc fields. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1,3 +1,4 @@
|
|||||||
|
;; Deterministic serialization for content addressing
|
||||||
(define
|
(define
|
||||||
canonical-serialize
|
canonical-serialize
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -23,6 +24,7 @@
|
|||||||
(canonical-dict val)
|
(canonical-dict val)
|
||||||
:else (str val))))
|
:else (str val))))
|
||||||
|
|
||||||
|
;; Normalize number representation (no trailing zeros)
|
||||||
(define
|
(define
|
||||||
canonical-number
|
canonical-number
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -40,6 +42,7 @@
|
|||||||
(if (ends-with? trimmed ".") (str trimmed "0") trimmed))
|
(if (ends-with? trimmed ".") (str trimmed "0") trimmed))
|
||||||
s)))))
|
s)))))
|
||||||
|
|
||||||
|
;; Serialize dict with sorted keys
|
||||||
(define
|
(define
|
||||||
canonical-dict
|
canonical-dict
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -61,16 +64,19 @@
|
|||||||
sorted-keys))
|
sorted-keys))
|
||||||
"}"))))
|
"}"))))
|
||||||
|
|
||||||
|
;; Compute SHA3-256 content ID from an expression
|
||||||
(define
|
(define
|
||||||
content-id
|
content-id
|
||||||
:effects ()
|
:effects ()
|
||||||
(fn (expr) (sha3-256 (canonical-serialize expr))))
|
(fn (expr) (sha3-256 (canonical-serialize expr))))
|
||||||
|
|
||||||
|
;; First 16 chars of content ID (short form)
|
||||||
(define
|
(define
|
||||||
content-id-short
|
content-id-short
|
||||||
:effects ()
|
:effects ()
|
||||||
(fn (expr) (slice (content-id expr) 0 16)))
|
(fn (expr) (slice (content-id expr) 0 16)))
|
||||||
|
|
||||||
|
;; Create a bytecode module container
|
||||||
(define
|
(define
|
||||||
make-bytecode-module
|
make-bytecode-module
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -78,6 +84,7 @@
|
|||||||
(version source-hash code)
|
(version source-hash code)
|
||||||
(list (quote sxbc) version source-hash code)))
|
(list (quote sxbc) version source-hash code)))
|
||||||
|
|
||||||
|
;; Type predicate for bytecode modules
|
||||||
(define
|
(define
|
||||||
bytecode-module?
|
bytecode-module?
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -85,12 +92,16 @@
|
|||||||
(expr)
|
(expr)
|
||||||
(and (list? expr) (>= (len expr) 4) (= (first expr) (quote sxbc)))))
|
(and (list? expr) (>= (len expr) 4) (= (first expr) (quote sxbc)))))
|
||||||
|
|
||||||
|
;; Get module format version
|
||||||
(define bytecode-module-version :effects () (fn (m) (nth m 1)))
|
(define bytecode-module-version :effects () (fn (m) (nth m 1)))
|
||||||
|
|
||||||
|
;; Get source content hash
|
||||||
(define bytecode-module-source-hash :effects () (fn (m) (nth m 2)))
|
(define bytecode-module-source-hash :effects () (fn (m) (nth m 2)))
|
||||||
|
|
||||||
|
;; Get compiled bytecode
|
||||||
(define bytecode-module-code :effects () (fn (m) (nth m 3)))
|
(define bytecode-module-code :effects () (fn (m) (nth m 3)))
|
||||||
|
|
||||||
|
;; Create a code object (arity + constants + bytecode)
|
||||||
(define
|
(define
|
||||||
make-code-object
|
make-code-object
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -104,6 +115,7 @@
|
|||||||
(set! parts (concat parts (list :upvalue-count upvalue-count))))
|
(set! parts (concat parts (list :upvalue-count upvalue-count))))
|
||||||
(concat parts (list :bytecode bytecode :constants constants)))))
|
(concat parts (list :bytecode bytecode :constants constants)))))
|
||||||
|
|
||||||
|
;; Create provenance record (author, timestamp, source)
|
||||||
(define
|
(define
|
||||||
make-provenance
|
make-provenance
|
||||||
:effects ()
|
:effects ()
|
||||||
|
|||||||
@@ -1,41 +1,62 @@
|
|||||||
|
;; Assert condition is truthy, error with message
|
||||||
(define assert (fn (condition msg) (when (not condition) (error (or msg "Assertion failed")))))
|
(define assert (fn (condition msg) (when (not condition) (error (or msg "Assertion failed")))))
|
||||||
|
|
||||||
|
;; Assert two values are equal
|
||||||
(define assert= (fn (actual expected msg) (when (not (= actual expected)) (error (or msg (str "Expected " expected ", got " actual))))))
|
(define assert= (fn (actual expected msg) (when (not (= actual expected)) (error (or msg (str "Expected " expected ", got " actual))))))
|
||||||
|
|
||||||
|
;; Dict of mock IO operations for testing
|
||||||
(define default-platform {:current-user (fn () nil) :csrf-token (fn () "test-csrf-token") :app-url (fn (service &rest path) "/mock-app-url") :frag (fn (service comp &rest args) "") :sleep (fn (ms) nil) :local-storage-set (fn (key val) nil) :set-cookie (fn (name val &rest opts) nil) :url-for (fn (endpoint &rest args) "/mock-url") :create-element (fn (tag) nil) :request-path (fn () "/") :config (fn (key) nil) :set-attr (fn (el name val) nil) :set-text (fn (el text) nil) :remove-child (fn (parent child) nil) :fetch (fn (url &rest opts) {:status 200 :body "" :ok true}) :query (fn (service name &rest args) (list)) :add-class (fn (el cls) nil) :get-element (fn (id) nil) :now (fn () 0) :abort (fn (code) nil) :action (fn (service name &rest args) {:ok true}) :remove-class (fn (el cls) nil) :append-child (fn (parent child) nil) :request-arg (fn (name) nil) :emit-dom (fn (op &rest args) nil) :local-storage-get (fn (key) nil) :get-cookie (fn (name) nil)})
|
(define default-platform {:current-user (fn () nil) :csrf-token (fn () "test-csrf-token") :app-url (fn (service &rest path) "/mock-app-url") :frag (fn (service comp &rest args) "") :sleep (fn (ms) nil) :local-storage-set (fn (key val) nil) :set-cookie (fn (name val &rest opts) nil) :url-for (fn (endpoint &rest args) "/mock-url") :create-element (fn (tag) nil) :request-path (fn () "/") :config (fn (key) nil) :set-attr (fn (el name val) nil) :set-text (fn (el text) nil) :remove-child (fn (parent child) nil) :fetch (fn (url &rest opts) {:status 200 :body "" :ok true}) :query (fn (service name &rest args) (list)) :add-class (fn (el cls) nil) :get-element (fn (id) nil) :now (fn () 0) :abort (fn (code) nil) :action (fn (service name &rest args) {:ok true}) :remove-class (fn (el cls) nil) :append-child (fn (parent child) nil) :request-arg (fn (name) nil) :emit-dom (fn (op &rest args) nil) :local-storage-get (fn (key) nil) :get-cookie (fn (name) nil)})
|
||||||
|
|
||||||
|
;; Create a test session with mock IO platform
|
||||||
(define make-harness :effects () (fn (&key platform) (let ((merged (if (nil? platform) default-platform (merge default-platform platform)))) {:log (list) :platform merged :state {:cookies {} :storage {} :dom nil}})))
|
(define make-harness :effects () (fn (&key platform) (let ((merged (if (nil? platform) default-platform (merge default-platform platform)))) {:log (list) :platform merged :state {:cookies {} :storage {} :dom nil}})))
|
||||||
|
|
||||||
|
;; Clear IO log and state for a new test
|
||||||
(define harness-reset! :effects () (fn (session) (dict-set! session "log" (list)) (dict-set! session "state" {:cookies {} :storage {} :dom nil}) session))
|
(define harness-reset! :effects () (fn (session) (dict-set! session "log" (list)) (dict-set! session "state" {:cookies {} :storage {} :dom nil}) session))
|
||||||
|
|
||||||
|
;; Append an IO call record to session log
|
||||||
(define harness-log :effects () (fn (session &key op) (let ((log (get session "log"))) (if (nil? op) log (filter (fn (entry) (= (get entry "op") op)) log)))))
|
(define harness-log :effects () (fn (session &key op) (let ((log (get session "log"))) (if (nil? op) log (filter (fn (entry) (= (get entry "op") op)) log)))))
|
||||||
|
|
||||||
|
;; Read state value from session store
|
||||||
(define harness-get :effects () (fn (session key) (get (get session "state") key)))
|
(define harness-get :effects () (fn (session key) (get (get session "state") key)))
|
||||||
|
|
||||||
|
;; Write state value to session store
|
||||||
(define harness-set! :effects () (fn (session key value) (dict-set! (get session "state") key value) nil))
|
(define harness-set! :effects () (fn (session key value) (dict-set! (get session "state") key value) nil))
|
||||||
|
|
||||||
|
;; Wrap a mock fn to record calls in the IO log
|
||||||
(define make-interceptor :effects () (fn (session op-name mock-fn) (fn (&rest args) (let ((result (if (empty? args) (mock-fn) (if (= 1 (len args)) (mock-fn (first args)) (if (= 2 (len args)) (mock-fn (first args) (nth args 1)) (if (= 3 (len args)) (mock-fn (first args) (nth args 1) (nth args 2)) (apply mock-fn args)))))) (log (get session "log"))) (append! log {:args args :result result :op op-name}) result))))
|
(define make-interceptor :effects () (fn (session op-name mock-fn) (fn (&rest args) (let ((result (if (empty? args) (mock-fn) (if (= 1 (len args)) (mock-fn (first args)) (if (= 2 (len args)) (mock-fn (first args) (nth args 1)) (if (= 3 (len args)) (mock-fn (first args) (nth args 1) (nth args 2)) (apply mock-fn args)))))) (log (get session "log"))) (append! log {:args args :result result :op op-name}) result))))
|
||||||
|
|
||||||
|
;; Bind all interceptors into the eval environment
|
||||||
(define install-interceptors :effects () (fn (session env) (for-each (fn (key) (let ((mock-fn (get (get session "platform") key)) (interceptor (make-interceptor session key mock-fn))) (env-bind! env key interceptor))) (keys (get session "platform"))) env))
|
(define install-interceptors :effects () (fn (session env) (for-each (fn (key) (let ((mock-fn (get (get session "platform") key)) (interceptor (make-interceptor session key mock-fn))) (env-bind! env key interceptor))) (keys (get session "platform"))) env))
|
||||||
|
|
||||||
|
;; Query IO log: all calls, or filtered by op name
|
||||||
(define io-calls :effects () (fn (session op-name) (filter (fn (entry) (= (get entry "op") op-name)) (get session "log"))))
|
(define io-calls :effects () (fn (session op-name) (filter (fn (entry) (= (get entry "op") op-name)) (get session "log"))))
|
||||||
|
|
||||||
|
;; Count IO calls, optionally filtered by op name
|
||||||
(define io-call-count :effects () (fn (session op-name) (len (io-calls session op-name))))
|
(define io-call-count :effects () (fn (session op-name) (len (io-calls session op-name))))
|
||||||
|
|
||||||
|
;; Get the nth IO call record
|
||||||
(define io-call-nth :effects () (fn (session op-name n) (let ((calls (io-calls session op-name))) (if (< n (len calls)) (nth calls n) nil))))
|
(define io-call-nth :effects () (fn (session op-name n) (let ((calls (io-calls session op-name))) (if (< n (len calls)) (nth calls n) nil))))
|
||||||
|
|
||||||
|
;; Get args from the nth call to an operation
|
||||||
(define io-call-args :effects () (fn (session op-name n) (let ((call (io-call-nth session op-name n))) (if (nil? call) nil (get call "args")))))
|
(define io-call-args :effects () (fn (session op-name n) (let ((call (io-call-nth session op-name n))) (if (nil? call) nil (get call "args")))))
|
||||||
|
|
||||||
|
;; Get return value from the nth call to an operation
|
||||||
(define io-call-result :effects () (fn (session op-name n) (let ((call (io-call-nth session op-name n))) (if (nil? call) nil (get call "result")))))
|
(define io-call-result :effects () (fn (session op-name n) (let ((call (io-call-nth session op-name n))) (if (nil? call) nil (get call "result")))))
|
||||||
|
|
||||||
|
;; Assert an IO operation was called at least once
|
||||||
(define assert-io-called :effects () (fn (session op-name) (assert (> (io-call-count session op-name) 0) (str "Expected IO operation " op-name " to be called but it was not"))))
|
(define assert-io-called :effects () (fn (session op-name) (assert (> (io-call-count session op-name) 0) (str "Expected IO operation " op-name " to be called but it was not"))))
|
||||||
|
|
||||||
|
;; Assert an IO operation was never called
|
||||||
(define assert-no-io :effects () (fn (session op-name) (assert (= (io-call-count session op-name) 0) (str "Expected IO operation " op-name " not to be called but it was called " (io-call-count session op-name) " time(s)"))))
|
(define assert-no-io :effects () (fn (session op-name) (assert (= (io-call-count session op-name) 0) (str "Expected IO operation " op-name " not to be called but it was called " (io-call-count session op-name) " time(s)"))))
|
||||||
|
|
||||||
|
;; Assert exact call count for an operation
|
||||||
(define assert-io-count :effects () (fn (session op-name expected) (let ((actual (io-call-count session op-name))) (assert (= actual expected) (str "Expected " op-name " to be called " expected " time(s) but was called " actual " time(s)")))))
|
(define assert-io-count :effects () (fn (session op-name expected) (let ((actual (io-call-count session op-name))) (assert (= actual expected) (str "Expected " op-name " to be called " expected " time(s) but was called " actual " time(s)")))))
|
||||||
|
|
||||||
|
;; Assert args of the nth call match expected
|
||||||
(define assert-io-args :effects () (fn (session op-name n expected-args) (let ((actual (io-call-args session op-name n))) (assert (equal? actual expected-args) (str "Expected call " n " to " op-name " with args " (str expected-args) " but got " (str actual))))))
|
(define assert-io-args :effects () (fn (session op-name n expected-args) (let ((actual (io-call-args session op-name n))) (assert (equal? actual expected-args) (str "Expected call " n " to " op-name " with args " (str expected-args) " but got " (str actual))))))
|
||||||
|
|
||||||
|
;; Assert result of the nth call matches expected
|
||||||
(define assert-io-result :effects () (fn (session op-name n expected) (let ((actual (io-call-result session op-name n))) (assert (equal? actual expected) (str "Expected call " n " to " op-name " to return " (str expected) " but got " (str actual))))))
|
(define assert-io-result :effects () (fn (session op-name n expected) (let ((actual (io-call-result session op-name n))) (assert (equal? actual expected) (str "Expected call " n " to " op-name " to return " (str expected) " but got " (str actual))))))
|
||||||
|
|
||||||
|
;; Assert a state key has the expected value
|
||||||
(define assert-state :effects () (fn (session key expected) (let ((actual (harness-get session key))) (assert (equal? actual expected) (str "Expected state " key " to be " (str expected) " but got " (str actual))))))
|
(define assert-state :effects () (fn (session key expected) (let ((actual (harness-get session key))) (assert (equal? actual expected) (str "Expected state " key " to be " (str expected) " but got " (str actual))))))
|
||||||
|
|||||||
@@ -50,6 +50,7 @@
|
|||||||
;; --------------------------------------------------------------------------
|
;; --------------------------------------------------------------------------
|
||||||
;; Returns a list of top-level AST expressions.
|
;; Returns a list of top-level AST expressions.
|
||||||
|
|
||||||
|
;; Parse SX source string into AST
|
||||||
(define sx-parse :effects []
|
(define sx-parse :effects []
|
||||||
(fn ((source :as string))
|
(fn ((source :as string))
|
||||||
(let ((pos 0)
|
(let ((pos 0)
|
||||||
@@ -360,6 +361,7 @@
|
|||||||
;; Serializer — AST → SX source text
|
;; Serializer — AST → SX source text
|
||||||
;; --------------------------------------------------------------------------
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
;; Serialize AST value back to SX source
|
||||||
(define sx-serialize :effects []
|
(define sx-serialize :effects []
|
||||||
(fn (val)
|
(fn (val)
|
||||||
(case (type-of val)
|
(case (type-of val)
|
||||||
@@ -376,6 +378,7 @@
|
|||||||
:else (str val))))
|
:else (str val))))
|
||||||
|
|
||||||
|
|
||||||
|
;; Serialize a dict to SX {:key val} format
|
||||||
(define sx-serialize-dict :effects []
|
(define sx-serialize-dict :effects []
|
||||||
(fn ((d :as dict))
|
(fn ((d :as dict))
|
||||||
(str "{"
|
(str "{"
|
||||||
|
|||||||
@@ -1,3 +1,4 @@
|
|||||||
|
;; Registry of all valid HTML tag names
|
||||||
(define
|
(define
|
||||||
HTML_TAGS
|
HTML_TAGS
|
||||||
(list
|
(list
|
||||||
@@ -141,6 +142,7 @@
|
|||||||
"dialog"
|
"dialog"
|
||||||
"menu"))
|
"menu"))
|
||||||
|
|
||||||
|
;; Self-closing tags (br, img, hr, etc.)
|
||||||
(define
|
(define
|
||||||
VOID_ELEMENTS
|
VOID_ELEMENTS
|
||||||
(list
|
(list
|
||||||
@@ -159,6 +161,7 @@
|
|||||||
"track"
|
"track"
|
||||||
"wbr"))
|
"wbr"))
|
||||||
|
|
||||||
|
;; Attrs that are true/false (checked, disabled, etc.)
|
||||||
(define
|
(define
|
||||||
BOOLEAN_ATTRS
|
BOOLEAN_ATTRS
|
||||||
(list
|
(list
|
||||||
@@ -186,8 +189,10 @@
|
|||||||
"reversed"
|
"reversed"
|
||||||
"selected"))
|
"selected"))
|
||||||
|
|
||||||
|
;; Extensible list of forms treated as definitions
|
||||||
(define *definition-form-extensions* (list))
|
(define *definition-form-extensions* (list))
|
||||||
|
|
||||||
|
;; Check if a symbol names a definition form
|
||||||
(define
|
(define
|
||||||
definition-form?
|
definition-form?
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -203,6 +208,7 @@
|
|||||||
(= name "defeffect")
|
(= name "defeffect")
|
||||||
(contains? *definition-form-extensions* name))))
|
(contains? *definition-form-extensions* name))))
|
||||||
|
|
||||||
|
;; Parse keyword attrs and children from element arg list
|
||||||
(define
|
(define
|
||||||
parse-element-args
|
parse-element-args
|
||||||
:effects (render)
|
:effects (render)
|
||||||
@@ -233,6 +239,7 @@
|
|||||||
args)
|
args)
|
||||||
(list attrs children))))
|
(list attrs children))))
|
||||||
|
|
||||||
|
;; Render attr dict to HTML attribute string
|
||||||
(define
|
(define
|
||||||
render-attrs
|
render-attrs
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -255,6 +262,7 @@
|
|||||||
:else (str " " key "=\"" (escape-attr (str val)) "\""))))
|
:else (str " " key "=\"" (escape-attr (str val)) "\""))))
|
||||||
(keys attrs)))))
|
(keys attrs)))))
|
||||||
|
|
||||||
|
;; Evaluate cond expression (dispatches to scheme/clojure style)
|
||||||
(define
|
(define
|
||||||
eval-cond
|
eval-cond
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -265,6 +273,7 @@
|
|||||||
(eval-cond-scheme clauses env)
|
(eval-cond-scheme clauses env)
|
||||||
(eval-cond-clojure clauses env))))
|
(eval-cond-clojure clauses env))))
|
||||||
|
|
||||||
|
;; Scheme-style cond: ((test body) ...)
|
||||||
(define
|
(define
|
||||||
eval-cond-scheme
|
eval-cond-scheme
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -285,6 +294,7 @@
|
|||||||
body
|
body
|
||||||
(eval-cond-scheme (rest clauses) env)))))))
|
(eval-cond-scheme (rest clauses) env)))))))
|
||||||
|
|
||||||
|
;; Clojure-style cond: (test body test body ...)
|
||||||
(define
|
(define
|
||||||
eval-cond-clojure
|
eval-cond-clojure
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -303,6 +313,7 @@
|
|||||||
body
|
body
|
||||||
(eval-cond-clojure (slice clauses 2) env)))))))
|
(eval-cond-clojure (slice clauses 2) env)))))))
|
||||||
|
|
||||||
|
;; Evaluate let binding pairs, extend env
|
||||||
(define
|
(define
|
||||||
process-bindings
|
process-bindings
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -324,6 +335,7 @@
|
|||||||
bindings)
|
bindings)
|
||||||
local)))
|
local)))
|
||||||
|
|
||||||
|
;; Check if an expression should be rendered vs evaluated
|
||||||
(define
|
(define
|
||||||
is-render-expr?
|
is-render-expr?
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -350,6 +362,7 @@
|
|||||||
(> (len expr) 1)
|
(> (len expr) 1)
|
||||||
(= (type-of (nth expr 1)) "keyword")))))))))
|
(= (type-of (nth expr 1)) "keyword")))))))))
|
||||||
|
|
||||||
|
;; Merge spread child attrs into parent element attrs
|
||||||
(define
|
(define
|
||||||
merge-spread-attrs
|
merge-spread-attrs
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -385,6 +398,7 @@
|
|||||||
(dict-set! target key val)))))
|
(dict-set! target key val)))))
|
||||||
(keys spread-dict))))
|
(keys spread-dict))))
|
||||||
|
|
||||||
|
;; Escape special chars for HTML text content
|
||||||
(define
|
(define
|
||||||
escape-html
|
escape-html
|
||||||
(fn
|
(fn
|
||||||
@@ -397,4 +411,5 @@
|
|||||||
(set! r (replace r "\"" """))
|
(set! r (replace r "\"" """))
|
||||||
r)))
|
r)))
|
||||||
|
|
||||||
|
;; Escape special chars for HTML attribute values
|
||||||
(define escape-attr (fn (s) (escape-html s)))
|
(define escape-attr (fn (s) (escape-html s)))
|
||||||
|
|||||||
@@ -1,17 +1,23 @@
|
|||||||
|
;; Create raw signal dict with value, subs, deps fields
|
||||||
(define
|
(define
|
||||||
make-signal
|
make-signal
|
||||||
(fn
|
(fn
|
||||||
(value)
|
(value)
|
||||||
(dict "__signal" true "value" value "subscribers" (list) "deps" (list))))
|
(dict "__signal" true "value" value "subscribers" (list) "deps" (list))))
|
||||||
|
|
||||||
|
;; Type predicate for signals
|
||||||
(define signal? (fn (x) (and (dict? x) (has-key? x "__signal"))))
|
(define signal? (fn (x) (and (dict? x) (has-key? x "__signal"))))
|
||||||
|
|
||||||
|
;; Read current value from signal
|
||||||
(define signal-value (fn (s) (get s "value")))
|
(define signal-value (fn (s) (get s "value")))
|
||||||
|
|
||||||
|
;; Write value to signal (no notification)
|
||||||
(define signal-set-value! (fn (s v) (dict-set! s "value" v)))
|
(define signal-set-value! (fn (s v) (dict-set! s "value" v)))
|
||||||
|
|
||||||
|
;; List of subscriber functions
|
||||||
(define signal-subscribers (fn (s) (get s "subscribers")))
|
(define signal-subscribers (fn (s) (get s "subscribers")))
|
||||||
|
|
||||||
|
;; Add a subscriber function
|
||||||
(define
|
(define
|
||||||
signal-add-sub!
|
signal-add-sub!
|
||||||
(fn
|
(fn
|
||||||
@@ -20,6 +26,7 @@
|
|||||||
(not (contains? (get s "subscribers") f))
|
(not (contains? (get s "subscribers") f))
|
||||||
(dict-set! s "subscribers" (append (get s "subscribers") (list f))))))
|
(dict-set! s "subscribers" (append (get s "subscribers") (list f))))))
|
||||||
|
|
||||||
|
;; Remove a subscriber function
|
||||||
(define
|
(define
|
||||||
signal-remove-sub!
|
signal-remove-sub!
|
||||||
(fn
|
(fn
|
||||||
@@ -29,15 +36,19 @@
|
|||||||
"subscribers"
|
"subscribers"
|
||||||
(filter (fn (sub) (not (identical? sub f))) (get s "subscribers")))))
|
(filter (fn (sub) (not (identical? sub f))) (get s "subscribers")))))
|
||||||
|
|
||||||
|
;; List of upstream signal dependencies
|
||||||
(define signal-deps (fn (s) (get s "deps")))
|
(define signal-deps (fn (s) (get s "deps")))
|
||||||
|
|
||||||
|
;; Set upstream dependencies
|
||||||
(define signal-set-deps! (fn (s deps) (dict-set! s "deps" deps)))
|
(define signal-set-deps! (fn (s deps) (dict-set! s "deps" deps)))
|
||||||
|
|
||||||
|
;; Create a reactive signal (user-facing constructor)
|
||||||
(define
|
(define
|
||||||
signal
|
signal
|
||||||
:effects ()
|
:effects ()
|
||||||
(fn ((initial-value :as any)) (make-signal initial-value)))
|
(fn ((initial-value :as any)) (make-signal initial-value)))
|
||||||
|
|
||||||
|
;; Dereference a signal, returning its current value
|
||||||
(define
|
(define
|
||||||
deref
|
deref
|
||||||
:effects ()
|
:effects ()
|
||||||
@@ -58,6 +69,7 @@
|
|||||||
(signal-add-sub! s notify-fn))))
|
(signal-add-sub! s notify-fn))))
|
||||||
(signal-value s)))))
|
(signal-value s)))))
|
||||||
|
|
||||||
|
;; Set signal to new value and notify subscribers
|
||||||
(define
|
(define
|
||||||
reset!
|
reset!
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -72,6 +84,7 @@
|
|||||||
(signal-set-value! s value)
|
(signal-set-value! s value)
|
||||||
(notify-subscribers s))))))
|
(notify-subscribers s))))))
|
||||||
|
|
||||||
|
;; Apply function to current value and reset
|
||||||
(define
|
(define
|
||||||
swap!
|
swap!
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -87,6 +100,7 @@
|
|||||||
(signal-set-value! s new-val)
|
(signal-set-value! s new-val)
|
||||||
(notify-subscribers s))))))
|
(notify-subscribers s))))))
|
||||||
|
|
||||||
|
;; Create a derived signal that auto-updates from dependencies
|
||||||
(define
|
(define
|
||||||
computed
|
computed
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -100,6 +114,7 @@
|
|||||||
(register-in-scope (fn () (dispose-computed s)))
|
(register-in-scope (fn () (dispose-computed s)))
|
||||||
s))))
|
s))))
|
||||||
|
|
||||||
|
;; Create a side-effect that runs when dependencies change
|
||||||
(define
|
(define
|
||||||
effect
|
effect
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -115,10 +130,13 @@
|
|||||||
(register-in-scope dispose-fn)
|
(register-in-scope dispose-fn)
|
||||||
dispose-fn)))))
|
dispose-fn)))))
|
||||||
|
|
||||||
|
;; Nesting counter for batched updates
|
||||||
(define *batch-depth* 0)
|
(define *batch-depth* 0)
|
||||||
|
|
||||||
|
;; Queued notifications during batch
|
||||||
(define *batch-queue* (list))
|
(define *batch-queue* (list))
|
||||||
|
|
||||||
|
;; Batch multiple signal updates, notify once at end
|
||||||
(define
|
(define
|
||||||
batch
|
batch
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -148,6 +166,7 @@
|
|||||||
queue)
|
queue)
|
||||||
(for-each (fn ((sub :as lambda)) (sub)) pending))))))
|
(for-each (fn ((sub :as lambda)) (sub)) pending))))))
|
||||||
|
|
||||||
|
;; Notify all subscribers of a signal change
|
||||||
(define
|
(define
|
||||||
notify-subscribers
|
notify-subscribers
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -158,6 +177,7 @@
|
|||||||
(when (not (contains? *batch-queue* s)) (append! *batch-queue* s))
|
(when (not (contains? *batch-queue* s)) (append! *batch-queue* s))
|
||||||
(flush-subscribers s))))
|
(flush-subscribers s))))
|
||||||
|
|
||||||
|
;; Process queued subscriber notifications
|
||||||
(define
|
(define
|
||||||
flush-subscribers
|
flush-subscribers
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -165,6 +185,7 @@
|
|||||||
((s :as dict))
|
((s :as dict))
|
||||||
(for-each (fn (sub) (cek-call sub nil)) (signal-subscribers s))))
|
(for-each (fn (sub) (cek-call sub nil)) (signal-subscribers s))))
|
||||||
|
|
||||||
|
;; Tear down a computed signal, remove from deps
|
||||||
(define
|
(define
|
||||||
dispose-computed
|
dispose-computed
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -177,6 +198,7 @@
|
|||||||
(signal-deps s))
|
(signal-deps s))
|
||||||
(signal-set-deps! s (list)))))
|
(signal-set-deps! s (list)))))
|
||||||
|
|
||||||
|
;; Evaluate body in an island disposal scope
|
||||||
(define
|
(define
|
||||||
with-island-scope
|
with-island-scope
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
@@ -185,6 +207,7 @@
|
|||||||
(scope-push! "sx-island-scope" scope-fn)
|
(scope-push! "sx-island-scope" scope-fn)
|
||||||
(let ((result (body-fn))) (scope-pop! "sx-island-scope") result)))
|
(let ((result (body-fn))) (scope-pop! "sx-island-scope") result)))
|
||||||
|
|
||||||
|
;; Register a disposable in the current island scope
|
||||||
(define
|
(define
|
||||||
register-in-scope
|
register-in-scope
|
||||||
:effects (mutation)
|
:effects (mutation)
|
||||||
|
|||||||
Reference in New Issue
Block a user