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
53 changed files with 1896 additions and 2385 deletions

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

@@ -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)