coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Inline test runner: 5/5 temperature converter tests passing

Browse Source 
Fixed three fundamental issues:
1. cek-try arg passing: handler was called with raw string instead of
   (List [String msg]), causing "lambda expects 1 args, got N" errors
2. Silent island hydration failures: hydrate-island now wraps body
   render in cek-try, displaying red error box with stack trace instead
   of empty div. No more silent failures.
3. swap! thunk leak: apply result wasn't trampolined, storing thunks
   as signal values instead of evaluated results

Also fixed: assert= uses = instead of equal? for value comparison,
assert-signal-value uses deref instead of signal-value, HTML entity
decoding in script tag test source via host-call replaceAll.

Temperature converter demo page now shows live test results:
  ✓ initial celsius is 20
  ✓ computed fahrenheit = celsius * 1.8 + 32
  ✓ +5 increments celsius
  ✓ fahrenheit updates on celsius change
  ✓ multiple clicks accumulate

1116/1116 OCaml tests pass.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-26 01:51:30 +00:00
parent 7a8a166326
commit b53a0fabea
8 changed files with 88 additions and 1444 deletions
Download Patch File Download Diff File Expand all files Collapse all files

253
spec/signals.sx
View File

@@ -1,258 +1,45 @@
;; ==========================================================================
;; spec/signals.sx — Core reactive signal specification
;;
;; Defines the signal primitive: a container for a value that notifies
;; subscribers when it changes. Signals are the core reactive state
;; primitive for SX — usable in any context (web, CLI, embedded, server).
;;
;; Signals are pure computation — no DOM, no IO. Platform-specific
;; extensions (island scopes, DOM rendering, events) live in web/signals.sx.
;;
;; Signals are plain dicts with a "__signal" marker key. No platform
;; primitives needed — all signal operations are pure SX.
;;
;; Reactive tracking uses the general scope system:
;; "sx-reactive" — tracking context for computed/effect dep discovery
;; "sx-island-scope" — disposable collector (named for history, works anywhere)
;;
;; Scope-based tracking:
;; (scope-push! "sx-reactive" {:deps (list) :notify fn}) → void
;; (scope-pop! "sx-reactive") → void
;; (context "sx-reactive" nil) → dict or nil
;;
;; CEK callable dispatch:
;; (cek-call f args) → any — call f with args list via CEK machine.
;; ==========================================================================
(define make-signal (fn (value) (dict "__signal" true "value" value "subscribers" (list) "deps" (list))))
;; --------------------------------------------------------------------------
;; Signal container — plain dict with marker key
;; --------------------------------------------------------------------------
(define make-signal (fn (value)
(dict "__signal" true "value" value "subscribers" (list) "deps" (list))))
(define signal? (fn (x)
(and (dict? x) (has-key? x "__signal"))))
(define signal? (fn (x) (and (dict? x) (has-key? x "__signal"))))
(define signal-value (fn (s) (get s "value")))
(define signal-set-value! (fn (s v) (dict-set! s "value" v)))
(define signal-subscribers (fn (s) (get s "subscribers")))
(define signal-add-sub! (fn (s f)
(when (not (contains? (get s "subscribers") f))
(append! (get s "subscribers") f))))
(define signal-add-sub! (fn (s f) (when (not (contains? (get s "subscribers") f)) (append! (get s "subscribers") f))))
(define signal-remove-sub! (fn (s f)
(dict-set! s "subscribers"
(filter (fn (sub) (not (identical? sub f)))
(get s "subscribers")))))
(define signal-remove-sub! (fn (s f) (dict-set! s "subscribers" (filter (fn (sub) (not (identical? sub f))) (get s "subscribers")))))
(define signal-deps (fn (s) (get s "deps")))
(define signal-set-deps! (fn (s deps) (dict-set! s "deps" deps)))
(define signal :effects () (fn ((initial-value :as any)) (make-signal initial-value)))
;; --------------------------------------------------------------------------
;; signal — create a reactive container
;; --------------------------------------------------------------------------
(define deref :effects () (fn ((s :as any)) (if (not (signal? s)) s (let ((ctx (context "sx-reactive" nil))) (when ctx (let ((dep-list (get ctx "deps")) (notify-fn (get ctx "notify"))) (when (not (contains? dep-list s)) (append! dep-list s) (signal-add-sub! s notify-fn)))) (signal-value s)))))
(define signal :effects []
(fn ((initial-value :as any))
(make-signal initial-value)))
(define reset! :effects (mutation) (fn ((s :as signal) value) (when (signal? s) (let ((old (signal-value s))) (when (not (identical? old value)) (signal-set-value! s value) (notify-subscribers s))))))
(define swap! :effects (mutation) (fn ((s :as signal) (f :as lambda) &rest args) (when (signal? s) (let ((old (signal-value s)) (new-val (trampoline (apply f (cons old args))))) (when (not (identical? old new-val)) (signal-set-value! s new-val) (notify-subscribers s))))))
;; --------------------------------------------------------------------------
;; deref — read signal value, subscribe current reactive context
;; --------------------------------------------------------------------------
(define computed :effects (mutation) (fn ((compute-fn :as lambda)) (let ((s (make-signal nil)) (deps (list)) (compute-ctx nil)) (let ((recompute (fn () (for-each (fn ((dep :as signal)) (signal-remove-sub! dep recompute)) (signal-deps s)) (signal-set-deps! s (list)) (let ((ctx (dict "deps" (list) "notify" recompute))) (scope-push! "sx-reactive" ctx) (let ((new-val (cek-call compute-fn nil))) (scope-pop! "sx-reactive") (signal-set-deps! s (get ctx "deps")) (let ((old (signal-value s))) (signal-set-value! s new-val) (when (not (identical? old new-val)) (notify-subscribers s)))))))) (recompute) (register-in-scope (fn () (dispose-computed s))) s))))
(define deref :effects []
(fn ((s :as any))
(if (not (signal? s))
s
(let ((ctx (context "sx-reactive" nil)))
(when ctx
(let ((dep-list (get ctx "deps"))
(notify-fn (get ctx "notify")))
(when (not (contains? dep-list s))
(append! dep-list s)
(signal-add-sub! s notify-fn))))
(signal-value s)))))
;; --------------------------------------------------------------------------
;; reset! — write a new value, notify subscribers
;; --------------------------------------------------------------------------
(define reset! :effects [mutation]
(fn ((s :as signal) value)
(when (signal? s)
(let ((old (signal-value s)))
(when (not (identical? old value))
(signal-set-value! s value)
(notify-subscribers s))))))
;; --------------------------------------------------------------------------
;; swap! — update signal via function
;; --------------------------------------------------------------------------
(define swap! :effects [mutation]
(fn ((s :as signal) (f :as lambda) &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))))))
;; --------------------------------------------------------------------------
;; computed — derived signal with automatic dependency tracking
;; --------------------------------------------------------------------------
(define computed :effects [mutation]
(fn ((compute-fn :as lambda))
(let ((s (make-signal nil))
(deps (list))
(compute-ctx nil))
(let ((recompute
(fn ()
(for-each
(fn ((dep :as signal)) (signal-remove-sub! dep recompute))
(signal-deps s))
(signal-set-deps! s (list))
(let ((ctx (dict "deps" (list) "notify" recompute)))
(scope-push! "sx-reactive" ctx)
(let ((new-val (cek-call compute-fn nil)))
(scope-pop! "sx-reactive")
(signal-set-deps! s (get ctx "deps"))
(let ((old (signal-value s)))
(signal-set-value! s new-val)
(when (not (identical? old new-val))
(notify-subscribers s))))))))
(recompute)
(register-in-scope (fn () (dispose-computed s)))
s))))
;; --------------------------------------------------------------------------
;; effect — side effect that runs when dependencies change
;; --------------------------------------------------------------------------
(define effect :effects [mutation]
(fn ((effect-fn :as lambda))
(let ((deps (list))
(disposed false)
(cleanup-fn nil))
(let ((run-effect
(fn ()
(when (not disposed)
(when cleanup-fn (cek-call cleanup-fn nil))
(for-each
(fn ((dep :as signal)) (signal-remove-sub! dep run-effect))
deps)
(set! deps (list))
(let ((ctx (dict "deps" (list) "notify" run-effect)))
(scope-push! "sx-reactive" ctx)
(let ((result (cek-call effect-fn nil)))
(scope-pop! "sx-reactive")
(set! deps (get ctx "deps"))
(when (callable? result)
(set! cleanup-fn result))))))))
(run-effect)
(let ((dispose-fn
(fn ()
(set! disposed true)
(when cleanup-fn (cek-call cleanup-fn nil))
(for-each
(fn ((dep :as signal)) (signal-remove-sub! dep run-effect))
deps)
(set! deps (list)))))
(register-in-scope dispose-fn)
dispose-fn)))))
;; --------------------------------------------------------------------------
;; batch — group multiple signal writes into one notification pass
;; --------------------------------------------------------------------------
(define effect :effects (mutation) (fn ((effect-fn :as lambda)) (let ((deps (list)) (disposed false) (cleanup-fn nil)) (let ((run-effect (fn () (when (not disposed) (when cleanup-fn (cek-call cleanup-fn nil)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list)) (let ((ctx (dict "deps" (list) "notify" run-effect))) (scope-push! "sx-reactive" ctx) (let ((result (cek-call effect-fn nil))) (scope-pop! "sx-reactive") (set! deps (get ctx "deps")) (when (callable? result) (set! cleanup-fn result)))))))) (run-effect) (let ((dispose-fn (fn () (set! disposed true) (when cleanup-fn (cek-call cleanup-fn nil)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list))))) (register-in-scope dispose-fn) dispose-fn)))))
(define *batch-depth* 0)
(define *batch-queue* (list))
(define batch :effects [mutation]
(fn ((thunk :as lambda))
(set! *batch-depth* (+ *batch-depth* 1))
(cek-call thunk nil)
(set! *batch-depth* (- *batch-depth* 1))
(when (= *batch-depth* 0)
(let ((queue *batch-queue*))
(set! *batch-queue* (list))
(let ((seen (list))
(pending (list)))
(for-each
(fn ((s :as signal))
(for-each
(fn ((sub :as lambda))
(when (not (contains? seen sub))
(append! seen sub)
(append! pending sub)))
(signal-subscribers s)))
queue)
(for-each (fn ((sub :as lambda)) (sub)) pending))))))
(define batch :effects (mutation) (fn ((thunk :as lambda)) (set! *batch-depth* (+ *batch-depth* 1)) (cek-call thunk nil) (set! *batch-depth* (- *batch-depth* 1)) (when (= *batch-depth* 0) (let ((queue *batch-queue*)) (set! *batch-queue* (list)) (let ((seen (list)) (pending (list))) (for-each (fn ((s :as signal)) (for-each (fn ((sub :as lambda)) (when (not (contains? seen sub)) (append! seen sub) (append! pending sub))) (signal-subscribers s))) queue) (for-each (fn ((sub :as lambda)) (sub)) pending))))))
(define notify-subscribers :effects (mutation) (fn ((s :as signal)) (if (> *batch-depth* 0) (when (not (contains? *batch-queue* s)) (append! *batch-queue* s)) (flush-subscribers s))))
;; --------------------------------------------------------------------------
;; notify-subscribers — internal notification dispatch
;; --------------------------------------------------------------------------
(define flush-subscribers :effects (mutation) (fn ((s :as signal)) (for-each (fn ((sub :as lambda)) (sub)) (signal-subscribers s))))
(define notify-subscribers :effects [mutation]
(fn ((s :as signal))
(if (> *batch-depth* 0)
(when (not (contains? *batch-queue* s))
(append! *batch-queue* s))
(flush-subscribers s))))
(define dispose-computed :effects (mutation) (fn ((s :as signal)) (when (signal? s) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep nil)) (signal-deps s)) (signal-set-deps! s (list)))))
(define flush-subscribers :effects [mutation]
(fn ((s :as signal))
(for-each
(fn ((sub :as lambda)) (sub))
(signal-subscribers s))))
(define with-island-scope :effects (mutation) (fn ((scope-fn :as lambda) (body-fn :as lambda)) (scope-push! "sx-island-scope" scope-fn) (let ((result (body-fn))) (scope-pop! "sx-island-scope") result)))
;; --------------------------------------------------------------------------
;; dispose-computed — tear down a computed signal
;; --------------------------------------------------------------------------
(define dispose-computed :effects [mutation]
(fn ((s :as signal))
(when (signal? s)
(for-each
(fn ((dep :as signal)) (signal-remove-sub! dep nil))
(signal-deps s))
(signal-set-deps! s (list)))))
;; --------------------------------------------------------------------------
;; Reactive scope — automatic cleanup of signals within a scope
;; --------------------------------------------------------------------------
(define with-island-scope :effects [mutation]
(fn ((scope-fn :as lambda) (body-fn :as lambda))
(scope-push! "sx-island-scope" scope-fn)
(let ((result (body-fn)))
(scope-pop! "sx-island-scope")
result)))
(define register-in-scope :effects [mutation]
(fn ((disposable :as lambda))
(let ((collector (scope-peek "sx-island-scope")))
(when collector
(cek-call collector (list disposable))))))
(define register-in-scope :effects (mutation) (fn ((disposable :as lambda)) (let ((collector (scope-peek "sx-island-scope"))) (when collector (cek-call collector (list disposable))))))