giles
b53a0fabea
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>
46 lines
4.4 KiB
Plaintext
46 lines
4.4 KiB
Plaintext
(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-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-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)))
|
|
|
|
(define deref :effects () (fn ((s :as any)) (if (not (signal? s)) s (let ((ctx (context "sx-reactive" nil))) (when ctx (let ((dep-list (get ctx "deps")) (notify-fn (get ctx "notify"))) (when (not (contains? dep-list s)) (append! dep-list s) (signal-add-sub! s notify-fn)))) (signal-value s)))))
|
|
|
|
(define reset! :effects (mutation) (fn ((s :as signal) value) (when (signal? s) (let ((old (signal-value s))) (when (not (identical? old value)) (signal-set-value! s value) (notify-subscribers s))))))
|
|
|
|
(define swap! :effects (mutation) (fn ((s :as signal) (f :as lambda) &rest args) (when (signal? s) (let ((old (signal-value s)) (new-val (trampoline (apply f (cons old args))))) (when (not (identical? old new-val)) (signal-set-value! s new-val) (notify-subscribers s))))))
|
|
|
|
(define computed :effects (mutation) (fn ((compute-fn :as lambda)) (let ((s (make-signal nil)) (deps (list)) (compute-ctx nil)) (let ((recompute (fn () (for-each (fn ((dep :as signal)) (signal-remove-sub! dep recompute)) (signal-deps s)) (signal-set-deps! s (list)) (let ((ctx (dict "deps" (list) "notify" recompute))) (scope-push! "sx-reactive" ctx) (let ((new-val (cek-call compute-fn nil))) (scope-pop! "sx-reactive") (signal-set-deps! s (get ctx "deps")) (let ((old (signal-value s))) (signal-set-value! s new-val) (when (not (identical? old new-val)) (notify-subscribers s)))))))) (recompute) (register-in-scope (fn () (dispose-computed s))) s))))
|
|
|
|
(define 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 notify-subscribers :effects (mutation) (fn ((s :as signal)) (if (> *batch-depth* 0) (when (not (contains? *batch-queue* s)) (append! *batch-queue* s)) (flush-subscribers s))))
|
|
|
|
(define flush-subscribers :effects (mutation) (fn ((s :as signal)) (for-each (fn ((sub :as lambda)) (sub)) (signal-subscribers s))))
|
|
|
|
(define dispose-computed :effects (mutation) (fn ((s :as signal)) (when (signal? s) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep nil)) (signal-deps s)) (signal-set-deps! s (list)))))
|
|
|
|
(define with-island-scope :effects (mutation) (fn ((scope-fn :as lambda) (body-fn :as lambda)) (scope-push! "sx-island-scope" scope-fn) (let ((result (body-fn))) (scope-pop! "sx-island-scope") result)))
|
|
|
|
(define register-in-scope :effects (mutation) (fn ((disposable :as lambda)) (let ((collector (scope-peek "sx-island-scope"))) (when collector (cek-call collector (list disposable))))))
|