Compare commits

..

20 Commits

Author SHA1 Message Date
9cfca1d008 flow: reference host driver flow-drive-host/flow-run-host + 4 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Completes the host ABI from work-queue to driver loop: the host supplies only a
(kind payload) -> answer dispatch fn; flow-drive-host services one tick of pending
requests, flow-run-host ticks until quiescent (bounded). Tested via the art-dag
render -> human-review -> publish pipeline driven entirely by flow-run-host. The
art-dag integration is now: define dispatch, call flow-run-host. 166/166, 11 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:33:04 +00:00
3cbf33d2d2 flow: host integration ABI (request/await/host-queue) + 11 tests (Phase 8)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 38s
The seam for hooking flow to art-dag and human-in-the-loop later. (request kind
payload) suspends with a typed (flow-request kind payload) envelope and returns the
host's resume value; await-human/await-render sugar. (flow-host-requests) is the
host work queue: (id kind payload) for every suspended flow awaiting a host effect;
request?/request-kind/request-payload parse a tag. Tests include the art-dag-shaped
driver loop (render -> human-review -> publish). Host owns IO+persistence; flow only
requests (replay-safe). 162/162 across 11 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:24:16 +00:00
c2d628e9c3 flow: README — API reference + deterministic-replay contract
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m10s
User-facing docs for the flow engine: the node model, every combinator, the
suspend/resume durability contract (escape-only call/cc -> deterministic replay),
lifecycle/introspection/hygiene API, fed-sx distribution, and substrate notes.
Doc-only; 151/151 unchanged.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:37:10 +00:00
aabb950256 flow: store hygiene flow/gc + flow/forget + 9 tests
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
flow/gc drops terminal (done/cancelled) records, keeps live suspended flows, returns
count removed; flow/forget id drops one terminal record and refuses live flows.
Bounds unbounded store growth (retention/GC). Bumped conformance sx_server timeout
to 540s for the 10-suite run under CPU contention. 151/151 across 10 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:34:53 +00:00
2b47b2925c flow: end-to-end integration suite + 10 tests (Phase 7)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Realistic flows composing every phase: an order pipeline (validate via attempt ->
payment suspend -> branch -> ledger federation via remote-node) and an onboarding
flow, each run through the full lifecycle including a simulated crash (export/wipe/
import) and a peer handoff mid-flow, with flow/pending|status|result introspection.
142/142 across 9 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:17:40 +00:00
d9b9da3843 flow: railway attempt combinator — fail-value short-circuit + 10 tests (Phase 6)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
(attempt n1 n2 ...) threads like sequence but stops at the first node returning a
(fail ...) value, returning that failure. Makes the fail/recover error model
compose into validation/ETL pipelines (railway-oriented). 132/132 across 8 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:09:21 +00:00
0a1b89c975 flow: bounded iteration combinators flow-while/flow-until + 6 tests
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
(flow-while pred body max) / (flow-until pred body max) re-run body threading the
value while/until pred holds, capped at max steps for a deterministic bound (no
unbounded loops in pure SX). 122/122 across 7 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:02:59 +00:00
0e6ba55647 flow: combinator library — tap, recover, map-flow + 11 tests (Phase 5 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
tap: side-effecting pass-through (returns input). recover: fail-VALUE counterpart
of try-catch (run node; on (fail r) run handler on r). map-flow: run a node over
each item of a list, join results sequentially. 116/116 across 7 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:57:48 +00:00
c1d24eb9b3 flow: operational introspection API — flow/status,result,list,pending + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
flow/status id -> done|suspended|cancelled|unknown; flow/result id -> value or
error; flow/list -> (id status) per flow; flow/pending -> (id waiting-tag) for
suspended flows (operator view of what each awaits). Pure store introspection.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:53:23 +00:00
16cb727406 flow: replication + handoff across instances + 6 tests (Phase 4 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
flow-replicate-to copies the plain-data store export to a peer's replica slot;
flow-restore-from imports it. Handoff = replicate, local instance dies, peer
restores and resumes by id. The replay log survives the move, so all resolved
suspends carry over. Same durable-data mechanism as crash recovery, across
instances. All four phases complete: 93/93.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:48:39 +00:00
f8722b3b08 flow: remote-failover — try peers in order, fall through to local + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
(remote-failover addrs fn local) tries fn on each peer in order, moves to the next
on any raised error, and runs the local node if every peer fails. Threads input,
composes in sequences.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:44:04 +00:00
e1f802cfff flow: remote-node via mock fed-sx transport + 7 tests (Phase 4 begins)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m4s
(remote-node addr fn) runs a node on a federation peer. Transport is the fed-sx
boundary, mocked by a peer registry (flow-peer-register!); raises
flow-remote-unreachable / flow-remote-no-fn. Composes with sequence/suspend/retry.
Also fixes conformance.sh to load remote.sx before api.sx.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:40:25 +00:00
97c7623743 flow: crash recovery — store export/import + resumable scan + 8 tests (Phase 3 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
Records are name-keyed (defflow registers names); flow-store-export nulls live
procs to plain data, flow-store-import! restores, flow-resumable-ids scans for
paused flows. Resume re-resolves the proc by name, so a flow survives a wiped
store (simulated restart). The whole durable model persists only plain data.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:25:47 +00:00
e896deffc8 flow: Phase 3 suspend/resume/cancel via deterministic replay + 17 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Guest Scheme call/cc is escape-only (re-entry hangs), so durable resume uses
deterministic replay: suspend escapes to the driver; resume re-runs the flow and
replays resolved suspends from a (tag value) log. No live continuation is ever
serialized — persisted state is plain data, survives restart. Adds flow/start
(now state-returning, backward compatible), flow/resume, flow/cancel, store.sx.
Harness reuses one env with a per-test reset (full env rebuild 66x was too slow).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:20:09 +00:00
e762cc2e32 flow: timeout combinator — cooperative step budget + 7 tests (Phase 2 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
(timeout budget node) bounds a node deterministically: nodes opt in via (tick),
budget ticks are allowed, the next raises flow-timeout. No scheduler/clock in pure
SX so the budget is a step count, not wall-clock. Budgets nest and are per-run.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:42:16 +00:00
4674620d7e flow: retry combinator — re-run node on raised exceptions + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
(retry n node) re-runs up to n attempts on a raised exception; the last attempt's
exception propagates. Explicit (fail ...) values are NOT retried — they pass through.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:39:21 +00:00
f3da3b975a flow: try-catch combinator — reify raised exceptions + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
(try-catch node handler) runs node; on a raised exception calls (handler error)
with the reified error via Scheme guard, returns the handler value.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:37:26 +00:00
1731476dc6 flow: error model — fail/failed?/fail-reason failure values + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
Explicit (fail reason) values flow downstream as data and are inspected with
failed?/fail-reason — distinct from raised exceptions (retry/try-catch territory).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:35:40 +00:00
65cbdb8387 flow: branch combinator (conditional) + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Phase 2 control flow. (branch pred then else) selects then/else node by running
pred on the threaded input; named 'branch' since 'cond' is a Scheme special form.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:32:37 +00:00
91ffba9975 flow: Phase 1 declarative DAG — sequence/parallel/defflow combinators + 18 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
Flow combinators as a Scheme prelude loaded onto scheme-standard-env; a flow is a
Scheme procedure input->output, run inside the interpreter (sets up Phase 3 call/cc
suspend). flow/start entry point, conformance runner, scoreboard.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:22:22 +00:00
67 changed files with 2016 additions and 3946 deletions

View File

@@ -1,63 +0,0 @@
# APL conformance config — sourced by lib/guest/conformance.sh.
LANG_NAME=apl
MODE=counters
COUNTERS_PASS=apl-test-pass
COUNTERS_FAIL=apl-test-fail
TIMEOUT_PER_SUITE=300
PRELOADS=(
spec/stdlib.sx
lib/r7rs.sx
lib/apl/runtime.sx
lib/apl/tokenizer.sx
lib/apl/parser.sx
lib/apl/transpile.sx
lib/apl/test-harness.sx
)
SUITES=(
"structural:lib/apl/tests/structural.sx"
"operators:lib/apl/tests/operators.sx"
"dfn:lib/apl/tests/dfn.sx"
"tradfn:lib/apl/tests/tradfn.sx"
"valence:lib/apl/tests/valence.sx"
"programs:lib/apl/tests/programs.sx"
"system:lib/apl/tests/system.sx"
"idioms:lib/apl/tests/idioms.sx"
"eval-ops:lib/apl/tests/eval-ops.sx"
"pipeline:lib/apl/tests/pipeline.sx"
)
emit_scoreboard_json() {
local n=${#GC_NAMES[@]} i sep
printf '{\n'
printf ' "suites": {\n'
for ((i=0; i<n; i++)); do
sep=","; [ $i -eq $((n-1)) ] && sep=""
printf ' "%s": {"pass": %d, "fail": %d}%s\n' \
"${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_FAIL[$i]}" "$sep"
done
printf ' },\n'
printf ' "total_pass": %d,\n' "$GC_TOTAL_PASS"
printf ' "total_fail": %d,\n' "$GC_TOTAL_FAIL"
printf ' "total": %d\n' "$GC_TOTAL"
printf '}\n'
}
emit_scoreboard_md() {
local n=${#GC_NAMES[@]} i
printf '# APL Conformance Scoreboard\n\n'
printf '_Generated by `lib/apl/conformance.sh`_\n\n'
printf '| Suite | Pass | Fail | Total |\n'
printf '|-------|-----:|-----:|------:|\n'
for ((i=0; i<n; i++)); do
printf '| %s | %d | %d | %d |\n' \
"${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_FAIL[$i]}" "${GC_TOTAL_S[$i]}"
done
printf '| **Total** | **%d** | **%d** | **%d** |\n' "$GC_TOTAL_PASS" "$GC_TOTAL_FAIL" "$GC_TOTAL"
printf '\n'
printf '## Notes\n\n'
printf '%s\n' '- Suites use the standard `apl-test name got expected` framework loaded against `lib/apl/runtime.sx` + `lib/apl/transpile.sx`.'
printf '%s\n' '- `lib/apl/tests/parse.sx` and `lib/apl/tests/scalar.sx` use their own self-contained frameworks and are excluded from this scoreboard.'
}

View File

@@ -1,5 +1,116 @@
#!/usr/bin/env bash #!/usr/bin/env bash
# lib/apl/conformance.sh — APL conformance via the shared guest driver. # lib/apl/conformance.sh — run APL test suites, emit scoreboard.json + scoreboard.md.
# Config lives in lib/apl/conformance.conf (MODE=counters). Override the binary
# with SX_SERVER=path/to/sx_server.exe bash lib/apl/conformance.sh set -uo pipefail
exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@" cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
SUITES=(structural operators dfn tradfn valence programs system idioms eval-ops pipeline)
OUT_JSON="lib/apl/scoreboard.json"
OUT_MD="lib/apl/scoreboard.md"
run_suite() {
local suite=$1
local file="lib/apl/tests/${suite}.sx"
local TMP
TMP=$(mktemp)
cat > "$TMP" << EPOCHS
(epoch 1)
(load "spec/stdlib.sx")
(load "lib/r7rs.sx")
(load "lib/apl/runtime.sx")
(load "lib/apl/tokenizer.sx")
(load "lib/apl/parser.sx")
(load "lib/apl/transpile.sx")
(epoch 2)
(eval "(define apl-test-pass 0)")
(eval "(define apl-test-fail 0)")
(eval "(define apl-test (fn (name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (set! apl-test-fail (+ apl-test-fail 1)))))")
(epoch 3)
(load "${file}")
(epoch 4)
(eval "(list apl-test-pass apl-test-fail)")
EPOCHS
local OUTPUT
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
rm -f "$TMP"
local LINE
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
if [ -z "$LINE" ]; then
LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
| sed -E 's/^\(ok 4 //; s/\)$//')
fi
local P F
P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
P=${P:-0}
F=${F:-0}
echo "${P} ${F}"
}
declare -A SUITE_PASS
declare -A SUITE_FAIL
TOTAL_PASS=0
TOTAL_FAIL=0
echo "Running APL conformance suite..." >&2
for s in "${SUITES[@]}"; do
read -r p f < <(run_suite "$s")
SUITE_PASS[$s]=$p
SUITE_FAIL[$s]=$f
TOTAL_PASS=$((TOTAL_PASS + p))
TOTAL_FAIL=$((TOTAL_FAIL + f))
printf " %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
done
# scoreboard.json
{
printf '{\n'
printf ' "suites": {\n'
first=1
for s in "${SUITES[@]}"; do
if [ $first -eq 0 ]; then printf ',\n'; fi
printf ' "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
first=0
done
printf '\n },\n'
printf ' "total_pass": %d,\n' "$TOTAL_PASS"
printf ' "total_fail": %d,\n' "$TOTAL_FAIL"
printf ' "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
printf '}\n'
} > "$OUT_JSON"
# scoreboard.md
{
printf '# APL Conformance Scoreboard\n\n'
printf '_Generated by `lib/apl/conformance.sh`_\n\n'
printf '| Suite | Pass | Fail | Total |\n'
printf '|-------|-----:|-----:|------:|\n'
for s in "${SUITES[@]}"; do
p=${SUITE_PASS[$s]}
f=${SUITE_FAIL[$s]}
printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
done
printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
printf '\n'
printf '## Notes\n\n'
printf '%s\n' '- Suites use the standard `apl-test name got expected` framework loaded against `lib/apl/runtime.sx` + `lib/apl/transpile.sx`.'
printf '%s\n' '- `lib/apl/tests/parse.sx` and `lib/apl/tests/scalar.sx` use their own self-contained frameworks and are excluded from this scoreboard.'
} > "$OUT_MD"
echo "Wrote $OUT_JSON and $OUT_MD" >&2
echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
[ "$TOTAL_FAIL" -eq 0 ]

View File

@@ -9,9 +9,9 @@
"system": {"pass": 13, "fail": 0}, "system": {"pass": 13, "fail": 0},
"idioms": {"pass": 64, "fail": 0}, "idioms": {"pass": 64, "fail": 0},
"eval-ops": {"pass": 14, "fail": 0}, "eval-ops": {"pass": 14, "fail": 0},
"pipeline": {"pass": 152, "fail": 0} "pipeline": {"pass": 40, "fail": 0}
}, },
"total_pass": 562, "total_pass": 450,
"total_fail": 0, "total_fail": 0,
"total": 562 "total": 450
} }

View File

@@ -13,8 +13,8 @@ _Generated by `lib/apl/conformance.sh`_
| system | 13 | 0 | 13 | | system | 13 | 0 | 13 |
| idioms | 64 | 0 | 64 | | idioms | 64 | 0 | 64 |
| eval-ops | 14 | 0 | 14 | | eval-ops | 14 | 0 | 14 |
| pipeline | 152 | 0 | 152 | | pipeline | 40 | 0 | 40 |
| **Total** | **562** | **0** | **562** | | **Total** | **450** | **0** | **450** |
## Notes ## Notes

View File

@@ -1,15 +0,0 @@
; lib/apl/test-harness.sx — counters + assertion fn for the shared conformance
; driver (lib/guest/conformance.sh, MODE=counters). Loaded as a PRELOAD so each
; suite starts from a fresh 0/0; suites call (apl-test name got expected).
(define apl-test-pass 0)
(define apl-test-fail 0)
(define
apl-test
(fn
(name got expected)
(if
(= got expected)
(set! apl-test-pass (+ apl-test-pass 1))
(set! apl-test-fail (+ apl-test-fail 1)))))

View File

@@ -1,38 +0,0 @@
; feed/acl — per-viewer visibility filtering. The same candidate stream yields
; different timelines for different viewers, so ACL is applied per request and
; pre-ACL timelines are never cached.
;
; permit? is injected: (permit? viewer activity) -> bool. Wire a real acl-sx
; predicate here; feed/permit-acl? is a self-contained default that reads an
; optional :visible-to allowlist on the activity.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-elem?), lib/feed/rank.sx (feed/top).
; default permit: actor always sees own activity; absent/nil :visible-to is
; public; otherwise viewer must be in the allowlist.
(define
feed/permit-acl?
(fn
(viewer a)
(or
(equal? viewer (get a :actor))
(let
((allowed (get a :visible-to nil)))
(if (= allowed nil) true (feed/-elem? viewer allowed))))))
(define feed/permit-public? (fn (viewer a) true))
; filter a stream to what viewer may read
(define
feed/visible
(fn
(stream viewer permit?)
(feed/filter stream (fn (a) (permit? viewer a)))))
; the capstone: candidate stream -> ACL for viewer -> rank -> top-N
(define
feed/timeline
(fn
(stream viewer permit? score-fn n)
(feed/top (feed/visible stream viewer permit?) score-fn n)))

View File

@@ -1,62 +0,0 @@
; feed/aggregate — group-by / counting via key-reduce. Keys must be strings
; (dict keys), so composite keys (actor, day) are joined into one string.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx.
; group activities into a dict: key-string -> (list of activities), order-preserving
(define
feed/group-by
(fn
(stream key-fn)
(reduce
(fn
(g a)
(let
((k (key-fn a)))
(assoc g k (append (get g k (list)) (list a)))))
{}
(feed/items stream))))
; key-string -> count
(define
feed/group-count
(fn
(stream key-fn)
(reduce
(fn
(g a)
(let
((k (key-fn a)))
(assoc g k (+ (get g k 0) 1))))
{}
(feed/items stream))))
; --- composite keys ---------------------------------------------------------
(define feed/day (fn (at window) (floor (/ at window))))
; (actor, day-bucket) -> "actor#day"
(define
feed/actor-day-key
(fn
(window)
(fn
(a)
(string-append
(get a :actor)
"#"
(number->string (feed/day (get a :at) window))))))
(define
feed/by-actor-day
(fn (stream window) (feed/group-count stream (feed/actor-day-key window))))
; per-actor activity counts
(define
feed/actor-counts
(fn (stream) (feed/group-count stream feed/actor)))
; per-object activity counts (engagement)
(define
feed/object-counts
(fn (stream) (feed/group-count stream feed/object)))

View File

@@ -1,24 +0,0 @@
; feed/api — ergonomic API over the stream layer for non-APL callers.
; A single mutable activity log; post appends, all returns it as a stream.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx (loaded by harness).
(define feed/-log (list))
; post — normalize then append. Returns the stored activity.
(define
feed/post
(fn
(raw)
(let
((a (feed/normalize raw)))
(begin (set! feed/-log (append feed/-log (list a))) a))))
; all — the whole log as a stream (insertion order)
(define feed/all (fn () (feed/stream feed/-log)))
; reset! — clear the log (test hygiene)
(define feed/reset! (fn () (begin (set! feed/-log (list)) nil)))
; size — number of posted activities
(define feed/size (fn () (len feed/-log)))

View File

@@ -1,125 +0,0 @@
#!/usr/bin/env bash
# lib/feed/conformance.sh — run feed test suites, emit scoreboard.json + scoreboard.md.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
SUITES=(basic fanout rank integration content notify home dedupe trending mute page thread)
OUT_JSON="lib/feed/scoreboard.json"
OUT_MD="lib/feed/scoreboard.md"
run_suite() {
local suite=$1
local file="lib/feed/tests/${suite}.sx"
local TMP
TMP=$(mktemp)
cat > "$TMP" << EPOCHS
(epoch 1)
(load "spec/stdlib.sx")
(load "lib/r7rs.sx")
(load "lib/apl/runtime.sx")
(load "lib/feed/normalize.sx")
(load "lib/feed/stream.sx")
(load "lib/feed/api.sx")
(load "lib/feed/fanout.sx")
(load "lib/feed/dedupe.sx")
(load "lib/feed/aggregate.sx")
(load "lib/feed/rank.sx")
(load "lib/feed/acl.sx")
(load "lib/feed/fed.sx")
(load "lib/feed/content.sx")
(load "lib/feed/notify.sx")
(load "lib/feed/home.sx")
(load "lib/feed/trending.sx")
(load "lib/feed/mute.sx")
(load "lib/feed/page.sx")
(load "lib/feed/thread.sx")
(epoch 2)
(eval "(define feed-test-pass 0)")
(eval "(define feed-test-fail 0)")
(eval "(define feed-test (fn (name got expected) (if (= got expected) (set! feed-test-pass (+ feed-test-pass 1)) (set! feed-test-fail (+ feed-test-fail 1)))))")
(epoch 3)
(load "${file}")
(epoch 4)
(eval "(list feed-test-pass feed-test-fail)")
EPOCHS
local OUTPUT
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
rm -f "$TMP"
local LINE
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
if [ -z "$LINE" ]; then
LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
| sed -E 's/^\(ok 4 //; s/\)$//')
fi
local P F
P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
P=${P:-0}
F=${F:-0}
echo "${P} ${F}"
}
declare -A SUITE_PASS
declare -A SUITE_FAIL
TOTAL_PASS=0
TOTAL_FAIL=0
echo "Running feed conformance suite..." >&2
for s in "${SUITES[@]}"; do
read -r p f < <(run_suite "$s")
SUITE_PASS[$s]=$p
SUITE_FAIL[$s]=$f
TOTAL_PASS=$((TOTAL_PASS + p))
TOTAL_FAIL=$((TOTAL_FAIL + f))
printf " %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
done
# scoreboard.json
{
printf '{\n'
printf ' "suites": {\n'
first=1
for s in "${SUITES[@]}"; do
if [ $first -eq 0 ]; then printf ',\n'; fi
printf ' "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
first=0
done
printf '\n },\n'
printf ' "total_pass": %d,\n' "$TOTAL_PASS"
printf ' "total_fail": %d,\n' "$TOTAL_FAIL"
printf ' "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
printf '}\n'
} > "$OUT_JSON"
# scoreboard.md
{
printf '# feed Conformance Scoreboard\n\n'
printf '_Generated by `lib/feed/conformance.sh`_\n\n'
printf '| Suite | Pass | Fail | Total |\n'
printf '|-------|-----:|-----:|------:|\n'
for s in "${SUITES[@]}"; do
p=${SUITE_PASS[$s]}
f=${SUITE_FAIL[$s]}
printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
done
printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
} > "$OUT_MD"
echo "Wrote $OUT_JSON and $OUT_MD" >&2
echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
[ "$TOTAL_FAIL" -eq 0 ]

View File

@@ -1,68 +0,0 @@
; feed/content — TF-IDF relevance over activity :tags. Rare tags carry more
; signal, so an activity matching an uncommon tag ranks above one matching a
; common tag. Composes with rank.sx: feed/tfidf-score is just another scorer.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-distinct), lib/feed/rank.sx (feed/rank).
; document frequency: tag -> number of activities whose :tags contain it
; (a tag repeated within one activity counts once toward df)
(define
feed/tag-df
(fn
(stream)
(reduce
(fn
(df a)
(reduce
(fn (d t) (assoc d t (+ (get d t 0) 1)))
df
(feed/-distinct (get a :tags))))
{}
(feed/items stream))))
; inverse document frequency: tag -> log(N / df)
(define
feed/tag-idf
(fn
(stream)
(let
((n (feed/count stream)) (df (feed/tag-df stream)))
(reduce
(fn (idf t) (assoc idf t (log (/ n (get df t)))))
{}
(keys df)))))
; term frequency within one activity: tag -> occurrence count
(define
feed/-tf
(fn
(a)
(reduce
(fn (tf t) (assoc tf t (+ (get tf t 0) 1)))
{}
(get a :tags))))
; relevance of an activity to a query (list of tags) given precomputed idf:
; sum over query tags of tf(tag in activity) * idf(tag in corpus)
(define
feed/tfidf-score
(fn
(idf query)
(fn
(a)
(let
((tf (feed/-tf a)))
(reduce
(fn
(acc t)
(+ acc (* (get tf t 0) (get idf t 0))))
0
query)))))
; rank a stream by relevance to query tags (idf computed over the stream itself)
(define
feed/by-relevance
(fn
(stream query)
(feed/rank stream (feed/tfidf-score (feed/tag-idf stream) query))))

View File

@@ -1,76 +0,0 @@
; feed/dedupe — collapse duplicate items, keeping first occurrence per key.
; Each verb may want its own key (see briefing): "alice posted X" keys on
; (actor verb object) — distinct per actor; "alice liked X / bob liked X"
; collapse on (verb object) so the cross-actor likes fold into one.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-elem? lives in fanout.sx).
; generic: dedupe a stream by key-fn, first occurrence wins (stable)
(define
feed/-dedup-by
(fn
(items key-fn)
(get
(reduce
(fn
(st x)
(let
((k (key-fn x)))
(if (feed/-elem? k (get st :seen)) st {:seen (append (get st :seen) (list k)) :out (append (get st :out) (list x))})))
{:seen (list) :out (list)}
items)
:out)))
(define
feed/dedupe
(fn
(stream key-fn)
(feed/stream (feed/-dedup-by (feed/items stream) key-fn))))
; --- keys -------------------------------------------------------------------
(define
feed/activity-key
(fn (a) (list (get a :actor) (get a :verb) (get a :object))))
; collapse cross-actor duplicates of the same verb+object (e.g. likes)
(define feed/collapse-key (fn (a) (list (get a :verb) (get a :object))))
; per-receiver inbox key — one inbox event per (receiver, actor, verb, object)
(define
feed/event-key
(fn
(ev)
(let
((a (get ev :activity)))
(list (get ev :to) (get a :actor) (get a :verb) (get a :object)))))
; verbs whose duplicates collapse across actors (reactions, not authorship).
; rebindable: callers can (set! feed/collapse-verbs ...) to tune the policy.
(define
feed/collapse-verbs
(list "like" "favourite" "follow" "boost" "repost"))
; per-verb key: collapse-verbs fold on (verb object); the rest key on
; (actor verb object).
(define
feed/smart-key
(fn
(a)
(if
(feed/-elem? (get a :verb) feed/collapse-verbs)
(feed/collapse-key a)
(feed/activity-key a))))
; --- ready-made dedupers ----------------------------------------------------
(define feed/dedupe-activities (fn (s) (feed/dedupe s feed/activity-key)))
(define feed/dedupe-collapse (fn (s) (feed/dedupe s feed/collapse-key)))
; verb-aware: reactions collapse cross-actor, posts stay distinct per actor
(define feed/dedupe-smart (fn (s) (feed/dedupe s feed/smart-key)))
; dedupe an inbox: at most one event per receiver per (actor verb object)
(define feed/dedupe-inbox (fn (inbox) (feed/dedupe inbox feed/event-key)))

View File

@@ -1,114 +0,0 @@
; feed/fanout — THE SHOWCASE. Fan activities out to followers via the APL outer
; product (∘.×). activities ∘.× audience → an (activity × follower) matrix of
; inbox events; flatten to a vector; guard-keep only real follow edges.
;
; Requires: lib/apl/runtime.sx, lib/feed/normalize.sx, lib/feed/stream.sx.
;
; NOTE: apl-outer's combiner result is run through (if (scalar? r) (disclose r) r).
; A bare dict counts as a scalar (shape ()) and disclose nils it — so the combiner
; must (enclose ...) its event dict; apl-outer then discloses it back intact.
; --- graph: {followee -> (list of followers)} -------------------------------
(define feed/followers (fn (graph user) (get graph user (list))))
; build a graph from (follower followee) edges: "follower follows followee"
(define
feed/follow-graph
(fn
(edges)
(reduce
(fn
(g e)
(let
((follower (first e)) (followee (nth e 1)))
(assoc
g
followee
(append (feed/followers g followee) (list follower)))))
{}
edges)))
; --- helpers ----------------------------------------------------------------
; unwrap an apl-scalar (has :ravel) back to its value; pass activities through
(define
feed/-val
(fn
(x)
(if (and (= (type-of x) "dict") (has-key? x :ravel)) (disclose x) x)))
(define feed/-elem? (fn (x lst) (some (fn (y) (equal? x y)) lst)))
(define
feed/-distinct
(fn
(lst)
(if
(= (len lst) 0)
(list)
(get (apl-unique (make-array (list (len lst)) lst)) :ravel))))
; rank-2 matrix -> rank-1 stream of its ravel
(define feed/-flatten (fn (arr) (feed/stream (get arr :ravel))))
; distinct receivers across the whole graph, sorted for determinism
; (dict key order is unspecified, so sort to pin audience/recipient ordering)
(define
feed/audience
(fn
(graph)
(sort
(feed/-distinct
(reduce
(fn (acc k) (append acc (feed/followers graph k)))
(list)
(keys graph))))))
; --- the outer product ------------------------------------------------------
; one (activity, follower) inbox event, enclosed so apl-outer keeps the dict
(define feed/-mk-event (fn (a f) (enclose {:activity (feed/-val a) :to (feed/-val f)})))
; keep events where :to actually follows the activity's actor
(define
feed/-edge?
(fn
(graph)
(fn
(ev)
(feed/-elem?
(get ev :to)
(feed/followers graph (get (get ev :activity) :actor))))))
; fanout — activities ∘.× audience, flatten, guard-keep real edges
(define
feed/fanout
(fn
(stream graph)
(let
((matrix (apl-outer feed/-mk-event stream (feed/stream (feed/audience graph)))))
(feed/filter (feed/-flatten matrix) (feed/-edge? graph)))))
; --- inbox queries ----------------------------------------------------------
(define
feed/inbox-for
(fn
(inbox user)
(feed/filter inbox (fn (ev) (equal? (get ev :to) user)))))
(define
feed/recipients
(fn
(inbox)
(feed/-distinct (map (fn (ev) (get ev :to)) (feed/items inbox)))))
; the activities (unwrapped) destined for a user
(define
feed/inbox-activities
(fn
(inbox user)
(map
(fn (ev) (get ev :activity))
(feed/items (feed/inbox-for inbox user)))))

View File

@@ -1,60 +0,0 @@
; feed/fed — federation. Outbound: a local post fans out, then splits into local
; vs remote inboxes; remote events are handed to an injected send-fn. Inbound:
; peer activities merge into the local stream, deduped. Backfill: pull peer
; history via an injected fetch-fn and merge.
;
; remote? / send-fn / fetch-fn are injected so real fed-sx transport wires in here
; without feed depending on it.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx,
; lib/feed/dedupe.sx.
; --- merge / ingest ---------------------------------------------------------
(define
feed/merge
(fn (s1 s2) (feed/stream (append (feed/items s1) (feed/items s2)))))
; merge a peer stream into local, dropping (actor verb object) duplicates
(define
feed/ingest
(fn (local peer) (feed/dedupe-activities (feed/merge local peer))))
; --- inbound ----------------------------------------------------------------
; peer pushes raw activities to the local inbox; normalize + ingest
(define
feed/inbound
(fn
(local raw-activities)
(feed/ingest local (feed/stream (map feed/normalize raw-activities)))))
; backfill on subscribe: pull peer history via fetch-fn, normalize, ingest
(define
feed/backfill
(fn (local fetch-fn peer-id) (feed/inbound local (fetch-fn peer-id))))
; --- outbound ---------------------------------------------------------------
; split an inbox into local vs remote deliveries by viewer-id predicate
(define feed/partition-inbox (fn (inbox remote?) {:local (feed/filter inbox (fn (ev) (not (remote? (get ev :to))))) :remote (feed/filter inbox (fn (ev) (remote? (get ev :to))))}))
; fan a stream out over the graph, then partition by locality
(define
feed/federate
(fn
(stream graph remote?)
(feed/partition-inbox (feed/fanout stream graph) remote?)))
; deliver: hand each remote event to send-fn, return the local inbox to enqueue
(define
feed/deliver
(fn
(stream graph remote? send-fn)
(let
((parts (feed/federate stream graph remote?)))
(begin
(for-each
(fn (ev) (send-fn (get ev :to) (get ev :activity)))
(feed/items (get parts :remote)))
(get parts :local)))))

View File

@@ -1,23 +0,0 @@
; feed/home — the capstone. A user's home timeline is the whole pipeline as one
; line: fan all activities out over the follow graph, take the events landing in
; the viewer's inbox, dedupe cross-posts, apply the viewer's ACL, rank, take N.
;
; Requires: fanout.sx, dedupe.sx, acl.sx (feed/timeline), rank.sx, stream.sx.
; the activities in a user's inbox, as a stream
(define
feed/inbox-stream
(fn (inbox user) (feed/stream (feed/inbox-activities inbox user))))
; fanout ∘ inbox ∘ dedupe ∘ ACL ∘ rank ∘ take
(define
feed/home
(fn
(stream graph viewer permit? score-fn n)
(feed/timeline
(feed/dedupe-activities
(feed/inbox-stream (feed/fanout stream graph) viewer))
viewer
permit?
score-fn
n)))

View File

@@ -1,44 +0,0 @@
; feed/mute — viewer-controlled filtering. ACL (acl.sx) is author-controlled
; visibility; mute is the reader's own preference: hide muted actors or tags.
; Like ACL it is per-viewer and applied per request, never cached.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-elem?).
; drop activities authored by a muted actor
(define
feed/mute-actors
(fn
(stream actors)
(feed/filter
stream
(fn (a) (not (feed/-elem? (get a :actor) actors))))))
; drop activities carrying any muted tag
(define
feed/mute-tags
(fn
(stream tags)
(feed/filter
stream
(fn (a) (not (some (fn (t) (feed/-elem? t tags)) (get a :tags)))))))
; drop activities about a muted object (thread mute)
(define
feed/mute-objects
(fn
(stream objects)
(feed/filter
stream
(fn (a) (not (feed/-elem? (get a :object) objects))))))
; apply a viewer preference bag: {:mute-actors (...) :mute-tags (...) :mute-objects (...)}
(define
feed/apply-prefs
(fn
(stream prefs)
(feed/mute-objects
(feed/mute-tags
(feed/mute-actors stream (get prefs :mute-actors (list)))
(get prefs :mute-tags (list)))
(get prefs :mute-objects (list)))))

View File

@@ -1,31 +0,0 @@
; feed/normalize — coerce arbitrary input into the canonical activity record.
; An activity is a small dict {:actor :verb :object :at :tags}; a stream is an
; APL vector of such dicts (see stream.sx). Extra keys on the raw input survive
; (e.g. :visible-to for ACL, peer metadata for federation) — :tags is the
; flexible bag but the record is not closed.
(define feed/activity-keys (list :actor :verb :object :at :tags))
(define
feed/normalize
(fn
(raw)
(let
((d (if (= (type-of raw) "dict") raw {})))
(merge d {:actor (get d :actor "") :object (get d :object nil) :at (get d :at 0) :tags (let ((t (get d :tags (list)))) (if (list? t) t (list t))) :verb (get d :verb "post")}))))
(define
feed/activity
(fn (actor verb object at tags) (feed/normalize {:actor actor :object object :at at :tags tags :verb verb})))
(define feed/actor (fn (a) (get a :actor)))
(define feed/verb (fn (a) (get a :verb)))
(define feed/object (fn (a) (get a :object)))
(define feed/at (fn (a) (get a :at)))
(define feed/tags (fn (a) (get a :tags)))
(define
feed/activity?
(fn
(a)
(and (= (type-of a) "dict") (has-key? a :actor) (has-key? a :verb))))

View File

@@ -1,45 +0,0 @@
; feed/notify — a notification feed is a thin layer over a recipient's inbox:
; the events directed at a user, optionally verb-filtered, and a digest that
; collapses "alice, bob and 1 other liked X" by (verb, object).
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/inbox-for, feed/-elem?).
; all inbox events for a user (their raw notifications)
(define feed/notifications (fn (inbox user) (feed/inbox-for inbox user)))
; restrict to notification-worthy verbs (e.g. (list "like" "reply" "follow"))
(define
feed/notify-verbs
(fn
(inbox user verbs)
(feed/filter
(feed/inbox-for inbox user)
(fn (ev) (feed/-elem? (get (get ev :activity) :verb) verbs)))))
; group key "verb|object" — deterministic, sortable
(define
feed/-notify-key
(fn
(ev)
(let
((a (get ev :activity)))
(string-append (get a :verb) "|" (get a :object)))))
; digest: one entry per (verb, object) with the distinct actors and a count,
; ordered by key for determinism.
(define
feed/notify-digest
(fn
(inbox user)
(let
((events (feed/items (feed/inbox-for inbox user))))
(let
((groups (reduce (fn (g ev) (let ((a (get ev :activity)) (k (feed/-notify-key ev))) (let ((cur (get g k {:object (get a :object) :actors (list) :verb (get a :verb)}))) (assoc g k (assoc cur :actors (append (get cur :actors) (list (get a :actor)))))))) {} events)))
(map
(fn
(k)
(let
((grp (get groups k)))
(assoc grp :count (len (get grp :actors)))))
(sort (keys groups)))))))

View File

@@ -1,50 +0,0 @@
; feed/page — pagination. Offset/limit for indexed access, and cursor-based
; (by :at) for recency feeds, which is stable under inserts: a cursor is the
; :at of the last item seen, and the next page is the newest items older than it.
;
; Requires: lib/feed/stream.sx (feed/recent, feed/take, feed/filter).
; --- offset / limit ---------------------------------------------------------
(define
feed/page
(fn
(stream offset limit)
(feed/stream (take (drop (feed/items stream) offset) limit))))
(define
feed/page-count
(fn (stream limit) (ceil (/ (feed/count stream) limit))))
; --- cursor (recency feeds) -------------------------------------------------
; activities strictly older than cursor (scroll down / load older)
(define
feed/before
(fn
(stream cursor)
(feed/filter stream (fn (a) (< (get a :at) cursor)))))
; activities strictly newer than cursor (load newer / "N new posts")
(define
feed/after
(fn
(stream cursor)
(feed/filter stream (fn (a) (> (get a :at) cursor)))))
; one page: the `limit` newest activities older than cursor, newest first
(define
feed/page-before
(fn
(stream cursor limit)
(feed/take (feed/recent (feed/before stream cursor)) limit)))
; cursor to fetch the next (older) page: :at of the last item of a page,
; or nil when the page is empty (end of feed)
(define
feed/next-cursor
(fn
(page)
(let
((items (feed/items page)))
(if (= (len items) 0) nil (get (last items) :at)))))

View File

@@ -1,92 +0,0 @@
; feed/rank — scoring + ranking. Scorers are (activity -> number). Ranking is a
; stable two-pass grade-down: first by :at descending (the tiebreak), then by
; score descending — so ties resolve by recency, then by input order. Fully
; deterministic on ties.
;
; Requires: lib/apl/runtime.sx, lib/feed/normalize.sx, lib/feed/stream.sx.
; --- scorers ----------------------------------------------------------------
; recency: half-life decay. score = 0.5 ^ (age / half-life). at==now -> 1.0.
(define
feed/recency
(fn
(now half-life)
(fn (a) (expt 0.5 (/ (- now (get a :at)) half-life)))))
; velocity: how many of this actor's activities fall in (at-window, at] —
; a burst of recent activity scores higher.
(define
feed/velocity
(fn
(stream window)
(fn
(a)
(len
(filter
(fn
(b)
(and
(equal? (get b :actor) (get a :actor))
(<= (get b :at) (get a :at))
(> (get b :at) (- (get a :at) window))))
(feed/items stream))))))
; engagement: how many activities in the stream touch this activity's :object
(define
feed/engagement
(fn
(stream)
(fn
(a)
(len
(filter
(fn (b) (equal? (get b :object) (get a :object)))
(feed/items stream))))))
; composite: weighted sum. parts = (list (list weight scorer) ...)
(define
feed/composite
(fn
(parts)
(fn
(a)
(reduce
(fn (acc p) (+ acc (* (first p) ((nth p 1) a))))
0
parts))))
; --- ranking ----------------------------------------------------------------
; stable reorder of items by key-fn, descending (grade-down is stable)
(define
feed/-desc-by
(fn
(items key-fn)
(let
((keys (make-array (list (len items)) (map key-fn items))))
(let
((order (get (apl-grade-down keys) :ravel)))
(map (fn (i) (nth items (- i 1))) order)))))
; rank by score descending; ties -> :at descending -> input order
(define
feed/rank
(fn
(stream score-fn)
(let
((by-at (feed/-desc-by (feed/items stream) feed/at)))
(feed/stream (feed/-desc-by by-at score-fn)))))
; attach a :score to each activity (for inspection / debugging)
(define
feed/with-scores
(fn
(stream score-fn)
(feed/stream
(map (fn (a) (assoc a :score (score-fn a))) (feed/items stream)))))
; top-N ranked timeline
(define
feed/top
(fn (stream score-fn n) (feed/take (feed/rank stream score-fn) n)))

View File

@@ -1,19 +0,0 @@
{
"suites": {
"basic": {"pass": 30, "fail": 0},
"fanout": {"pass": 29, "fail": 0},
"rank": {"pass": 24, "fail": 0},
"integration": {"pass": 22, "fail": 0},
"content": {"pass": 15, "fail": 0},
"notify": {"pass": 8, "fail": 0},
"home": {"pass": 6, "fail": 0},
"dedupe": {"pass": 9, "fail": 0},
"trending": {"pass": 11, "fail": 0},
"mute": {"pass": 9, "fail": 0},
"page": {"pass": 14, "fail": 0},
"thread": {"pass": 12, "fail": 0}
},
"total_pass": 189,
"total_fail": 0,
"total": 189
}

View File

@@ -1,19 +0,0 @@
# feed Conformance Scoreboard
_Generated by `lib/feed/conformance.sh`_
| Suite | Pass | Fail | Total |
|-------|-----:|-----:|------:|
| basic | 30 | 0 | 30 |
| fanout | 29 | 0 | 29 |
| rank | 24 | 0 | 24 |
| integration | 22 | 0 | 22 |
| content | 15 | 0 | 15 |
| notify | 8 | 0 | 8 |
| home | 6 | 0 | 6 |
| dedupe | 9 | 0 | 9 |
| trending | 11 | 0 | 11 |
| mute | 9 | 0 | 9 |
| page | 14 | 0 | 14 |
| thread | 12 | 0 | 12 |
| **Total** | **189** | **0** | **189** |

View File

@@ -1,75 +0,0 @@
; feed/stream — a stream is an APL vector (rank-1 array) whose ravel holds
; activity dicts. Operations lift APL primitives onto this shape: filter via
; compress (/), sort via grade (⍋), take via ↑, reverse via ⌽.
;
; Requires: lib/apl/runtime.sx, lib/feed/normalize.sx (loaded by harness).
(define feed/stream (fn (acts) (make-array (list (len acts)) acts)))
(define feed/items (fn (s) (get s :ravel)))
(define feed/count (fn (s) (len (get s :ravel))))
(define feed/empty (feed/stream (list)))
(define feed/empty? (fn (s) (= (feed/count s) 0)))
; filter — bool mask ∘ compress. pred : activity -> truthy
(define
feed/filter
(fn
(s pred)
(let
((items (get s :ravel)))
(let
((mask (make-array (list (len items)) (map (fn (a) (if (pred a) 1 0)) items))))
(apl-compress mask s)))))
; sort-by — ascending, stable on ties (grade-up is stable). key-fn : activity -> number
(define
feed/sort-by
(fn
(s key-fn)
(let
((items (get s :ravel)))
(let
((keys (make-array (list (len items)) (map key-fn items))))
(let
((order (get (apl-grade-up keys) :ravel)))
(feed/stream (map (fn (i) (nth items (- i 1))) order)))))))
(define feed/sort-by-at (fn (s) (feed/sort-by s feed/at)))
; newest-first: ascending sort then reverse (⌽)
(define feed/recent (fn (s) (apl-reverse (feed/sort-by-at s))))
; take N (↑), clamped to stream length so it never over-takes/pads
(define
feed/take
(fn
(s n)
(let
((c (feed/count s)))
(if (>= n c) s (apl-take (apl-scalar n) s)))))
(define feed/reverse (fn (s) (apl-reverse s)))
; common predicates
(define
feed/by-actor
(fn (s actor) (feed/filter s (fn (a) (equal? (get a :actor) actor)))))
(define
feed/by-verb
(fn (s verb) (feed/filter s (fn (a) (equal? (get a :verb) verb)))))
(define
feed/by-object
(fn
(s object)
(feed/filter s (fn (a) (equal? (get a :object) object)))))
; activities at or after timestamp t
(define
feed/since
(fn (s t) (feed/filter s (fn (a) (>= (get a :at) t)))))

View File

@@ -1,118 +0,0 @@
; Phase 1 — normalize, stream ops, api. Uses the feed-test harness
; (feed-test name got expected) provided by conformance.sh.
; ---------- normalize ----------
(feed-test
"normalize default actor"
(feed/actor (feed/normalize {}))
"")
(feed-test
"normalize default verb"
(feed/verb (feed/normalize {}))
"post")
(feed-test
"normalize default at"
(feed/at (feed/normalize {}))
0)
(feed-test
"normalize default object"
(feed/object (feed/normalize {}))
nil)
(feed-test
"normalize default tags"
(feed/tags (feed/normalize {}))
(list))
(feed-test
"normalize keeps actor"
(feed/actor (feed/normalize {:actor "alice"}))
"alice")
(feed-test
"normalize keeps verb"
(feed/verb (feed/normalize {:verb "like"}))
"like")
(feed-test
"normalize scalar tag -> list"
(feed/tags (feed/normalize {:tags "x"}))
(list "x"))
(feed-test
"normalize list tags kept"
(feed/tags (feed/normalize {:tags (list "a" "b")}))
(list "a" "b"))
(feed-test
"activity constructor at"
(feed/at (feed/activity "a" "post" "o" 5 (list)))
5)
(feed-test
"activity? on activity"
(feed/activity? (feed/normalize {:actor "a"}))
true)
(feed-test "activity? on number" (feed/activity? 5) false)
(feed-test "activity? on bare dict" (feed/activity? {:foo 1}) false)
; ---------- stream ----------
(define
S
(feed/stream
(list
(feed/activity "alice" "post" "p1" 30 (list))
(feed/activity "bob" "like" "p1" 10 (list))
(feed/activity "alice" "post" "p2" 20 (list)))))
(feed-test "stream count" (feed/count S) 3)
(feed-test "stream items len" (len (feed/items S)) 3)
(feed-test
"sort-by-at actors asc"
(map feed/actor (feed/items (feed/sort-by-at S)))
(list "bob" "alice" "alice"))
(feed-test
"recent newest first"
(map feed/at (feed/items (feed/recent S)))
(list 30 20 10))
(feed-test
"take 2 of recent"
(feed/count (feed/take (feed/recent S) 2))
2)
(feed-test
"take clamps past end"
(feed/count (feed/take S 10))
3)
(feed-test
"by-actor alice count"
(feed/count (feed/by-actor S "alice"))
2)
(feed-test
"by-verb like actor"
(map feed/actor (feed/items (feed/by-verb S "like")))
(list "bob"))
(feed-test
"by-object p1 count"
(feed/count (feed/by-object S "p1"))
2)
(feed-test
"since 20 count"
(feed/count (feed/since S 20))
2)
(feed-test
"reverse ats"
(map feed/at (feed/items (feed/reverse S)))
(list 20 10 30))
(feed-test "empty? on empty" (feed/empty? feed/empty) true)
(feed-test
"empty? on filtered-out"
(feed/empty? (feed/by-actor S "zzz"))
true)
; ---------- api ----------
(feed/reset!)
(feed/post {:actor "x" :at 1 :verb "post"})
(feed/post {:actor "y" :at 2 :verb "like"})
(feed-test "api size after posts" (feed/size) 2)
(feed-test "api all count" (feed/count (feed/all)) 2)
(feed-test
"post returns normalized verb"
(feed/verb (feed/post {:actor "z"}))
"post")
(feed-test "api size after third post" (feed/size) 3)

View File

@@ -1,85 +0,0 @@
; Follow-up — TF-IDF content ranking over :tags. (feed-test name got expected)
(define
corpus
(feed/stream
(list
(feed/normalize {:actor "u" :object "o1" :at 10 :tags (list "cats" "funny")})
(feed/normalize {:actor "u" :object "o2" :at 20 :tags (list "cats" "news")})
(feed/normalize {:actor "u" :object "o3" :at 30 :tags (list "politics" "news")})
(feed/normalize {:actor "u" :object "o4" :at 40 :tags (list "cats")}))))
; ---------- document frequency ----------
(feed-test "df cats" (get (feed/tag-df corpus) "cats") 3)
(feed-test "df news" (get (feed/tag-df corpus) "news") 2)
(feed-test "df funny" (get (feed/tag-df corpus) "funny") 1)
(feed-test "df politics" (get (feed/tag-df corpus) "politics") 1)
(feed-test "df full" (feed/tag-df corpus) {:news 2 :funny 1 :politics 1 :cats 3})
; ---------- inverse document frequency ----------
(feed-test
"idf news = log(4/2)"
(get (feed/tag-idf corpus) "news")
(log 2))
(feed-test
"idf funny = log(4/1)"
(get (feed/tag-idf corpus) "funny")
(log 4))
(feed-test
"rarer tag has higher idf"
(>
(get (feed/tag-idf corpus) "funny")
(get (feed/tag-idf corpus) "cats"))
true)
; ---------- tf-idf scoring ----------
(define idf (feed/tag-idf corpus))
(feed-test
"score query funny on o1"
((feed/tfidf-score idf (list "funny")) (feed/normalize {:actor "u" :object "x" :tags (list "cats" "funny")}))
(log 4))
(feed-test
"score query funny on non-match"
((feed/tfidf-score idf (list "funny")) (feed/normalize {:actor "u" :object "x" :tags (list "cats")}))
0)
(feed-test
"unknown query tag scores 0"
((feed/tfidf-score idf (list "zzz")) (feed/normalize {:actor "u" :object "x" :tags (list "cats")}))
0)
; ---------- ranking by relevance ----------
; query news: o2,o3 match (score log2), o1,o4 don't (0); ties break by :at desc
(feed-test
"by-relevance news order"
(map
(fn (a) (get a :object))
(feed/items (feed/by-relevance corpus (list "news"))))
(list "o3" "o2" "o4" "o1"))
; query funny: only o1 matches -> ranks first
(feed-test
"by-relevance funny first"
(get
(nth (feed/items (feed/by-relevance corpus (list "funny"))) 0)
:object)
"o1")
; query (cats news): o2 carries both tags -> highest combined tf-idf
(feed-test
"by-relevance cats+news top"
(get
(nth
(feed/items (feed/by-relevance corpus (list "cats" "news")))
0)
:object)
"o2")
(feed-test
"by-relevance preserves count"
(feed/count (feed/by-relevance corpus (list "cats")))
4)

View File

@@ -1,56 +0,0 @@
; Follow-up — verb-aware (smart) dedupe. (feed-test name got expected)
; reactions (like/follow) collapse cross-actor; posts stay distinct per actor
(define
M
(feed/stream
(list
(feed/activity "alice" "like" "X" 1 (list))
(feed/activity "bob" "like" "X" 2 (list))
(feed/activity "alice" "post" "P" 3 (list))
(feed/activity "bob" "post" "P" 4 (list))
(feed/activity "alice" "follow" "C" 5 (list))
(feed/activity "bob" "follow" "C" 6 (list))))) ; collapses
(feed-test
"smart dedupe total"
(feed/count (feed/dedupe-smart M))
4)
(feed-test
"smart keeps both posts"
(feed/count (feed/by-verb (feed/dedupe-smart M) "post"))
2)
(feed-test
"smart collapses likes to one"
(feed/count (feed/by-verb (feed/dedupe-smart M) "like"))
1)
(feed-test
"smart collapses follows to one"
(feed/count (feed/by-verb (feed/dedupe-smart M) "follow"))
1)
(feed-test
"collapsed like keeps first actor"
(map feed/actor (feed/items (feed/by-verb (feed/dedupe-smart M) "like")))
(list "alice"))
; contrast: plain activity dedupe keeps cross-actor likes distinct
(feed-test
"activity dedupe keeps both likes"
(feed/count (feed/by-verb (feed/dedupe-activities M) "like"))
2)
; contrast: blanket collapse folds the two posts (same verb+object) too
(feed-test
"collapse dedupe folds posts"
(feed/count (feed/by-verb (feed/dedupe-collapse M) "post"))
1)
; smart-key dispatch
(feed-test
"smart-key reaction -> (verb object)"
(feed/smart-key (feed/activity "alice" "like" "X" 0 (list)))
(list "like" "X"))
(feed-test
"smart-key post -> (actor verb object)"
(feed/smart-key (feed/activity "alice" "post" "P" 0 (list)))
(list "alice" "post" "P"))

View File

@@ -1,187 +0,0 @@
; Phase 2 — fanout via outer product + dedupe. (feed-test name got expected)
; ---------- graph ----------
; edges: (follower followee). bob,carol follow alice; carol,dave follow bob.
(define
G
(feed/follow-graph
(list
(list "bob" "alice")
(list "carol" "alice")
(list "carol" "bob")
(list "dave" "bob"))))
(feed-test "followers alice" (feed/followers G "alice") (list "bob" "carol"))
(feed-test "followers bob" (feed/followers G "bob") (list "carol" "dave"))
(feed-test "followers unknown" (feed/followers G "zzz") (list))
(feed-test "audience distinct" (feed/audience G) (list "bob" "carol" "dave"))
; ---------- fanout ----------
(define
S
(feed/stream
(list
(feed/activity "alice" "post" "p1" 10 (list))
(feed/activity "alice" "post" "p2" 20 (list))
(feed/activity "bob" "like" "p1" 30 (list)))))
(define IB (feed/fanout S G))
(feed-test "fanout total edges" (feed/count IB) 6)
(feed-test
"inbox bob count"
(feed/count (feed/inbox-for IB "bob"))
2)
(feed-test
"inbox carol count"
(feed/count (feed/inbox-for IB "carol"))
3)
(feed-test
"inbox dave count"
(feed/count (feed/inbox-for IB "dave"))
1)
(feed-test
"inbox alice (follows none)"
(feed/count (feed/inbox-for IB "alice"))
0)
(feed-test
"recipients order"
(feed/recipients IB)
(list "bob" "carol" "dave"))
(feed-test
"bob inbox objects"
(map (fn (a) (get a :object)) (feed/inbox-activities IB "bob"))
(list "p1" "p2"))
(feed-test
"dave inbox objects"
(map (fn (a) (get a :object)) (feed/inbox-activities IB "dave"))
(list "p1"))
(feed-test
"dave inbox verb"
(map (fn (a) (get a :verb)) (feed/inbox-activities IB "dave"))
(list "like"))
; empty graph → no audience → no edges
(feed-test
"empty graph fanout"
(feed/count (feed/fanout S {}))
0)
; actor nobody follows produces no edges
(define
Sghost
(feed/stream (list (feed/activity "ghost" "post" "g1" 5 (list)))))
(feed-test
"unfollowed actor fanout"
(feed/count (feed/fanout Sghost G))
0)
; ---------- high fanout (popular actor) ----------
(define
Gstar
(feed/follow-graph
(list
(list "u1" "star")
(list "u2" "star")
(list "u3" "star")
(list "u4" "star")
(list "u5" "star"))))
(define
Sstar
(feed/stream (list (feed/activity "star" "post" "s1" 1 (list)))))
(feed-test
"star fanout count"
(feed/count (feed/fanout Sstar Gstar))
5)
(feed-test "star audience size" (len (feed/audience Gstar)) 5)
; ---------- mutual follow ----------
(define Gmut (feed/follow-graph (list (list "a" "b") (list "b" "a"))))
(define
Smut
(feed/stream
(list
(feed/activity "a" "post" "pa" 1 (list))
(feed/activity "b" "post" "pb" 2 (list)))))
(define IBmut (feed/fanout Smut Gmut))
(feed-test "mutual total" (feed/count IBmut) 2)
(feed-test
"mutual a gets pb"
(map (fn (x) (get x :object)) (feed/inbox-activities IBmut "a"))
(list "pb"))
(feed-test
"mutual b gets pa"
(map (fn (x) (get x :object)) (feed/inbox-activities IBmut "b"))
(list "pa"))
; ---------- dedupe ----------
(define
Sdup2
(feed/stream
(list
(feed/activity "alice" "post" "p1" 1 (list))
(feed/activity "alice" "post" "p1" 9 (list))
(feed/activity "alice" "post" "p2" 2 (list)))))
(feed-test
"dedupe-activities collapses dup"
(feed/count (feed/dedupe-activities Sdup2))
2)
(feed-test
"dedupe-activities keeps distinct"
(map
(fn (a) (get a :object))
(feed/items (feed/dedupe-activities Sdup2)))
(list "p1" "p2"))
(define
Slikes
(feed/stream
(list
(feed/activity "alice" "like" "X" 1 (list))
(feed/activity "bob" "like" "X" 2 (list))
(feed/activity "carol" "like" "Y" 3 (list)))))
(feed-test
"collapse cross-actor likes"
(feed/count (feed/dedupe-collapse Slikes))
2)
(feed-test
"collapse keeps distinct objects"
(map
(fn (a) (get a :object))
(feed/items (feed/dedupe-collapse Slikes)))
(list "X" "Y"))
(feed-test
"activity-key shape"
(feed/activity-key (feed/activity "a" "post" "o" 0 (list)))
(list "a" "post" "o"))
(feed-test
"collapse-key shape"
(feed/collapse-key (feed/activity "a" "like" "o" 0 (list)))
(list "like" "o"))
; cross-post: alice posts p1 twice → bob's inbox has it twice → dedupe-inbox → once
(define
Scross
(feed/stream
(list
(feed/activity "alice" "post" "p1" 1 (list))
(feed/activity "alice" "post" "p1" 5 (list)))))
(define IBcross (feed/fanout Scross G))
(feed-test
"cross-post raw bob count"
(feed/count (feed/inbox-for IBcross "bob"))
2)
(feed-test
"cross-post deduped bob count"
(feed/count (feed/inbox-for (feed/dedupe-inbox IBcross) "bob"))
1)
(feed-test
"dedupe-inbox keeps distinct receivers"
(feed/count (feed/dedupe-inbox IBcross))
2)

View File

@@ -1,73 +0,0 @@
; Follow-up — feed/home capstone pipeline. (feed-test name got expected)
; alice follows star and bob (edges: follower followee)
(define
G
(feed/follow-graph (list (list "alice" "star") (list "alice" "bob"))))
; star posts s1 then s2; bob posts b1; star re-posts s1 (cross-post dup);
; zoe posts z1 (alice does NOT follow zoe)
(define
S
(feed/stream
(list
(feed/activity "star" "post" "s1" 10 (list))
(feed/activity "star" "post" "s2" 20 (list))
(feed/activity "bob" "post" "b1" 15 (list))
(feed/activity "star" "post" "s1" 5 (list))
(feed/activity "zoe" "post" "z1" 30 (list)))))
(define rec (feed/recency 100 10))
(feed-test
"home count (deduped, followed only)"
(feed/count (feed/home S G "alice" feed/permit-public? rec 10))
3)
(feed-test
"home order by recency"
(map
(fn (a) (get a :object))
(feed/items (feed/home S G "alice" feed/permit-public? rec 10)))
(list "s2" "b1" "s1"))
(feed-test
"home excludes unfollowed zoe"
(feed/-elem?
"z1"
(map
(fn (a) (get a :object))
(feed/items (feed/home S G "alice" feed/permit-public? rec 10))))
false)
(feed-test
"home top-2"
(map
(fn (a) (get a :object))
(feed/items (feed/home S G "alice" feed/permit-public? rec 2)))
(list "s2" "b1"))
(feed-test
"home dedupes cross-post (one s1)"
(len
(filter
(fn (o) (equal? o "s1"))
(map
(fn (a) (get a :object))
(feed/items
(feed/home S G "alice" feed/permit-public? rec 10)))))
1)
; ACL applied per-viewer in the home pipeline
(define
Sacl
(feed/stream
(list (feed/normalize {:actor "star" :object "pub" :at 20}) (feed/normalize {:actor "star" :object "sec" :visible-to (list "carol") :at 25}))))
(define Gacl (feed/follow-graph (list (list "alice" "star"))))
(feed-test
"home hides activity alice not permitted"
(map
(fn (a) (get a :object))
(feed/items (feed/home Sacl Gacl "alice" feed/permit-acl? rec 10)))
(list "pub"))

View File

@@ -1,155 +0,0 @@
; Phase 4 — visibility (ACL) + federation, and the end-to-end timeline.
; (feed-test name got expected)
; ---------- ACL visibility ----------
; pub: public. sec: bob, allows carol. dm: frank, allows dave.
(define
C
(feed/stream
(list
(feed/normalize {:actor "alice" :object "pub" :at 10})
(feed/normalize {:actor "bob" :object "sec" :visible-to (list "carol") :at 20})
(feed/normalize {:actor "frank" :object "dm" :visible-to (list "dave") :at 30}))))
(feed-test
"public visible to anyone"
(feed/count (feed/visible C "zoe" feed/permit-acl?))
1)
(feed-test
"carol sees allowlisted + public"
(feed/count (feed/visible C "carol" feed/permit-acl?))
2)
(feed-test
"dave sees dm + public"
(feed/count (feed/visible C "dave" feed/permit-acl?))
2)
(feed-test
"author always sees own private"
(feed/count (feed/visible C "frank" feed/permit-acl?))
2)
(feed-test
"permit-public? lets all through"
(feed/count (feed/visible C "zoe" feed/permit-public?))
3)
(feed-test
"visible objects for dave"
(map
(fn (a) (get a :object))
(feed/items (feed/visible C "dave" feed/permit-acl?)))
(list "pub" "dm"))
; per-viewer: same stream, different timelines
(feed-test
"zoe timeline differs from carol"
(not
(=
(feed/count (feed/visible C "zoe" feed/permit-acl?))
(feed/count (feed/visible C "carol" feed/permit-acl?))))
true)
; ---------- federation: merge / ingest ----------
(define
L
(feed/stream
(list
(feed/activity "alice" "post" "p1" 10 (list))
(feed/activity "alice" "post" "p2" 20 (list)))))
(define
P
(feed/stream
(list
(feed/activity "alice" "post" "p2" 20 (list))
(feed/activity "peer" "post" "p9" 25 (list)))))
(feed-test "merge concatenates" (feed/count (feed/merge L P)) 4)
(feed-test
"ingest dedupes overlap"
(feed/count (feed/ingest L P))
3)
(feed-test
"inbound normalizes + ingests"
(feed/count (feed/inbound L (list {:actor "peer" :object "p9" :at 25} {:actor "alice" :object "p1" :at 10})))
3)
; backfill via injected fetch-fn
(define peer-history (fn (peer-id) (list {:actor peer-id :object "h1" :at 1} {:actor peer-id :object "h2" :at 2})))
(feed-test
"backfill merges peer history"
(feed/count (feed/backfill L peer-history "remote"))
4)
(feed-test
"backfill objects present"
(map
(fn (a) (get a :object))
(feed/items
(feed/by-actor (feed/backfill L peer-history "remote") "remote")))
(list "h1" "h2"))
; ---------- federation: outbound partition ----------
; bob (local), alice@remote + carol@remote (remote) follow star
(define
Gf
(feed/follow-graph
(list
(list "bob" "star")
(list "alice@remote" "star")
(list "carol@remote" "star"))))
(define
Sf
(feed/stream (list (feed/activity "star" "post" "s1" 1 (list)))))
(define
remote?
(fn (id) (feed/-elem? id (list "alice@remote" "carol@remote"))))
(define parts (feed/federate Sf Gf remote?))
(feed-test "local deliveries" (feed/count (get parts :local)) 1)
(feed-test "remote deliveries" (feed/count (get parts :remote)) 2)
(feed-test
"local recipient is bob"
(feed/recipients (get parts :local))
(list "bob"))
; deliver: send-fn receives each remote event, local inbox returned
(define sent (list))
(define send-fn (fn (to act) (set! sent (append sent (list to)))))
(define local-inbox (feed/deliver Sf Gf remote? send-fn))
(feed-test "deliver returns local inbox" (feed/count local-inbox) 1)
(feed-test "deliver sent to both remotes" (len sent) 2)
(feed-test "deliver remote targets" sent (list "alice@remote" "carol@remote"))
; ---------- end-to-end: federated, ACL-filtered, ranked timeline ----------
(define
base
(feed/stream
(list
(feed/normalize {:actor "alice" :object "a1" :at 100})
(feed/normalize {:actor "bob" :object "b1" :visible-to (list "carol") :at 90})
(feed/normalize {:actor "eve" :object "e1" :visible-to (list "dave") :at 80}))))
(define federated (feed/inbound base (list {:actor "peer" :object "x1" :at 110})))
(define rec (feed/recency 120 10))
(define
carol-tl
(feed/timeline federated "carol" feed/permit-acl? rec 3))
; eve's :visible-to excludes carol -> filtered out; peer/alice public, bob allows carol
(feed-test "carol federated timeline count" (feed/count carol-tl) 3)
(feed-test
"carol timeline order (recency)"
(map (fn (a) (get a :object)) (feed/items carol-tl))
(list "x1" "a1" "b1"))
(feed-test
"eve dm excluded from carol"
(feed/-elem? "e1" (map (fn (a) (get a :object)) (feed/items carol-tl)))
false)
(feed-test
"dave sees eve dm not bob"
(map
(fn (a) (get a :object))
(feed/items
(feed/timeline federated "dave" feed/permit-acl? rec 5)))
(list "x1" "a1" "e1"))

View File

@@ -1,68 +0,0 @@
; Follow-up — viewer mute/block filtering. (feed-test name got expected)
(define
S
(feed/stream
(list
(feed/normalize {:actor "alice" :object "P1" :at 1 :tags (list "news")})
(feed/normalize {:actor "bob" :object "P2" :at 2 :tags (list "spam")})
(feed/normalize {:actor "alice" :object "P3" :at 3 :tags (list "cats")})
(feed/normalize {:actor "carol" :object "P4" :at 4 :tags (list "news" "spam")}))))
; ---------- mute actors ----------
(feed-test
"mute bob drops his post"
(map
(fn (a) (get a :object))
(feed/items (feed/mute-actors S (list "bob"))))
(list "P1" "P3" "P4"))
(feed-test
"mute alice drops two"
(feed/count (feed/mute-actors S (list "alice")))
2)
(feed-test
"mute nobody keeps all"
(feed/count (feed/mute-actors S (list)))
4)
; ---------- mute tags ----------
(feed-test
"mute spam tag drops two"
(map
(fn (a) (get a :object))
(feed/items (feed/mute-tags S (list "spam"))))
(list "P1" "P3"))
(feed-test
"mute news+cats leaves spam-only"
(map
(fn (a) (get a :object))
(feed/items (feed/mute-tags S (list "news" "cats"))))
(list "P2"))
; ---------- mute objects ----------
(feed-test
"mute object P3 (thread mute)"
(feed/count (feed/mute-objects S (list "P3")))
3)
; ---------- combined prefs ----------
(feed-test
"apply-prefs actors + tags"
(map
(fn (a) (get a :object))
(feed/items (feed/apply-prefs S {:mute-actors (list "bob") :mute-tags (list "cats")})))
(list "P1" "P4"))
(feed-test
"apply-prefs empty keeps all"
(feed/count (feed/apply-prefs S {}))
4)
(feed-test
"apply-prefs all three filters"
(map
(fn (a) (get a :object))
(feed/items (feed/apply-prefs S {:mute-objects (list "P3") :mute-actors (list "carol") :mute-tags (list "spam")})))
(list "P1"))

View File

@@ -1,69 +0,0 @@
; Follow-up — notification feed over an inbox. (feed-test name got expected)
; an inbox is a stream of {:to receiver :activity act} events
(define mk-ev (fn (to act) {:activity act :to to}))
(define
IB
(feed/stream
(list
(mk-ev "alice" (feed/activity "bob" "like" "P" 10 (list)))
(mk-ev "alice" (feed/activity "carol" "like" "P" 20 (list)))
(mk-ev "alice" (feed/activity "dave" "reply" "Q" 30 (list)))
(mk-ev "bob" (feed/activity "eve" "like" "R" 40 (list))))))
; ---------- raw notifications ----------
(feed-test
"alice notification count"
(feed/count (feed/notifications IB "alice"))
3)
(feed-test
"bob notification count"
(feed/count (feed/notifications IB "bob"))
1)
(feed-test
"zoe no notifications"
(feed/count (feed/notifications IB "zoe"))
0)
; ---------- verb filtering ----------
(feed-test
"alice likes only"
(feed/count (feed/notify-verbs IB "alice" (list "like")))
2)
(feed-test
"alice replies only"
(feed/count (feed/notify-verbs IB "alice" (list "reply")))
1)
(feed-test
"alice like+reply"
(feed/count (feed/notify-verbs IB "alice" (list "like" "reply")))
3)
(feed-test
"alice follow (none)"
(feed/count (feed/notify-verbs IB "alice" (list "follow")))
0)
; ---------- digest ----------
(define dig (feed/notify-digest IB "alice"))
(feed-test "digest group count" (len dig) 2)
(feed-test
"digest sorted by key (like|P before reply|Q)"
(map (fn (g) (get g :object)) dig)
(list "P" "Q"))
(feed-test
"like group actors"
(get (nth dig 0) :actors)
(list "bob" "carol"))
(feed-test "like group count" (get (nth dig 0) :count) 2)
(feed-test "like group verb" (get (nth dig 0) :verb) "like")
(feed-test "reply group count" (get (nth dig 1) :count) 1)
(feed-test
"reply group actors"
(get (nth dig 1) :actors)
(list "dave"))
(feed-test "empty digest for zoe" (feed/notify-digest IB "zoe") (list))

View File

@@ -1,86 +0,0 @@
; Follow-up — pagination (offset + cursor). (feed-test name got expected)
; ---------- offset / limit ----------
(define
O
(feed/stream
(list
(feed/activity "u" "post" "o1" 1 (list))
(feed/activity "u" "post" "o2" 2 (list))
(feed/activity "u" "post" "o3" 3 (list))
(feed/activity "u" "post" "o4" 4 (list))
(feed/activity "u" "post" "o5" 5 (list)))))
(feed-test
"page 1"
(map
(fn (a) (get a :object))
(feed/items (feed/page O 0 2)))
(list "o1" "o2"))
(feed-test
"page 2"
(map
(fn (a) (get a :object))
(feed/items (feed/page O 2 2)))
(list "o3" "o4"))
(feed-test
"page 3 (partial)"
(map
(fn (a) (get a :object))
(feed/items (feed/page O 4 2)))
(list "o5"))
(feed-test
"page past end empty"
(feed/count (feed/page O 10 2))
0)
(feed-test "page-count 5/2 = 3" (feed/page-count O 2) 3)
(feed-test "page-count 5/5 = 1" (feed/page-count O 5) 1)
; ---------- cursor (recency) ----------
(define
R
(feed/stream
(list
(feed/activity "u" "post" "a" 50 (list))
(feed/activity "u" "post" "b" 40 (list))
(feed/activity "u" "post" "c" 30 (list))
(feed/activity "u" "post" "d" 20 (list))
(feed/activity "u" "post" "e" 10 (list)))))
(define p1 (feed/page-before R 100 2))
(feed-test
"cursor page 1 newest first"
(map (fn (a) (get a :object)) (feed/items p1))
(list "a" "b"))
(feed-test "next cursor after page 1" (feed/next-cursor p1) 40)
(define p2 (feed/page-before R (feed/next-cursor p1) 2))
(feed-test
"cursor page 2"
(map (fn (a) (get a :object)) (feed/items p2))
(list "c" "d"))
(feed-test "next cursor after page 2" (feed/next-cursor p2) 20)
(define p3 (feed/page-before R (feed/next-cursor p2) 2))
(feed-test
"cursor page 3 (partial)"
(map (fn (a) (get a :object)) (feed/items p3))
(list "e"))
(feed-test
"empty page nil cursor"
(feed/next-cursor (feed/page-before R 5 2))
nil)
(feed-test
"after cursor loads newer"
(map
(fn (a) (get a :object))
(feed/items (feed/recent (feed/after R 30))))
(list "a" "b"))
(feed-test
"before cursor count"
(feed/count (feed/before R 30))
2)

View File

@@ -1,160 +0,0 @@
; Phase 3 — aggregation + ranking. (feed-test name got expected)
; ---------- aggregation ----------
(define
A
(feed/stream
(list
(feed/activity "alice" "post" "p1" 5 (list))
(feed/activity "alice" "post" "p2" 15 (list))
(feed/activity "bob" "post" "p3" 25 (list))
(feed/activity "alice" "like" "p1" 35 (list)))))
(feed-test "actor-counts" (feed/actor-counts A) {:alice 3 :bob 1})
(feed-test "object-counts" (feed/object-counts A) {:p2 1 :p3 1 :p1 2})
(feed-test
"group-by actor alice len"
(len (get (feed/group-by A feed/actor) "alice"))
3)
(feed-test
"group-count empty"
(feed/group-count feed/empty feed/actor)
{})
; day bucketing
(define
D
(feed/stream
(list
(feed/activity "alice" "post" "p1" 5 (list))
(feed/activity "alice" "post" "p2" 8 (list))
(feed/activity "alice" "post" "p3" 12 (list)))))
(feed-test "feed/day floor" (feed/day 12 10) 1)
(feed-test "feed/day same bucket" (feed/day 8 10) 0)
(feed-test "by-actor-day" (feed/by-actor-day D 10) {:alice#0 2 :alice#1 1})
; ---------- recency ----------
(define rec (feed/recency 100 10))
(feed-test
"recency at=now -> 1"
(rec (feed/activity "x" "post" "o" 100 (list)))
1)
(feed-test
"recency age=hl -> .5"
(rec (feed/activity "x" "post" "o" 90 (list)))
0.5)
(feed-test
"recency age=2hl -> .25"
(rec (feed/activity "x" "post" "o" 80 (list)))
0.25)
; ---------- velocity ----------
(define vel (feed/velocity D 10))
(feed-test
"velocity burst (at=12)"
(vel (feed/activity "alice" "post" "z" 12 (list)))
3)
(feed-test
"velocity mid (at=8)"
(vel (feed/activity "alice" "post" "z" 8 (list)))
2)
(feed-test
"velocity first (at=5)"
(vel (feed/activity "alice" "post" "z" 5 (list)))
1)
(feed-test
"velocity other actor"
(vel (feed/activity "bob" "post" "z" 12 (list)))
0)
; ---------- engagement ----------
(define eng (feed/engagement A))
(feed-test
"engagement p1"
(eng (feed/activity "x" "post" "p1" 0 (list)))
2)
(feed-test
"engagement p2"
(eng (feed/activity "x" "post" "p2" 0 (list)))
1)
; ---------- composite ----------
(define
cmp1
(feed/composite (list (list 2 (fn (a) (get a :at))))))
(feed-test
"composite single part"
(cmp1 (feed/activity "x" "post" "o" 5 (list)))
10)
(define
cmp2
(feed/composite
(list
(list 2 (fn (a) (get a :at)))
(list 3 (fn (a) 1)))))
(feed-test
"composite two parts"
(cmp2 (feed/activity "x" "post" "o" 5 (list)))
13)
; ---------- ranking ----------
(define
R
(feed/stream
(list
(feed/activity "u" "post" "oC" 80 (list))
(feed/activity "u" "post" "oA" 100 (list))
(feed/activity "u" "post" "oB" 90 (list)))))
(feed-test
"rank by recency objects"
(map (fn (a) (get a :object)) (feed/items (feed/rank R rec)))
(list "oA" "oB" "oC"))
(feed-test
"top-2 by recency"
(map (fn (a) (get a :object)) (feed/items (feed/top R rec 2)))
(list "oA" "oB"))
(feed-test "top-2 count" (feed/count (feed/top R rec 2)) 2)
; constant score -> tiebreak by :at descending
(define
T
(feed/stream
(list
(feed/activity "u" "post" "f" 10 (list))
(feed/activity "u" "post" "g" 30 (list))
(feed/activity "u" "post" "h" 20 (list)))))
(feed-test
"tiebreak at-desc"
(map
(fn (a) (get a :object))
(feed/items (feed/rank T (fn (a) 0))))
(list "g" "h" "f"))
; equal score AND equal :at -> stable input order
(define
E
(feed/stream
(list
(feed/activity "u" "post" "first" 50 (list))
(feed/activity "u" "post" "second" 50 (list)))))
(feed-test
"stable equal-key input order"
(map
(fn (a) (get a :object))
(feed/items (feed/rank E (fn (a) 0))))
(list "first" "second"))
(feed-test
"with-scores attaches score"
(get (nth (feed/items (feed/with-scores R rec)) 1) :score)
1)
(feed-test "rank preserves count" (feed/count (feed/rank A rec)) 4)

View File

@@ -1,49 +0,0 @@
; Follow-up — conversation threading via :reply-to closure. (feed-test name got expected)
(define
S
(feed/stream
(list
(feed/normalize {:actor "a" :object "root" :at 1})
(feed/normalize {:actor "b" :object "r1" :at 2 :verb "reply" :reply-to "root"})
(feed/normalize {:actor "c" :object "r2" :at 3 :verb "reply" :reply-to "root"})
(feed/normalize {:actor "d" :object "r3" :at 4 :verb "reply" :reply-to "r1"})
(feed/normalize {:actor "e" :object "x" :at 5}))))
; ---------- direct replies ----------
(feed-test "direct replies to root" (feed/reply-count S "root") 2)
(feed-test "direct replies to r1" (feed/reply-count S "r1") 1)
(feed-test "no replies to r3" (feed/reply-count S "r3") 0)
(feed-test
"replies objects to root"
(map (fn (a) (get a :object)) (feed/items (feed/replies S "root")))
(list "r1" "r2"))
; ---------- thread closure ----------
(feed-test
"thread objects root (transitive)"
(feed/thread-objects S "root")
(list "root" "r1" "r2" "r3"))
(feed-test
"thread root chronological"
(map (fn (a) (get a :object)) (feed/items (feed/thread S "root")))
(list "root" "r1" "r2" "r3"))
(feed-test "thread size root" (feed/thread-size S "root") 4)
(feed-test
"thread excludes unrelated x"
(feed/-elem?
"x"
(map (fn (a) (get a :object)) (feed/items (feed/thread S "root"))))
false)
; ---------- sub-thread ----------
(feed-test
"thread from r1 (sub-tree)"
(map (fn (a) (get a :object)) (feed/items (feed/thread S "r1")))
(list "r1" "r3"))
(feed-test "thread size r1" (feed/thread-size S "r1") 2)
(feed-test "leaf thread is itself" (feed/thread-size S "r3") 1)
(feed-test "unrelated thread is itself" (feed/thread-size S "x") 1)

View File

@@ -1,82 +0,0 @@
; Follow-up — trending objects/actors by recent activity. (feed-test name got expected)
; window (50,100]: X@60,X@70 (a), Y@80 (b), Z@90 (c); W@40 is too old
(define
S
(feed/stream
(list
(feed/activity "a" "post" "X" 60 (list))
(feed/activity "a" "post" "X" 70 (list))
(feed/activity "b" "post" "Y" 80 (list))
(feed/activity "c" "post" "Z" 90 (list))
(feed/activity "d" "post" "W" 40 (list)))))
; ---------- trending objects ----------
(feed-test
"trending count (3 in window)"
(len (feed/trending S 100 50 10))
3)
(feed-test
"trending top object"
(get
(nth (feed/trending S 100 50 10) 0)
:object)
"X")
(feed-test
"trending top count"
(get
(nth (feed/trending S 100 50 10) 0)
:count)
2)
(feed-test
"trending order (count desc, key asc tiebreak)"
(map
(fn (e) (get e :object))
(feed/trending S 100 50 10))
(list "X" "Y" "Z"))
(feed-test
"trending top-2"
(map
(fn (e) (get e :object))
(feed/trending S 100 50 2))
(list "X" "Y"))
(feed-test
"old object W excluded"
(feed/-elem?
"W"
(map
(fn (e) (get e :object))
(feed/trending S 100 50 10)))
false)
(feed-test
"narrow window keeps only newest"
(map
(fn (e) (get e :object))
(feed/trending S 100 15 10))
(list "Z"))
(feed-test
"empty window -> nothing"
(feed/trending S 100 5 10)
(list))
; ---------- trending actors ----------
(feed-test
"trending actor top"
(get
(nth (feed/trending-actors S 100 50 10) 0)
:actor)
"a")
(feed-test
"trending actor count"
(get
(nth (feed/trending-actors S 100 50 10) 0)
:count)
2)
(feed-test
"trending actors order"
(map
(fn (e) (get e :actor))
(feed/trending-actors S 100 50 10))
(list "a" "b" "c"))

View File

@@ -1,59 +0,0 @@
; feed/thread — conversation threading. A reply carries :reply-to <parent-object>
; (normalize preserves it). A thread is the transitive closure over :reply-to from
; a root object: root + replies + replies-to-replies, gathered chronologically.
;
; Requires: lib/feed/normalize.sx, lib/feed/stream.sx, lib/feed/fanout.sx
; (feed/-elem?, feed/-distinct).
; direct replies to an object
(define
feed/replies
(fn
(stream object)
(feed/filter stream (fn (a) (equal? (get a :reply-to) object)))))
(define
feed/reply-count
(fn (stream object) (feed/count (feed/replies stream object))))
; iterate f from x until the result stops growing (set-closure fixpoint)
(define
feed/-fixpoint
(fn
(f x)
(let
((nx (f x)))
(if (= (len nx) (len x)) x (feed/-fixpoint f nx)))))
; the set of object-ids in the thread rooted at `root`
(define
feed/thread-objects
(fn
(stream root)
(let
((all (feed/items stream)))
(feed/-fixpoint
(fn
(acc)
(feed/-distinct
(append
acc
(map
(fn (a) (get a :object))
(filter (fn (a) (feed/-elem? (get a :reply-to) acc)) all)))))
(list root)))))
; the full thread as a chronological stream (root + all descendants)
(define
feed/thread
(fn
(stream root)
(let
((objs (feed/thread-objects stream root)))
(feed/sort-by-at
(feed/filter stream (fn (a) (feed/-elem? (get a :object) objs)))))))
; how many activities are in the thread (root counts as 1)
(define
feed/thread-size
(fn (stream root) (feed/count (feed/thread stream root))))

View File

@@ -1,42 +0,0 @@
; feed/trending — what's hot right now: objects (or actors) ranked by activity
; count within a recency window. Deterministic: count descending, ties broken by
; key ascending (entries are pre-sorted by key, then stable grade-down by count).
;
; Requires: lib/feed/stream.sx, lib/feed/aggregate.sx (object/actor-counts),
; lib/feed/rank.sx (feed/-desc-by).
; activities within (now-window, now]
(define
feed/-recent
(fn
(stream now window)
(feed/filter
stream
(fn (a) (and (<= (get a :at) now) (> (get a :at) (- now window)))))))
; counts dict -> top-N entries {label key, :count n}, count desc, key asc
(define
feed/-top-counts
(fn
(counts label n)
(let
((entries (map (fn (k) (assoc {:count (get counts k)} label k)) (sort (keys counts)))))
(take (feed/-desc-by entries (fn (e) (get e :count))) n))))
; top-N trending objects in the window
(define
feed/trending
(fn
(stream now window n)
(feed/-top-counts
(feed/object-counts (feed/-recent stream now window))
:object n)))
; top-N most active actors in the window
(define
feed/trending-actors
(fn
(stream now window n)
(feed/-top-counts
(feed/actor-counts (feed/-recent stream now window))
:actor n)))

141
lib/flow/README.md Normal file
View File

@@ -0,0 +1,141 @@
# flow — durable DAG workflows on Scheme
`flow` is a workflow engine for rose-ash: content pipelines (write → review →
publish → federate), scheduled jobs, and multi-step user flows (signup, confirm,
onboard) that **survive process restarts**. It is a thin Scheme prelude over the
Scheme-on-SX guest (`lib/scheme/`); a flow runs *inside* the interpreter.
Run the suite: `bash lib/flow/conformance.sh`**151/151 across 10 suites**.
## Model
A **flow** is just a Scheme procedure of one argument — the upstream value:
```
node : input -> output
```
Combinators build composite nodes out of child nodes. A node that ignores its
argument is effectively a thunk. There is no separate "graph" object: composition
*is* function composition, so flows are values you can name, pass, and nest.
```scheme
(defflow publish
(sequence
(lambda (draft) (string-append draft "!"))
(branch (lambda (post) (>= (string-length post) 3))
(remote-node 'fed 'publish)
(flow-const 'rejected))))
(flow/start publish "hello") ; => federated, or a (flow-suspended id tag) state
```
## Building blocks (`spec.sx`)
| Combinator | Meaning |
|---|---|
| `(flow-node f)` / `(flow-id x)` / `(flow-const v)` | leaf nodes |
| `(sequence n ...)` | thread input left-to-right |
| `(parallel n ...)` | fan input to every child, join results into a list (sequential eval) |
| `(map-flow node)` | run `node` over each item of a list input, join results |
| `(flow-while pred body max)` / `(flow-until ...)` | bounded iteration (cap `max` steps) |
| `(defflow name body)` | bind + register a named flow (so it survives restart) |
## Control flow + errors (`spec.sx`)
| Combinator | Meaning |
|---|---|
| `(branch pred then else)` | `pred` on input selects `then`/`else` (`cond` is a Scheme special form) |
| `(retry n node)` | re-run on a *raised exception*, up to `n` attempts |
| `(timeout budget node)` | cooperative **step budget**: nodes call `(tick)`; the `(budget+1)`-th tick raises `flow-timeout` |
| `(try-catch node handler)` | catch a raised exception → `(handler error)` |
| `(fail reason)` / `(failed? x)` / `(fail-reason x)` | explicit failure *values* (flow downstream as data) |
| `(recover node handler)` | the fail-VALUE counterpart of try-catch |
| `(attempt n ...)` | railway sequence: stop at the first node returning a `(fail ...)` |
| `(tap effect)` | run a side effect, return input unchanged |
**Two error channels, on purpose.** Raised exceptions are for *bugs/transients*
(caught by `retry`/`try-catch`). `(fail reason)` values are for *expected business
outcomes* (validation rejected, declined) and compose via `attempt`/`recover`.
## Suspend / resume — the durable core (`spec.sx`, `store.sx`)
The guest Scheme's `call/cc` is **escape-only** — re-invoking a captured
continuation after it returns *hangs* the runtime. So flow does **not** serialize
continuations. Instead it uses **deterministic replay**:
- `(suspend tag)` — if `tag` is already in the replay log, return its logged value;
otherwise escape to the driver as `(flow-suspended tag)`.
- `resume` appends `(tag value)` to the log and **re-runs the flow from the start**.
Already-resolved suspends replay their values; the first unresolved one escapes
again (or the flow completes).
The entire persisted state is the replay log — plain data. No live continuation is
ever stored, so flows survive process restarts and even moves between instances.
> **Author contract:** suspend `tag`s must be unique and deterministic across
> replays, and **all** non-determinism / side effects must go through suspend
> points (so their results are logged) — otherwise they re-run on every replay.
### Lifecycle (`store.sx`)
```scheme
(flow/start flow input) ; raw result if it completes, else (flow-suspended id tag)
(flow/resume id value) ; inject value at the waiting tag, continue
(flow/cancel id) ; terminate; a later resume is rejected
```
### Introspection & hygiene
```scheme
(flow/status id) ; done | suspended | cancelled | unknown
(flow/result id) ; result if done, else (flow-error reason)
(flow/list) ; ((id status) ...)
(flow/pending) ; ((id waiting-tag) ...) — what each suspended flow awaits
(flow/gc) ; drop terminal records, keep live ones; returns count removed
(flow/forget id) ; drop one terminal record (refuses live flows)
```
### Crash recovery
```scheme
(flow-store-export) ; the store as plain data (live procs nulled)
(flow-store-import! d) ; restore the store from exported data
(flow-resumable-ids) ; ids of suspended flows to wake on restart
```
On restart the flow definitions are reloaded (`defflow` re-registers names) and the
exported store reimported; `resume` re-resolves each flow's procedure **by name**.
## Distribution via fed-sx (`remote.sx`)
```scheme
(flow-peer-register! addr table) ; mock a peer's exposed functions (fed-sx boundary)
(remote-node addr fn) ; run a node on a peer
(remote-failover addrs fn local) ; try peers in order, fall through to a local node
(flow-replicate-to addr) ; copy this store to a peer's replica slot
(flow-restore-from addr) ; import a peer's replica (handoff)
```
**Handoff** is crash recovery across instances: replicate → local instance dies →
peer restores the (plain-data) store and resumes. The replay log carries over, so
all resolved suspends survive the move.
## Files
| File | Contents |
|---|---|
| `spec.sx` | combinators (flow-combinators-src / flow-control-src / flow-suspend-src) |
| `store.sx` | durable store, lifecycle, crash recovery, introspection, hygiene |
| `remote.sx` | fed-sx transport (mock peer registry), failover, replication |
| `api.sx` | `flow-make-env` / `flow-run` SX helpers (one cached env, per-test reset) |
| `tests/*.sx` | 10 suites, 151 cases |
| `conformance.sh` | loads substrate + flow layer, runs every suite |
## Notes on the substrate
The guest Scheme (`lib/scheme/`, imported read-only) lacks dotted-rest params
`(a . rest)` and named `let`; combinators use `(lambda args ...)` variadics + top-
level recursion. `cons` is list-only (no dotted pairs), so log/assoc entries are
2-element lists. Strings box as `{:scm-string "..."}`. Timeout is a step budget
because there is no wall clock; `parallel` is sequential for the same reason.

65
lib/flow/api.sx Normal file
View File

@@ -0,0 +1,65 @@
;; lib/flow/api.sx — flow runtime entry points.
;;
;; Builds a Scheme env preloaded with the flow combinators (lib/flow/spec.sx),
;; the durable store + lifecycle (lib/flow/store.sx), the fed-sx remote layer
;; (lib/flow/remote.sx), and the host integration ABI (lib/flow/host.sx), and
;; provides SX helpers to run flow programs.
;;
;; Scheme-level API (available inside flow programs):
;; (flow/start flow input) — run a flow; raw result if it completes, else
;; (flow-suspended id tag). Defined in store.sx.
;; (flow/resume id value) — resume a suspended flow (store.sx)
;; (flow/cancel id) — cancel a flow (store.sx)
;; (suspend tag) — suspension point (spec.sx)
;; (request kind payload) — host request envelope over suspend (host.sx)
;; (remote-node addr fn) — node executed on a federation peer (remote.sx)
;;
;; SX-level helpers (for hosts and tests):
;; (flow-make-env) — fresh standard env + combinators + store + remote + host
;; (flow-run src) — eval a Scheme program string in a reset shared env
;; (flow-run-in env src) — eval a Scheme program string in a given env
;;
;; flow-run reuses ONE env (building the full standard env is expensive) and
;; resets the mutable flow globals before each program, so tests stay isolated
;; without paying for a fresh standard env each time. flow-registry persists (it
;; models reloaded flow definitions surviving a restart).
(define
flow-make-env
(fn
()
(let
((env (scheme-standard-env)))
(flow-load-combinators! env)
(flow-load-store! env)
(flow-load-remote! env)
(flow-load-host! env)
env)))
(define
flow-run-in
(fn (env src) (scheme-eval-program (scheme-parse-all src) env)))
(define
flow-reset-src
"(set! flow-store (list)) (set! flow-next-id 0) (set! flow-replay-log (list)) (set! flow-suspend-k #f) (set! flow-timeout-budget -1) (set! flow-peers (list)) (set! flow-replicas (list))")
(define flow-env-cache false)
(define
flow-shared-env
(fn
()
(begin
(if flow-env-cache nil (set! flow-env-cache (flow-make-env)))
flow-env-cache)))
(define
flow-run
(fn
(src)
(let
((env (flow-shared-env)))
(begin
(scheme-eval-program (scheme-parse-all flow-reset-src) env)
(scheme-eval-program (scheme-parse-all src) env)))))

103
lib/flow/conformance.sh Executable file
View File

@@ -0,0 +1,103 @@
#!/usr/bin/env bash
# flow-on-sx conformance runner — runs all flow test suites in one sx_server process.
#
# Usage:
# bash lib/flow/conformance.sh # run all suites
# bash lib/flow/conformance.sh -v # verbose (list each suite)
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
# Suites: NAME RUNNER-FN PATH
SUITES=(
"basic flow-basic-tests-run! lib/flow/tests/basic.sx"
"control flow-ctl-tests-run! lib/flow/tests/control.sx"
"suspend flow-sus-tests-run! lib/flow/tests/suspend.sx"
"recovery flow-rec-tests-run! lib/flow/tests/recovery.sx"
"distributed flow-dist-tests-run! lib/flow/tests/distributed.sx"
"api flow-api-tests-run! lib/flow/tests/api.sx"
"combinators flow-cmb-tests-run! lib/flow/tests/combinators.sx"
"railway flow-rail-tests-run! lib/flow/tests/railway.sx"
"integration flow-int-tests-run! lib/flow/tests/integration.sx"
"hygiene flow-hyg-tests-run! lib/flow/tests/hygiene.sx"
"host flow-hst-tests-run! lib/flow/tests/host.sx"
)
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
EPOCH=1
emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); }
emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); }
{
emit_load "lib/guest/lex.sx"
emit_load "lib/guest/reflective/env.sx"
emit_load "lib/guest/reflective/quoting.sx"
emit_load "lib/scheme/parser.sx"
emit_load "lib/scheme/eval.sx"
emit_load "lib/scheme/runtime.sx"
emit_load "lib/flow/spec.sx"
emit_load "lib/flow/store.sx"
emit_load "lib/flow/remote.sx"
emit_load "lib/flow/host.sx"
emit_load "lib/flow/api.sx"
for SUITE in "${SUITES[@]}"; do
read -r _NAME _RUNNER FILE <<< "$SUITE"
emit_load "$FILE"
emit_eval "($_RUNNER)"
done
} > "$TMPFILE"
OUTPUT=$(timeout 540 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
TOTAL_PASS=0
TOTAL_FAIL=0
FAILED_SUITES=()
LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true)
I=0
while read -r LINE; do
[ -z "$LINE" ] && continue
P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}')
F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}')
[ -z "$P" ] && P=0
[ -z "$F" ] && F=0
SUITE_INFO="${SUITES[$I]}"
SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}')
TOTAL_PASS=$((TOTAL_PASS + P))
TOTAL_FAIL=$((TOTAL_FAIL + F))
if [ "$F" -gt 0 ]; then
FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))")
printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))"
echo "$LINE" | grep -oE ':name "[^"]*"' | sed 's/:name / fail: /'
elif [ "$VERBOSE" = "-v" ]; then
printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P"
fi
I=$((I+1))
done <<< "$LAST_DICT_LINES"
TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
if [ "$TOTAL" -eq 0 ]; then
echo "ERROR: no suite results parsed. Raw output:" >&2
echo "$OUTPUT" >&2
exit 1
fi
if [ $TOTAL_FAIL -eq 0 ]; then
echo "ok $TOTAL_PASS/$TOTAL flow-on-sx tests passed (${#SUITES[@]} suites)"
else
echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:"
for S in "${FAILED_SUITES[@]}"; do echo " $S"; done
exit 1
fi

42
lib/flow/host.sx Normal file
View File

@@ -0,0 +1,42 @@
;; lib/flow/host.sx — the host integration ABI (Phase 8).
;;
;; `suspend` is flow's seam to the outside world, but a bare (suspend tag) is just a
;; signal — every author would invent their own tag shape. This layer defines a
;; stable request/response contract so a host (e.g. an art-dag driver, or a human
;; review UI) can hook in WITHOUT reverse-engineering ad-hoc tags.
;;
;; A flow asks the host to do something and waits for the answer:
;; (request kind payload) — suspend with a typed envelope (flow-request kind
;; payload); evaluates to the host's resume value.
;; (await-human prompt) — request kind=human (a decision point)
;; (await-render recipe) — request kind=render (e.g. an art-dag job)
;; (await-effect kind p) — request of an arbitrary kind
;;
;; The host drives flows by polling its work queue and resuming:
;; (flow-host-requests) — ((id kind payload) ...) for every SUSPENDED flow whose
;; waiting tag is a host request. The host dispatches by kind (render -> submit a
;; Celery job; human -> show UI), then calls (flow/resume id answer).
;; (request? tag) / (request-kind tag) / (request-payload tag) — parse one tag.
;;
;; Reference driver — the host only supplies `dispatch`, a (kind payload) -> answer:
;; (flow-drive-host dispatch) — one tick: service every CURRENTLY pending
;; request (snapshot), resuming each with (dispatch kind payload); returns the
;; count serviced. Resumes may create new requests — serviced on the next tick.
;; (flow-run-host dispatch maxticks) — tick until quiescent (no pending requests)
;; or maxticks reached; returns total requests serviced. Bounded for determinism.
;;
;; Contract: the host owns IO and persistence. flow stays deterministic — a flow
;; never performs IO itself, it only `request`s; the host performs the effect and
;; feeds the result back via resume (which the replay log records, so the effect is
;; not re-run on recovery). Persist with flow-store-export after each transition and
;; flow-store-import! on boot.
(define
flow-host-src
"(define (request kind payload) (suspend (list (quote flow-request) kind payload)))\n (define (request? tag) (and (pair? tag) (eq? (car tag) (quote flow-request))))\n (define (request-kind tag) (car (cdr tag)))\n (define (request-payload tag) (car (cdr (cdr tag))))\n (define (await-human prompt) (request (quote human) prompt))\n (define (await-render recipe) (request (quote render) recipe))\n (define (await-effect kind payload) (request kind payload))\n (define (flow-host-req-step pend)\n (if (null? pend)\n (list)\n (let ((id (car (car pend))) (tag (car (cdr (car pend)))))\n (if (request? tag)\n (cons (list id (request-kind tag) (request-payload tag))\n (flow-host-req-step (cdr pend)))\n (flow-host-req-step (cdr pend))))))\n (define (flow-host-requests) (flow-host-req-step (flow/pending)))\n (define (flow-drive-host-step reqs dispatch)\n (if (null? reqs)\n 0\n (begin\n (flow/resume (car (car reqs)) (dispatch (car (cdr (car reqs))) (car (cdr (cdr (car reqs))))))\n (+ 1 (flow-drive-host-step (cdr reqs) dispatch)))))\n (define (flow-drive-host dispatch) (flow-drive-host-step (flow-host-requests) dispatch))\n (define (flow-run-host dispatch maxticks)\n (if (<= maxticks 0)\n 0\n (let ((n (flow-drive-host dispatch)))\n (if (= n 0) 0 (+ n (flow-run-host dispatch (- maxticks 1)))))))")
(define
flow-load-host!
(fn
(env)
(begin (scheme-eval-program (scheme-parse-all flow-host-src) env) env)))

34
lib/flow/remote.sx Normal file
View File

@@ -0,0 +1,34 @@
;; lib/flow/remote.sx — distributed nodes via fed-sx (Phase 4).
;;
;; A node can execute on a federation peer. The transport is the fed-sx boundary;
;; it is MOCKED in tests by a peer registry mapping addr -> function table. In
;; production flow-transport would issue a fed-sx call; here it dispatches locally.
;;
;; (flow-peer-register! addr table) — register a mock peer. table is a list of
;; (fn-name proc) entries — the functions that peer exposes.
;; (flow-transport addr fn input) — invoke fn on the peer with input. Raises
;; (flow-remote-unreachable) if the addr is unknown, (flow-remote-no-fn) if the
;; peer does not expose fn.
;; (remote-node addr fn) — a node that runs fn on the peer at addr.
;; (remote-failover addrs fn local) — try fn on each peer in addrs in order; on a
;; raised error move to the next peer; if every peer fails, run the `local`
;; node as a fallback.
;;
;; Persistence across instances + handoff. Each instance runs the same flow
;; definitions, so the only thing that needs to cross the wire is the (plain-data)
;; store — exactly flow-store-export from store.sx. Replication pushes that export
;; to a peer's replica slot; handoff = restore the replica on the peer and resume.
;;
;; (flow-replicate-to addr) — copy this instance's store to peer addr's replica
;; (flow-restore-from addr) — import the replica from peer addr (#t / #f)
;; (flow-replica-get addr) — the raw replicated store at addr (or #f)
(define
flow-remote-src
"(define flow-peers (list))\n (define (flow-assoc key alist)\n (if (null? alist)\n #f\n (if (eq? (car (car alist)) key) (car (cdr (car alist))) (flow-assoc key (cdr alist)))))\n (define (flow-peer-register! addr table) (set! flow-peers (cons (list addr table) flow-peers)))\n (define (flow-transport addr fn input)\n (let ((table (flow-assoc addr flow-peers)))\n (if table\n (let ((proc (flow-assoc fn table)))\n (if proc (proc input) (raise (quote flow-remote-no-fn))))\n (raise (quote flow-remote-unreachable)))))\n (define (remote-node addr fn) (lambda (input) (flow-transport addr fn input)))\n (define (flow-failover-step addrs fn input local)\n (if (null? addrs)\n (local input)\n (guard (e (#t (flow-failover-step (cdr addrs) fn input local)))\n (flow-transport (car addrs) fn input))))\n (define (remote-failover addrs fn local)\n (lambda (input) (flow-failover-step addrs fn input local)))\n\n (define flow-replicas (list))\n (define (flow-replicas-remove addr reps)\n (if (null? reps)\n (list)\n (if (eq? (car (car reps)) addr)\n (flow-replicas-remove addr (cdr reps))\n (cons (car reps) (flow-replicas-remove addr (cdr reps))))))\n (define (flow-replicate-to addr)\n (set! flow-replicas (cons (list addr (flow-store-export)) (flow-replicas-remove addr flow-replicas))))\n (define (flow-replica-get addr) (flow-assoc addr flow-replicas))\n (define (flow-restore-from addr)\n (let ((data (flow-replica-get addr)))\n (if data (begin (flow-store-import! data) #t) #f)))")
(define
flow-load-remote!
(fn
(env)
(begin (scheme-eval-program (scheme-parse-all flow-remote-src) env) env)))

19
lib/flow/scoreboard.json Normal file
View File

@@ -0,0 +1,19 @@
{
"total": 166,
"passed": 166,
"failed": 0,
"suites": {
"basic": { "passed": 18, "total": 18 },
"control": { "passed": 31, "total": 31 },
"suspend": { "passed": 17, "total": 17 },
"recovery": { "passed": 8, "total": 8 },
"distributed": { "passed": 19, "total": 19 },
"api": { "passed": 12, "total": 12 },
"combinators": { "passed": 17, "total": 17 },
"railway": { "passed": 10, "total": 10 },
"integration": { "passed": 10, "total": 10 },
"hygiene": { "passed": 9, "total": 9 },
"host": { "passed": 15, "total": 15 }
},
"phases": { "phase1": "done", "phase2": "done", "phase3": "done", "phase4": "done", "phase5": "done", "phase6": "done", "phase7": "done", "phase8": "done" }
}

53
lib/flow/scoreboard.md Normal file
View File

@@ -0,0 +1,53 @@
# flow-on-sx Scoreboard
**All tests pass: 166 / 166 across 11 suites. Phases 1-8 complete.**
`bash lib/flow/conformance.sh`
## Per-suite breakdown
| Suite | Passing | Covers |
|-------|--------:|--------|
| basic | 18 | Phase 1: single nodes, linear sequence, data-flow threading, defflow, parallel fan/join, nested composition, publish-shaped flow |
| control | 31 | Phase 2: `branch` (6); error model `fail`/`failed?`/`fail-reason` (6); `try-catch` (6); `retry n` (6); `timeout` cooperative step budget (7) |
| suspend | 17 | Phase 3: suspend/resume/cancel via deterministic replay; multi-step, replay determinism, lifecycle guards, suspend-in-branch |
| recovery | 8 | Phase 3: crash recovery — store export/import, resumable scan, restart-at-every-step, replay-log survival |
| distributed | 19 | Phase 4: `remote-node` (7); `remote-failover` (6); replication + handoff across instances (6) |
| api | 12 | Phase 5: introspection — `flow/status`, `flow/result`, `flow/list`, `flow/pending` |
| combinators | 17 | Phase 5: `tap`, `recover` (fail-value), `map-flow` fan-over-list, `flow-while`/`flow-until` bounded iteration |
| railway | 10 | Phase 6: `attempt` — fail-value short-circuiting sequence + recover rejoin |
| integration | 10 | Phase 7: end-to-end order + onboarding flows composing every phase (suspend, branch, federation, crash recovery, handoff, introspection) |
| hygiene | 9 | Phase 5: `flow/gc` (prune terminal flows), `flow/forget` (drop one terminal record) |
| host | 15 | Phase 8: host ABI — `request`/`await-human`/`await-render`, `flow-host-requests` queue, `flow-run-host` reference driver; art-dag-shaped render→review→publish loop |
## Architecture
Flow combinators are a **Scheme prelude** (`lib/flow/spec.sx`) loaded onto
`scheme-standard-env`. A flow is a Scheme procedure `input -> output`. The whole
flow executes inside the Scheme interpreter, so Phase 3's `suspend` (call/cc) will
capture the flow continuation directly.
- `lib/flow/spec.sx` — combinators: `flow-node`, `flow-id`, `flow-const`,
`sequence`, `parallel`, `defflow`; `flow-load-combinators!`.
- `lib/flow/api.sx``flow/start` (Scheme); `flow-make-env`, `flow-run`,
`flow-run-in` (SX helpers).
- `lib/flow/tests/basic.sx` — 18 cases.
- `lib/flow/conformance.sh` — loads substrate + flow layer, runs suites.
## Semantics notes
- **node** = 1-arg Scheme procedure; the upstream value is the argument. A node
ignoring its argument is effectively a thunk.
- **sequence** threads left-to-right; empty sequence = identity.
- **parallel** fans the same input to every branch and joins results into a list.
Evaluation is **sequential** for now; true concurrency arrives in Phase 3.
## Phases
- [x] Phase 1 — Declarative DAG + sequential execution (combinators + 18 tests, `flow/start`)
- [x] Phase 2 — Control flow + error handling (branch, error model, try-catch, retry, timeout)
- [x] Phase 3 — Suspend/resume (suspend/resume/cancel + crash recovery via deterministic replay)
- [x] Phase 4 — Distributed nodes via fed-sx (remote-node, failover, replication + handoff)
- [x] Phase 5 — Operational API + combinators (introspection, tap, recover, map-flow)
- [ ] Phase 3 — Suspend / resume (the showcase)
- [ ] Phase 4 — Distributed nodes via fed-sx

61
lib/flow/spec.sx Normal file
View File

@@ -0,0 +1,61 @@
;; lib/flow/spec.sx — flow combinators as a Scheme prelude.
;;
;; A flow is a Scheme procedure of one argument: the upstream value.
;; node : input -> output
;; A leaf node ignoring its argument is effectively a thunk. Combinators
;; build composite nodes out of child nodes. The whole flow runs INSIDE the
;; Scheme interpreter.
;;
;; Phase 1 combinators (flow-combinators-src):
;; flow-node / flow-id / flow-const / sequence / parallel / defflow
;; defflow both binds the flow and registers it by name (flow-register!, in
;; store.sx) so it can be re-resolved after a process restart.
;; map-flow (Phase 5): run a node over each item of a list input, join results.
;; flow-while / flow-until (Phase 5): bounded iteration — re-run body, threading
;; the value, while/until pred holds, up to `max` steps (deterministic bound; no
;; unbounded loops in pure SX).
;;
;; Phase 2 combinators (flow-control-src):
;; branch / fail / failed? / fail-reason / try-catch / retry / timeout / tick
;; tap (Phase 5): side-effecting pass-through (returns input unchanged).
;; recover (Phase 5): the fail-VALUE counterpart of try-catch.
;; attempt (Phase 6): railway sequence — thread nodes left-to-right but stop at
;; the first node that returns a (fail ...) value, returning that failure.
;;
;; Phase 3 suspend core (flow-suspend-src):
;; The guest Scheme's call/cc is ESCAPE-ONLY (re-invoking a captured k after it
;; returns hangs the runtime), so suspend/resume CANNOT re-enter a continuation.
;; Instead, durability uses DETERMINISTIC REPLAY: a flow re-runs from the start
;; on each resume; suspend points that have already been resolved replay their
;; logged value, and the first unresolved suspend escapes back to the driver.
;; The entire persisted state is the replay log (plain (tag value) data), which
;; survives process restart — no live continuation is ever serialized.
;;
;; (suspend tag) — if tag is in the replay log, return its value; else escape
;; to the driver as (flow-suspended tag). tags must be unique & deterministic
;; across replays. ALL effects/non-determinism must go through suspend so their
;; results are logged (otherwise they re-run on every replay).
;; (flow-drive flow input log) — run flow with the given replay log; returns
;; (flow-done result) or (flow-suspended tag).
(define
flow-combinators-src
"(define (flow-node f) f)\n (define (flow-id input) input)\n (define (flow-const v) (lambda (input) v))\n (define (flow-seq-step ns v)\n (if (null? ns) v (flow-seq-step (cdr ns) ((car ns) v))))\n (define sequence (lambda ns (lambda (input) (flow-seq-step ns input))))\n (define parallel (lambda ns (lambda (input) (map (lambda (n) (n input)) ns))))\n (define (map-flow node) (lambda (items) (map node items)))\n (define (flow-while-step pred body input n)\n (if (<= n 0)\n input\n (if (pred input) (flow-while-step pred body (body input) (- n 1)) input)))\n (define (flow-while pred body max) (lambda (input) (flow-while-step pred body input max)))\n (define (flow-until-step pred body input n)\n (if (<= n 0)\n input\n (if (pred input) input (flow-until-step pred body (body input) (- n 1)))))\n (define (flow-until pred body max) (lambda (input) (flow-until-step pred body input max)))\n (define-syntax defflow\n (syntax-rules ()\n ((defflow nm body)\n (begin (define nm body) (flow-register! (quote nm) nm)))))")
(define
flow-control-src
"(define (branch pred then else)\n (lambda (input) (if (pred input) (then input) (else input))))\n (define (fail reason) (list (quote flow-fail) reason))\n (define (failed? x) (and (pair? x) (eq? (car x) (quote flow-fail))))\n (define (fail-reason x) (car (cdr x)))\n (define (recover node handler)\n (lambda (input)\n (let ((r (node input)))\n (if (failed? r) (handler (fail-reason r)) r))))\n (define (tap effect)\n (lambda (input) (begin (effect input) input)))\n (define (flow-attempt-step ns v)\n (if (failed? v)\n v\n (if (null? ns) v (flow-attempt-step (cdr ns) ((car ns) v)))))\n (define attempt (lambda ns (lambda (input) (flow-attempt-step ns input))))\n (define (try-catch node handler)\n (lambda (input) (guard (e (#t (handler e))) (node input))))\n (define (flow-retry-step n node input)\n (guard (e (#t (if (<= n 1) (raise e) (flow-retry-step (- n 1) node input))))\n (node input)))\n (define (retry n node) (lambda (input) (flow-retry-step n node input)))\n (define flow-timeout-budget -1)\n (define (tick)\n (if (< flow-timeout-budget 0)\n 0\n (begin\n (set! flow-timeout-budget (- flow-timeout-budget 1))\n (if (< flow-timeout-budget 0)\n (raise (quote flow-timeout))\n flow-timeout-budget))))\n (define (timeout budget node)\n (lambda (input)\n (let ((saved flow-timeout-budget))\n (set! flow-timeout-budget budget)\n (guard (e (#t (begin (set! flow-timeout-budget saved) (raise e))))\n (let ((result (node input)))\n (set! flow-timeout-budget saved)\n result)))))")
(define
flow-suspend-src
"(define flow-replay-log (list))\n (define flow-suspend-k #f)\n (define (flow-log-lookup tag log)\n (if (null? log)\n (list #f #f)\n (if (eq? (car (car log)) tag)\n (list #t (car (cdr (car log))))\n (flow-log-lookup tag (cdr log)))))\n (define (suspend tag)\n (let ((hit (flow-log-lookup tag flow-replay-log)))\n (if (car hit)\n (car (cdr hit))\n (flow-suspend-k (list (quote flow-suspended) tag)))))\n (define (flow-drive flow input log)\n (set! flow-replay-log log)\n (call/cc\n (lambda (k)\n (set! flow-suspend-k k)\n (list (quote flow-done) (flow input)))))")
(define
flow-load-combinators!
(fn
(env)
(begin
(scheme-eval-program (scheme-parse-all flow-combinators-src) env)
(scheme-eval-program (scheme-parse-all flow-control-src) env)
(scheme-eval-program (scheme-parse-all flow-suspend-src) env)
env)))

45
lib/flow/store.sx Normal file

File diff suppressed because one or more lines are too long

79
lib/flow/tests/api.sx Normal file
View File

@@ -0,0 +1,79 @@
;; lib/flow/tests/api.sx — Phase 5: operational introspection API.
(define flow-api-pass 0)
(define flow-api-fail 0)
(define flow-api-fails (list))
(define
flow-api-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-api-pass (+ flow-api-pass 1))
(begin
(set! flow-api-fail (+ flow-api-fail 1))
(append! flow-api-fails {:name name :expected expected :actual actual})))))
(define flow-a (fn (src) (flow-run src)))
;; ── flow/status ─────────────────────────────────────────────────
(flow-api-test "status: unknown id" (flow-a "(flow/status 999)") "unknown")
(flow-api-test
"status: suspended flow"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/status id)")
"suspended")
(flow-api-test
"status: completed flow"
(flow-a
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) v))) (define id (car (cdr (flow/start w 0)))) (flow/resume id 5) (flow/status id)")
"done")
(flow-api-test
"status: cancelled flow"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id) (flow/status id)")
"cancelled")
;; ── flow/result ─────────────────────────────────────────────────
(flow-api-test
"result: returns the value of a completed flow"
(flow-a
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) (list (quote got) v)))) (define id (car (cdr (flow/start w 0)))) (flow/resume id 9) (flow/result id)")
(list "got" 9))
(flow-api-test
"result: a still-suspended flow has no result"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/result id)")
(list "flow-error" "not-done"))
(flow-api-test
"result: unknown id errors"
(flow-a "(flow/result 999)")
(list "flow-error" "no-such-flow"))
;; ── flow/list ───────────────────────────────────────────────────
(flow-api-test "list: empty store" (flow-a "(flow/list)") (list))
(flow-api-test
"list: reports id + status for each flow (newest first)"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (flow/start w 0) (flow/start (lambda (x) (* x 2)) 5) (flow/list)")
(list (list 2 "done") (list 1 "suspended")))
;; ── flow/pending ────────────────────────────────────────────────
(flow-api-test
"pending: lists suspended flows with their waiting tag"
(flow-a
"(defflow w (lambda (x) (suspend (quote review)))) (flow/start w 0) (flow/pending)")
(list (list 1 "review")))
(flow-api-test
"pending: excludes completed and cancelled flows"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (defflow v (sequence (lambda (x) (suspend (quote r))) (lambda (y) y))) (define i1 (car (cdr (flow/start w 0)))) (define i2 (car (cdr (flow/start v 0)))) (define i3 (car (cdr (flow/start w 0)))) (flow/resume i2 1) (flow/cancel i3) (flow/pending)")
(list (list 1 "q")))
(flow-api-test
"pending: operator can drain all pending flows"
(flow-a
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) (* v 10)))) (flow/start w 0) (flow/start w 0) (define ps (flow/pending)) (flow/resume (car (car ps)) 1) (flow/resume (car (car (cdr ps))) 2) (flow/list)")
(list (list 1 "done") (list 2 "done")))
(define flow-api-tests-run! (fn () {:total (+ flow-api-pass flow-api-fail) :passed flow-api-pass :failed flow-api-fail :fails flow-api-fails}))

121
lib/flow/tests/basic.sx Normal file
View File

@@ -0,0 +1,121 @@
;; lib/flow/tests/basic.sx — Phase 1: declarative DAG + sequential execution.
(define flow-basic-pass 0)
(define flow-basic-fail 0)
(define flow-basic-fails (list))
(define
flow-basic-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-basic-pass (+ flow-basic-pass 1))
(begin
(set! flow-basic-fail (+ flow-basic-fail 1))
(append! flow-basic-fails {:name name :expected expected :actual actual})))))
;; Run a Scheme flow-program string and return its final value.
(define flow-b (fn (src) (flow-run src)))
;; Scheme strings are boxed as {:scm-string "..."}; unwrap to a host string.
(define flow-bs (fn (src) (get (flow-run src) :scm-string)))
;; ── single node ─────────────────────────────────────────────────
(flow-basic-test
"node: identity passes input through"
(flow-b "(flow/start flow-id 7)")
7)
(flow-basic-test
"node: const ignores input"
(flow-b "(flow/start (flow-const 99) 1)")
99)
(flow-basic-test
"node: bare lambda is a node"
(flow-b "(flow/start (lambda (x) (* x x)) 6)")
36)
;; ── linear sequence ─────────────────────────────────────────────
(flow-basic-test
"sequence: empty is identity"
(flow-b "(flow/start (sequence) 42)")
42)
(flow-basic-test
"sequence: single child"
(flow-b "(flow/start (sequence (lambda (x) (+ x 1))) 41)")
42)
(flow-basic-test
"sequence: two children thread"
(flow-b
"(flow/start (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 10))) 4)")
50)
(flow-basic-test
"sequence: three children thread"
(flow-b
"(flow/start (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2)) (lambda (x) (- x 3))) 5)")
9)
;; ── data flow between nodes ─────────────────────────────────────
(flow-basic-test
"data flow: string accumulation"
(flow-bs
"(flow/start (sequence (lambda (s) (string-append s \"-a\")) (lambda (s) (string-append s \"-b\"))) \"x\")")
"x-a-b")
(flow-basic-test
"data flow: list build"
(flow-b
"(flow/start (sequence (lambda (x) (cons x (list))) (lambda (xs) (cons 0 xs))) 7)")
(list 0 7))
;; ── defflow ─────────────────────────────────────────────────────
(flow-basic-test
"defflow: names a flow"
(flow-b
"(defflow inc2 (sequence (lambda (x) (+ x 1)) (lambda (x) (+ x 1)))) (flow/start inc2 40)")
42)
(flow-basic-test
"defflow: reusable"
(flow-b
"(defflow dbl (lambda (x) (* x 2))) (+ (flow/start dbl 3) (flow/start dbl 10))")
26)
;; ── parallel (sequential semantics, join into list) ─────────────
(flow-basic-test
"parallel: fans input to all branches"
(flow-b
"(flow/start (parallel (lambda (x) (+ x 1)) (lambda (x) (* x 2)) (lambda (x) (- x 3))) 10)")
(list 11 20 7))
(flow-basic-test
"parallel: empty joins to empty list"
(flow-b "(flow/start (parallel) 5)")
(list))
(flow-basic-test
"parallel: single branch"
(flow-b "(flow/start (parallel (lambda (x) (* x x))) 9)")
(list 81))
;; ── nested composition ──────────────────────────────────────────
(flow-basic-test
"nested: sequence of sequences"
(flow-b
"(flow/start (sequence (sequence (lambda (x) (+ x 1)) (lambda (x) (+ x 1))) (sequence (lambda (x) (* x 3)))) 0)")
6)
(flow-basic-test
"nested: parallel inside sequence, join then reduce"
(flow-b
"(flow/start (sequence (parallel (lambda (x) (+ x 1)) (lambda (x) (* x 2))) (lambda (xs) (apply + xs))) 10)")
31)
(flow-basic-test
"nested: sequence inside parallel branch"
(flow-b
"(flow/start (parallel (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2))) (lambda (x) x)) 5)")
(list 12 5))
;; ── publish-shaped flow (the architecture sketch) ───────────────
(flow-basic-test
"publish: write -> (review | spell) -> join lengths"
(flow-b
"(defflow publish (sequence (lambda (draft) (string-append draft \"!\")) (parallel (lambda (c) (string-length c)) (lambda (c) (string-length (string-append c \"?\")))))) (flow/start publish \"hi\")")
(list 3 4))
(define flow-basic-tests-run! (fn () {:total (+ flow-basic-pass flow-basic-fail) :passed flow-basic-pass :failed flow-basic-fail :fails flow-basic-fails}))

View File

@@ -0,0 +1,108 @@
;; lib/flow/tests/combinators.sx — Phase 5: combinator library (tap, recover, map-flow, iteration).
(define flow-cmb-pass 0)
(define flow-cmb-fail 0)
(define flow-cmb-fails (list))
(define
flow-cmb-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-cmb-pass (+ flow-cmb-pass 1))
(begin
(set! flow-cmb-fail (+ flow-cmb-fail 1))
(append! flow-cmb-fails {:name name :expected expected :actual actual})))))
(define flow-m (fn (src) (flow-run src)))
;; ── tap (side-effecting pass-through) ───────────────────────────
(flow-cmb-test
"tap: returns input unchanged"
(flow-m "(flow/start (tap (lambda (x) (* x 999))) 7)")
7)
(flow-cmb-test
"tap: runs the side effect"
(flow-m
"(define seen 0) (flow/start (tap (lambda (x) (set! seen x))) 42) seen")
42)
(flow-cmb-test
"tap: value flows on while the effect observes it"
(flow-m
"(define log 0) (flow/start (sequence (lambda (x) (+ x 1)) (tap (lambda (x) (set! log x))) (lambda (x) (* x 2))) 10) (list log (flow/result 1))")
(list 11 22))
;; ── recover (fail-value counterpart of try-catch) ───────────────
(flow-cmb-test
"recover: passes a non-fail value through"
(flow-m "(flow/start (recover (lambda (x) (* x 2)) (lambda (r) -1)) 5)")
10)
(flow-cmb-test
"recover: handles a fail value via the reason"
(flow-m
"(flow/start (recover (lambda (x) (fail (quote too-small))) (lambda (r) (list (quote recovered) r))) 1)")
(list "recovered" "too-small"))
(flow-cmb-test
"recover: handler can supply a default value"
(flow-m
"(flow/start (sequence (recover (lambda (x) (if (> x 0) x (fail (quote neg))) ) (flow-const 0)) (lambda (x) (* x 10))) -3)")
0)
(flow-cmb-test
"recover: does not catch raised exceptions (those are try-catch's job)"
(flow-m
"(flow/start (try-catch (recover (lambda (x) (raise (quote boom))) (flow-const 0)) (lambda (e) e)) 1)")
"boom")
;; ── map-flow (run a node over a list, join) ─────────────────────
(flow-cmb-test
"map-flow: applies the node to each item"
(flow-m "(flow/start (map-flow (lambda (x) (* x x))) (list 1 2 3 4))")
(list 1 4 9 16))
(flow-cmb-test
"map-flow: empty list joins to empty"
(flow-m "(flow/start (map-flow (lambda (x) (+ x 1))) (list))")
(list))
(flow-cmb-test
"map-flow: each item runs an independent sub-flow"
(flow-m
"(flow/start (map-flow (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2)))) (list 0 4 9))")
(list 2 10 20))
(flow-cmb-test
"map-flow: composes — fan over a list then reduce the join"
(flow-m
"(flow/start (sequence (map-flow (lambda (x) (* x 10))) (lambda (xs) (apply + xs))) (list 1 2 3))")
60)
;; ── flow-while / flow-until (bounded iteration) ─────────────────
(flow-cmb-test
"flow-while: iterates while the predicate holds"
(flow-m
"(flow/start (flow-while (lambda (x) (< x 10)) (lambda (x) (+ x 1)) 100) 0)")
10)
(flow-cmb-test
"flow-while: a false predicate leaves input unchanged"
(flow-m
"(flow/start (flow-while (lambda (x) (< x 0)) (lambda (x) (+ x 1)) 100) 5)")
5)
(flow-cmb-test
"flow-while: respects the max-iteration bound"
(flow-m "(flow/start (flow-while (lambda (x) #t) (lambda (x) (+ x 1)) 3) 0)")
3)
(flow-cmb-test
"flow-while: doubles until past a threshold"
(flow-m
"(flow/start (flow-while (lambda (x) (< x 50)) (lambda (x) (* x 2)) 100) 3)")
96)
(flow-cmb-test
"flow-until: iterates until the predicate becomes true"
(flow-m
"(flow/start (flow-until (lambda (x) (>= x 10)) (lambda (x) (+ x 3)) 100) 0)")
12)
(flow-cmb-test
"flow-until: composes inside a sequence"
(flow-m
"(flow/start (sequence (flow-until (lambda (x) (> x 100)) (lambda (x) (* x 3)) 100) (lambda (x) (- x 100))) 5)")
35)
(define flow-cmb-tests-run! (fn () {:total (+ flow-cmb-pass flow-cmb-fail) :passed flow-cmb-pass :failed flow-cmb-fail :fails flow-cmb-fails}))

179
lib/flow/tests/control.sx Normal file
View File

@@ -0,0 +1,179 @@
;; lib/flow/tests/control.sx — Phase 2: control flow + error handling.
(define flow-ctl-pass 0)
(define flow-ctl-fail 0)
(define flow-ctl-fails (list))
(define
flow-ctl-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-ctl-pass (+ flow-ctl-pass 1))
(begin
(set! flow-ctl-fail (+ flow-ctl-fail 1))
(append! flow-ctl-fails {:name name :expected expected :actual actual})))))
(define flow-c (fn (src) (flow-run src)))
(define flow-cs (fn (src) (get (flow-run src) :scm-string)))
;; ── branch ──────────────────────────────────────────────────────
(flow-ctl-test
"branch: true selects then"
(flow-c
"(flow/start (branch (lambda (x) (> x 0)) (lambda (x) (* x 100)) (lambda (x) (- 0 x))) 5)")
500)
(flow-ctl-test
"branch: false selects else"
(flow-c
"(flow/start (branch (lambda (x) (> x 0)) (lambda (x) (* x 100)) (lambda (x) (- 0 x))) -3)")
3)
(flow-ctl-test
"branch: predicate sees the threaded input"
(flow-c
"(flow/start (sequence (lambda (x) (+ x 1)) (branch (lambda (x) (> x 3)) (flow-const 100) (flow-const 0))) 3)")
100)
(flow-ctl-test
"branch: branches are full nodes (sequence inside)"
(flow-c
"(flow/start (branch (lambda (x) (< x 10)) (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2))) (flow-const 0)) 4)")
10)
(flow-ctl-test
"branch: nested branch (3-way sign)"
(flow-c
"(defflow sign (branch (lambda (x) (> x 0)) (flow-const 1) (branch (lambda (x) (< x 0)) (flow-const -1) (flow-const 0)))) (list (flow/start sign 7) (flow/start sign -7) (flow/start sign 0))")
(list 1 -1 0))
(flow-ctl-test
"branch: publish-shaped approval gate"
(flow-cs
"(defflow publish (branch (lambda (post) (>= (string-length post) 3)) (lambda (post) (string-append post \" [published]\")) (lambda (post) (string-append post \" [rejected]\")))) (flow/start publish \"ok\")")
"ok [rejected]")
;; ── error model — explicit (fail reason) values ─────────────────
(flow-ctl-test
"fail: failed? is true for a failure value"
(flow-c "(failed? (fail 404))")
true)
(flow-ctl-test
"fail: fail-reason extracts the reason"
(flow-c "(fail-reason (fail 404))")
404)
(flow-ctl-test
"fail: failed? is false for a plain value"
(flow-c "(failed? 7)")
false)
(flow-ctl-test
"fail: failed? is false for an ordinary list"
(flow-c "(failed? (list 1 2 3))")
false)
(flow-ctl-test
"fail: a node may emit a failure as data"
(flow-c
"(defflow validate (lambda (s) (if (>= (string-length s) 3) s (fail (quote too-short))))) (failed? (flow/start validate \"hi\"))")
true)
(flow-ctl-test
"fail: failure flows downstream, branch recovers"
(flow-c
"(defflow guarded (sequence (lambda (s) (if (>= (string-length s) 3) (string-length s) (fail (quote too-short)))) (branch failed? (lambda (f) (list (quote recovered) (fail-reason f))) (lambda (n) (list (quote ok) n))))) (flow/start guarded \"hi\")")
(list "recovered" "too-short"))
;; ── try-catch — reify raised exceptions ─────────────────────────
(flow-ctl-test
"try-catch: no exception returns node result"
(flow-c "(flow/start (try-catch (lambda (x) (* x 2)) (lambda (e) -1)) 5)")
10)
(flow-ctl-test
"try-catch: handler runs on raise"
(flow-c
"(flow/start (try-catch (lambda (x) (raise (quote boom))) (flow-const 99)) 1)")
99)
(flow-ctl-test
"try-catch: handler receives the reified error"
(flow-c "(flow/start (try-catch (lambda (x) (raise 42)) (lambda (e) e)) 0)")
42)
(flow-ctl-test
"try-catch: catches exception from deep inside a sequence"
(flow-c
"(flow/start (try-catch (sequence (lambda (x) (+ x 1)) (lambda (x) (raise (quote deep)))) (flow-const -99)) 5)")
-99)
(flow-ctl-test
"try-catch: handler may convert to a failure value"
(flow-c
"(failed? (flow/start (try-catch (lambda (x) (raise (quote bad))) (lambda (e) (fail e))) 0))")
true)
(flow-ctl-test
"try-catch: composes — recover then continue"
(flow-c
"(flow/start (sequence (try-catch (lambda (x) (raise (quote x))) (flow-const 10)) (lambda (n) (* n 5))) 0)")
50)
;; ── retry — re-run on raised exceptions ─────────────────────────
(flow-ctl-test
"retry: succeeds after transient failures"
(flow-c
"(define ctr 0) (defflow flaky (lambda (x) (set! ctr (+ ctr 1)) (if (< ctr 3) (raise (quote nope)) (* x 10)))) (list (flow/start (retry 5 flaky) 7) ctr)")
(list 70 3))
(flow-ctl-test
"retry: exhausted re-raises (caught by try-catch)"
(flow-c
"(flow/start (try-catch (retry 2 (lambda (x) (raise (quote always)))) (flow-const (quote gaveup))) 0)")
"gaveup")
(flow-ctl-test
"retry: n=1 means a single attempt"
(flow-c
"(define ctr 0) (flow/start (try-catch (retry 1 (lambda (x) (set! ctr (+ ctr 1)) (raise (quote bad)))) (lambda (e) ctr)) 0)")
1)
(flow-ctl-test
"retry: success on first attempt does not re-run"
(flow-c
"(define ctr 0) (flow/start (sequence (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (* x 2))) (lambda (n) ctr)) 21)")
1)
(flow-ctl-test
"retry: does not retry explicit failure values"
(flow-c
"(define ctr 0) (failed? (flow/start (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (fail (quote bad)))) 0))")
true)
(flow-ctl-test
"retry: failure-value path runs node exactly once"
(flow-c
"(define ctr 0) (flow/start (sequence (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (fail (quote bad)))) (lambda (f) ctr)) 0)")
1)
;; ── timeout — cooperative step budget ───────────────────────────
(flow-ctl-test
"timeout: work within budget completes"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 10 (lambda (x) (cd x))) (flow-const (quote timed-out))) 5)")
99)
(flow-ctl-test
"timeout: work exceeding budget raises flow-timeout"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 10 (lambda (x) (cd x))) (flow-const (quote timed-out))) 20)")
"timed-out")
(flow-ctl-test
"timeout: exact budget boundary completes"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 5 (lambda (x) (cd x))) (flow-const (quote timed-out))) 5)")
99)
(flow-ctl-test
"timeout: one tick over the budget raises"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 5 (lambda (x) (cd x))) (flow-const (quote timed-out))) 6)")
"timed-out")
(flow-ctl-test
"timeout: the raised error is identifiable"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 2 (lambda (x) (cd x))) (lambda (e) e)) 9)")
"flow-timeout")
(flow-ctl-test
"timeout: a node that never ticks is unbounded"
(flow-c "(flow/start (timeout 0 (lambda (x) (* x 2))) 5)")
10)
(flow-ctl-test
"timeout: budget is restored across sequential timeouts"
(flow-c
"(define (cd n) (if (<= n 0) 1 (begin (tick) (cd (- n 1))))) (flow/start (sequence (timeout 4 (lambda (x) (cd x))) (timeout 4 (lambda (x) (cd 3))) (lambda (x) (begin (tick) (+ x 100)))) 3)")
101)
(define flow-ctl-tests-run! (fn () {:total (+ flow-ctl-pass flow-ctl-fail) :passed flow-ctl-pass :failed flow-ctl-fail :fails flow-ctl-fails}))

View File

@@ -0,0 +1,120 @@
;; lib/flow/tests/distributed.sx — Phase 4: distributed nodes via fed-sx (mocked).
(define flow-dist-pass 0)
(define flow-dist-fail 0)
(define flow-dist-fails (list))
(define
flow-dist-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-dist-pass (+ flow-dist-pass 1))
(begin
(set! flow-dist-fail (+ flow-dist-fail 1))
(append! flow-dist-fails {:name name :expected expected :actual actual})))))
(define flow-d (fn (src) (flow-run src)))
;; ── remote-node ─────────────────────────────────────────────────
(flow-dist-test
"remote: a node executes on a peer"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote double) (lambda (x) (* x 2))))) (flow/start (remote-node (quote edge) (quote double)) 21)")
42)
(flow-dist-test
"remote: remote nodes compose in a sequence"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote inc) (lambda (x) (+ x 1))) (list (quote double) (lambda (x) (* x 2))))) (flow/start (sequence (remote-node (quote edge) (quote inc)) (remote-node (quote edge) (quote double))) 4)")
10)
(flow-dist-test
"remote: a remote node mixes with local nodes"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote double) (lambda (x) (* x 2))))) (flow/start (sequence (lambda (x) (+ x 5)) (remote-node (quote edge) (quote double)) (lambda (x) (- x 1))) 10)")
29)
(flow-dist-test
"remote: unreachable peer raises flow-remote-unreachable"
(flow-d
"(flow/start (try-catch (remote-node (quote ghost) (quote double)) (lambda (e) e)) 1)")
"flow-remote-unreachable")
(flow-dist-test
"remote: unknown function on a peer raises flow-remote-no-fn"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote double) (lambda (x) (* x 2))))) (flow/start (try-catch (remote-node (quote edge) (quote missing)) (lambda (e) e)) 1)")
"flow-remote-no-fn")
(flow-dist-test
"remote: a remote node can suspend the flow (peer returns control)"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote review) (lambda (x) x)))) (flow/start (sequence (remote-node (quote edge) (quote review)) (lambda (x) (suspend (quote human))) (lambda (v) (list (quote published) v))) 7)")
(list "flow-suspended" 1 "human"))
(flow-dist-test
"remote: a transient remote failure is recoverable with retry"
(flow-d
"(define hits 0) (flow-peer-register! (quote edge) (list (list (quote flaky) (lambda (x) (begin (set! hits (+ hits 1)) (if (< hits 2) (raise (quote down)) (* x 3))))))) (list (flow/start (retry 3 (remote-node (quote edge) (quote flaky))) 7) hits)")
(list 21 2))
;; ── failover (retry on a different peer, fall through to local) ──
(flow-dist-test
"failover: first reachable peer serves the request"
(flow-d
"(flow-peer-register! (quote p2) (list (list (quote f) (lambda (x) (+ x 100))))) (flow/start (remote-failover (list (quote p2) (quote down)) (quote f) (flow-const (quote local))) 5)")
105)
(flow-dist-test
"failover: skips an unreachable peer to the next one"
(flow-d
"(flow-peer-register! (quote p2) (list (list (quote f) (lambda (x) (+ x 100))))) (flow/start (remote-failover (list (quote down) (quote p2)) (quote f) (flow-const (quote local))) 5)")
105)
(flow-dist-test
"failover: skips a peer whose function raises"
(flow-d
"(flow-peer-register! (quote bad) (list (list (quote f) (lambda (x) (raise (quote boom)))))) (flow-peer-register! (quote good) (list (list (quote f) (lambda (x) (* x 10))))) (flow/start (remote-failover (list (quote bad) (quote good)) (quote f) (flow-const 0)) 4)")
40)
(flow-dist-test
"failover: all peers fail, the local fallback runs"
(flow-d
"(flow/start (remote-failover (list (quote down1) (quote down2)) (quote f) (lambda (x) (* x -1))) 9)")
-9)
(flow-dist-test
"failover: threads the input through to the chosen peer"
(flow-d
"(flow-peer-register! (quote p) (list (list (quote f) (lambda (x) (list (quote got) x))))) (flow/start (sequence (lambda (x) (+ x 1)) (remote-failover (list (quote p)) (quote f) (flow-const 0))) 41)")
(list "got" 42))
(flow-dist-test
"failover: composes inside a larger sequence"
(flow-d
"(flow-peer-register! (quote p) (list (list (quote f) (lambda (x) (* x 2))))) (flow/start (sequence (remote-failover (list (quote down) (quote p)) (quote f) (flow-const 1)) (lambda (x) (+ x 3))) 5)")
13)
;; ── replication + handoff ───────────────────────────────────────
(flow-dist-test
"replicate: a peer holds the exported store"
(flow-d
"(defflow w (lambda (x) (suspend (quote q)))) (flow/start w 10) (flow-replicate-to (quote peerB)) (if (flow-replica-get (quote peerB)) (quote replicated) (quote missing))")
"replicated")
(flow-dist-test
"handoff: a peer resumes a flow after the local instance dies"
(flow-d
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) (list (quote done) v)))) (define id (car (cdr (flow/start w 10)))) (flow-replicate-to (quote peerB)) (set! flow-store (list)) (flow-restore-from (quote peerB)) (flow/resume id 55)")
(list "done" 55))
(flow-dist-test
"handoff: restored peer reports the flow as resumable"
(flow-d
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 10)))) (flow-replicate-to (quote peerB)) (set! flow-store (list)) (flow-restore-from (quote peerB)) (flow-resumable-ids)")
(list 1))
(flow-dist-test
"handoff: without restore the dead instance has lost the flow"
(flow-d
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 10)))) (flow-replicate-to (quote peerB)) (set! flow-store (list)) (flow/resume id 1)")
(list "flow-error" "no-such-flow"))
(flow-dist-test
"restore: from an unknown peer yields false"
(flow-d "(flow-restore-from (quote nowhere))")
false)
(flow-dist-test
"handoff: replication preserves the replay log across the move"
(flow-d
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list x)))) (define id (car (cdr (flow/start two 0)))) (flow/resume id 11) (flow-replicate-to (quote peerB)) (set! flow-store (list)) (flow-restore-from (quote peerB)) (flow/resume id 22)")
(list 22))
(define flow-dist-tests-run! (fn () {:total (+ flow-dist-pass flow-dist-fail) :passed flow-dist-pass :failed flow-dist-fail :fails flow-dist-fails}))

106
lib/flow/tests/host.sx Normal file
View File

@@ -0,0 +1,106 @@
;; lib/flow/tests/host.sx — Phase 8: host integration ABI (request/await/host-queue/driver).
(define flow-hst-pass 0)
(define flow-hst-fail 0)
(define flow-hst-fails (list))
(define
flow-hst-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-hst-pass (+ flow-hst-pass 1))
(begin
(set! flow-hst-fail (+ flow-hst-fail 1))
(append! flow-hst-fails {:name name :expected expected :actual actual})))))
(define flow-hst (fn (src) (flow-run src)))
;; ── request envelope ────────────────────────────────────────────
(flow-hst-test
"request: suspends with a typed envelope"
(flow-hst
"(car (cdr (cdr (flow/start (lambda (x) (request (quote render) x)) 5))))")
(list "flow-request" "render" 5))
(flow-hst-test
"request?: recognizes an envelope"
(flow-hst "(request? (list (quote flow-request) (quote human) 1))")
true)
(flow-hst-test
"request?: a plain tag is not a request"
(flow-hst "(request? (list (quote review) 1))")
false)
(flow-hst-test
"request-kind / request-payload: parse the envelope"
(flow-hst
"(define t (list (quote flow-request) (quote render) (list (quote recipe) 7))) (list (request-kind t) (request-payload t))")
(list "render" (list "recipe" 7)))
;; ── named decision points ───────────────────────────────────────
(flow-hst-test
"await-human: is a request of kind human"
(flow-hst
"(car (cdr (cdr (flow/start (lambda (x) (await-human x)) (quote approve?)))))")
(list "flow-request" "human" "approve?"))
(flow-hst-test
"await-render: is a request of kind render"
(flow-hst
"(car (cdr (cdr (flow/start (lambda (x) (await-render x)) (quote recipe)))))")
(list "flow-request" "render" "recipe"))
(flow-hst-test
"request: the host's resume value flows back into the flow"
(flow-hst
"(defflow f (sequence (lambda (x) (await-render x)) (lambda (art) (list (quote got) art)))) (define id (car (cdr (flow/start f 1)))) (flow/resume id (quote the-artifact))")
(list "got" "the-artifact"))
;; ── host work queue ─────────────────────────────────────────────
(flow-hst-test
"flow-host-requests: lists (id kind payload) for pending requests"
(flow-hst
"(flow/start (lambda (x) (await-render x)) 99) (flow-host-requests)")
(list (list 1 "render" 99)))
(flow-hst-test
"flow-host-requests: excludes bare (non-request) suspends"
(flow-hst
"(defflow a (lambda (x) (await-render x))) (defflow b (lambda (x) (suspend (quote plain)))) (flow/start a 1) (flow/start b 2) (flow-host-requests)")
(list (list 1 "render" 1)))
;; ── the art-dag-shaped host driver loop (manual resumes) ────────
(flow-hst-test
"host driver: render then human-review then publish"
(flow-hst
"(defflow pipeline (sequence (lambda (recipe) (await-render recipe)) (lambda (art) (await-human (list (quote review) art))) (branch (lambda (d) (eq? d (quote approve))) (flow-const (quote published)) (flow-const (fail (quote rejected)))))) (define id (car (cdr (flow/start pipeline 99)))) (define r1 (flow-host-requests)) (flow/resume id (list (quote art) 99)) (define r2 (flow-host-requests)) (flow/resume id (quote approve)) (list r1 r2 (flow/status id) (flow/result id))")
(list
(list (list 1 "render" 99))
(list (list 1 "human" (list "review" (list "art" 99))))
"done"
"published"))
(flow-hst-test
"host driver: rejection at the human gate yields a failure"
(flow-hst
"(defflow pipeline (sequence (lambda (recipe) (await-render recipe)) (lambda (art) (await-human (list (quote review) art))) (branch (lambda (d) (eq? d (quote approve))) (flow-const (quote published)) (flow-const (fail (quote rejected)))))) (define id (car (cdr (flow/start pipeline 1)))) (flow/resume id (quote artifact)) (failed? (flow/resume id (quote reject)))")
true)
;; ── reference driver: host supplies only a dispatch fn ──────────
(flow-hst-test
"flow-drive-host: one tick services every pending request"
(flow-hst
"(flow/start (lambda (x) (await-render x)) 5) (define n (flow-drive-host (lambda (k p) (list (quote done) p)))) (list n (flow/status 1) (flow/result 1))")
(list 1 "done" (list "done" 5)))
(flow-hst-test
"flow-run-host: drives a render -> human pipeline to completion"
(flow-hst
"(defflow pipeline (sequence (lambda (recipe) (await-render recipe)) (lambda (art) (await-human (list (quote review) art))) (branch (lambda (d) (eq? d (quote approve))) (flow-const (quote published)) (flow-const (fail (quote rejected)))))) (define id (car (cdr (flow/start pipeline 99)))) (define serviced (flow-run-host (lambda (kind payload) (if (eq? kind (quote render)) (list (quote art) payload) (quote approve))) 10)) (list serviced (flow/status id) (flow/result id))")
(list 2 "done" "published"))
(flow-hst-test
"flow-run-host: returns 0 when nothing is pending"
(flow-hst "(flow-run-host (lambda (k p) p) 5)")
0)
(flow-hst-test
"flow-run-host: respects the maxticks bound"
(flow-hst
"(defflow pipe2 (sequence (lambda (r) (await-render r)) (lambda (a) (await-human a)) (lambda (d) d))) (define id (car (cdr (flow/start pipe2 1)))) (define serviced (flow-run-host (lambda (k p) p) 1)) (list serviced (flow/status id))")
(list 1 "suspended"))
(define flow-hst-tests-run! (fn () {:total (+ flow-hst-pass flow-hst-fail) :passed flow-hst-pass :failed flow-hst-fail :fails flow-hst-fails}))

67
lib/flow/tests/hygiene.sx Normal file
View File

@@ -0,0 +1,67 @@
;; lib/flow/tests/hygiene.sx — Phase 5: store hygiene (flow/gc, flow/forget).
(define flow-hyg-pass 0)
(define flow-hyg-fail 0)
(define flow-hyg-fails (list))
(define
flow-hyg-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-hyg-pass (+ flow-hyg-pass 1))
(begin
(set! flow-hyg-fail (+ flow-hyg-fail 1))
(append! flow-hyg-fails {:name name :expected expected :actual actual})))))
(define flow-h (fn (src) (flow-run src)))
;; ── flow/gc ─────────────────────────────────────────────────────
(flow-hyg-test
"gc: empty store removes nothing"
(flow-h "(flow/gc)")
0)
(flow-hyg-test
"gc: removes a done flow, keeps a suspended one"
(flow-h
"(defflow w (lambda (x) (suspend (quote q)))) (flow/start w 0) (flow/start (lambda (x) x) 5) (define removed (flow/gc)) (list removed (flow/list))")
(list 1 (list (list 1 "suspended"))))
(flow-hyg-test
"gc: removes a cancelled flow"
(flow-h
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id) (flow/gc)")
1)
(flow-hyg-test
"gc: a kept suspended flow is still resumable"
(flow-h
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) (* v 2)))) (define id (car (cdr (flow/start w 0)))) (flow/start (lambda (x) x) 1) (flow/gc) (flow/resume id 21)")
42)
(flow-hyg-test
"gc: counts every terminal flow it drops"
(flow-h
"(flow/start (lambda (x) x) 1) (flow/start (lambda (x) x) 2) (defflow w (lambda (x) (suspend (quote q)))) (flow/start w 0) (flow/gc)")
2)
;; ── flow/forget ─────────────────────────────────────────────────
(flow-hyg-test
"forget: drops a completed flow"
(flow-h
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) v))) (define id (car (cdr (flow/start w 0)))) (flow/resume id 7) (list (flow/forget id) (flow/status id))")
(list true "unknown"))
(flow-hyg-test
"forget: refuses to drop a live (suspended) flow"
(flow-h
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (list (flow/forget id) (flow/status id))")
(list false "suspended"))
(flow-hyg-test
"forget: drops a cancelled flow"
(flow-h
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id) (list (flow/forget id) (flow/status id))")
(list true "unknown"))
(flow-hyg-test
"forget: unknown id yields false"
(flow-h "(flow/forget 999)")
false)
(define flow-hyg-tests-run! (fn () {:total (+ flow-hyg-pass flow-hyg-fail) :passed flow-hyg-pass :failed flow-hyg-fail :fails flow-hyg-fails}))

View File

@@ -0,0 +1,115 @@
;; lib/flow/tests/integration.sx — Phase 7: end-to-end flows composing every phase.
(define flow-int-pass 0)
(define flow-int-fail 0)
(define flow-int-fails (list))
(define
flow-int-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-int-pass (+ flow-int-pass 1))
(begin
(set! flow-int-fail (+ flow-int-fail 1))
(append! flow-int-fails {:name name :expected expected :actual actual})))))
(define flow-i (fn (src) (flow-run src)))
;; The order-processing flow, defined once per program via this prelude string:
;; validate amount (attempt: fail if <= 0)
;; -> suspend for payment confirmation (resume value = confirmed amount)
;; -> branch: confirmed>0 ? record on the ledger peer : declined failure
(define
order-prelude
"(flow-peer-register! (quote ledger) (list (list (quote record) (lambda (amt) (list (quote recorded) amt)))))\n (defflow order\n (attempt\n (lambda (amt) (if (> amt 0) amt (fail (quote invalid-amount))))\n (lambda (amt) (suspend (quote await-payment)))\n (branch (lambda (amt) (> amt 0))\n (remote-node (quote ledger) (quote record))\n (flow-const (fail (quote declined))))))")
;; ── happy path through every phase ──────────────────────────────
(flow-int-test
"order: validate -> suspend -> resume -> branch -> federate"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (flow/resume id 250)"))
(list "recorded" 250))
(flow-int-test
"order: starting suspends awaiting payment"
(flow-i
(str
order-prelude
"(define s (flow/start order 100)) (list (car s) (car (cdr (cdr s))))"))
(list "flow-suspended" "await-payment"))
(flow-int-test
"order: invalid amount fails up front and never suspends"
(flow-i
(str
order-prelude
"(define r (flow/start order -5)) (list (failed? r) (fail-reason r))"))
(list true "invalid-amount"))
(flow-int-test
"order: a declined payment yields a failure value"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (failed? (flow/resume id 0))"))
true)
;; ── crash recovery mid-flow ─────────────────────────────────────
(flow-int-test
"order: survives a simulated crash between suspend and resume"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow/resume id 250)"))
(list "recorded" 250))
;; ── handoff to a peer mid-flow ──────────────────────────────────
(flow-int-test
"order: hands off to a peer that resumes and completes"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (flow-replicate-to (quote nodeB)) (set! flow-store (list)) (flow-restore-from (quote nodeB)) (flow/resume id 250)"))
(list "recorded" 250))
;; ── introspection during the flow's life ────────────────────────
(flow-int-test
"order: pending shows what the flow awaits, then result after resume"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (define p (flow/pending)) (flow/resume id 250) (list p (flow/status id) (flow/result id))"))
(list
(list (list 1 "await-payment"))
"done"
(list "recorded" 250)))
;; ── onboarding: two human steps + cancellation ──────────────────
(define
onboard-prelude
"(defflow onboard\n (sequence\n (lambda (user) (+ user 1))\n (lambda (x) (suspend (quote confirm-email)))\n (lambda (x) (suspend (quote complete-profile)))\n (lambda (x) (list (quote onboarded) x))))")
(flow-int-test
"onboard: two suspends resume in order to completion"
(flow-i
(str
onboard-prelude
"(define id (car (cdr (flow/start onboard 0)))) (flow/resume id 7) (flow/resume id 9)"))
(list "onboarded" 9))
(flow-int-test
"onboard: the second pending tag appears after the first resume"
(flow-i
(str
onboard-prelude
"(define id (car (cdr (flow/start onboard 0)))) (flow/resume id 7) (car (cdr (car (flow/pending))))"))
"complete-profile")
(flow-int-test
"onboard: cancelling abandons the flow"
(flow-i
(str
onboard-prelude
"(define id (car (cdr (flow/start onboard 0)))) (flow/cancel id) (list (flow/status id) (car (flow/resume id 7)))"))
(list "cancelled" "flow-error"))
(define flow-int-tests-run! (fn () {:total (+ flow-int-pass flow-int-fail) :passed flow-int-pass :failed flow-int-fail :fails flow-int-fails}))

73
lib/flow/tests/railway.sx Normal file
View File

@@ -0,0 +1,73 @@
;; lib/flow/tests/railway.sx — Phase 6: railway-oriented composition (attempt).
(define flow-rail-pass 0)
(define flow-rail-fail 0)
(define flow-rail-fails (list))
(define
flow-rail-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-rail-pass (+ flow-rail-pass 1))
(begin
(set! flow-rail-fail (+ flow-rail-fail 1))
(append! flow-rail-fails {:name name :expected expected :actual actual})))))
(define flow-r (fn (src) (flow-run src)))
;; ── attempt — short-circuit on the first (fail ...) ─────────────
(flow-rail-test
"attempt: threads like sequence when nothing fails"
(flow-r
"(flow/start (attempt (lambda (x) (+ x 1)) (lambda (x) (* x 10))) 4)")
50)
(flow-rail-test
"attempt: empty is identity"
(flow-r "(flow/start (attempt) 7)")
7)
(flow-rail-test
"attempt: returns the first failure"
(flow-r
"(failed? (flow/start (attempt (lambda (x) (fail (quote bad))) (lambda (x) (* x 10))) 4))")
true)
(flow-rail-test
"attempt: the failure carries its reason"
(flow-r
"(fail-reason (flow/start (attempt (lambda (x) x) (lambda (x) (fail (quote rejected)))) 4))")
"rejected")
(flow-rail-test
"attempt: nodes after a failure do not run"
(flow-r
"(define ran 0) (flow/start (attempt (lambda (x) (fail (quote stop))) (lambda (x) (begin (set! ran (+ ran 1)) x))) 0) ran")
0)
(flow-rail-test
"attempt: a failed input short-circuits immediately"
(flow-r
"(define ran 0) (fail-reason (flow/start (attempt (lambda (x) (begin (set! ran (+ ran 1)) x))) (fail (quote pre))))")
"pre")
(flow-rail-test
"attempt: middle failure halts the chain"
(flow-r
"(define ran 0) (flow/start (attempt (lambda (x) (+ x 1)) (lambda (x) (fail (quote mid))) (lambda (x) (begin (set! ran (+ ran 1)) x))) 5) ran")
0)
;; ── attempt + recover (rejoin the happy track) ──────────────────
(flow-rail-test
"attempt + recover: recover turns a failure into a value"
(flow-r
"(flow/start (recover (attempt (lambda (x) (if (> x 0) x (fail (quote non-positive)))) (lambda (x) (* x 2))) (flow-const 0)) -5)")
0)
(flow-rail-test
"attempt + recover: happy path passes recover through"
(flow-r
"(flow/start (recover (attempt (lambda (x) (if (> x 0) x (fail (quote non-positive)))) (lambda (x) (* x 2))) (flow-const 0)) 5)")
10)
(flow-rail-test
"attempt: validation pipeline reports the failing stage"
(flow-r
"(defflow validate (attempt (lambda (s) (if (>= (string-length s) 3) s (fail (quote too-short)))) (lambda (s) (if (<= (string-length s) 8) s (fail (quote too-long)))) (lambda (s) (list (quote ok) (string-length s))))) (list (fail-reason (flow/start validate \"hi\")) (flow/start validate \"hello\"))")
(list "too-short" (list "ok" 5)))
(define flow-rail-tests-run! (fn () {:total (+ flow-rail-pass flow-rail-fail) :passed flow-rail-pass :failed flow-rail-fail :fails flow-rail-fails}))

View File

@@ -0,0 +1,71 @@
;; lib/flow/tests/recovery.sx — Phase 3: crash recovery (store export/import + restart).
;;
;; "restart" is simulated within one program: (set! flow-store (list)) wipes the
;; in-memory store (process death), while flow-registry persists as it would after
;; reloading flow definitions. Recovery = import the exported (plain-data) store and
;; resume; the flow proc is re-resolved by name.
(define flow-rec-pass 0)
(define flow-rec-fail 0)
(define flow-rec-fails (list))
(define
flow-rec-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-rec-pass (+ flow-rec-pass 1))
(begin
(set! flow-rec-fail (+ flow-rec-fail 1))
(append! flow-rec-fails {:name name :expected expected :actual actual})))))
(define flow-r (fn (src) (flow-run src)))
;; ── export / wipe / import ──────────────────────────────────────
(flow-rec-test
"export nulls the live procedure"
(flow-r
"(defflow w (lambda (x) (suspend (quote await)))) (flow/start w 10) (car (cdr (car (cdr (car (flow-store-export))))))")
false)
(flow-rec-test
"a wiped store loses the flow (process death)"
(flow-r
"(defflow w (lambda (x) (suspend (quote await)))) (define id (car (cdr (flow/start w 10)))) (set! flow-store (list)) (flow/resume id 1)")
(list "flow-error" "no-such-flow"))
(flow-rec-test
"import restores a wiped store and resume completes"
(flow-r
"(defflow w (sequence (lambda (x) (suspend (quote await))) (lambda (c) (list (quote done) c)))) (define id (car (cdr (flow/start w 10)))) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow/resume id 777)")
(list "done" 777))
;; ── resumable scan ──────────────────────────────────────────────
(flow-rec-test
"resumable-ids lists the suspended flow after import"
(flow-r
"(defflow w (lambda (x) (suspend (quote await)))) (define id (car (cdr (flow/start w 10)))) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow-resumable-ids)")
(list 1))
(flow-rec-test
"resumable-ids excludes completed flows"
(flow-r
"(defflow w (sequence (lambda (x) (suspend (quote await))) (lambda (c) c))) (define id (car (cdr (flow/start w 10)))) (flow/resume id 5) (flow-resumable-ids)")
(list))
(flow-rec-test
"resumable-ids excludes cancelled flows after import"
(flow-r
"(defflow w (lambda (x) (suspend (quote await)))) (define id (car (cdr (flow/start w 10)))) (flow/cancel id) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow-resumable-ids)")
(list))
;; ── restart at every step ───────────────────────────────────────
(flow-rec-test
"two suspends survive a restart between each step"
(flow-r
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list (quote end) x)))) (define id (car (cdr (flow/start two 0)))) (define s1 (flow-store-export)) (set! flow-store (list)) (flow-store-import! s1) (flow/resume id 100) (define s2 (flow-store-export)) (set! flow-store (list)) (flow-store-import! s2) (flow/resume id 200)")
(list "end" 200))
(flow-rec-test
"import preserves the replay log (earlier value survives restart)"
(flow-r
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list x)))) (define id (car (cdr (flow/start two 0)))) (flow/resume id 11) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow/resume id 22)")
(list 22))
(define flow-rec-tests-run! (fn () {:total (+ flow-rec-pass flow-rec-fail) :passed flow-rec-pass :failed flow-rec-fail :fails flow-rec-fails}))

114
lib/flow/tests/suspend.sx Normal file
View File

@@ -0,0 +1,114 @@
;; lib/flow/tests/suspend.sx — Phase 3: suspend / resume / cancel (deterministic replay).
(define flow-sus-pass 0)
(define flow-sus-fail 0)
(define flow-sus-fails (list))
(define
flow-sus-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-sus-pass (+ flow-sus-pass 1))
(begin
(set! flow-sus-fail (+ flow-sus-fail 1))
(append! flow-sus-fails {:name name :expected expected :actual actual})))))
(define flow-s (fn (src) (flow-run src)))
;; ── flow/start ──────────────────────────────────────────────────
(flow-sus-test
"start: non-suspending flow returns the raw result"
(flow-s "(flow/start (lambda (x) (* x 2)) 5)")
10)
(flow-sus-test
"start: a suspending flow returns a flow-suspended state"
(flow-s
"(defflow w (sequence (lambda (x) (+ x 1)) (lambda (g) (suspend (quote await))) (lambda (c) c))) (car (flow/start w 10))")
"flow-suspended")
(flow-sus-test
"start: suspended state carries a numeric id"
(flow-s
"(defflow w (lambda (x) (suspend (quote await)))) (car (cdr (flow/start w 10)))")
1)
(flow-sus-test
"start: suspended state carries the suspend tag"
(flow-s
"(defflow w (lambda (x) (suspend (quote await)))) (car (cdr (cdr (flow/start w 10))))")
"await")
;; ── flow/resume ─────────────────────────────────────────────────
(flow-sus-test
"resume: injects the value and completes"
(flow-s
"(defflow w (sequence (lambda (x) (+ x 1)) (lambda (g) (suspend (quote await))) (lambda (c) (list (quote done) c)))) (define s (flow/start w 10)) (flow/resume (car (cdr s)) 777)")
(list "done" 777))
(flow-sus-test
"resume: injected value threads into the next node"
(flow-s
"(defflow w (sequence (lambda (x) (suspend (quote v))) (lambda (n) (* n 3)))) (define s (flow/start w 0)) (flow/resume (car (cdr s)) 14)")
42)
(flow-sus-test
"resume: replays earlier suspends (recompute is deterministic)"
(flow-s
"(define runs 0) (defflow w (sequence (lambda (x) (begin (set! runs (+ runs 1)) (+ x 1))) (lambda (g) (suspend (quote await))) (lambda (c) c))) (define s (flow/start w 10)) (flow/resume (car (cdr s)) 99) runs")
2)
;; ── multi-step suspension ───────────────────────────────────────
(flow-sus-test
"multi: first resume suspends at the next tag"
(flow-s
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list (quote end) x)))) (define s (flow/start two 0)) (define s2 (flow/resume (car (cdr s)) 100)) (car (cdr (cdr s2)))")
"b")
(flow-sus-test
"multi: second resume completes with the latest value"
(flow-s
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list (quote end) x)))) (define id (car (cdr (flow/start two 0)))) (flow/resume id 100) (flow/resume id 200)")
(list "end" 200))
;; ── error / lifecycle guards ────────────────────────────────────
(flow-sus-test
"resume: completed flow cannot be resumed again"
(flow-s
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/resume id 1) (flow/resume id 2)")
(list "flow-error" "not-suspended"))
(flow-sus-test
"resume: unknown id errors"
(flow-s "(flow/resume 999 1)")
(list "flow-error" "no-such-flow"))
;; ── flow/cancel ─────────────────────────────────────────────────
(flow-sus-test
"cancel: returns a flow-cancelled state"
(flow-s
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id)")
(list "flow-cancelled" 1))
(flow-sus-test
"cancel: a cancelled flow cannot be resumed (stale resume rejected)"
(flow-s
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id) (flow/resume id 5)")
(list "flow-error" "not-suspended"))
(flow-sus-test
"cancel: unknown id errors"
(flow-s "(flow/cancel 999)")
(list "flow-error" "no-such-flow"))
;; ── composition ─────────────────────────────────────────────────
(flow-sus-test
"suspend inside a branch arm"
(flow-s
"(defflow gate (branch (lambda (x) (> x 0)) (lambda (x) (suspend (quote approve))) (flow-const (quote rejected)))) (define s (flow/start gate 5)) (flow/resume (car (cdr s)) (quote approved))")
"approved")
(flow-sus-test
"two independent runs get independent ids"
(flow-s
"(defflow w (lambda (x) (suspend (quote q)))) (list (car (cdr (flow/start w 0))) (car (cdr (flow/start w 0))))")
(list 1 2))
(flow-sus-test
"suspend reason may be a structured value"
(flow-s
"(defflow w (lambda (x) (suspend (list (quote needs) (quote approval))))) (car (cdr (cdr (flow/start w 0))))")
(list "needs" "approval"))
(define flow-sus-tests-run! (fn () {:total (+ flow-sus-pass flow-sus-fail) :passed flow-sus-pass :failed flow-sus-fail :fails flow-sus-fails}))

View File

@@ -1,639 +0,0 @@
# Abstraction Radar — backlog
Maintained by the read-only `radar` loop (see `plans/agent-briefings/radar-loop.md`).
Detection only — implementation is a separate, coordinated step owned by the
relevant subsystem loop, never by radar.
**AHA gate to reach _Proposed_:** ≥3 real consumers · all past Phase 2 & API-stable ·
structurally identical (file:line evidence) · a natural home (usually NOT lib/guest).
Anything short → _Watching_ (what's missing) or _Rejected_ (why).
---
## Last scan
- **Date:** 2026-06-07 (radar loop, pass 38)
- **Pass 38 — migration plan DRAFTED (planning loop worklist complete).** All 5 specs
written under `loops/migration:plans/migration/` (host-readiness, strangler-shadow-
harness, slice-01-blog, data-migration, slice-sequencing); loop added a 6th revealed
thread `open-questions.md` (digest for humans) then is end-of-worklist. **Decision point
for the operator: review the plan + decide whether to start an IMPLEMENTATION loop**
(first target per the plan: `lib/host` Phase 1 + multi-`Set-Cookie` fix → slice-01-blog
1a). Branch `loops/migration` is local/un-pushed (per operator's no-push preference).
No new radar candidate; A1 at 13; fed-sx still on deadlock.
- **Date:** 2026-06-07 (radar loop, pass 37)
- **Pass 37 — migration plan 4/5 specs done.** Long-pole shipped: `data-migration.md`
(Postgres → persist via **genesis-import** — seed each stream with current DB state as
initial events). Only `slice-sequencing.md` left; loop self-pacing fine. No new radar
candidate; events (iCal import) + content (sanitize, 799/799) incremental; A1 at 13.
- **Date:** 2026-06-07 (radar loop, pass 36)
- **Pass 36 — migration planning loop healthy + productive.** Self-pacing restored (now
schedules its own ~20min wake-ups). Shipped 2 more specs (3/5 threads): strangler-shadow-
harness (Caddy handle-per-route + offline-replay shadow-diff at the `content/blocks`
facade) and slice-01-blog (GET /<slug>/; **found blog already has `Post.sx_content` +
lexical→SX pipeline** — a real head-start). data-migration + slice-sequencing pending.
No new radar candidate; A1 steady at 13; fed-sx still on deadlock.
- **Date:** 2026-06-07 (radar loop, pass 35)
- **Pass 35 — quiet for findings; ops note.** The migration PLANNING loop had completed
host-readiness and **stalled idle ~1hr** (self-paced `/loop` didn't re-fire after one
iteration). Nudged it to continue its worklist (now on strangler-shadow-harness) +
schedule its own next wake-up. No new radar candidate; events/content incremental;
A1 steady at 13; fed-sx still on the deadlock reproducer.
- **Date:** 2026-06-07 (radar loop, pass 34)
- **Pass 34 — quiet, no new finding.** Minimal churn: migration planning loop still on
host-readiness (next thread pending, self-paced); maude scoreboard refresh; fed-sx
grinding the fed-prims deadlock; A1 adopters steady at 13. Nothing new to discover.
- **Date:** 2026-06-07 (radar loop, pass 33)
- **Pass 33 — host-layer story clarified (refines the migration strategy).** `dream` =
**Dream-on-SX**: OCaml's Dream web framework on the SX CEK, and the project owner's
**confirmed decision to move rose-ash OFF Quart onto Dream** as the ergonomic HTTP front
door over the native SX server (router/session/middleware/cors/csrf/auth/ws/html/json —
16 modules). So the host layer is: **host-on-sx native server (Phases 1-3, carries it
now) → Dream-on-SX framework front door (gated on ocaml-on-sx Phases 1-5) + host-persist
(done) + fed-sx (AP transport).** The migration PLANNING loop (new, tmux `migration`,
commit-only) is now the owner of refining this — it already shipped `host-readiness.md`
pinning the near-term gate to **`lib/host` (unbuilt) + a multi-`Set-Cookie` primitive
fix** (`sx_server.ml:735`). NOTE: `plans/rose-ash-on-sx-migration.md` under-specified the
framework layer (said "host-on-sx HTTP host"); the Dream-over-Quart decision + the
native→Dream sequence is the correction — the planning loop will fold it into its specs.
`maude` at Phase 5 (rewriting-logic substrate). Radar tracks; planning loop details.
- **Date:** 2026-06-07 (radar loop, pass 32)
- **Pass 32 — A1 DONE.** `loops/conformance` merged to architecture (`db76cc8c`); 13 adopters
now on the shared driver; radar spot-checked common-lisp = 487/487 green post-merge →
coordination flag CLEARED. A1 moved to a new **Done** section. New nascent subsystems
`dream` + `maude` (0 files), `fed-prims` resumed (mutex-deadlock fix). The idle
`a1-conformance` loop can be retired (worklist complete).
- **Date:** 2026-06-07 (radar loop, pass 31)
- **Pass 31 — A1 conformance loop WORKLIST COMPLETE.** tcl excluded (foreign `*.tcl`); final:
4 migrated (common-lisp/erlang/feed/go) + 5 excluded (forth/js/ocaml/smalltalk/tcl). A1 =
**12 on shared driver + 6 excluded**; only the parity-gated merge to architecture remains.
commerce shipped a refund saga on flow (2nd flow use) + finished Phase 5 → going quiescent.
relations building graph algos (all-paths) — still unconsumed (W9 unchanged).
- **Date:** 2026-06-07 (radar loop, pass 30)
- **Pass 30:** conformance loop near done — `ocaml` + `smalltalk` excluded (both foreign
`test.sh`/corpus runners, as predicted). Tally: 4 migrated, 4 excluded, **tcl only** left.
Next A1 milestone = the `loops/conformance`→architecture merge under adopter-parity. No
new candidate; relations/artdag steady (no new W9 delegation).
- **Date:** 2026-06-07 (radar loop, pass 29)
- **Pass 29:** conformance loop excluded `js` (test262 fixtures) → 4 migrated + 2 excluded,
3 remain (ocaml/smalltalk/tcl). New subsystems advancing fast: `relations` → Phase 4
federation, `artdag` → Phase 6 federation → both fold into W1 (now 7 federation modules,
theme-not-shape holds) and W9 (relations past Phase 2 but not yet consumed by anyone).
- **Date:** 2026-06-07 (radar loop, pass 28)
- **Pass 28 — fleet expanding again.** Conformance loop: `go` migrated 609/609; **`forth`
excluded** (foreign Forth corpus — classify-then-exclude working). 4 migrated +1 excluded
on the branch; js/ocaml/smalltalk/tcl remain. **2 new subsystems:** `relations` (Phase 1,
parent/child rel facts → new W9 nascent watch) and `artdag` (nascent, 0 files). `events`
MERGED to architecture (its persist+flow adoption now integrated — W4/W8 landed). Briefing
commit hints more incoming: `dream`, `host`, +5 language chisels.
- **Date:** 2026-06-07 (radar loop, passes 2627)
- **Passes 2627 (routine tracking):** conformance loop steady at ~1 migration/iteration —
erlang 761/761, then feed 189/189. A1 = 8 on architecture + 3 on the branch; 6 remain.
W4 still gated (host-persist adapter not landed); no new subsystem; app loops on
incremental domain work (commerce Phase 5 payment envelope, content/events/identity/fed-sx).
Nothing new to discover; merge-time adopter-parity flag still open.
- **Date:** 2026-06-07 (radar loop, pass 25)
- **Pass 25:** A1 → **8 adopters** (events via its own loop) + common-lisp 487/487 on the
conformance branch. The conformance loop **extended the shared `lib/guest` driver**
(per-suite counters/preloads) to do it → raised a **coordination flag in A1**: verify the
branch is non-regressive against all 8 adopters before merging to architecture. commerce
drafting Phase 5 provider-neutral payment envelope. No new candidate; A1 advancing fast.
- **Date:** 2026-06-07 (radar loop, pass 24)
- **Pass 24 — three real updates.** (1) **A1 → 7 adopters** (search migrated, counters mode
— corrects the earlier exclusion). (2) The dedicated `conformance` loop ran its 1st
iteration: refused to force-migrate common-lisp (parity gate worked) and surfaced a
**driver feature-gap** (per-suite counters + preloads) gating the complex multi-suite
candidates → A1 now splits simple-now vs gated-on-driver-enhancement. (3) **W8 commerce
is LIVE** ("order lifecycle as a durable flow-on-sx flow, Phase 3 done") → 2 live flow
consumers. events shipped TZ/DST; mod reverted its extraction note (declined on re-read).
- **Date:** 2026-06-07 (radar loop, pass 23)
- **Pass 23 — trigger fired (empty streak ends at 1922).** commerce recorded a Phase 3
**flow-integration design** (order saga as a flow-on-sx flow, payment suspended until
webhook resume) → 2nd durable-flow consumer; **W8 broadened** from "delivery" to
"externally-resumed orchestration on lib/flow." events made its federation transport
**fed-sx-ready** (injected) → reinforces W1's 5/5 inject-fed-sx seam. acl left tmux
(now fully quiescent). host-persist adapter still not landed (W4 migration still gated).
- **Empty-discovery streak: passes 1922** (last verified pass 22). Fleet at steady state —
active loops (content CvRDT, events recurrence/reschedule, identity grant-mgmt, fed-sx
outbox internals) are building *inside* their domains, not cross-cutting infra. Census
exhausted (p17); all gates re-tested (W1 p18, W2 p19). No new candidate clears any gate.
- **Radar is now trigger-driven.** The next substantive pass needs one of: **(a)** a new
subsystem worktree spawning (auto-joins scan), or **(b)** host-persist's durable adapter
landing → unblocks the W4 acl/mod→persist/log migration, or **(c)** a quiescent
subsystem (acl/mod/search/commerce, static ~916 passes) resuming. Polling ~hourly until
one fires; will tighten cadence then.
- **Date:** 2026-06-07 (radar loop, pass 20)
- **Pass 20 — honest empty pass.** 3 new census recurrences since p17 (normalize/index ×2,
query ×3) — all **name collisions** (same noun, domain-specific op), added to the table.
Recorded the meta-pattern: the fleet shares vocabulary, not structure. Most subsystems
quiescent (acl/mod/search/commerce static ~9-15 passes = API-stable); only events/
identity/content/fed-sx still committing domain features. No new gate-clearer.
- **Date:** 2026-06-07 (radar loop, pass 19)
- **Pass 19 — honest empty pass.** Scanned 10 active subsystems. content/index.sx is a
blog index/tag-cloud listing (presentation, not full-text search — no search reinvention)
and content/multi-doc indexing adds no per-viewer filter. **W2 re-tested: still 2**
(feed, search) — acl's `permit?`-like matches are its own authZ *engine* (the home),
not a downstream read filter. No new candidate cleared any gate.
- **Date:** 2026-06-07 (radar loop, pass 18)
- **Pass 18 — W1 gate re-test.** events shipped Phase 4 federation (5th consumer): a 5th
divergent merge (sorted agenda + `:origin` provenance), trust-gate = runtime list
membership (shares mod's mechanism, not acl's). Reinforces W1's "theme not shape" — but
the **inject-fed-sx-transport seam is now 5/5**, strengthening "all are fed-sx
consumers-in-waiting." Trust sub-pattern refined: mod+events (runtime set) vs acl (rule).
- **Date:** 2026-06-07 (radar loop, pass 17)
- **Pass 17 — filename census declared EXHAUSTED** (see the Census-status table above).
Examined the last unswept ≥2 recurrences (schema/engine = acl⇄mod substrate twins;
catalog/batch = name collisions; store = divergent). No new candidate. Incremental churn
elsewhere (content 621/621, identity PAR, events reminders). Future passes pivot from
censusing to re-testing gates as consumers mature.
- **Date:** 2026-06-07 (radar loop, pass 16)
- **Pass 16:** events started Phase 3 — **durable notification delivery on `lib/flow`**
(new W8: at-least-once + idempotency exemplar; fed-sx/mod roll their own outbox). The two
`notify.sx` (feed vs events) are a name collision (read-side digest vs delivery), noted
in W8. Substrate-adoption story deepening: app domains now consume persist (content/
commerce/events), flow (events), commerce (events), acl-authZ (identity).
- **Date:** 2026-06-07 (radar loop, pass 15)
- **Pass 15:** added the **scanning-method note** above after `query.sx` again proved to
be merged-lib copies (lib/prolog + lib/persist in every worktree). Corrected census
surfaced `wire`×2 (content+mod) → Rejected (shared role, divergent structure: generic SX
serializer vs bespoke pipe-format under a Prolog-env string-prim constraint). events↔
commerce integration appeared (paid tickets); acl/mod/search quiescent ~7 passes (now
API-stable). No new gate-clearer.
- **Date:** 2026-06-07 (radar loop, pass 14)
- **Pass 14:** filename census flagged `snapshot`×?? — but the `*/lib/persist/snapshot.sx`
copies are just the merged `lib/persist` in each worktree, NOT consumers (same artifact
as `lib/feed/rank.sx` everywhere). The one distinct file, `content/snapshot.sx`,
reimplements persist's projection-checkpoint on raw KV instead of using `persist/snapshot`
→ new W7 (persist-adoption nudge). `audit`×3 = the W4 fakes (acl/mod/identity), known.
- **Date:** 2026-06-07 (radar loop, pass 13)
- **Pass 13 — honest re-test, no gate-clearer.** Re-tested the two longest-waiting gates
against the maturing app-domain loops: **W2** (per-viewer visibility) still 2 consumers
(feed, search) — commerce/content/events/identity add no per-viewer read filter; **W3**
(pagination) still 2 (feed, search) — `content/page.sx` is an HTML wrapper, not
pagination (filename collision, noted in W3). Incremental churn only elsewhere.
- **Date:** 2026-06-07 (radar loop, pass 12)
- **Pass 12:** `events` shipped **transactional booking on persist** (3rd live persist
consumer) using `persist/append-expect` (optimistic-concurrency CAS, lock-free capacity
safety). W4 ledger now shows a persist feature-ladder append → append-once → append-expect
that the hand-rolled fakes can't match. No new candidate; W4 reinforced.
- **Date:** 2026-06-07 (radar loop, pass 11)
- **Pass 11 — W4 sharpened with a consumer ledger.** commerce built an **order ledger on
persist** (2nd live exemplar; uses `persist/append-once` for webhook idempotency) and
identity a **grant audit ledger** (in-memory Erlang fake, gated on an Erlang↔persist
bridge). The append-only monotonic-seq event-log pattern is now validated across 4
domains, 2 live on persist + 3 fakes flagged for adoption. See W4 table.
- **Date:** 2026-06-07 (radar loop, pass 10)
- **Pass 10:** commerce/content/events/identity advancing (content 238/238). Probed a
shape outside the routing table — **guarded lifecycle state machines** (mod/lifecycle +
identity/membership) → new W6: shared *design principle*, divergent *structure*
(SX transition-table vs Erlang gen_server), NOT an extraction target. No gate-clearer.
- **Date:** 2026-06-07 (radar loop, pass 9)
- **Pass 9:** `commerce` + `content` reached Phase 2 (`content` 162/162). **Key find:
`content` built its op log directly on `persist/log`** (backend-injected, append+replay-
to-seq) — the live reference exemplar for W4 (see W4). `events` MONTHLY RRULE,
`identity` OAuth2 auth-code + PKCE, search boolean-filtered ranked. A1 still 6 adopters.
- **Date:** 2026-06-06 (radar loop, pass 8)
- **Pass 8 — fleet expanded by 4 app-domain loops** (the briefing's anticipated
`commerce`/`identity` arrivals, auto-picked up by dynamic discovery). All early-stage,
**pre-Phase-2 → moving targets, none count toward any gate yet**:
- `commerce` (Phase 1: `api/cart/catalog/price`). Its "per-line audit" is a cost
*breakdown view* (`api.sx:44`), **not** an append-only decision log → NOT a W4
consumer.
- `events` (Phase 1: `calendar.sx`, RRULE expansion).
- `identity` (early: `session/token`). Defers authZ to acl (`token.sx:15`) — reinforces
W2's "delegate `permit?` to acl-on-sx" routing; identity = authN, acl = authZ.
- `content` (just-started: `block.sx`).
These are the future consumers W2/W3 are waiting on — re-check their per-viewer filters
/ pagination once each clears Phase 2. No new gate-clearer this pass.
- **Pass 7:** **A1 jumped 4→6 adopters**`acl` + `mod` migrated to the shared
conformance driver (first app-domain adopters; proves it generalizes past substrates).
`host-persist` closed its blob-adapter blocker (durable storage adapter now landing →
W4 migration path opening). search shipped proximity/NEAR; flow + persist quiescent.
- **Pass 6:** new worktree **`host-persist`** (active — building persist's durable host
adapter); `feed` went quiescent (left tmux). acl shipped hardening (+25), fed-sx-m1 at
Step 6c. **mod loop independently wrote a shared-plumbing note** (`mod-on-sx.md`,
538b8a53) corroborating W4/W5 — folded its claims + home disagreements into W1/W4/W5.
No new gate-clearer (audit log still 2 consumers), but consumers are now API-stable.
- **Pass 5:** search (+highlight/snippet) and fed-sx-m1 (+follower_graph) moved; rest
unchanged. Filename census: `api`×6, `fed`×3, then `schema/rank/query/page/explain/
engine/batch/audit`×2. Examined the ×6 `api.sx` → Rejected (shared name, divergent
structure incl. implicit-vs-explicit-state contract). rank/batch/engine all ≤2 +
substrate/domain-divergent → no new gate-clearer.
- **Pass 4:** no churn vs pass 3 (same worktrees/tmux/HEADs/adopters). Swept audit+explain
surfaces: acl/mod share an append-only-log shape (→ sharpened W4 with persist/log API
evidence) and a proof-explain shape (→ new W5, substrate-bound). No new gate-clearer.
- **Pass 3 (earlier today):** subsystem set + tmux + A1 adopters (4) all unchanged vs pass 2. Loops
advanced: acl shipped Phase 4 federation; search shipped Phase 4 + pagination; feed
shipped pagination/threading; mod at Ext 19 (capstone); persist did a worked acl-grants
migration (W4). New shape found: offset/limit pagination → folded into W3.
- **Subsystem set discovered:** loop worktrees `acl, erlang, fed-prims, fed-sx-m1,
feed, flow, go, kernel, mod, ocaml, persist, radar, ruby, search,
sx-vm-extensions`; main-repo `lib/*` incl. merged `feed` + substrates (`apl,
common-lisp, datalog, erlang, forth, go, haskell, hyperscript, js, lua, minikanren,
ocaml, prolog, scheme, smalltalk, tcl`) + `lib/guest`.
Actively looping (tmux): `acl, fed-sx-m1, feed, flow, mod, persist, search`
(+ radar).
- **New since pass 1:** worktrees `kernel` (empty/unset — not yet a repo) and `ocaml`
(`lib/ocaml/baseline` only). Both early-stage, prePhase 2 → out of proposal scope.
- Re-enumerate every pass; new loops (e.g. a future `commerce`/`identity`) auto-join.
**Census status (pass 17): EXHAUSTED.** Every own-namespace filename recurring ≥2× has
been examined and dispositioned — further filename-censusing is low-yield until new
subsystems/modules appear. Map:
| filename | owners | verdict |
|---|---|---|
| `api` ×10 | all | Rejected — shared role, divergent state contract |
| `fed`/`federation` | feed/search/mod/acl(+content) | W1 — theme not shape |
| `audit` ×3 | acl/mod/identity | W4 — append-only log → persist/log |
| `page` ×3 | feed/search (pagination) + content (HTML wrapper) | W3 + collision noted |
| `explain` ×2 | acl/mod | W5 — proof tree, substrate-bound |
| `snapshot` ×2 | persist(facet) + content(reinvents) | W7 |
| `wire` ×2 | content(SX serializer) / mod(pipe-format) | Rejected — divergent |
| `schema`,`engine` ×2 | acl/mod | substrate-twin parallels (Datalog vs Prolog); only audit (W4) is liftable |
| `catalog`,`batch` ×2 | commerce/persist, mod/persist | name collisions, unrelated |
| `normalize` ×2 | content(tree-prune)/feed(record-coerce) | name collision (pass 20) |
| `index` ×2 | content(listing)/search(inverted index) | name collision (pass 20) |
| `query` ×3 | content(doc-block)/search(bool AST)/persist(stream-read) | 3-way name collision (pass 20) |
| `store` ×2 | content(on persist) / flow(workflow records) | related concept, divergent |
| `rank` ×2 | feed/search | different domains (activities vs docs), ≤2 |
**acl⇄mod are structural twins** (decision engine over a logic substrate, Datalog vs
Prolog) — they parallel across engine/schema/explain/audit/fed, but only the *audit log*
is substrate-agnostic and liftable (→ W4); the rest are substrate-idiomatic. Next passes:
re-test gates (W2/W3/W8) as consumers mature, watch new modules — not re-census.
**Meta-pattern (pass 20):** new module names keep *recurring* but the operations keep
*colliding* — same noun, domain-specific op (normalize, index, query, catalog, batch,
notify, page, store all proved to be collisions). This is *why* genuine extraction
candidates are rare: the fleet shares vocabulary, not structure. The real shared assets
are the **substrate subsystems** (persist, flow, acl, fed-sx) that app domains *adopt*
(W1/W2/W4/W7/W8), not hand-rolled libs to extract.
**Scanning-method note (learned the hard way, passes 5/12/14/15):** a filename census
for *cross-subsystem* recurrence MUST restrict to each subsystem's OWN namespace —
`X/lib/X/*.sx` — never `X/lib/*/`. The merged substrate libs (`lib/prolog`, `lib/persist`,
`lib/feed`, `lib/datalog`, …) are checked out inside *every* worktree, so a naive census
reports e.g. `query.sx`/`snapshot.sx`/`rank.sx` ×N as phantom recurrences that are really
one merged file copied N times. Correct one-liner:
`for w in <subsystems>; do for f in $w/lib/$w/*.sx; do basename $f .sx; done; done | sort | uniq -c | sort -rn`.
---
## Done
### A1 · Shared conformance driver — ✅ COMPLETE (merged `db76cc8c`, pass 32)
Full closed loop: radar detected it → dedicated `conformance` loop implemented it
(classify-then-migrate-or-exclude, hard parity gate) → **merged to architecture**
(`db76cc8c Merge loops/conformance into architecture: A1 conformance-driver migration`)
→ radar spot-verified post-merge (**common-lisp 487/487 green** on architecture — exercises
the new per-suite-counters/preloads driver feature, the riskiest change). Final state:
- **13 on the shared driver:** acl, apl, common-lisp, datalog, erlang, events, feed, go,
haskell, mod, prolog, relations, search.
- **6 correctly excluded** (foreign-program runners — a legitimately different harness):
forth, js, ocaml, smalltalk, tcl, lua.
- The shared driver gained per-suite counters + per-suite preloads (backward-compatible);
spot-check confirms existing adopters unaffected. Coordination flag CLEARED.
Detail of the migration arc retained under the original entry below.
## Proposed (cleared the gate)
_(empty — A1 graduated to Done, pass 32.)_
### A1 · Adopt the shared conformance driver across subsystems
- **Pattern:** every subsystem hand-rolls a near-identical `conformance.sh`
(epoch-load → eval → scoreboard emit) and an inline `<x>-test name got expected`
pass/fail counter.
- **Consumers (≥3, overwhelming):** 15 `lib/*/conformance.sh` — `apl, feed, datalog,
flow, mod, lua, erlang, forth, go, common-lisp, haskell, js, ocaml, prolog,
smalltalk, tcl`.
- **Home:** `lib/guest` — the one legitimate exception (the shared driver
`lib/guest/conformance.sh` + `lib/guest/conformance.sx` already exist; modes
`dict` and `counters`).
- **Status: IN PROGRESS — 6 adopters (pass 7).** `prolog` (dict), `haskell` (counters),
`apl` (dict), `datalog` (dict), and **`acl` (dict) + `mod` (dict), newly migrated this
pass** — all 3-line exec shims into `lib/guest/conformance.sh` with a `conformance.conf`.
**acl + mod are the first *app-domain* adopters** (not language substrates) — strong
evidence the driver generalizes beyond the substrate layer, which was the open question.
The `apl` migration earlier *surfaced a latent bug*: the old awk extractor
under-counted `pipeline` (40 vs the real 152 assertions); true apl total is **562**,
not 450 — evidence that adopting the driver also improves correctness.
- **Not a target (different harness shape):** `lua/conformance.sh` is a Python runner
(`lib/lua/conformance.py`) that walks real `*.lua` source files via `lua-eval-ast`
and classifies pass/fail/timeout — it does not run SX `deftest` suites with a
counter/dict scoreboard, so the shared driver does not fit. Excluded, not pending.
- **Remaining hand-rolled candidates (~120220 lines each):** `common-lisp, erlang,
feed, forth, go, js, ocaml, smalltalk, tcl` — now being worked by the dedicated
`conformance` loop (above). (`lua` excluded: walks real `*.lua` files via Python.
`smalltalk` likely excludes too — runs `*.st` via its own `test.sh`. `search` was
thought to be excluded but DID migrate via counters mode — see the 7-adopter note.)
- **Action:** each remaining subsystem's OWN loop migrates when quiescent — add a
`conformance.conf` (+ a `test-harness.sx` preload defining its counters) and
replace `conformance.sh` with the 1-line exec shim
(`exec bash …/guest/conformance.sh …/conformance.conf "$@"`). Recipe template:
`lib/haskell/conformance.conf` (counters) or `lib/prolog/conformance.conf` (dict).
Keep the `bash lib/X/conformance.sh` entry point so no loop is disrupted.
- **Priority: HIGH** (15 consumers, low risk, interface-preserving, additive).
- **8 adopters on architecture** (pass 25): acl, apl, datalog, **events**, haskell, mod,
prolog, search — `events` migrated via its OWN loop; `search` via counters mode (which
corrects the earlier "search excluded" note). **+4 on the `loops/conformance` branch:
`common-lisp` 487/487, `erlang` 761/761, `feed` 189/189, `go` 609/609** — pending merge.
**5 EXCLUDED — all foreign-runner harnesses** (correctly, not force-migrated): `forth`
(Hayes core.fr via awk+python), `js` (test262 `.js`/`.expected`), `ocaml` (scrapes
`test.sh` + `.ml` baseline), `smalltalk` (scrapes `test.sh` + `*.st` corpus), `tcl`
(foreign `*.tcl` vs `# expected:` annotations).
- **✅ CONFORMANCE LOOP WORKLIST COMPLETE (pass 31).** Final A1 picture:
- **12 on the shared driver:** acl, apl, datalog, events, haskell, mod, prolog, search
(on architecture) + common-lisp, erlang, feed, go (on `loops/conformance`, pending merge).
- **6 correctly excluded** (foreign-program runners — testing a language impl against an
external corpus is legitimately a different harness): forth, js, ocaml, smalltalk, tcl, lua.
- **Honest finding:** the driver's reach is narrower than the raw "15 conformance.sh"
count implied — language substrates that run real `.lua/.st/.ml/.tcl/.js/.fr` programs
*should* keep their foreign runners. ~half migrate, ~half don't, and that's correct.
- **One step left:** merge `loops/conformance` → architecture under the **adopter-parity
check** (the coordination flag above — the shared `lib/guest` driver change must be
proven non-regressive against all existing adopters first). The loop is now idle.
- **NOW IN PROGRESS — dedicated loop (2026-06-07).** A human-triggered `conformance` loop
(worktree `/root/rose-ash-loops/conformance`, branch `loops/conformance`, tmux session
`a1-conformance`, briefing `plans/agent-briefings/conformance-loop.md`) is working the
remaining candidates (common-lisp, erlang, feed, forth, go, js, ocaml, smalltalk, tcl)
one per iteration, **classify-then-migrate-or-exclude with a hard test-count parity gate**
(reverts on any mismatch; never pushes to main/architecture). Radar tracks; it implements.
- **Driver-capability boundary found (pass 24, first iteration).** The loop did NOT
force-migrate `common-lisp` (baseline 305/0 across 12 suites) — the shared driver can't
reproduce it: `MODE=counters` supports only ONE global pass/fail counter pair + ONE fixed
preload set, but common-lisp needs **per-suite counter names** (8 distinct pairs) and
**per-suite preload chains**. It logged a precise blocker + unblock path (extend the
`SUITES` entry format with optional per-suite counters/preloads) and moved on.
- **Driver gap RESOLVED next iteration (pass 25) — but it touched the shared driver.** The
loop extended `lib/guest/conformance.sh` (+38 lines: optional per-suite counters + per-suite
preloads in the `SUITES` format, backward-compatible) and then migrated common-lisp at
**487/487** (above the 305 baseline — likely another extractor under-count correction, à la
apl's `pipeline`). The parity gate held throughout.
- **⚠ COORDINATION FLAG (radar): the `loops/conformance` branch now carries a change to the
SHARED `lib/guest` driver** used by all 8 adopters. It's additive by design, but **before
this branch merges to `architecture`, re-run the existing adopters' suites under the new
driver to confirm zero regression** (acl/apl/datalog/events/haskell/mod/prolog/search).
This is the one cross-cutting risk in an otherwise per-subsystem-isolated effort — surfaced
here so the merge is gated on adopter-parity, not assumed.
---
## Watching (real but not yet through the gate)
### W1 · Federation scaffold (merge / ingest / backfill / trust-gate)
- **FAILS the structural-identity gate (deep-dived 2026-06-06, all 4 read).** Consumer
count is met (4) but they are *superficially* similar, not structurally identical —
the federated unit and merge op differ fundamentally:
| Subsystem (file) | Federated unit | Merge op | Trust gate | Injected transport |
|---|---|---|---|---|
| feed (`fed.sx:14,18,40`) | activity streams | dedupe by `(actor verb object)` | none (visibility via `permit?` separately) | `send-fn`, `fetch-fn` |
| search (`fed.sx:8`) | inverted indices | relabel DocId `peer*1000+local` + union posting lists | none | none (pure merge fn) |
| mod (`fed.sx:11-14,99`) | moderation decisions | advisory-list vs applied-list; bind iff `mod/trusted?` | **yes — runtime list** `mod/trusted? peer scope` | mock outbox / `fed-send!` |
| acl (`federation.sx:43,56`) | Datalog delegate facts | pull facts, gate by `trust`/`level_covers` rule, re-saturate | **yes — Datalog rule** at query time | `transport` dict |
| events (`federation.sx`) | calendar agendas | fold trusted peers' agendas into one sorted agenda + `:origin` provenance | **yes — runtime list** `ev/trusts?` (peer-id ∈ trust-set) | injected behind `ev/peer-agenda` |
- **The ONLY real commonality is the injection seam** (now 5/5, pass 18), not extractable
code: every one says "the real transport is `fed-sx`'s job; inject `send-fn`/`fetch-fn`/
`transport`/`peer-agenda` and mock it in tests." That is an architectural *convention the
fleet already follows*. The merge op diverges 5 ways (dedupe / index-union / advisory /
fact-saturation / agenda-sort). The trust gate, where present, splits: **mod + events use
a runtime trust-set membership check; acl uses a declarative Datalog rule** — so even the
trust sub-pattern is 2-of-3, and the membership check is a trivial one-liner (below the
extraction threshold). No shared merge, no single shared trust mechanism.
- **Disposition:** do NOT extract a shared "federation lib." When `fed-sx` ships its
real transport, these 4 become its *consumers* (wiring `send-fn`/`fetch-fn`/`transport`
to it) — that work belongs to each subsystem's loop + the `fed-sx` loop, not a
cross-cutting extraction. Stop re-proposing on the shared name. Home: `fed-sx`.
- **Now 7 federation modules (pass 29):** + `relations` (Phase 4: erel trust-gating,
peer_rel/trust, fed-sx mock transport — Datalog-rule trust like acl) and `artdag`
(Phase 6: content-addressed cache + trust + **invalidation** — a merge shape unlike any
other). Each new one reinforces "theme not shape": 7 divergent merges, all sharing only
the inject-fed-sx-transport seam. Verdict unchanged — they're fed-sx consumers-in-waiting.
- **Narrower sub-claim (mod note, pass 6; refined pass 18):** mod asserts the *fed
trust/outbox* shape shares between mod+acl. Radar evidence refines this: the trust gate
splits by mechanism, not by subsystem pair — **mod + events** both use a runtime
trust-set membership check (`mod/trusted?`, `ev/trusts?`), while **acl** uses a Datalog
rule. So a "trust-set membership" helper has 2 consumers (mod, events) — but it's a
one-line `member?` and the merge it gates diverges, so still not worth extracting.
Resolve at the architecture-merge point if a heavier shared trust-set surface emerges.
### W2 · Per-viewer visibility / permission filter
- **2 shipped consumers, same shape** — `filter <injected-permit> <ranked/candidate stream>`:
- `feed/lib/feed/acl.sx:27` `feed/visible = (feed/filter stream (fn (a) (permit? viewer a)))`,
capstone at `:34` (stream → ACL → rank → top-N). `permit?` injected, sig `(viewer activity)→bool`.
- `search/lib/search/fed.sx:16` `aclFilter permit docs = filter permit docs`;
`topNTfIdfAcl n permit ts idx = take n (aclFilter permit (rankTfIdf ts idx))`.
`permit` injected, sig `DocId→Bool` (viewer baked in by caller).
- **NOT a consumer:** `mod/lib/mod/policy.sx` is moderation policy (reviewer actions),
no per-viewer read filter. So mod won't be the 3rd.
- **Missing:** (a) only 2 consumers, need ≥3; (b) the two interfaces *diverge* —
feed passes `(viewer, item)`, search bakes the viewer in — so any shared form must
pick a convention; (c) both already **inject** the predicate, and the filter body is
literally one line (`filter permit xs`). Leaning toward: the predicate's home is
`acl-on-sx` (`permit?`), and the one-line filter is too thin to extract.
- **Home when ripe:** delegate `permit?` to `acl-on-sx`; do NOT extract the filter.
Re-check if a 3rd genuine per-viewer read filter ships (e.g. events/commerce).
### W3 · Collection helpers (group-by, dedupe-by-key, stable top-N, distinct-order, offset/limit page)
- feed built all of these on APL primitives. search/commerce/events will want
group-by / top-N.
- **NEW (2026-06-06): offset/limit pagination shipped in 2 subsystems, identical shape**
`take limit (drop offset xs)`:
- `feed/lib/feed/page.sx:9` `feed/page` (offset/limit window over a stream).
- `search/lib/search/page.sx:9` `paginate off lim docs = take lim (drop off docs)`.
- NOT a 3rd: `persist/lib/persist/query.sx:5` has a *since-cursor* for incremental log
consumption — resumable-stream semantics, not result windowing. Different shape.
- feed *also* has cursor-by-`:at` recency pagination (`page.sx:21-44`); search has no
cursor. So only the plain offset/limit window is shared, and it is a literal 1-liner.
- **Missing:** ≥3 stable consumers; AND every item here is collection math that belongs
in the **substrate** (APL/Haskell already expose grade/sort/unique/take/drop), not a
shared lib. A 1-line `take/drop` window is far below the extraction threshold. Watch;
revisit only if a non-substrate subsystem needs the same windowing without take/drop.
- **Filename-collision caution (pass 13):** `content/lib/content/page.sx` is an **HTML
page wrapper** (full HTML5 doc), NOT pagination — do not count it as a 3rd pagination
consumer. `page.sx` now means two unrelated things across the fleet. Re-tested pass 13:
pagination still only feed + search (2).
### W4 · In-memory store fakes → `persist-on-sx`
- Not an abstraction to extract — a migration target. Every subsystem fakes its
store with a mutable list (`feed/-log`, flow store, mod audit, …).
- **Owner:** `persist-on-sx` (in progress). Tracked there, listed here for visibility.
- **Concrete instance (file:line, found pass 4): the append-only decision/audit log.**
`acl/lib/acl/audit.sx` and `mod/lib/mod/audit.sx` are the SAME hand-rolled shape, and
`persist/lib/persist/log.sx` (the persist *log facet*) already implements it durably:
| role | acl/audit.sx | mod/audit.sx | persist/log.sx (target) |
|---|---|---|---|
| log var | `acl-audit-log` :9 | `mod/*audit-log*` :10 | backend stream |
| monotonic seq | `acl-audit-seq` :10 | `mod/*audit-seq*` :11 | per-stream high-water :1 |
| append (auto-seq) | `acl-audit-decide!` | commit :32 | `persist/append` :17 |
| count | `acl-audit-count` :51 | `mod/audit-count` :44 | `persist/count` :12 |
| read-all oldest-first | snapshot/tail :73 | `mod/audit-all` :43 | `persist/read` :29 |
| read seq≥from | — | by-seq | `persist/read-from` :31 |
Both deliberately use a monotonic seq with **no wall-clock** (deterministic/testable) —
identical to persist/log's design. Action when persist's host adapter lands: acl + mod
loops swap their in-memory log for `persist/log`. 2 consumers today; not a new lib —
the home already exists. Belongs to acl/mod loops × persist loop, not an extraction.
- **Cross-loop corroboration (pass 6):** the mod loop independently reached the same
conclusion — `mod/plans/mod-on-sx.md` (commit 538b8a53): *"mod-sx (Prolog) and acl-sx
(Datalog) converged on the same module shape … only the audit log + fed trust/outbox
shapes truly share; extract at the architecture-merge point, refactoring both consumers
atomically, not unilaterally from a loop branch."* Confirms the shape AND the
do-not-extract-unilaterally stance.
- **Home disagreement to resolve at merge:** mod's note proposes lifting the audit-log
primitives into **`lib/guest/`**. Radar routing disagrees: a durable append-only log is
a **`persist-on-sx`** concern (the log facet already exists), not language-impl plumbing.
Hold the line — `lib/guest` is lexer/parser/AST/HM/test-runner, not an event log.
- **Migration is becoming concrete:** new `host-persist` loop (worktree + tmux, pass 6)
is building the durable-storage host adapter persist was blocked on — once it lands,
acl/mod can actually swap to `persist/log`.
- **LIVE REFERENCE EXEMPLAR (pass 9): `content` already does it right.** `content`
(Phase 2 complete, 162/162) built its op log directly on `persist/log` instead of
faking it — `content/lib/content/store.sx`: backend injected via `(persist/open)`
("content knows nothing about which backend", :10); append op as event
`persist/append b (content/-stream doc-id) …` (:20); read `persist/read` (:36);
`persist/last-seq` (:47); **version = replay op stream up to a seq**
(filter `persist/event-seq ev <= seq`, :61). "The op log is the source of truth …
the materialised doc is a cache, never primary state."
This proves the W4 target is real, not hypothetical: acl + mod's hand-rolled
monotonic-seq logs should adopt exactly content's `persist/log` pattern.
- **Consumer ledger of the append-only monotonic-seq event log (pass 11):**
| consumer | what | backing | note |
|---|---|---|---|
| content (`store.sx`) | doc op log | **persist/log ✓ live** | plain append + replay-to-seq |
| commerce (`ledger.sx`) | order ledger | **persist/log ✓ live** | `persist/append-once` — idempotent, webhook-replay-safe :40,58 |
| events (`booking.sx`) | booking roster | **persist/log ✓ live** | `persist/append-expect` — optimistic-concurrency CAS, capacity-safe, lock-free |
| acl (`audit.sx`) | decision log | in-memory fake (SX) | migrate directly when host adapter lands |
| mod (`audit.sx`) | decision log | in-memory fake (SX) | migrate directly |
| identity (`audit.sx`) | grant ledger | in-memory fake (**Erlang**) | `{Seq,Subject,Action}`; needs an **Erlang↔persist bridge** first — author scoped it out until persist lands ("queryable semantics identical") |
- **Two takeaways:** (1) the pattern is **validated across domains** — CRDT doc ops,
financial orders, event bookings, rule decisions, OAuth grants all reduce to the same
append-only monotonic-seq stream; (2) migrating to `persist/log` is strictly *better*
than the fakes — persist exposes a **feature ladder the fakes don't have**:
`append` (content) → `append-once`/idempotency (commerce) → `append-expect`/optimistic-
concurrency (events). Every fake would have to reinvent a weaker version of these.
This is an **adoption** item (the home already exists), NOT a new extraction — owned by
persist/host-persist × each consumer loop. The SX fakes (acl, mod) migrate directly;
the Erlang fake (identity) is gated on an Erlang↔persist bridge.
### W5 · Proof-tree explanation over a logic-program derivation
- `acl/lib/acl/explain.sx` (reconstructs a canonical proof by goal-directed search over a
saturated Datalog db) and `mod/lib/mod/explain.sx` (renders a Prolog-style proof tree
goal-by-goal with proved/unproved marks + unification bindings) are the same *idea*.
- **Missing / disposition:** only 2 consumers, and they sit on **different substrates**
(acl→`lib/datalog`, mod→`lib/prolog`). Proof reconstruction/rendering is logic-engine
machinery → it belongs in each **substrate** (datalog/prolog), not a shared app lib.
Watch; revisit only if a 3rd logic-backed subsystem reimplements proof explanation.
- **Cross-loop note (pass 6):** mod's note calls `mod/proof-goals` (re-query-each-goal)
generic and proposes lifting it into **`lib/guest/`**. Radar caveat: proof-tree
reconstruction *is* engine-agnostic logic machinery, but `lib/guest` is for
lexer/parser/AST/HM/match/test-runner — a logic-engine proof helper is a poor fit there.
If genuinely shared by ≥3 engines, a `lib/logic`-style substrate helper is the better
home than `lib/guest`. Still 2 consumers → stays Watching either way.
---
### W9 · Parent/child relationship tracking → the new `relations` subsystem (nascent)
- **New subsystem (pass 28):** `relations` (loops/relations, Phase 1 — `schema.sx`+`api.sx`,
rel facts + `relate`/`unrelate`/`children`/`parents`/`related`, 22 tests). Per CLAUDE.md
it's the canonical "cross-domain parent/child relationship tracking."
- **Why watch:** several subsystems already track parent/child *locally* — feed reply-to
threading (`thread`/`replies`), content nested block trees, events occurrence/RECURRENCE-ID
links. If `relations` becomes the shared home, those are candidate *delegators* (like
acl=authZ, persist=log). But it's **Phase 1, pre-Phase-2, moving target** — and each
local impl is currently domain-specific (different keys/semantics). Do NOT propose yet.
Re-check when relations is past Phase 2 AND ≥3 subsystems' relationship logic could
genuinely delegate to it. `artdag` also just spawned (nascent, 0 files) — tracking only.
(pass 32: `dream` + `maude` also spawned, nascent 0-files; `fed-prims` resumed.)
- **Update pass 29:** relations rocketed to **Phase 4** (one gate — past Phase 2 — now met),
but it's building ITSELF out (schema/federation), **not yet being consumed** by anyone.
The blocker is the other gate: 0 subsystems currently *delegate* their parent/child logic
to it (feed/content/events still track locally). Watch for the first real delegation.
(artdag also raced to Phase 6 — these ports advance fast; treat committed state as truth.)
### W8 · Durable externally-resumed orchestration on `lib/flow` (suspend→host-IO→resume)
- **The shared shape:** a durable `flow` that `request`s an external action (a suspend
point), the **host** performs the IO, then `flow/resume`s the flow with the outcome;
flow's deterministic replay means a completed step never re-runs on recovery.
- **Consumers (pass 24): 2 LIVE** (events delivery, commerce order saga).
- `events/lib/events/notify.sx` (**live**) — reminders/digests as durable flows;
suspend on delivery `dispatch`, resume with send outcome. At-least-once + idempotency key.
- `commerce` (**LIVE** as of pass 24 — "order lifecycle as a durable flow-on-sx flow,
21 tests, Phase 3 done") — order saga `(defflow ordf … (request 'reserve oid) … )`:
reserve→pay→fulfil as a flow, **payment stays suspended until the payment webhook calls
`flow/resume`**. Carries only the order-id; pure orchestration over `ledger.sx`.
- **Now 2 LIVE consumers** of the *same* pattern: long-running process, external resume
(delivery dispatch vs payment webhook). fed-sx/mod still roll their own outbox (watch
for convergence). Strengthens "lib/flow is the home"; still adoption, not extraction.
- **Disposition:** `lib/flow` IS the abstraction (events proves it, commerce adopts it) →
this is an **adoption** observation like W4, NOT an extraction. Home = `lib/flow`.
- **Flow-onboarding friction (light signal):** commerce's note logs real gotchas adopting
flow — `flow-make-env` returns a large likely-cyclic env (don't print it), env build is
slow (budget ~540s like flow's own suite). If ≥3 subsystems hit the same onboarding
gotchas, that's a signal to smooth `lib/flow`'s adopter API — flow's concern, flagged here.
- **Name-collision caveat:** `notify.sx` means two unrelated things — `feed/notify.sx` is
a *read-side digest* (group inbox by verb+object), NOT delivery. Do not pair them.
### W7 · Snapshot/projection-checkpoint reimplemented vs `persist/snapshot` (delegate)
- `persist/lib/persist/snapshot.sx` already provides a **generic** projection checkpoint:
store `{:value :seq}` in the kv facet under a namespaced key; the headline property is
**snapshot + tail == full replay** (pure, clock-free).
- `content/lib/content/snapshot.sx` **reimplements that same pattern on raw persist KV**
rather than delegating: `persist/kv-put b (content/-snap-key doc-id) {:doc … :seq seq}`
(:20), `persist/kv-has?`/`kv-get` (:27-28), and its own tail-replay (:53-59). It never
calls `persist/snapshot-*`. content's doc-materialisation *is* a projection fold over
its op stream — exactly what `persist/snapshot` checkpoints generically.
- **Disposition:** persist-adoption nudge (like W4): content could delegate to
`persist/snapshot` (its projection = "fold ops → doc"), dropping the duplicated
KV+replay code. Home already exists → NOT an extraction; owned by content × persist
loops. Only 1 reinventor today; watch whether commerce/events/identity also hand-roll a
snapshot on raw KV instead of using the facet (would strengthen the nudge). NB timeline:
unclear if `persist/snapshot` predated content's — flag, don't blame.
### W6 · Guarded lifecycle state machine (illegal transition = explicit error)
- Recurs as a **design principle**, NOT a shared structure (found pass 10):
- `mod/lib/mod/lifecycle.sx` — pure SX: immutable case `{:state :error :history …}`,
explicit transition table `mod/lc-transitions` (:31), illegal transition returns the
case unchanged with `:error` set. States open→triaged→decided→appealed→final.
- `identity/lib/identity/membership.sx` — an **Erlang `gen_server`** fragment (identity
runs on erlang-on-sx): a `receive` loop with `case find(...) of … {error, St}` guards.
States none→pending→active→lapsed→revoked.
- **Both share the guideline** ("invalid transitions are explicit errors, never silent
no-ops") but **implement it substrate-idiomatically** — SX transition-table over
immutable values vs an Erlang process loop with per-message case guards. Same W1/`api.sx`
trap: shared *idea*, divergent *structure*.
- **Disposition:** not an extraction target — the FSM mechanism is ~10 substrate-specific
lines; the value is in each domain's state graph, not the plumbing. At most a **design
guideline** ("model lifecycle as a guarded FSM with explicit-error transitions"). Watch
whether commerce-checkout / events-booking add their own — if so it confirms the
*guideline*, still not a lib. Do not propose extracting a shared state-machine lib.
## Rejected (considered, declined — do not re-propose)
- **"Continuous auto-implementing abstractor loop."** Rejected at design time: an
agent writing across `lib/<x>/**` breaks the worktree isolation that makes the
fleet safe, and is rewarded for manufacturing premature/wrong abstractions. The
radar is read-only by design. (This file is the alternative.)
- **Shared `api.sx` "public boundary" module (×6).** Rejected pass 4-5: every subsystem
has an `api.sx` (acl, feed, flow, mod, persist, search — a 100% filename match), but it
is a naming *convention for the public entry point*, not a shared structure. They
disagree on the most basic contract: acl/feed use **implicit module state**
(`acl/api.sx` "implicit current db", `feed/api.sx` "single mutable log") while
`persist/api.sx` threads an **explicit backend as every call's first arg**; flow's api
*builds a Scheme env*, search's api *concatenates a Haskell source string*, mod's is a
*lifecycle state-machine façade* (17 defs vs persist's 1). Same role, no common shape —
the W1 coincidental-resemblance trap. Do not re-propose on the filename.
- **Shared `wire.sx` "serialization" module (×2).** Rejected pass 15: content + mod both
have a `wire.sx`, but `content/wire.sx` uses the **generic SX serializer**
(`serialize`/`parse`, full-fidelity round-trip) while `mod/wire.sx` is a **bespoke
versioned pipe-delimited line** (subset of fields, `split` hand-built over slice/len
because mod's Prolog-loaded env strips string prims). Shared role (wire format),
divergent structure + substrate constraint → not a candidate; the SX serializer is
already the shared tool for SX-substrate subsystems, and mod can't use it. (Same family
as the `api.sx` rejection above.)
- **Dumping app-domain plumbing into `lib/guest`.** Rejected: `lib/guest` is for
language-implementation plumbing. App patterns route to acl/fed-sx/persist/
substrate/host instead (see the routing rule in the briefing).

View File

@@ -1,117 +0,0 @@
# abstraction-radar loop agent (read-only scout)
Role: continuously scan **all** rose-ash subsystems for genuine abstraction /
deduplication opportunities and maintain a ranked, evidence-backed backlog at
`plans/abstractions.md`. You are a **scout, not an implementer** — you detect and
document; you never refactor across subsystems.
```
description: abstraction-radar (read-only scout)
subagent_type: general-purpose
run_in_background: true
isolation: worktree
```
## Prompt
You are the sole background agent on branch `loops/radar`, worktree
`/root/rose-ash-loops/radar`, forever. Self-paced. Your ONLY writes are to
`plans/abstractions.md` (and, rarely, refining this briefing). Push to
`origin/loops/radar` after each update. Never touch `main` or `architecture`.
## The one hard rule: you do NOT edit `lib/**` — ever
You read across every subsystem and write findings to `plans/abstractions.md`.
You do **not** implement abstractions, migrate code, or edit any `lib/<x>/**`
file in any worktree. Implementation is a separate, coordinated, human-triggered
step — proposing well is your whole job. An abstractor that writes across
subsystems would collide with the very isolation that keeps the other loops safe;
that is exactly why you are read-only.
## Dynamic discovery — re-enumerate every iteration, never hardcode
The set of subsystems grows as new loops are spawned. Each iteration, rebuild the
list from the filesystem + tmux so newly-added subsystems are automatically in
scope:
1. `ls -d /root/rose-ash-loops/*/` — every loop worktree. For a worktree named `X`,
its in-flight subsystem is `lib/X/` **inside that worktree**
(`/root/rose-ash-loops/X/lib/X/`) — that's the current, possibly-uncommitted
state. Read it there, not from your own worktree.
2. `ls -d /root/rose-ash/lib/*/` — subsystems merged into / dormant on the main repo
(e.g. `feed` once merged, the language substrates `apl`/`haskell`/`prolog`/…).
3. `tmux ls` — which subsystems are actively looping right now (affects whether a
candidate's consumers are "stable" — see the gate).
Treat the union as your scan surface. When a `commerce` or `identity` loop appears
later, step 1 picks it up with no change to you. Note in `abstractions.md` the
date and the subsystem set you scanned, so drift is visible.
## The AHA gate — before ANY candidate goes in the backlog as "proposed"
"Avoid Hasty Abstractions." A wrong shared abstraction is far costlier than the
duplication it replaces. A candidate may be listed as **proposed** only if ALL hold:
- **≥3 real consumers** (not 2 — three independent uses). Fewer → log it under
"Watching" with its consumer count, do not propose.
- **All consumers past Phase 2 and API-stable.** If a consumer's loop is mid-flight
and its interfaces are still moving (`tmux ls` shows it active + its plan has
unchecked early-phase boxes), the pattern is a moving target → "Watching."
- **Structurally identical, not superficially similar.** Show the shared shape with
file:line evidence from each consumer. Coincidental resemblance is the #1 trap.
- **It has a natural home.** And that home is usually **not** `lib/guest` — see the
routing rule below.
Anything failing a gate goes under **Watching** (with what's missing) or
**Rejected** (with why), never silently dropped — so it isn't re-proposed each pass.
## Routing rule — most patterns do NOT belong in lib/guest
`lib/guest` is for **language-implementation plumbing** (lexer/parser/AST/HM/match/
test-runner), and it has its own consumer-gated roadmap. App-subsystem patterns
almost always have a better home — route, don't dump:
| Pattern kind | Home (not lib/guest) |
|---|---|
| per-viewer visibility / permission filter | `acl-on-sx` (delegate to `permit?`) |
| federation scaffold (merge/ingest/backfill/trust) | `fed-sx` |
| durable store / event log / kv | `persist-on-sx` |
| collection math (group-by, dedupe, stable top-N) | the substrate (APL/Haskell/…) |
| HTTP/handler/middleware plumbing | `host-on-sx` |
| conformance/test harness | `lib/guest` (the one real exception — `test-runner.sx` + the shared driver live there) |
If a pattern's home is one of the subsystems, the recommended **action** is "adopt
/ delegate there," and the work belongs to that subsystem's own loop (in its
scope), not to a cross-cutting change.
## Each iteration
1. Re-discover the subsystem set (above). Record it + the date in `abstractions.md`.
2. Pick ONE thread: either deep-dive a "Watching" candidate to gather file:line
evidence and re-test its gates, or sweep for a new recurring shape across the
current set.
3. Update `plans/abstractions.md`: move items between Watching / Proposed /
In-progress (owned by a subsystem loop) / Done / Rejected, with evidence.
4. Keep it ranked by (consumers × effort-saved ÷ risk). Short, factual.
5. Commit (`radar: <one-line finding>`) and push to `origin/loops/radar`.
Do not invent work to look busy: if a pass finds nothing that clears the gate,
record "scanned N subsystems on <date>, no new candidates cleared the gate" and
stop until next iteration. Empty passes are a valid, honest result.
## Gotchas
- SX files: `sx-tree` MCP tools take `file:` not `path:`. But you mostly READ —
prefer `sx_find_across`, `sx_comp_usage`, `sx_comp_list`, `sx_summarise`, plus
`Grep`/`Glob`/`Bash` for cross-worktree scanning.
- `plans/abstractions.md` is a `.md` — edit it with normal Write/Edit, not sx-tree.
- Never run `sx_build`. You don't build anything; you read.
## Style
- Evidence over assertion: every claim cites file:line in ≥3 consumers.
- Honest empty passes. Rejected items stay rejected with a reason.
- One finding per commit. Update. Push. Next.
Go. Read `plans/abstractions.md` (seeded), re-discover the subsystem set, and
advance the highest-value thread.

View File

@@ -1,82 +0,0 @@
# commerce-on-sx: Catalog, cart, pricing & orders on miniKanren
> **DRAFT outline.** The revenue vertical. Depends on `persist-on-sx` (durable
> orders) and `flow-on-sx` (checkout as a durable flow). Don't start before
> persist-on-sx Phase 1 is green.
rose-ash's revenue engine — market (catalog), cart (checkout), orders (SumUp
payment, reconciliation) — has no SX subsystem. The hard part of commerce isn't
CRUD; it's **pricing**: discounts, bundles, tax, membership rates, promotions that
stack (or don't). These are relations, and a relational engine can run them in
multiple directions — forward ("what's the total?") and backward ("what promo code
yields this total?", "which line item triggered the discount?").
That's a miniKanren fit. Pricing/promotion rules are relational; cart and order
*lifecycle* (reserve → pay → fulfil → reconcile) is a durable `flow`; the order
ledger is a `persist` stream. Commerce is the first real **composition** subsystem.
End-state: a catalog model, a relational pricing/promotion engine, a cart with
deterministic totals, and an order lifecycle flow with payment-webhook
reconciliation — all auditable via the event log.
## Status (rolling)
`bash lib/commerce/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only `lib/commerce/**` and `plans/commerce-on-sx.md`. May **import**
from `lib/minikanren/`, and (once they exist) `lib/persist/` + `lib/flow/`. Do not
edit substrates.
- **Architecture:** prices/promotions are miniKanren relations over catalog facts;
a cart total is a *deterministic* query result (first solution under a fixed rule
order). Order lifecycle is a `flow` that suspends at the payment IO boundary.
Money is integer minor units — never floats.
- **Determinism:** promotion stacking must have explicit, tested precedence;
totals must be reproducible from the cart + catalog snapshot.
- **Commits:** one feature per commit. Progress log + tick boxes.
## Architecture sketch
```
Catalog + cart Total / order
product(id,price,tags) {:subtotal :discounts :tax :total}
│ ▲
▼ │
lib/commerce/catalog.sx lib/commerce/price.sx
— product / variant / stock facts — miniKanren pricing relations
│ — promo stacking, membership rates
▼ ▲
lib/commerce/cart.sx lib/commerce/order.sx (flow + store)
— line items, quantities — reserve→pay→fulfil→reconcile
│ — SumUp webhook = flow resume
▼ │
lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout) ──┘
```
## Phase 1 — Catalog + cart + deterministic totals
- [ ] `catalog.sx` — product/variant/stock as facts
- [ ] `cart.sx` — line items, add/remove/qty
- [ ] `price.sx` — base pricing relation, subtotal; tax
- [ ] `api.sx` + tests + scoreboard + conformance.sh
## Phase 2 — Promotions (relational)
- [ ] promo rules: percentage, fixed, bundle, member rate
- [ ] explicit stacking precedence; "best price" backward query
- [ ] tests: stacking order, mutually-exclusive promos, member vs guest
## Phase 3 — Order lifecycle (flow + store)
- [ ] order flow: reserve stock → await payment → fulfil
- [ ] payment webhook resumes the suspended flow
- [ ] order ledger as a `persist` stream; idempotent reconciliation
## Phase 4 — Reconciliation + federation
- [ ] mismatch detection (paid≠ordered) as queries over the ledger
- [ ] cross-instance catalog (federated marketplace) — out-of-scope stub
- [ ] tests: webhook replay, partial refund, double-charge guard
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

View File

@@ -1,82 +0,0 @@
# content-on-sx: Documents, blocks & collaborative editing on Smalltalk
> **DRAFT outline.** The CMS vertical — blog, WYSIWYG editor, Ghost sync. Depends
> on `persist-on-sx` (document history as an event log). Ghost/CMS sync stays a thin
> external adapter (Python/FFI) until a native replacement exists.
rose-ash's `blog` domain is content management: a block-based WYSIWYG editor,
navigation, Ghost CMS sync. A document is a tree of live blocks; editing is a
stream of operations; collaboration needs conflict-free merge. That is an object
model — blocks are objects, edits are messages, and a document is the object graph
responding to them. Smalltalk's "everything is an object responding to messages"
maps directly to a block/WYSIWYG model, and a semilattice (CRDT) merge keeps
concurrent edits conflict-free.
End-state: a Smalltalk-on-SX document model (typed blocks, structural ops),
operation log + CRDT merge for collaborative editing, versioning/history via the
event store, and a render boundary to HTML/SX. External CMS (Ghost) sync is an
injected adapter, not core.
## Status (rolling)
`bash lib/content/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only `lib/content/**` and `plans/content-on-sx.md`. May **import**
from `lib/smalltalk/`, and (once it exists) `lib/persist/`. Do not edit substrates.
- **Architecture:** a document is an ordered tree of blocks (objects); an edit is a
message (`insert`/`update`/`move`/`delete`); concurrent edits merge via a
commutative (CRDT/semilattice) operation so order doesn't matter. History is the
`persist` event stream; any version is a replay.
- **Determinism:** merge must be commutative + idempotent (test: apply ops in any
order / twice → same document).
- **Commits:** one feature per commit. Progress log + tick boxes.
## Architecture sketch
```
Edit op Rendered document
(insert block after id) ... HTML / SX tree
│ ▲
▼ │
lib/content/block.sx lib/content/render.sx
— typed blocks as objects — block tree → HTML/SX
— heading/text/image/embed — (reuses SX render boundary)
│ ▲
▼ │
lib/content/doc.sx lib/content/merge.sx
— ordered block tree — CRDT/semilattice op merge
— apply op, structural moves — concurrent-edit reconciliation
│ ▲
▼ │
lib/content/api.sx ── (content/edit) (content/render) (content/history) ──┐
│ │
├── op log + versions → persist │
└── Ghost/CMS sync → injected external adapter (thin, non-core) ──┘
```
## Phase 1 — Block document model
- [ ] `block.sx` — typed block objects
- [ ] `doc.sx` — ordered tree, apply edit op, structural moves
- [ ] `render.sx` — block tree → HTML/SX
- [ ] `api.sx` + tests + scoreboard + conformance.sh
## Phase 2 — Op log + versioning
- [ ] edit ops as `persist` events; replay to any version
- [ ] `(content/history doc)`, diff between versions
## Phase 3 — Collaborative merge (CRDT)
- [ ] commutative/idempotent op merge
- [ ] concurrent-edit tests (any order, double-apply → identical)
## Phase 4 — External sync + federation
- [ ] Ghost/CMS sync via injected adapter (import/export)
- [ ] federated documents (peer-authored blocks) — trust-gated stub
- [ ] tests: round-trip import/export, conflict on concurrent external edit
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

View File

@@ -1,81 +0,0 @@
# events-on-sx: Calendar, ticketing & notification delivery on Datalog
> **DRAFT outline.** The events vertical + the shared notification-delivery edge.
> Depends on `persist-on-sx` (bookings ledger) and `flow-on-sx` (reminders, retrying
> delivery). Pairs with `commerce-on-sx` for paid tickets.
rose-ash's `events` domain is calendar + ticketing: recurring events, availability,
capacity, bookings. Scheduling is constraint reasoning — "is this slot free given
recurrence, capacity, and the attendee's other bookings?" — which is rule
evaluation over facts. Datalog expresses availability, recurrence expansion, and
capacity as rules; a booking is a transaction; reminders and digests are durable
`flow`s. Notification *delivery* (email/push) — needed here and by `feed/notify`
is folded in as an injected transport, extractable later.
End-state: a Datalog-on-SX events layer with recurrence expansion, availability +
capacity rules, transactional booking, and a flow-driven notification dispatcher
(reminders, digests, retries) over an injected transport.
## Status (rolling)
`bash lib/events/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only `lib/events/**` and `plans/events-on-sx.md`. May **import** from
`lib/datalog/`, and (once they exist) `lib/persist/` + `lib/flow/`. Do not edit
substrates.
- **Architecture:** events/availability/capacity are Datalog facts + rules;
recurrence expands to occurrence facts within a window; a booking checks rules
then appends a `persist` event (idempotent, capacity-safe). Notifications are flows
that suspend on transport IO and retry on failure.
- **Determinism:** recurrence expansion + availability must be reproducible for a
fixed window + ruleset; capacity checks must be race-safe (no overbooking).
- **Commits:** one feature per commit. Progress log + tick boxes.
## Architecture sketch
```
Event + booking Result
event(id,start,rrule,capacity) {:booked | :full | :conflict} + reminders
│ ▲
▼ │
lib/events/calendar.sx lib/events/availability.sx
— event facts, recurrence (RRULE) — free/busy + capacity rules (Datalog)
— expand occurrences in window │
│ ▲
▼ │
lib/events/booking.sx lib/events/notify.sx (flow)
— transactional, capacity-safe — reminders / digests, retry on fail
— bookings → persist ledger — injected transport (email/push)
│ │
▼ ▼
lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ──────┘
```
## Phase 1 — Calendar + recurrence
- [ ] `calendar.sx` — event facts, RRULE expansion in a window
- [ ] `availability.sx` — free/busy rules
- [ ] `api.sx` + tests + scoreboard + conformance.sh
## Phase 2 — Ticketing + booking
- [ ] capacity rules; transactional booking → `persist` (no overbooking)
- [ ] paid tickets compose with `commerce` order flow
- [ ] tests: capacity edge, double-book guard, conflict detection
## Phase 3 — Notification delivery (flow)
- [ ] `notify.sx` — reminder/digest flows over injected transport
- [ ] retry/backoff on transport failure (flow suspend/resume)
- [ ] tests: delivery success, retry path, idempotent re-send
- [ ] NOTE: shared with `feed/notify` — candidate for later extraction to a
`delivery-on-sx` once a second consumer is real
## Phase 4 — Federation
- [ ] cross-instance events (peer calendar) — trust-gated stub
- [ ] tests: federated agenda merge
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

View File

@@ -14,7 +14,7 @@ APL, ACL visibility filtering via `lib/acl/`, federation via fed-sx.
## Status (rolling) ## Status (rolling)
`bash lib/feed/conformance.sh`**189/189** (Phases 14 + TF-IDF, notifications, home, smart-dedupe, trending, mute, pagination, threading) `bash lib/feed/conformance.sh`**0/0** (not yet started)
## Ground rules ## Ground rules
@@ -59,118 +59,47 @@ lib/feed/api.sx lib/feed/fed.sx
## Phase 1 — Stream model + basic ops ## Phase 1 — Stream model + basic ops
- [x] `lib/feed/normalize.sx` — activity record schema; coerce arbitrary inputs - [ ] `lib/feed/normalize.sx` — activity record schema; coerce arbitrary inputs
- [x] `lib/feed/stream.sx` — APL vector representation; filter by predicate; sort by - [ ] `lib/feed/stream.sx` — APL vector representation; filter by predicate; sort by
`:at`; take N (`↑`); reverse (`⌽`) `:at`; take N (`↑`); reverse (`⌽`)
- [x] `lib/feed/api.sx``(feed/post activity)`, `(feed/all)` - [ ] `lib/feed/api.sx``(feed/post activity)`, `(feed/all)`
- [x] `lib/feed/tests/basic.sx`30 cases: normalize defaults, filter, sort, take, api - [ ] `lib/feed/tests/basic.sx`15+ cases: post, query, filter, sort
- [x] `lib/feed/scoreboard.{json,md}` - [ ] `lib/feed/scoreboard.{json,md}`
- [x] `lib/feed/conformance.sh` - [ ] `lib/feed/conformance.sh`
## Phase 2 — Fanout via outer product ## Phase 2 — Fanout via outer product
- [x] follower graph: `followers user → vector of user ids` (`feed/follow-graph`, - [ ] follower graph: `followers user → vector of user ids`
`feed/followers`; graph = `{followee -> (followers)}` dict) - [ ] fanout: activities `∘.×` followers → matrix `(activity, follower)` pairs
- [x] fanout: activities `∘.×` audience → matrix via `apl-outer feed/-mk-event` - [ ] flatten to inbox events vector
- [x] flatten to inbox events vector (`feed/-flatten` rank-2 → rank-1) - [ ] dedupe — group by `(actor, verb, object)` collapse to one inbox event per
- [x] dedupe — `feed/dedupe-inbox` by `(to, actor, verb, object)`; also receiver
`feed/dedupe-activities` `(actor verb object)` and `feed/dedupe-collapse` - [ ] `lib/feed/tests/fanout.sx` — 20+ cases: small graph, mutual follow, popular
`(verb object)` for cross-actor likes actor (high-fanout), cross-post dedupe
- [x] `lib/feed/tests/fanout.sx` — 29 cases: small graph, mutual follow, star
(high-fanout), empty graph, unfollowed actor, cross-post dedupe
## Phase 3 — Aggregation + ranking ## Phase 3 — Aggregation + ranking
- [x] group-by — `feed/group-by`/`feed/group-count` key-reduce; `feed/by-actor-day` - [ ] group-by — `(actor, day) → count` via key-reduce
buckets `(actor, day)` via `feed/day` (string-joined keys) - [ ] velocity score — recent activity count over window
- [x] velocity score — `feed/velocity` counts actor's activities in `(at-window, at]` - [ ] recency score — decay by age
- [x] recency score — `feed/recency` half-life decay `0.5^(age/hl)` - [ ] composite rank — weighted sum of components
- [x] composite rank — `feed/composite` weighted sum of `(weight scorer)` parts - [ ] top-N per timeline
- [x] top-N per timeline — `feed/top` = rank then take - [ ] `lib/feed/tests/rank.sx` — 20+ cases: ranking stable on tie, decay shape,
- [x] `lib/feed/tests/rank.sx` — 24 cases: decay shape, velocity burst, stable per-user weighting
tie-break, top-N, composite
## Phase 4 — Visibility filter + federation ## Phase 4 — Visibility filter + federation
`lib/acl/` and fed-sx don't exist yet and are out of scope (import `lib/apl/` - [ ] ACL filter — each candidate activity passed through `(acl/permit? viewer :read
only), so ACL/transport are injected: `permit?`, `remote?`, `send-fn`, `fetch-fn` activity)`
are function parameters. Real acl-sx / fed-sx wire in at the call site unchanged. - [ ] fed-sx outbound — local `feed/post` fans out to remote followers' inboxes
- [ ] fed-sx inbound — peer activities arrive at local inbox
- [x] ACL filter — `feed/visible stream viewer permit?`; default `feed/permit-acl?` - [ ] backfill on subscribe — request peer history, merge into local stream
reads `:visible-to` allowlist (+ author-sees-own); per-viewer, never cached - [ ] `lib/feed/tests/integration.sx` — federated timeline with ACL applied
- [x] fed-sx outbound — `feed/federate`/`feed/deliver` fan out then partition
local vs remote inboxes; remote events handed to injected `send-fn`
- [x] fed-sx inbound — `feed/inbound` normalizes + `feed/ingest` dedupes peer
activities into the local stream
- [x] backfill on subscribe — `feed/backfill local fetch-fn peer-id`
- [x] `lib/feed/tests/integration.sx` — 22 cases incl. end-to-end
`feed/timeline` (federated → ACL for viewer → recency rank → top-N)
## Progress log ## Progress log
- **Phase 1 done (30/30).** Stream = APL rank-1 array whose ravel holds activity (loop fills this in)
dicts. `normalize.sx` (record schema + accessors), `stream.sx` (filter via `/`
compress, sort via `⍋` grade-up [stable], take via `↑`, reverse via `⌽`,
by-actor/verb/object/since predicates), `api.sx` (mutable log: post/all/reset!/size).
Substrate: `apl-compress`, `apl-grade-up`, `apl-take`, `apl-reverse`, `make-array`.
Grade-up returns 1-based indices (⎕IO=1), is stable on ties → deterministic sort.
- **Phase 2 done (59/59 total).** `fanout.sx` (graph + `apl-outer` showcase),
`dedupe.sx` (per-key dedupe, first-wins stable). Key APL gotcha: `scalar?` is
true for ANY dict and `disclose` nils a non-array dict, so an apl-outer combiner
MUST `enclose` its event dict — apl-outer discloses it back intact. `apl-unique`
preserves first-occurrence order; dict `keys` order is NOT stable, so
`feed/audience` sorts (else recipient ordering flakes). `apl-compress` needs a
rank-1 array, so the (activity×follower) matrix is flattened to its ravel before
the edge-guard filter.
- **Phase 3 done (83/83 total).** `aggregate.sx` (group-by/count, day buckets) +
`rank.sx` (recency/velocity/engagement scorers, composite, top-N). `sort` is
single-arg ascending only — no comparator — so ranking uses a stable two-pass
`apl-grade-down` (by :at desc, then by score desc) for deterministic tie-breaks.
Dict keys must be strings, so composite group keys are string-joined ("actor#day").
- **Phase 4 done (105/105 total).** `acl.sx` (per-viewer `feed/visible`,
`feed/timeline` capstone) + `fed.sx` (merge/ingest/inbound/backfill/federate/
deliver). ACL/transport are dependency-injected (permit?/remote?/send-fn/fetch-fn)
since lib/acl + fed-sx don't exist. `feed/normalize` now MERGEs defaults over the
raw dict (was projecting to 5 keys) so extra metadata (:visible-to, peer fields)
survives — matches the "flexible bag" principle.
## Roadmap is complete (all 4 phases). Possible follow-ups: ## Blockers
- Wire real acl-sx once `lib/acl/` exists (swap injected `permit?`). (loop fills this in)
- Wire real fed-sx transport (swap `send-fn`/`fetch-fn`).
- [x] TF-IDF over `:tags` for content ranking — `content.sx`: `feed/tag-df`,
`feed/tag-idf` (log N/df), `feed/tfidf-score`, `feed/by-relevance`; 15 tests.
Composes as a scorer with rank.sx. (120/120 total.)
- [x] Notification feed (verb-filtered, per-recipient) — `notify.sx`:
`feed/notifications`, `feed/notify-verbs`, `feed/notify-digest` (collapses
"X, Y liked Z" by (verb,object), sorted-deterministic); 8 tests. (128/128 total.)
- [x] **Capstone** `feed/home` — the whole pipeline as one line: fanout ∘ inbox ∘
dedupe ∘ ACL ∘ rank ∘ take (`home.sx`); 6 tests incl. per-viewer ACL + cross-post
dedupe. (134/134 total.)
- [x] Per-verb dedupe rules (briefing gotcha #3) — `feed/dedupe-smart` /
`feed/smart-key`: reactions (like/follow/boost/...) collapse cross-actor on
(verb,object); posts stay distinct per actor. `feed/collapse-verbs` is
rebindable policy; 9 tests. (143/143 total.)
- [x] Trending — `feed/trending` / `feed/trending-actors`: objects/actors ranked
by activity count in a recency window, count-desc with key-asc tiebreak
(`trending.sx`); 11 tests. (154/154 total.)
- [x] Mute/block — `feed/mute-actors` / `feed/mute-tags` / `feed/mute-objects` /
`feed/apply-prefs`: viewer-controlled per-request filtering (complements ACL's
author-controlled visibility) (`mute.sx`); 9 tests. (163/163 total.)
- [x] Pagination — `feed/page`/`feed/page-count` (offset) + `feed/before`/
`feed/after`/`feed/page-before`/`feed/next-cursor` (cursor by :at, stable under
inserts) (`page.sx`); 14 tests. (177/177 total.)
- [x] Threading — `feed/replies`/`feed/reply-count`/`feed/thread`/
`feed/thread-objects`/`feed/thread-size`: conversation closure over `:reply-to`
(transitive fixpoint), chronological (`thread.sx`); 12 tests. (189/189 total.)
(none)
## Notes for next iteration
- sx-tree MCP tools take `file:` NOT `path:` (CLAUDE.md is stale). Wrong key →
`Yojson Type_error("Expected string, got null")`. Looks like a broken binary, isn't.
- sx_server binary lives in main repo: `/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe`
(worktree has no `_build`). conformance.sh already points there with relative fallback.
- Phase 2 substrate verified available: `apl-outer` (∘.×), `apl-member` (∊),
`apl-unique`, `apl-iota` (1-based).

View File

@@ -16,7 +16,7 @@ federation extension via fed-sx for remote-node execution.
## Status (rolling) ## Status (rolling)
`bash lib/flow/conformance.sh`**0/0** (not yet started) `bash lib/flow/conformance.sh`**166/166** (Phases 1-8 complete; host ABI + reference driver)
## Ground rules ## Ground rules
@@ -62,47 +62,167 @@ lib/flow/spec.sx lib/flow/runtime.sx lib/flow/store.sx
## Phase 1 — Declarative DAG + sequential execution ## Phase 1 — Declarative DAG + sequential execution
- [ ] `lib/flow/spec.sx``defflow` macro, `sequence` combinator - [x] `lib/flow/spec.sx``defflow` macro, `sequence` combinator
- [ ] node = Scheme thunk; output threads to next node (data flow) - [x] node = Scheme procedure of one arg (upstream value threaded in); output
- [ ] `parallel` combinator (sequential semantics for now — TRUE parallelism in Phase 3) threads to next node (data flow). A node ignoring its arg is a thunk.
- [ ] runtime executes a flow synchronously, returns final value - [x] `parallel` combinator (sequential semantics for now — TRUE parallelism in Phase 3)
- [ ] `lib/flow/api.sx``(flow/start name args)` entry point - [x] runtime executes a flow synchronously, returns final value
- [ ] `lib/flow/tests/basic.sx` — 15+ cases: linear sequence, nested sequences, - [x] `lib/flow/api.sx``(flow/start flow input)` entry point
data flow between nodes, parallel-with-join - [x] `lib/flow/tests/basic.sx` — 18 cases: single nodes, linear/nested sequence,
- [ ] `lib/flow/scoreboard.{json,md}` data flow between nodes, parallel-with-join, publish-shaped flow
- [ ] `lib/flow/conformance.sh` - [x] `lib/flow/scoreboard.{json,md}`
- [x] `lib/flow/conformance.sh`
## Phase 2 — Control flow + error handling ## Phase 2 — Control flow + error handling
- [ ] `cond` combinator — predicate selects branch - [x] `cond` combinator — predicate selects branch (named `branch`; `cond` is a
- [ ] `retry n [backoff]` — re-runs node up to n times on exception Scheme special form). `(branch pred then else)` — 6 tests.
- [ ] `timeout ms`bounds node execution - [x] `retry n`re-runs node up to n attempts on a raised exception; last
- [ ] `try-catch` — exception handler with reified error exception propagates. Only raised exceptions are retried `(fail ...)` values
- [ ] error model — exceptions vs explicit `(fail :reason ...)` results pass through. 6 tests. (Backoff deferred: no wall clock in pure SX.)
- [ ] `lib/flow/tests/control.sx` — 25+ cases: each combinator + composition - [x] `timeout budget` — bounds node execution via a **cooperative step budget**
(deterministic; no scheduler/clock in pure SX). Nodes opt in via `(tick)`;
`budget` ticks allowed, the next raises `flow-timeout`. Non-ticking nodes are
unbounded; budgets nest. 7 tests.
- [x] `try-catch` — exception handler with reified error: `(try-catch node handler)`
runs node; on raise, calls `(handler error)` and returns its value. 6 tests.
- [x] error model — exceptions vs explicit `(fail reason)` results: `fail`/`failed?`/
`fail-reason` produce/inspect failure values that flow downstream as data
(distinct from raised exceptions caught by retry/try-catch). 6 tests.
- [x] `lib/flow/tests/control.sx` — 31 cases: branch, error model, try-catch,
retry, timeout + compositions
## Phase 3 — Suspend / resume (the showcase) ## Phase 3 — Suspend / resume (the showcase)
- [ ] `(suspend reason)``call/cc` captures continuation, returns flow-id to caller - [x] `(suspend tag)` — guest call/cc is ESCAPE-ONLY (re-entry hangs), so resume
- [ ] `lib/flow/store.sx` — serialize flow state (continuation + open vars) uses **deterministic replay**: suspend escapes to the driver as `(flow-suspended
- [ ] `(flow/resume id value)` — load continuation, inject value, re-enter tag)`; resume re-runs the flow, replaying resolved suspends from a `(tag value)`
- [ ] `(flow/cancel id)` — explicit termination log. No live continuation is ever serialized — the log is plain data.
- [ ] crash recovery — on restart, scan store for paused flows, mark resumable - [x] `lib/flow/store.sx` — flow store: id→record `(flow input log status payload)`;
- [ ] `lib/flow/tests/suspend.sx` — pause-resume scenarios, cancellation, "restart" `flow-drive` runs a flow against a replay log.
scenarios (simulated by re-loading store) - [x] `(flow/resume id value)` — append `(tag value)` to the log, re-drive; raw
result on completion, `(flow-suspended id tag)` on a further suspend.
- [x] `(flow/cancel id)` — mark cancelled; a later resume is rejected (stale replay
cannot wake a cancelled flow).
- [x] crash recovery — `flow-store-export` (procs nulled → plain data),
`flow-store-import!`, `flow-resumable-ids`. Records are name-keyed; resume
re-resolves the proc by name (defflow registers names), so a flow survives a
wiped store. `tests/recovery.sx`, 8 cases (export/wipe/import, resumable scan,
restart-at-every-step, replay-log survival).
- [x] `lib/flow/tests/suspend.sx` — 17 cases: start/resume/cancel, multi-step,
replay determinism, lifecycle guards, suspend-in-branch
- Harness: `flow-run` now reuses one env with a per-test reset (building the full
standard env 66× was too slow) — see `api.sx`.
## Phase 4 — Distributed nodes via fed-sx ## Phase 4 — Distributed nodes via fed-sx
- [ ] `(remote-node addr fn args)` — execute node on a federation peer - [x] `(remote-node addr fn)` — execute a node on a federation peer. Transport is
- [ ] failure semantics — retry on different peer, fall through to local the fed-sx boundary, MOCKED via a peer registry (`flow-peer-register!`); raises
- [ ] persistence across instances — flow state replicates via fed-sx `flow-remote-unreachable` / `flow-remote-no-fn`. Composes with sequence, suspend,
- [ ] handoff — flow started here can resume on a peer if the local instance is down retry. `tests/distributed.sx`, 7 cases.
- [ ] `lib/flow/tests/distributed.sx` — federated flow scenarios (mock fed-sx in tests) - [x] failure semantics — `(remote-failover addrs fn local)` tries each peer in
order, moves to the next on any raised error, and runs the `local` node if every
peer fails. 6 tests.
- [x] persistence across instances — `(flow-replicate-to addr)` copies this
instance's store (the plain-data export) to a peer's replica slot;
`(flow-restore-from addr)` imports it. Same mechanism as crash recovery, across
instances.
- [x] handoff — a flow started here resumes on a peer after the local instance dies:
replicate → wipe local store → restore on peer → `flow/resume`. The replay log
(and thus all resolved suspends) survives the move.
- [x] `lib/flow/tests/distributed.sx` — 19 cases: remote-node, failover,
replication, handoff (including replay-log survival across the move)
## Phase 5 — Operational API + combinator library
The four roadmap phases are complete; this phase rounds out the engine into
something operators and authors actually use. Accumulation, not a rewrite.
- [x] introspection API — `flow/status id`, `flow/result id`, `flow/list`,
`flow/pending` (operator view of what each suspended flow awaits). 12 tests in
`tests/api.sx`.
- [x] store hygiene — `flow/gc` drops terminal (done/cancelled) records keeping
live suspended flows (returns count); `flow/forget id` drops one terminal record
and refuses live flows. Bounds unbounded store growth. 9 tests in `tests/hygiene.sx`.
- [x] `tap` — side-effecting pass-through node (logging/metrics) that returns input
- [x] `recover` — complement to try-catch for the fail-VALUE channel: run node; if it
yields `(fail ...)`, run a recovery node on the reason
- [x] `map-flow` — run a flow per item of a list, join results (sequential)
- [x] `flow-while` / `flow-until` — bounded iteration: re-run body threading the
value while/until pred holds, capped at `max` steps (deterministic bound)
- [x] `lib/flow/tests/api.sx` (12) + `lib/flow/tests/combinators.sx` (17)
## Phase 6 — Railway-oriented composition
Make the `(fail reason)` value channel compose into real validation/ETL pipelines.
- [x] `attempt` — like `sequence`, but short-circuits at the first node that returns
a `(fail ...)` value, returning that failure (the railway track). Pairs with
`recover` for the rejoin.
- [x] `lib/flow/tests/railway.sx` — 10 cases: fail short-circuiting, no-run-after-
failure, recover rejoin, validation pipeline reporting the failing stage
## Phase 8 — Host integration ABI (art-dag / human-in-the-loop)
`suspend` is the seam to the outside world, but a bare tag is an ad-hoc convention.
This phase defines a stable request/response contract a host (an art-dag driver, a
review UI) codes against — so flow can orchestrate art-dag with human decision
points later without reverse-engineering tag shapes. `lib/flow/host.sx`.
- [x] `(request kind payload)` — suspend with a typed `(flow-request kind payload)`
envelope; evaluates to the host's resume value. `await-human`/`await-render`/
`await-effect` sugar.
- [x] `(flow-host-requests)` — the host work queue: `(id kind payload)` for every
suspended flow waiting on a host request; `request?`/`request-kind`/
`request-payload` parse a tag.
- [x] `(flow-drive-host dispatch)` / `(flow-run-host dispatch maxticks)` — reference
host driver: the host supplies only a `(kind payload) -> answer` dispatch fn; the
loop drains pending requests and resumes until quiescent (bounded).
- [x] `lib/flow/tests/host.sx` — 15 cases incl. the art-dag-shaped driver loop
(render → human-review → publish) run both manually and via `flow-run-host`.
- Contract (documented in `host.sx` + README): the host owns IO + persistence; a
flow never does IO, it only `request`s; the host performs the effect and feeds the
result back via resume (logged, so not re-run on recovery). NOT done here (host
side, out of `lib/flow` scope): the real Celery/IPFS bridge and a persistent store
backend — those live in the art-dag integration, coding against this ABI.
## Phase 7 — End-to-end integration
Prove the phases compose: realistic flows exercising attempt + suspend + branch +
remote-node + crash-recovery + handoff + introspection together.
- [x] `lib/flow/tests/integration.sx` — 10 cases: an order-processing flow (validate
→ payment suspend → branch → ledger federation) and an onboarding flow, run through
the full lifecycle including a simulated crash and a peer handoff mid-flow, plus
introspection (`flow/pending`/`status`/`result`) during the flow's life
## Progress log ## Progress log
(loop fills this in) - **Phase 1 (combinators + sequential runtime).** Flow built as a Scheme prelude
loaded onto `scheme-standard-env`: a flow is a Scheme procedure `input -> output`,
so the whole flow runs inside the interpreter (sets up Phase 3 call/cc suspend).
Combinators `flow-node`/`flow-id`/`flow-const`/`sequence`/`parallel`/`defflow` in
`spec.sx`; `flow/start` + SX helpers (`flow-make-env`/`flow-run`) in `api.sx`.
18/18 in `tests/basic.sx`. Substrate constraints found: dotted rest params
`(a . rest)` and named `let` are unsupported in `lib/scheme/eval.sx`, so
combinators use `(lambda args ...)` variadics + top-level recursion. Scheme
strings come back boxed as `{:scm-string "..."}` — unwrap with `(get s :scm-string)`.
- **Phases 2-4.** Control flow (branch/retry/timeout/try-catch + fail-value error
model), then the showcase: durable suspend/resume. Guest call/cc is escape-only
(re-entry hangs), so resume uses **deterministic replay** — re-run the flow,
replaying resolved suspends from a `(tag value)` log; only plain data persists, so
flows survive a wiped store (crash recovery) and a move to another instance
(replication + handoff). Phase 4 models the fed-sx boundary with a mock peer
registry. Timeout is a cooperative step budget (no wall clock in pure SX). Test
harness reuses one env with a per-test reset for speed.
- **Phases 5-7 + docs.** Operational API (introspection, hygiene), combinator
library (tap/recover/map-flow/while/until), railway `attempt`, end-to-end
integration suite, and `lib/flow/README.md` (full API reference + replay-semantics
contract). **151/151 across 10 suites.** Conformance sx_server timeout raised to
540s for the 10-suite run under shared-machine CPU contention.
## Blockers ## Blockers
(loop fills this in) (none)

View File

@@ -1,100 +0,0 @@
# host-on-sx: The SX web host — off Quart, onto the kernel (Dream-bound)
> **DRAFT outline.** The integration boundary that turns the subsystem libraries
> into running services, and the strangler path off Python/Quart. This is the
> dependency hub — it imports every subsystem. Decision recorded below: native
> server + SXTP **now**, `dream-on-sx` framework layer **next**, Python only at the
> external-integration edges.
The subsystems (`feed`, `search`, `acl`, `mod`, `flow`, `commerce`, `identity`,
`content`, `events`) are libraries. Something has to receive an HTTP request, route
it, call the right subsystem, and serialize the response. Today that's Python/Quart
— the one large non-SX component in the stack: separate runtime, deploy, and
failure mode. The goal is to move the web/host/domain layer onto the SX substrate
and retire Quart, **incrementally (strangler-fig), never big-bang.**
This is already underway: a native OCaml HTTP server is live in prod on
`sx.rose-ash.com` (~3ms cached, ~323 req/s, ~2MB RSS), `defhandler`/`defpage`
exist, and a partial **SXTP** protocol is specced. That is the unblocked near-term
host — no `ocaml-on-sx` dependency.
## Two layers, two timelines
1. **Now (unblocked): native server + SXTP adapter + SX handlers.** Route rose-ash
endpoints onto the SX host one at a time. Each migrated endpoint is an SX
handler dispatching to a subsystem; Quart proxies the rest until cut over.
2. **Next: `dream-on-sx` as the framework layer.** Dream gives Quart-grade
ergonomics — typed routing, middleware stacks, sessions, CSRF. It is gated on
`ocaml-on-sx` Phases 15 + minimal stdlib. **This plan is the concrete target
user that un-parks `dream-on-sx`** (see `plans/dream-on-sx.md`): "the subsystems
need an HTTP front door" is the real feature pulling Dream. Until then, do not
block migration on Dream — the native server is sufficient.
3. **Always: Python only at the edges.** External integrations — SumUp payments,
Ghost CMS, ActivityPub crypto, IPFS/Kubo — ride Python libraries today. They
stay as thin injected adapters (Python/FFI) behind subsystem interfaces until
native replacements exist. "Drop Quart" ≠ "drop every line of Python."
## Status (rolling)
`bash lib/host/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** `lib/host/**` and `plans/host-on-sx.md`. May **import** every subsystem
+ the kernel's server/SXTP surface. Do **not** edit `spec/`, `hosts/`, `shared/`,
or subsystem internals — wire to their public APIs only. Host-primitive / server
changes belong in `hosts/` (out of scope) → Blockers.
- **Architecture:** a route maps (method, path) → handler; a handler is an SX fn
`request -> response` that calls subsystem APIs; middleware is composed handlers
(auth via `identity`, permission via `acl`, mute via subsystem prefs). SXTP is the
wire format between host and subsystem-as-service.
- **Migration discipline:** each endpoint moved must be behavior-equivalent to its
Quart original (golden-response test before flip). Keep a migration ledger.
- **Commits:** one feature per commit. Progress log + tick boxes.
## Architecture sketch
```
HTTP request HTTP response
│ ▲
▼ │
native OCaml http server (prod) ──────► lib/host/router.sx
(hosts/ — out of scope) — (method,path) → handler
│ ▲
▼ │
lib/host/middleware.sx lib/host/handler.sx
— auth(identity) ∘ acl ∘ mute ∘ ... — request → subsystem call → response
│ ▲
▼ │
lib/host/sxtp.sx subsystem APIs (feed/search/commerce/…)
— wire format, host↔service — called via public interfaces
└── external edges: SumUp / Ghost / AP / IPFS → injected Python/FFI adapters
```
## Phase 1 — Router + handler + one real endpoint
- [ ] `router.sx` — route table, (method,path) match
- [ ] `handler.sx` — request/response model, subsystem dispatch
- [ ] migrate ONE read endpoint (e.g. a feed timeline) end-to-end, golden test
- [ ] `conformance.sh` + scoreboard
## Phase 2 — Middleware + SXTP
- [ ] `middleware.sx` — composable auth/acl/mute/error layers
- [ ] `sxtp.sx` — host↔subsystem wire format (align with existing spec)
- [ ] migrate a write endpoint (auth + permission + action)
## Phase 3 — Strangler migration ledger
- [ ] enumerate Quart endpoints; track migrated vs proxied
- [ ] golden-response harness vs the live Quart responses
- [ ] cut over a whole domain (smallest: `likes` or `relations`) as proof
## Phase 4 — Dream framework layer (gated)
- [ ] gate: `ocaml-on-sx` Phases 15 + minimal stdlib green
- [ ] adopt `dream-on-sx` routing/middleware/session ergonomics over the same handlers
- [ ] re-home external adapters as native where replacements land
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

View File

@@ -1,84 +0,0 @@
# identity-on-sx: OAuth2, sessions & membership on Erlang
> **DRAFT outline.** The identity core `acl-on-sx` assumes already exists. `acl`
> answers "may X do Y"; identity answers "who is X, and how did they prove it."
> Depends on `persist-on-sx` (grant/audit ledger). Pairs with `acl-on-sx`.
rose-ash's `account` domain is the OAuth2 authorization server every other app is
a client of: silent SSO, per-app first-party cookies, grant verification,
membership. Sessions and grants are **long-lived, concurrent, individually
addressable, and expire on their own** — that is the actor model. Erlang's
processes + mailboxes map cleanly: a session is a process, token issue/refresh/
revoke are messages, expiry is a process timeout, and SSO is one process answering
many apps.
End-state: an Erlang-on-SX layer with the OAuth2 authorization-code + silent
(`prompt=none`) flows as message protocols, a session/grant registry, token
lifecycle (issue/refresh/revoke/introspect), and membership state — all auditable
through the event log, all authorization questions delegated to `acl-on-sx`.
## Status (rolling)
`bash lib/identity/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only `lib/identity/**` and `plans/identity-on-sx.md`. May **import**
from `lib/erlang/`, and (once they exist) `lib/persist/` + `lib/acl/`. Do not edit
substrates.
- **Architecture:** a session/grant is a process holding its own state; the
registry routes messages by subject/client id. Tokens are opaque + introspected,
not self-validating (revocation must be real). Authorization decisions are NOT
made here — `identity` proves identity, `acl` decides permission.
- **Security:** revocation is immediate (kill the process / tombstone the grant);
no decision relies on a token that outlived its grant. Negative answers are
explicit, never "absence of a yes."
- **Commits:** one feature per commit. Progress log + tick boxes.
## Architecture sketch
```
Auth request Token / session
(authorize client scope subject) {:access :refresh :expires :grant}
│ ▲
▼ │
lib/identity/oauth.sx lib/identity/token.sx
— authz-code + prompt=none flows — issue / refresh / revoke / introspect
— as Erlang message protocols — opaque tokens, grant-backed
│ ▲
▼ │
lib/identity/session.sx lib/identity/registry.sx
— session = process, expiry=timeout — route by subject/client; SSO fan-out
│ │
▼ ▼
lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ──┐
│ │
└──────── grant + audit events → persist ; permission? → acl ──────────┘
```
## Phase 1 — Sessions + tokens
- [ ] `session.sx` — session process, create/lookup/expire
- [ ] `token.sx` — issue/introspect/revoke (opaque, grant-backed)
- [ ] `registry.sx` — route by subject/client
- [ ] `api.sx` + tests + scoreboard + conformance.sh
## Phase 2 — OAuth2 flows
- [ ] authorization-code flow as a message protocol
- [ ] refresh + rotation; revocation cascades to issued tokens
- [ ] tests: full code exchange, refresh, revoke-then-use (must fail)
## Phase 3 — Silent SSO + membership
- [ ] `prompt=none` cross-app login (one session, many clients)
- [ ] membership state + per-app grant projection
- [ ] grant verification delegated cache (mirror Redis-cache pattern)
## Phase 4 — Audit + federation
- [ ] every issue/refresh/revoke is a `persist` event; `(identity/audit subject)`
- [ ] federated identity (peer-asserted subject) — advisory, trust-gated stub
- [ ] tests: audit completeness, cross-instance subject mapping
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

View File

@@ -1,119 +0,0 @@
# persist-on-sx: Durable state on the SX kernel
> **DRAFT outline.** Foundation subsystem — the durable substrate the other five
> currently fake with in-memory mutable lists. Build this first.
>
> **"persist" = persistence / data store, NOT the shop.** The shop/commerce vertical
> is `commerce-on-sx`.
rose-ash needs durable state: every subsystem (feed log, flow store, mod audit,
search index, acl grants, sessions) today hand-rolls an in-memory structure that
vanishes on restart. `persist-on-sx` is the one durable substrate they share. It
lives directly on the SX kernel's IO-suspension primitives (`perform`/`cek-resume`
— the third CEK phase) so a read/write `perform`s and the kernel persists at the
boundary. Concrete storage backends are injected.
## Does it cover ALL persistence? No — and on purpose.
Event-sourcing-everything is a known trap (replay cost, event schema evolution,
awkward ad-hoc queries, 5MB images in a log). So persist owns the **durable
source-of-truth substrate**, exposed as **two facets over one backend protocol**,
with two things explicitly delegated out:
| Shape | Owner | Notes |
|-------|-------|-------|
| **Event streams** (append-only, history matters) | persist — **log facet** | feed activities, mod audit, order ledger, flow state, content edits |
| **Current-state values** (KV / document, no history) | persist — **kv facet** | profiles, stock counts, config, session blobs; also where projections materialize |
| **Snapshots / read models** (derived, queryable) | persist — projections → kv/log | rebuildable from the log; persisted so you don't replay to answer a query |
| **Blobs / large objects** (images, media) | **delegated** → content-addressed store (artdag/IPFS already) | persist stores the *reference/CID*, never the bytes |
| **Cache** (ephemeral, evictable) | **out of scope** | not persistence — different lifecycle (Redis-shaped) |
| **Ad-hoc relational query** | the subsystem, over a projected read model | the log is bad at "all orders by X in March"; project into a queryable kv/SQL backend |
So: persist is the **single durable substrate** for state that's either a stream of
changes or a current value — but it does **not** force everything into an event
log, it does **not** hold blobs (only their content-addressed refs), and it does
**not** do caching. Those boundaries are the whole point of calling it a substrate
rather than "the database."
End-state: `log` (append/read streams) + `kv` (get/put/delete by key) facets, an
injectable backend protocol (mem → file → Postgres → IPFS-ref), pure projections
with incremental snapshots, optimistic concurrency, and a subscription hook so
read models (feeds, indices, audit logs) update incrementally.
## Status (rolling)
`bash lib/persist/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only `lib/persist/**` and `plans/persist-on-sx.md`. May **import** the
kernel's IO-suspension surface (`perform`, platform IO ops) — verify what's
exported first. Do not add host primitives; a missing durable IO op is a Blockers
entry (it belongs in `hosts/`, out of scope).
- **Architecture:** an event is `{:stream :seq :type :at :data}`; the log is an
ordered append-only vector; a projection is `(fold step seed events)`; a kv value
is `(get/put/delete key)`. Both facets sit on one injected backend
`{:append :read :kv-get :kv-put :snapshot-read :snapshot-write}`. The in-memory
backend is the test default; real backends wire in unchanged.
- **Determinism:** replay is pure — same log → same state, always. No clocks or
randomness inside projections; time lives on the event.
- **Blobs:** store the content-address/CID and metadata; never the bytes. The blob
backend is a separate injected dependency.
- **Commits:** one feature per commit. Progress log + tick boxes.
## Architecture sketch
```
Command / write Read model / value
(append stream type data) (project stream step seed)
(kv-put key value) (kv-get key)
│ ▲
▼ │
lib/persist/event.sx lib/persist/project.sx
— {:stream :seq :type :at :data} — fold step seed; incremental from snapshot
│ ▲
▼ │
lib/persist/log.sx lib/persist/kv.sx lib/persist/snapshot.sx
— append/read — get/put/delete — checkpoint; replay = snapshot + tail
— optimistic seq — current-state
│ │ ▲
└──────────────────┴── (perform → backend) ───┘
lib/persist/backend.sx lib/persist/api.sx
— injected protocol — (persist/append) (persist/project)
— mem | file | pg | ipfs-ref — (persist/kv-get/put) (persist/subscribe)
└── blobs → content-addressed store (artdag/IPFS), by reference only
```
## Phase 1 — Log + kv + in-memory backend
- [ ] `event.sx` — event record, stream/seq helpers
- [ ] `backend.sx` — injectable protocol + in-memory impl (log + kv)
- [ ] `log.sx``append` (optimistic seq), `read`, `read-from`
- [ ] `kv.sx``get`/`put`/`delete` current-state
- [ ] `api.sx` + tests + scoreboard + conformance.sh
## Phase 2 — Projections + subscriptions
- [ ] `project.sx``(project stream step seed)`, incremental fold
- [ ] subscription hook — projection / kv read model re-runs on append
- [ ] concurrency conflict surfaced as a real result, not a crash
## Phase 3 — Snapshots + replay
- [ ] `snapshot.sx` — checkpoint a projection; replay = snapshot + tail
- [ ] compaction policy; replay-determinism tests
## Phase 4 — Durable backends via kernel IO
- [ ] file/log backend driven through `perform` (IO-suspension boundary)
- [ ] blob backend interface (store ref/CID; bytes live in artdag/IPFS)
- [ ] crash/restart replay test (mock IO platform)
- [ ] migration notes for swapping mem → durable under a live subsystem
## Consumers (post-foundation, not in scope here)
feed/-log, flow store, mod/audit, search index, acl grants, identity sessions all
become `persist` log or kv. Track each migration in that subsystem's plan.
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

View File

@@ -1,170 +0,0 @@
# Re-implementing rose-ash on SX — migration strategy
Status: **strategy proposal** (drafted by the `radar` loop, 2026-06-07). Not a
unilateral architecture decision — a starting point for the fleet to refine. Radar's
role here is detection: the `*-on-sx` subsystems have converged into a host-agnostic
re-implementation of rose-ash's domain logic, so this doc proposes *when* and *how* to
wire them to production.
---
## 1. Premise: we are ~70% into a re-implementation already
The fleet of `lib/<x>` SX subsystems is not a set of experiments — it is rose-ash's
domain logic, re-expressed substrate-by-substrate, deliberately **host-agnostic**:
| SX subsystem (`lib/`) | rose-ash production domain |
|---|---|
| content-on-sx (CRDT docs, versioning, `page.sx` HTML render) | **blog** |
| commerce-on-sx (catalog, pricing, cart, order + refund sagas) | **market + cart + orders** |
| events-on-sx (calendar, ticketing, booking) | **events** |
| feed-on-sx (activity streams, AP-shaped, threading) | **federation** |
| identity-on-sx (OAuth2, sessions, grants, membership) | **account** |
| acl-on-sx (permissions) | cross-cutting authZ |
| relations / likes | **relations / likes** (internal) |
| persist-on-sx (log / kv / snapshot facets) | per-service Postgres layer |
| flow-on-sx (durable sagas) | order/refund/delivery workflows |
| mod-on-sx, search-on-sx | new capabilities |
**The architectural enabler:** every core was built with *injected seams*`permit?`,
`send-fn`/`fetch-fn`, `transport`, `dispatch`, `backend`. That is ports-and-adapters
(hexagonal) on purpose. Evidence from the radar backlog (`plans/abstractions.md`):
W1 (7/7 federation modules inject the fed-sx transport), W4 (content/commerce/events run
live on `persist/log`), W8 (events+commerce run sagas on `lib/flow`). **The cores do not
depend on how they're hosted, persisted, or federated.**
**Corollary that makes the whole migration tractable:** because logic is separated from
rendering and storage, we can hold the **domain logic to parity** while **freely
redesigning the presentation** — the two are different layers with different rules.
---
## 2. The gating insight: the cores are *ahead of the host*
The domain logic is mature. What is *not* yet production-grade is the **host trio** — and
that is the real critical path:
- **host-on-sx** — HTTP / request-response / session host (briefing exists; the OCaml SX
HTTP server already serves `sx.rose-ash.com`).
- **host-persist** — durable storage adapter (real disk/pg/ipfs) under `persist`'s
facets (content-addressed blob blocker recently closed).
- **fed-sx** — the real ActivityPub transport every core injects (well into m2).
> **So "when do we start?" answers itself: start when the host trio is production-grade,
> not when the cores are done — they mostly already are.** Prioritise the host loops over
> further domain features.
---
## 3. The model: duplicate → cut over → diverge (per slice)
This is the "duplicate first, then change" approach, made precise. Each domain slice goes
through three phases independently:
**Phase A — Duplicate (hold logic to parity).** Stand the SX implementation of the slice
up *in parallel*, behind the existing edge, serving no users yet. Get its **domain/data
behaviour** to match Python (see §4 on how). Presentation can start as a rough port or an
early new design — it doesn't have to match.
**Phase B — Cut over (strangler flip).** Point the edge route for that slice at the SX
host. Python stays as instant rollback. The slice is now live on SX.
**Phase C — Diverge (change freely).** With the slice live and validated, evolve the
look/feel and functionality on the SX side. The validated domain logic underneath is
untouched, so UX/feature changes can't silently corrupt data.
You never rewrite the whole platform at once; you walk slices through A→B→C, oldest tree
strangled last.
---
## 4. The two techniques, and how "we'll change things" reshapes them
### Strangler edge
The edge (Caddy) is the front door every request hits. Add routing rules so **one route
at a time** goes to the SX host while everything else still goes to Python. Properties:
the site is never half-broken; any single route flips back to Python instantly; the old
app is strangled route-by-route. (Opposite of big-bang swap, which is how these die.)
### Shadow diff — split by layer
Run the new version on real traffic in the background, discard its output, and **log how
it differs** from Python. Flip the edge only when diffs are zero/intended.
But because we *intend* to change look/feel + functionality, parity is a tool we apply
**only where we want sameness**, not a straitjacket:
| Layer | Want parity? | Oracle |
|---|---|---|
| **Domain/data** (totals, tax, permissions, what's stored, who-sees-what) | **YES — silent difference = data corruption** | shadow-diff at the *core* boundary; deterministic cores → replay real request logs through the harness and diff |
| **Presentation/UX** (HTML, layout, look, feel, flows) | **NO — this is what we're changing** | manual QA + design review; this is the Phase-C divergence |
Practical shape: shadow-diff hits the **domain core's output** (the computed order, the
visible-activity set, the permission decision) — not the rendered HTML. The deterministic,
harness-replayable cores are the single biggest advantage we have here; it's the same
parity discipline that made the A1 conformance migration safe (one reference slice, hard
parity gate, revert on mismatch).
---
## 5. Readiness gates (start the production migration when ALL hold)
1. **Host trio production-grade** — host-on-sx (HTTP/session), host-persist (durable
adapter), fed-sx (AP transport) — each conformance-green.
2. **Data-migration story exists** — a way to get existing production Postgres state into
`persist` event streams (event-source the current state, or dual-write during overlap).
This is the honest long-pole; it is *not* domain logic and nobody has built it yet.
3. **One vertical slice proven end-to-end** at data-parity in production — the reference
migration, the way the conformance loop migrated one subsystem before the rest.
---
## 6. Sequencing
1. **Host trio first** (critical path — it's behind the cores).
2. **Build the strangler edge + shadow-diff harness** as first-class tooling: edge routing
rules + a dual-run logger that diffs *core outputs* (not HTML) and stores discrepancies.
3. **First slice = lowest risk × highest readiness × cleanest data oracle.**
Recommended: **the blog read path (content-on-sx)** or **the feed read path**
— read-heavy, no money, CRDT/versioning + `page.sx` HTML already exist, and the data
oracle is clean. *Avoid cart/orders/payments first* (transactional + SumUp webhooks =
highest blast radius).
4. **Persistence-first, federation-last.** Land host-persist + migrate per-domain event
stores before any cutover. Do fed-sx federation as a *coordinated* cut near the end —
W1 shows all 7 cores light up federation together once the shared transport ships.
5. **Walk the remaining slices A→B→C**, retiring Python routes as each cuts over.
---
## 7. The honest long tail (mostly host + adapters, not cores)
The cores are pure domain logic; the production *tail* is not in them yet and is most of
the remaining real effort:
- Auth: first-party cookies / Safari-ITP, CSRF, silent SSO, grant caching.
- Cross-cutting: rate limiting, observability/metrics, error pages, caching.
- Integrations: SumUp payment + webhooks, Ghost CMS sync.
- Presentation: the actual HTMX templates + CSS (this is also where the redesign happens).
- **Live data migration** — the single biggest non-core workstream.
---
## 8. Concrete next steps
1. Treat the **host trio** as the fleet's critical path; prioritise over more domain features.
2. Stand up the **strangler edge + core-level shadow-diff harness** as a tool.
3. Prove **one slice** (blog/content read path) end-to-end in production as the reference.
4. **Spec the Postgres → persist data migration** (the long-pole nobody has started).
5. Then walk slices through duplicate → cut over → diverge, redesigning UX in Phase C.
---
## 9. Why this is low-risk despite being a platform rewrite
- It's **wiring host-agnostic cores to a host**, not rewriting domain logic from scratch.
- The **strangler edge** means the site always works and any route reverts in seconds.
- **Deterministic cores** make data-parity *mechanically checkable* (replay + diff), so
correctness isn't a matter of faith.
- **Logic/presentation separation** lets us change look/feel + functionality (Phase C)
*without* re-risking the validated domain logic.
- It's the **same discipline that just shipped A1**: one reference migration, a hard
parity gate, honest exclusions, verify-before-merge.