giles
ed68b9883d
The keystone validation of the universal-algebra thesis. lib/host/execute.sx is a SECOND
interpreter over the SAME seq/alt/each composition algebra as the render-fold — but a
different fold: leaves are EFFECTS, seq = steps in order, alt+when = branch, each =
for-each, and the accumulator is an effect log instead of an HTML string. It REUSES
compose.sx's shared machinery verbatim — host/comp--pred? (when), host/comp--field
(field/value), host/comp--source (each source) — so the predicate set, context-environment,
and iteration source are domain-agnostic; only the leaf semantics + accumulator are new.
KEYSTONE (tested): ONE (alt (when (has "auth") …) …) skeleton + ONE context folds two ways
— render picks the branch → "<b>in</b>", execute picks the SAME branch → {:verb "enter"}.
A publish workflow (validate → branch-on-status → notify-each) runs as one execute-fold over
a composition object. So the behaviour model (Slice 9) is "an execute-fold over a composition
object", not a separate system — the way the recursive tree proved recursion, this proves the
algebra is domain-agnostic. host/exec-run; 13/13 (new execute suite); wired into conformance
+ serve. Full host conformance 371/373 in 42s (warm); the 2 fails are the pre-existing
relate-picker pair.
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
88 lines
4.6 KiB
Plaintext
88 lines
4.6 KiB
Plaintext
;; lib/host/tests/execute.sx — the EXECUTE-fold (lib/host/execute.sx): a second interpreter
|
|
;; over the SAME seq/alt/each composition algebra as the render-fold, proving the algebra is
|
|
;; domain-agnostic (plans/composition-objects.md step 7). Leaves are effects; the fold
|
|
;; returns an effect log. Reuses compose.sx's when-predicates / field resolver / each source.
|
|
|
|
(define host-ex-pass 0)
|
|
(define host-ex-fail 0)
|
|
(define host-ex-fails (list))
|
|
(define host-ex-test
|
|
(fn (name actual expected)
|
|
(if (= actual expected)
|
|
(set! host-ex-pass (+ host-ex-pass 1))
|
|
(begin
|
|
(set! host-ex-fail (+ host-ex-fail 1))
|
|
(append! host-ex-fails {:name name :actual actual :expected expected})))))
|
|
|
|
;; the verbs of an effect log, in order (effect records are {:verb :args}).
|
|
(define ex-verbs (fn (effects) (map (fn (e) (get e :verb)) effects)))
|
|
(define ex-args (fn (effects) (map (fn (e) (get e :args)) effects)))
|
|
|
|
;; -- seq: steps in order --
|
|
(host-ex-test "seq runs effects in order"
|
|
(ex-verbs (host/exec-run (quote (seq (effect a) (effect b) (effect c))) {}))
|
|
(list "a" "b" "c"))
|
|
(host-ex-test "nested seq flattens in order"
|
|
(ex-verbs (host/exec-run (quote (seq (effect a) (seq (effect b) (effect c)) (effect d))) {}))
|
|
(list "a" "b" "c" "d"))
|
|
|
|
;; -- alt + when: branch (reusing the render-fold's predicate set) --
|
|
(host-ex-test "alt runs the first branch whose when holds"
|
|
(ex-verbs (host/exec-run (quote (alt (when (has "auth") (effect publish)) (else (effect hold)))) {"auth" "y"}))
|
|
(list "publish"))
|
|
(host-ex-test "alt falls through to else when no when holds"
|
|
(ex-verbs (host/exec-run (quote (alt (when (has "auth") (effect publish)) (else (effect hold)))) {}))
|
|
(list "hold"))
|
|
(host-ex-test "alt eq predicate branches on a context value"
|
|
(ex-verbs (host/exec-run (quote (alt (when (eq "role" "admin") (effect grant)) (else (effect deny)))) {"role" "admin"}))
|
|
(list "grant"))
|
|
|
|
;; -- each: for-each over the (reused) source, with field resolution from the item --
|
|
(host-ex-test "each runs the body per item (for-each)"
|
|
(ex-verbs (host/exec-run (quote (each (items {:email "a"} {:email "b"}) (effect notify))) {}))
|
|
(list "notify" "notify"))
|
|
(host-ex-test "effect args resolve (field K) from the current item"
|
|
(ex-args (host/exec-run (quote (each (items {:email "a@x"} {:email "b@x"}) (effect notify (field :email)))) {}))
|
|
(list (list "a@x") (list "b@x")))
|
|
(host-ex-test "effect args resolve (field K) from the context, and literals pass through"
|
|
(ex-args (host/exec-run (quote (seq (effect log (field :who) "done"))) {"who" "alice"}))
|
|
(list (list "alice" "done")))
|
|
|
|
;; -- robustness: non-effect leaves / unknown heads produce no effects --
|
|
(host-ex-test "a non-list node yields no effects"
|
|
(host/exec-run "bare" {}) (list))
|
|
(host-ex-test "an unknown combinator head yields no effects"
|
|
(host/exec-run (quote (frobnicate 1 2)) {}) (list))
|
|
|
|
;; -- the KEYSTONE: ONE control skeleton, folded TWO ways. Same alt+when, same context, the
|
|
;; SAME branch is chosen (both use host/comp--pred?); render emits HTML, execute emits an
|
|
;; effect. The composition algebra is domain-agnostic — render and behaviour are two folds. --
|
|
(host-ex-test "same skeleton folds two ways — render picks the branch, execute picks the SAME branch (authed)"
|
|
(let ((ctx {"auth" "y"}))
|
|
(list (host/comp-render (quote (alt (when (has "auth") (text "<b>in</b>")) (else (text "out")))) ctx)
|
|
(ex-verbs (host/exec-run (quote (alt (when (has "auth") (effect enter)) (else (effect leave)))) ctx))))
|
|
(list "<b>in</b>" (list "enter")))
|
|
(host-ex-test "same skeleton folds two ways — the else branch agrees across folds (anon)"
|
|
(let ((ctx {}))
|
|
(list (host/comp-render (quote (alt (when (has "auth") (text "<b>in</b>")) (else (text "out")))) ctx)
|
|
(ex-verbs (host/exec-run (quote (alt (when (has "auth") (effect enter)) (else (effect leave)))) ctx))))
|
|
(list "out" (list "leave")))
|
|
|
|
;; -- a small workflow: validate -> (branch on status) -> notify each recipient. Proves the
|
|
;; behaviour model is just an execute-fold over a composition object. --
|
|
(host-ex-test "a publish workflow runs as one execute-fold over the composition"
|
|
(ex-verbs
|
|
(host/exec-run
|
|
(quote (seq
|
|
(effect validate (field :slug))
|
|
(alt (when (eq "status" "ready") (effect publish (field :slug)))
|
|
(else (effect hold (field :slug))))
|
|
(each (items {:to "a"} {:to "b"}) (effect notify (field :to)))))
|
|
{"slug" "post-1" "status" "ready"}))
|
|
(list "validate" "publish" "notify" "notify"))
|
|
|
|
(define host-ex-tests-run!
|
|
(fn ()
|
|
{:total (+ host-ex-pass host-ex-fail)
|
|
:passed host-ex-pass :failed host-ex-fail :fails host-ex-fails}))
|