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

Step 10c: batch coalescing + global subscriber registry

Browse Source 
Provide subscribers stored in global *provide-subscribers* dict (keyed
by name) instead of on provide frames. Fixes subscriber loss when
frames are reconstructed, and enables cross-cek_run notification.

Batch integration: batch-begin!/batch-end! primitives manage
*provide-batch-depth*. fire-provide-subscribers defers to queue when
depth > 0, batch-end! flushes deduped. signals.sx batch calls both.

context now prefers scope-peek over frame value — scope stack is the
source of truth since provide! always updates it (even in nested
cek_run where provide frames aren't on the kont).

2754/2768 OCaml (14 pre-existing). 32/32 WASM.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-05 11:39:38 +00:00
parent 44b520a9e9
commit fb262aa49b
7 changed files with 1457 additions and 1341 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hosts/ocaml/bin/run_tests.ml
View File

@@ -441,6 +441,8 @@ let make_test_env () =
match args with match args with
| [state] -> Sx_ref.cek_run state | [state] -> Sx_ref.cek_run state
| _ -> Nil); | _ -> Nil);
bind "batch-begin!" (fun _args -> Sx_ref.batch_begin_b ());
bind "batch-end!" (fun _args -> Sx_ref.batch_end_b ());
bind "now-ms" (fun _args -> Number 1000.0); bind "now-ms" (fun _args -> Number 1000.0);
bind "random-int" (fun args -> match args with [Number lo; _] -> Number lo | _ -> Number 0.0); bind "random-int" (fun args -> match args with [Number lo; _] -> Number lo | _ -> Number 0.0);
bind "try-rerender-page" (fun _args -> Nil); bind "try-rerender-page" (fun _args -> Nil);

27
hosts/ocaml/lib/sx_ref.ml
View File

File diff suppressed because one or more lines are too long

8
shared/static/wasm/sx/core-signals.sx
View File

@@ -149,8 +149,9 @@
batch batch
:effects (mutation) :effects (mutation)
(fn (fn
((thunk :as lambda)) ((thunk :as callable))
(set! *batch-depth* (+ *batch-depth* 1)) (set! *batch-depth* (+ *batch-depth* 1))
(batch-begin!)
(cek-call thunk nil) (cek-call thunk nil)
(set! *batch-depth* (- *batch-depth* 1)) (set! *batch-depth* (- *batch-depth* 1))
(when (when
@@ -165,14 +166,15 @@
((s :as signal)) ((s :as signal))
(for-each (for-each
(fn (fn
((sub :as lambda)) ((sub :as callable))
(when (when
(not (contains? seen sub)) (not (contains? seen sub))
(append! seen sub) (append! seen sub)
(append! pending sub))) (append! pending sub)))
(signal-subscribers s))) (signal-subscribers s)))
queue) queue)
(for-each (fn ((sub :as lambda)) (sub)) pending)))))) (for-each (fn ((sub :as callable)) (sub)) pending))))
(batch-end!)))
(define (define
notify-subscribers notify-subscribers
:effects (mutation) :effects (mutation)

2454
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create}; blake2_js_for_wasm_create: blake2_js_for_wasm_create};
} }
(globalThis)) (globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-b2cc3269",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-9b135b3a",[2,3,5]],["std_exit-10fb8830",[2]],["start-f5d3f095",0]],"generated":(b=>{var ({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-7ca4d3ad",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-bec4a5c4",[2,3,5]],["std_exit-10fb8830",[2]],["start-f5d3f095",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new

297
spec/evaluator.sx
View File

@@ -401,8 +401,11 @@
(define *bind-tracking* nil) (define *bind-tracking* nil)
;; Cond/case helpers ;; Cond/case helpers
(define *provide-batch-depth* 0)
(define *library-registry* (dict)) (define *library-registry* (dict))
;; Special form constructors — build state for CEK evaluation
(define (define
library-name-key library-name-key
(fn (fn
@@ -411,7 +414,6 @@
"." "."
(map (fn (s) (if (symbol? s) (symbol-name s) (str s))) spec)))) (map (fn (s) (if (symbol? s) (symbol-name s) (str s))) spec))))
;; Special form constructors — build state for CEK evaluation
(define (define
library-loaded? library-loaded?
(fn (spec) (has-key? *library-registry* (library-name-key spec)))) (fn (spec) (has-key? *library-registry* (library-name-key spec))))
@@ -436,9 +438,9 @@
(define io-lookup (fn (name) (get *io-registry* name))) (define io-lookup (fn (name) (get *io-registry* name)))
;; Quasiquote expansion
(define io-names (fn () (keys *io-registry*))) (define io-names (fn () (keys *io-registry*)))
;; Quasiquote expansion
(define (define
step-sf-io step-sf-io
(fn (fn
@@ -469,9 +471,17 @@
(define *prim-param-types* nil) (define *prim-param-types* nil)
;; Macro expansion — expand then re-evaluate the result
(define set-prim-param-types! (fn (types) (set! *prim-param-types* types))) (define set-prim-param-types! (fn (types) (set! *prim-param-types* types)))
;; Macro expansion — expand then re-evaluate the result ;; ═══════════════════════════════════════════════════════════════
;; Part 6: CEK Machine Core
;;
;; cek-run: trampoline loop — steps until terminal.
;; cek-step: single step — dispatches on phase (eval vs continue).
;; step-eval: evaluates control expression, pushes frames.
;; step-continue: pops a frame, processes result.
;; ═══════════════════════════════════════════════════════════════
(define (define
value-matches-type? value-matches-type?
(fn (fn
@@ -498,14 +508,6 @@
(slice expected-type 0 (- (string-length expected-type) 1)))) (slice expected-type 0 (- (string-length expected-type) 1))))
true))))) true)))))
;; ═══════════════════════════════════════════════════════════════
;; Part 6: CEK Machine Core
;;
;; cek-run: trampoline loop — steps until terminal.
;; cek-step: single step — dispatches on phase (eval vs continue).
;; step-eval: evaluates control expression, pushes frames.
;; step-continue: pops a frame, processes result.
;; ═══════════════════════════════════════════════════════════════
(define (define
strict-check-args strict-check-args
(fn (fn
@@ -577,6 +579,12 @@
(define eval-expr (fn (expr (env :as dict)) nil)) (define eval-expr (fn (expr (env :as dict)) nil))
;; ═══════════════════════════════════════════════════════════════
;; Part 7: Special Form Step Functions
;;
;; Each step-sf-* handles one special form in the eval phase.
;; They push frames and return new CEK states — never recurse.
;; ═══════════════════════════════════════════════════════════════
(define (define
bind-lambda-params bind-lambda-params
(fn (fn
@@ -601,12 +609,7 @@
true)) true))
false)))) false))))
;; ═══════════════════════════════════════════════════════════════ ;; R7RS guard: desugars to call/cc + handler-bind with sentinel re-raise
;; Part 7: Special Form Step Functions
;;
;; Each step-sf-* handles one special form in the eval phase.
;; They push frames and return new CEK states — never recurse.
;; ═══════════════════════════════════════════════════════════════
(define (define
call-lambda call-lambda
(fn (fn
@@ -633,7 +636,9 @@
(slice params (len args)))) (slice params (len args))))
(make-thunk (lambda-body f) local)))) (make-thunk (lambda-body f) local))))
;; R7RS guard: desugars to call/cc + handler-bind with sentinel re-raise ;; List evaluation — dispatches on head: special forms, macros,
;; higher-order forms, or function calls. This is the main
;; expression dispatcher for the CEK machine.
(define (define
call-component call-component
(fn (fn
@@ -651,9 +656,7 @@
(env-bind! local "children" children)) (env-bind! local "children" children))
(make-thunk (component-body comp) local)))) (make-thunk (component-body comp) local))))
;; List evaluation — dispatches on head: special forms, macros, ;; call/cc: capture entire kont as undelimited escape continuation
;; higher-order forms, or function calls. This is the main
;; expression dispatcher for the CEK machine.
(define (define
parse-keyword-args parse-keyword-args
(fn (fn
@@ -685,7 +688,6 @@
raw-args) raw-args)
(list kwargs children)))) (list kwargs children))))
;; call/cc: capture entire kont as undelimited escape continuation
(define (define
cond-scheme? cond-scheme?
(fn (fn
@@ -713,6 +715,7 @@
(= (type-of test) "symbol") (= (type-of test) "symbol")
(or (= (symbol-name test) "else") (= (symbol-name test) ":else")))))) (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))))))
;; Pattern matching (match form)
(define (define
sf-named-let sf-named-let
(fn (fn
@@ -760,7 +763,7 @@
((init-vals (map (fn (e) (trampoline (eval-expr e env))) inits))) ((init-vals (map (fn (e) (trampoline (eval-expr e env))) inits)))
(cek-call loop-fn init-vals)))))) (cek-call loop-fn init-vals))))))
;; Pattern matching (match form) ;; Condition system special forms
(define (define
sf-lambda sf-lambda
(fn (fn
@@ -790,7 +793,6 @@
params-expr))) params-expr)))
(make-lambda param-names body env)))) (make-lambda param-names body env))))
;; Condition system special forms
(define (define
sf-defcomp sf-defcomp
(fn (fn
@@ -1178,6 +1180,7 @@
(slice raw-args (len (macro-params mac))))) (slice raw-args (len (macro-params mac)))))
(trampoline (eval-expr (macro-body mac) local))))))) (trampoline (eval-expr (macro-body mac) local)))))))
;; Scope/provide/context — structured downward data passing
(define (define
cek-step-loop cek-step-loop
(fn (fn
@@ -1187,7 +1190,6 @@
state state
(cek-step-loop (cek-step state))))) (cek-step-loop (cek-step state)))))
;; Scope/provide/context — structured downward data passing
(define (define
cek-run cek-run
(fn (fn
@@ -1218,6 +1220,18 @@
(step-eval state) (step-eval state)
(step-continue state)))) (step-continue state))))
;; ═══════════════════════════════════════════════════════════════
;; R7RS syntax-rules / define-syntax
;;
;; syntax-rules creates a macro transformer via pattern matching.
;; define-syntax binds the transformer as a macro (reuses define).
;; Pattern language: _ (wildcard), literals (exact match),
;; pattern variables (bind), ... (ellipsis/repetition).
;; ═══════════════════════════════════════════════════════════════
;; Match a syntax-rules pattern against a form.
;; Returns a dict of bindings on success, nil on failure.
;; literals is a list of symbol name strings that must match exactly.
(define (define
step-eval step-eval
(fn (fn
@@ -1274,18 +1288,8 @@
(step-eval-list expr env kont)) (step-eval-list expr env kont))
:else (make-cek-value expr env kont))))) :else (make-cek-value expr env kont)))))
;; ═══════════════════════════════════════════════════════════════ ;; Match a list pattern against a form list, handling ellipsis at any position.
;; R7RS syntax-rules / define-syntax ;; pi = pattern index, fi = form index.
;;
;; syntax-rules creates a macro transformer via pattern matching.
;; define-syntax binds the transformer as a macro (reuses define).
;; Pattern language: _ (wildcard), literals (exact match),
;; pattern variables (bind), ... (ellipsis/repetition).
;; ═══════════════════════════════════════════════════════════════
;; Match a syntax-rules pattern against a form.
;; Returns a dict of bindings on success, nil on failure.
;; literals is a list of symbol name strings that must match exactly.
(define (define
step-sf-raise step-sf-raise
(fn (fn
@@ -1295,8 +1299,8 @@
env env
(kont-push (make-raise-eval-frame env false) kont)))) (kont-push (make-raise-eval-frame env false) kont))))
;; Match a list pattern against a form list, handling ellipsis at any position. ;; Find which pattern variable in a template drives an ellipsis.
;; pi = pattern index, fi = form index. ;; Returns the variable name (string) whose binding is a list, or nil.
(define (define
step-sf-guard step-sf-guard
(fn (fn
@@ -1370,8 +1374,8 @@
env env
kont)))) kont))))
;; Find which pattern variable in a template drives an ellipsis. ;; Find ALL ellipsis-bound pattern variables in a template.
;; Returns the variable name (string) whose binding is a list, or nil. ;; Returns a list of variable name strings.
(define (define
step-sf-callcc step-sf-callcc
(fn (fn
@@ -1381,8 +1385,8 @@
env env
(kont-push (make-callcc-frame env) kont)))) (kont-push (make-callcc-frame env) kont))))
;; Find ALL ellipsis-bound pattern variables in a template. ;; Instantiate a template with pattern variable bindings.
;; Returns a list of variable name strings. ;; Handles ellipsis repetition and recursive substitution.
(define (define
step-sf-case step-sf-case
(fn (fn
@@ -1392,8 +1396,9 @@
env env
(kont-push (make-case-frame nil (rest args) env) kont)))) (kont-push (make-case-frame nil (rest args) env) kont))))
;; Instantiate a template with pattern variable bindings. ;; Walk a template list, handling ellipsis at any position.
;; Handles ellipsis repetition and recursive substitution. ;; When element at i is followed by ... at i+1, expand the element
;; for each value of its ellipsis variables (all cycled in parallel).
(define (define
step-sf-let-match step-sf-let-match
(fn (fn
@@ -1407,9 +1412,10 @@
env env
kont)))) kont))))
;; Walk a template list, handling ellipsis at any position. ;; Try each syntax-rules clause against a form.
;; When element at i is followed by ... at i+1, expand the element ;; Returns the instantiated template for the first matching rule, or errors.
;; for each value of its ellipsis variables (all cycled in parallel). ;; form is the raw args (without macro name). We prepend a dummy _ symbol
;; because syntax-rules patterns include the keyword as the first element.
(define (define
step-eval-list step-eval-list
(fn (fn
@@ -1577,10 +1583,6 @@
:else (step-eval-call head args env kont))))) :else (step-eval-call head args env kont)))))
(step-eval-call head args env kont)))))) (step-eval-call head args env kont))))))
;; Try each syntax-rules clause against a form.
;; Returns the instantiated template for the first matching rule, or errors.
;; form is the raw args (without macro name). We prepend a dummy _ symbol
;; because syntax-rules patterns include the keyword as the first element.
(define (define
kont-extract-provides kont-extract-provides
(fn (fn
@@ -1596,6 +1598,10 @@
(cons {:subscribers (list) :env (get frame "env") :value (get frame "value") :type "provide" :remaining (list) :name (get frame "name")} rest-frames) (cons {:subscribers (list) :env (get frame "env") :value (get frame "value") :type "provide" :remaining (list) :name (get frame "name")} rest-frames)
rest-frames))))) rest-frames)))))
;; Special form: (syntax-rules (literal ...) (pattern template) ...)
;; Creates a Macro with rules/literals stored in closure env.
;; Body is a marker symbol; expand-macro detects it and calls
;; the pattern matcher directly.
(define (define
fire-provide-subscribers fire-provide-subscribers
(fn (fn
@@ -1604,12 +1610,64 @@
((subs (get frame "subscribers"))) ((subs (get frame "subscribers")))
(when (when
(not (empty? subs)) (not (empty? subs))
(for-each (fn (sub) (cek-call sub (list kont))) subs))))) (if
(> *provide-batch-depth* 0)
(for-each
(fn
(sub)
(when
(not (contains? *provide-batch-queue* sub))
(append! *provide-batch-queue* sub)))
subs)
(for-each (fn (sub) (cek-call sub (list kont))) subs))))))
(define
fire-provide-subscribers
(fn
(name)
(let
((subs (get *provide-subscribers* name)))
(when
(and subs (not (empty? subs)))
(if
(> *provide-batch-depth* 0)
(for-each
(fn
(sub)
(when
(not (contains? *provide-batch-queue* sub))
(append! *provide-batch-queue* sub)))
subs)
(for-each (fn (sub) (cek-call sub (list nil))) subs))))))
;; R7RS records (SRFI-9)
;;
;; (define-record-type <point>
;; (make-point x y)
;; point?
;; (x point-x)
;; (y point-y set-point-y!))
;;
;; Creates: constructor, predicate, accessors, optional mutators.
;; Opaque — only accessible through generated functions.
;; Generative — each call creates a unique type.
(define
batch-begin!
(fn () (set! *provide-batch-depth* (+ *provide-batch-depth* 1))))
;; Delimited continuations
(define
batch-end!
(fn
()
(set! *provide-batch-depth* (- *provide-batch-depth* 1))
(when
(= *provide-batch-depth* 0)
(let
((queue *provide-batch-queue*))
(set! *provide-batch-queue* (list))
(for-each (fn (sub) (cek-call sub (list nil))) queue)))))
;; Special form: (syntax-rules (literal ...) (pattern template) ...)
;; Creates a Macro with rules/literals stored in closure env.
;; Body is a marker symbol; expand-macro detects it and calls
;; the pattern matcher directly.
(define (define
step-sf-bind step-sf-bind
(fn (fn
@@ -1622,6 +1680,7 @@
env env
(kont-push (make-bind-frame body env prev) kont))))) (kont-push (make-bind-frame body env prev) kont)))))
;; Signal dereferencing with reactive dependency tracking
(define (define
step-sf-parameterize step-sf-parameterize
(fn (fn
@@ -1640,17 +1699,13 @@
(make-parameterize-frame bindings nil (list) body env) (make-parameterize-frame bindings nil (list) body env)
kont))))))) kont)))))))
;; R7RS records (SRFI-9) ;; ═══════════════════════════════════════════════════════════════
;; Part 8: Call Dispatch
;; ;;
;; (define-record-type <point> ;; cek-call: invoke a function from native code (runs a nested
;; (make-point x y) ;; trampoline). step-eval-call: CEK-native call dispatch for
;; point? ;; lambda, component, native fn, and continuations.
;; (x point-x) ;; ═══════════════════════════════════════════════════════════════
;; (y point-y set-point-y!))
;;
;; Creates: constructor, predicate, accessors, optional mutators.
;; Opaque — only accessible through generated functions.
;; Generative — each call creates a unique type.
(define (define
syntax-rules-match syntax-rules-match
(fn (fn
@@ -1671,7 +1726,7 @@
(syntax-rules-match-list pattern 0 form 0 literals) (syntax-rules-match-list pattern 0 form 0 literals)
:else (if (= pattern form) (dict) nil)))) :else (if (= pattern form) (dict) nil))))
;; Delimited continuations ;; Reactive signal tracking — captures dependency continuation for re-render
(define (define
syntax-rules-match-list syntax-rules-match-list
(fn (fn
@@ -1773,7 +1828,13 @@
template) template)
:else nil))) :else nil)))
;; Signal dereferencing with reactive dependency tracking ;; ═══════════════════════════════════════════════════════════════
;; Part 9: Higher-Order Form Machinery
;;
;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
;; ho-swap-args auto-detects argument order. HoSetupFrame stages
;; argument evaluation, then dispatches to the appropriate step-ho-*.
;; ═══════════════════════════════════════════════════════════════
(define (define
syntax-rules-find-all-vars syntax-rules-find-all-vars
(fn (fn
@@ -1791,13 +1852,6 @@
template) template)
:else (list)))) :else (list))))
;; ═══════════════════════════════════════════════════════════════
;; Part 8: Call Dispatch
;;
;; cek-call: invoke a function from native code (runs a nested
;; trampoline). step-eval-call: CEK-native call dispatch for
;; lambda, component, native fn, and continuations.
;; ═══════════════════════════════════════════════════════════════
(define (define
syntax-rules-instantiate syntax-rules-instantiate
(fn (fn
@@ -1811,7 +1865,6 @@
template template
:else (syntax-rules-instantiate-list template 0 bindings)))) :else (syntax-rules-instantiate-list template 0 bindings))))
;; Reactive signal tracking — captures dependency continuation for re-render
(define (define
syntax-rules-instantiate-list syntax-rules-instantiate-list
(fn (fn
@@ -1869,13 +1922,6 @@
((full-form (cons (make-symbol "_") form))) ((full-form (cons (make-symbol "_") form)))
(syntax-rules-try-rules literals rules full-form)))) (syntax-rules-try-rules literals rules full-form))))
;; ═══════════════════════════════════════════════════════════════
;; Part 9: Higher-Order Form Machinery
;;
;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
;; ho-swap-args auto-detects argument order. HoSetupFrame stages
;; argument evaluation, then dispatches to the appropriate step-ho-*.
;; ═══════════════════════════════════════════════════════════════
(define (define
syntax-rules-try-rules syntax-rules-try-rules
(fn (fn
@@ -2026,6 +2072,14 @@
(define *protocol-registry* (dict)) (define *protocol-registry* (dict))
;; ═══════════════════════════════════════════════════════════════
;; Part 10: Continue Phase — Frame Dispatch
;;
;; When phase="continue", pop the top frame and process the value.
;; Each frame type has its own handling: if frames check truthiness,
;; let frames bind the value, arg frames accumulate it, etc.
;; continue-with-call handles the final function/component dispatch.
;; ═══════════════════════════════════════════════════════════════
(define (define
sf-define-record-type sf-define-record-type
(fn (fn
@@ -2062,6 +2116,9 @@
field-specs) field-specs)
nil)))))) nil))))))
;; Final call dispatch from arg frame — all args evaluated, invoke function.
;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
;; native fn (direct call), continuation (resume), callcc continuation (escape).
(define (define
sf-define-protocol sf-define-protocol
(fn (fn
@@ -2178,6 +2235,13 @@
(list "match checks nil but has no non-nil pattern")))) (list "match checks nil but has no non-nil pattern"))))
warnings))) warnings)))
;; ═══════════════════════════════════════════════════════════════
;; Part 11: Entry Points
;;
;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
;; eval-expr / trampoline: top-level bindings that override the
;; forward declarations from Part 5.
;; ═══════════════════════════════════════════════════════════════
(define (define
sf-implement sf-implement
(fn (fn
@@ -2225,14 +2289,6 @@
(dict-set! impls type-name type-impls) (dict-set! impls type-name type-impls)
nil)))))) nil))))))
;; ═══════════════════════════════════════════════════════════════
;; Part 10: Continue Phase — Frame Dispatch
;;
;; When phase="continue", pop the top frame and process the value.
;; Each frame type has its own handling: if frames check truthiness,
;; let frames bind the value, arg frames accumulate it, etc.
;; continue-with-call handles the final function/component dispatch.
;; ═══════════════════════════════════════════════════════════════
(define (define
satisfies? satisfies?
(fn (fn
@@ -2247,9 +2303,6 @@
false false
(not (nil? (get (get proto "impls") (type-of value))))))))) (not (nil? (get (get proto "impls") (type-of value)))))))))
;; Final call dispatch from arg frame — all args evaluated, invoke function.
;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
;; native fn (direct call), continuation (resume), callcc continuation (escape).
(define (define
check-match-exhaustiveness check-match-exhaustiveness
(fn (fn
@@ -2307,13 +2360,6 @@
(list local body) (list local body)
(match-find-clause val (rest clauses) env)))))) (match-find-clause val (rest clauses) env))))))
;; ═══════════════════════════════════════════════════════════════
;; Part 11: Entry Points
;;
;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
;; eval-expr / trampoline: top-level bindings that override the
;; forward declarations from Part 5.
;; ═══════════════════════════════════════════════════════════════
(define (define
match-pattern match-pattern
(fn (fn
@@ -2750,10 +2796,9 @@
(not (contains? *bind-tracking* name)) (not (contains? *bind-tracking* name))
(append! *bind-tracking* name))) (append! *bind-tracking* name)))
(make-cek-value (make-cek-value
(if (let
frame ((sv (scope-peek name)))
(get frame "value") (if (nil? sv) (if frame (get frame "value") default-val) sv))
(let ((sv (scope-peek name))) (if (nil? sv) default-val sv)))
env env
kont)))) kont))))
@@ -3602,13 +3647,13 @@
(fn (fn
(name) (name)
(let (let
((pf (kont-find-provide rest-k name))) ((existing (get *provide-subscribers* name)))
(when (dict-set!
pf *provide-subscribers*
(dict-set! name
pf (append
"subscribers" (if existing existing (list))
(append (get pf "subscribers") (list subscriber)))))) (list subscriber)))))
tracked)) tracked))
(make-cek-value value fenv rest-k))) (make-cek-value value fenv rest-k)))
("provide-set" ("provide-set"
@@ -3616,23 +3661,15 @@
((name (get frame "name")) ((name (get frame "name"))
(fenv (get frame "env")) (fenv (get frame "env"))
(target (kont-find-provide rest-k name))) (target (kont-find-provide rest-k name)))
(if (let
target ((old-val (if target (get target "value") (scope-peek name))))
(let (when target (dict-set! target "value" value))
((old-val (get target "value"))) (scope-pop! name)
(dict-set! target "value" value) (scope-push! name value)
(scope-pop! name) (when
(scope-push! name value) (not (= old-val value))
(when (fire-provide-subscribers name))
(not (= old-val value)) (make-cek-value value fenv rest-k))))
(fire-provide-subscribers target rest-k))
(make-cek-value value fenv rest-k))
(if
(env-has? fenv "provide-set!")
(do
(apply (env-get fenv "provide-set!") (list name value))
(make-cek-value value fenv rest-k))
(make-cek-value nil fenv rest-k)))))
("scope-acc" ("scope-acc"
(let (let
((remaining (get frame "remaining")) ((remaining (get frame "remaining"))

8
spec/signals.sx
View File

@@ -149,8 +149,9 @@
batch batch
:effects (mutation) :effects (mutation)
(fn (fn
((thunk :as lambda)) ((thunk :as callable))
(set! *batch-depth* (+ *batch-depth* 1)) (set! *batch-depth* (+ *batch-depth* 1))
(batch-begin!)
(cek-call thunk nil) (cek-call thunk nil)
(set! *batch-depth* (- *batch-depth* 1)) (set! *batch-depth* (- *batch-depth* 1))
(when (when
@@ -165,14 +166,15 @@
((s :as signal)) ((s :as signal))
(for-each (for-each
(fn (fn
((sub :as lambda)) ((sub :as callable))
(when (when
(not (contains? seen sub)) (not (contains? seen sub))
(append! seen sub) (append! seen sub)
(append! pending sub))) (append! pending sub)))
(signal-subscribers s))) (signal-subscribers s)))
queue) queue)
(for-each (fn ((sub :as lambda)) (sub)) pending)))))) (for-each (fn ((sub :as callable)) (sub)) pending))))
(batch-end!)))
(define (define
notify-subscribers notify-subscribers
:effects (mutation) :effects (mutation)