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

Merge branch 'loops/agentic' into architecture

Browse Source
This commit is contained in:
giles
2026-07-03 15:11:19 +00:00
parent 4a9fd74239 c66ee35010
commit de9ace7056
11 changed files with 2290 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

317
lib/agentic/branch.sx Normal file
View File

@@ -0,0 +1,317 @@
; lib/agentic/branch.sx — agentic-sx Phase 2: one branch = one agent.
; spawn = branch-from-briefing: write the briefing, then a genesis "spawn"
; agent-commit whose parent is the fork point; the branch ref IS the agent.
; The commit verb snapshots a full worktree VALUE (path -> data) into a typed
; agent-commit and advances the branch by CAS — no shared index, multi-agent
; safe by construction. Branch topology = agent topology: fork points via
; git/merge-base, plus relations typed edges (sub-agent-of / reviews /
; merges) in a Datalog db carried on the space handle.
; Edge direction: (rel src dst kind) reads src=parent/actor, dst=child/object
; (root child sub-agent-of), (reviewer reviewee reviews), (into from merges).
; Session merges are always recorded as a two-parent "session-merge" commit
; (no fast-forward) so the merge itself is an agent action with metadata.
; Requires: lib/agentic/schema.sx, lib/git/*, lib/relations/* (+ datalog).
; ---- space: repo + relations db ----
(define agentic/space (fn (db name) {:repo (git/repo-named db name) :rels (relations-build-db (list))}))
(define agentic/space-repo (fn (sp) (get sp :repo)))
(define agentic/space-rels (fn (sp) (get sp :rels)))
(define agentic/branch-name (fn (agent) (str "agents/" agent)))
; ---- typed edges over relations ----
(define
agentic/relate!
(fn
(sp src dst kind)
(begin
(dl-assert! (agentic/space-rels sp) (relations-rel src dst kind))
true)))
(define
agentic/sub-agents
(fn
(sp agent)
(sort
(relations-children-of
(agentic/space-rels sp)
agent
(quote sub-agent-of)))))
(define
agentic/parent-agent
(fn
(sp agent)
(let
((ps (relations-parents-of (agentic/space-rels sp) agent (quote sub-agent-of))))
(if (= (len ps) 0) nil (nth ps 0)))))
(define
agentic/agent-tree
(fn
(sp agent)
(sort
(relations-descendants
(agentic/space-rels sp)
agent
(quote sub-agent-of)))))
(define
agentic/reviews!
(fn
(sp reviewer reviewee)
(agentic/relate! sp reviewer reviewee (quote reviews))))
(define
agentic/reviewers
(fn
(sp agent)
(sort
(relations-parents-of (agentic/space-rels sp) agent (quote reviews)))))
(define
agentic/reviewing
(fn
(sp agent)
(sort
(relations-children-of (agentic/space-rels sp) agent (quote reviews)))))
(define
agentic/merged-sessions
(fn
(sp agent)
(sort
(relations-children-of (agentic/space-rels sp) agent (quote merges)))))
(define
agentic/merged-into
(fn
(sp agent)
(sort
(relations-parents-of (agentic/space-rels sp) agent (quote merges)))))
; ---- spawn = branch-from-briefing ----
; base-cid nil => root agent over an empty tree; parent-agent nil => no edge.
; => {:agent :branch :briefing :genesis} | {:conflict true :actual cid}
(define
agentic/spawn-at!
(fn
(sp agent briefing base-cid parent-agent)
(let
((repo (agentic/space-repo sp)))
(let
((bcid (git/write repo briefing))
(tree
(if
(nil? base-cid)
(git/tree-from-files repo {})
(git/commit-tree (git/read repo base-cid))))
(parents (if (nil? base-cid) (list) (list base-cid))))
(let
((g (agentic/agent-commit tree parents "spawn" {:message (str "spawn: " (agentic/briefing-title briefing)) :agent agent :briefing bcid})))
(let
((gcid (git/write repo g)))
(let
((res (git/branch-create! repo (agentic/branch-name agent) gcid)))
(if
(and (dict? res) (has-key? res :conflict))
res
(begin
(if
(nil? parent-agent)
nil
(agentic/relate!
sp
parent-agent
agent
(quote sub-agent-of)))
{:agent agent :briefing bcid :branch (agentic/branch-name agent) :genesis gcid})))))))))
(define
agentic/spawn!
(fn (sp agent briefing) (agentic/spawn-at! sp agent briefing nil nil)))
(define
agentic/spawn-from!
(fn
(sp agent briefing parent-agent)
(let
((h (agentic/head sp parent-agent)))
(if
(nil? h)
{:agent parent-agent :error "no-such-agent"}
(agentic/spawn-at! sp agent briefing h parent-agent)))))
; ---- heads / listing ----
(define
agentic/head
(fn
(sp agent)
(git/branch-get (agentic/space-repo sp) (agentic/branch-name agent))))
(define
agentic/agents
(fn (sp) (git/refs-under (agentic/space-repo sp) "heads/agents/")))
; ---- the commit verb: snapshot + typed agent-commit + CAS advance ----
; files = the agent's FULL worktree value (path -> data). Briefing and agent
; identity propagate from the branch head. => cid | {:error ...} | {:conflict ...}
(define
agentic/commit!
(fn
(sp agent kind files meta)
(let
((repo (agentic/space-repo sp)))
(let
((head (agentic/head sp agent)))
(cond
((nil? head) {:agent agent :error "no-such-agent"})
((not (agentic/commit-kind? kind)) {:error "unknown-kind" :kind kind})
(else
(let
((tree (git/tree-from-files repo files))
(b (agentic/commit-briefing (git/read repo head))))
(let
((pm (if (nil? b) {:agent agent} {:agent agent :briefing b})))
(let
((cid (git/write repo (agentic/agent-commit tree (list head) kind (merge meta pm)))))
(let
((res (git/branch-cas! repo (agentic/branch-name agent) head cid)))
(if (and (dict? res) (has-key? res :conflict)) res cid)))))))))))
; commits authored by this agent, newest first, from its branch head
(define
agentic/session-log
(fn
(sp agent)
(let
((repo (agentic/space-repo sp)))
(let
((head (agentic/head sp agent)))
(if
(nil? head)
(list)
(filter
(fn (cid) (= (agentic/commit-agent (git/read repo cid)) agent))
(git/log repo head)))))))
; the branch's genesis spawn commit (oldest spawn authored by this agent)
(define
agentic/genesis
(fn
(sp agent)
(let
((repo (agentic/space-repo sp)))
(let
((head (agentic/head sp agent)))
(if
(nil? head)
nil
(let
((hits (filter (fn (cid) (let ((c (git/read repo cid))) (and (= (agentic/commit-kind c) "spawn") (= (agentic/commit-agent c) agent)))) (git/log repo head))))
(if (= (len hits) 0) nil (last hits))))))))
(define
agentic/briefing-of
(fn
(sp agent)
(let
((repo (agentic/space-repo sp)))
(let
((g (agentic/genesis sp agent)))
(if
(nil? g)
nil
(let
((bcid (agentic/commit-briefing (git/read repo g))))
(if (nil? bcid) nil (git/read repo bcid))))))))
; ---- topology: fork points via the DAG ----
(define
agentic/fork-point
(fn
(sp agent-a agent-b)
(let
((ha (agentic/head sp agent-a)) (hb (agentic/head sp agent-b)))
(if
(or (nil? ha) (nil? hb))
nil
(git/merge-base (agentic/space-repo sp) ha hb)))))
; ---- session merge: always an explicit two-parent session-merge commit ----
(define
agentic/merge-commit-at!
(fn
(sp into-agent from-agent ours theirs tree meta)
(let
((repo (agentic/space-repo sp)))
(let
((b (agentic/commit-briefing (git/read repo ours))))
(let
((pm (if (nil? b) {:agent into-agent :merged-agent from-agent} {:agent into-agent :briefing b :merged-agent from-agent})))
(let
((cid (git/write repo (agentic/agent-commit tree (list ours theirs) "session-merge" (merge meta pm)))))
(let
((res (git/branch-cas! repo (agentic/branch-name into-agent) ours cid)))
(if
(and (dict? res) (has-key? res :conflict))
res
(begin
(agentic/relate! sp into-agent from-agent (quote merges))
{:cid cid :result "merged"})))))))))
; => {:result "up-to-date"} | {:result "merged" :cid} |
; {:result "conflicts" :tree :conflicts (paths)} | {:error ...}
; Conflicts commit nothing — resolve with agentic/merge-resolve!.
(define
agentic/merge-session!
(fn
(sp into-agent from-agent meta)
(let
((repo (agentic/space-repo sp)))
(let
((ours (agentic/head sp into-agent))
(theirs (agentic/head sp from-agent)))
(cond
((nil? ours) {:agent into-agent :error "no-such-agent"})
((nil? theirs) {:agent from-agent :error "no-such-agent"})
(else
(let
((m (git/merge-commits repo ours theirs)))
(cond
((= (get m :result) "up-to-date") m)
((= (get m :result) "conflicts") m)
(else
(let
((tree (if (= (get m :result) "fast-forward") (git/commit-tree (git/read repo theirs)) (get m :tree))))
(agentic/merge-commit-at!
sp
into-agent
from-agent
ours
theirs
tree
meta)))))))))))
; conclude a conflicted session merge with resolved worktree files
(define
agentic/merge-resolve!
(fn
(sp into-agent from-agent files meta)
(let
((repo (agentic/space-repo sp)))
(let
((ours (agentic/head sp into-agent))
(theirs (agentic/head sp from-agent)))
(if
(or (nil? ours) (nil? theirs))
{:error "no-such-agent"}
(agentic/merge-commit-at!
sp
into-agent
from-agent
ours
theirs
(git/tree-from-files repo files)
meta))))))

191
lib/agentic/conformance.sh Executable file
View File

@@ -0,0 +1,191 @@
#!/usr/bin/env bash
# lib/agentic/conformance.sh — run agentic-sx test suites, emit scoreboard.json + scoreboard.md.
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
SUITES=(schema branch trace durable)
OUT_JSON="lib/agentic/scoreboard.json"
OUT_MD="lib/agentic/scoreboard.md"
# shared prefix: persist + artdag + datalog + sx-git + agentic schema
base_loads() {
cat << 'BASE'
(load "spec/stdlib.sx")
(load "lib/r7rs.sx")
(load "lib/persist/event.sx")
(load "lib/persist/backend.sx")
(load "lib/persist/log.sx")
(load "lib/persist/kv.sx")
(load "lib/artdag/dag.sx")
(load "lib/datalog/tokenizer.sx")
(load "lib/datalog/parser.sx")
(load "lib/datalog/unify.sx")
(load "lib/datalog/db.sx")
(load "lib/datalog/builtins.sx")
(load "lib/datalog/aggregates.sx")
(load "lib/datalog/strata.sx")
(load "lib/datalog/eval.sx")
(load "lib/datalog/api.sx")
(load "lib/datalog/magic.sx")
(load "lib/git/object.sx")
(load "lib/git/ref.sx")
(load "lib/git/dag.sx")
(load "lib/git/worktree.sx")
(load "lib/git/diff.sx")
(load "lib/git/merge.sx")
(load "lib/git/porcelain.sx")
(load "lib/agentic/schema.sx")
BASE
}
# relations stack (branch/trace suites)
relations_loads() {
cat << 'RELS'
(load "lib/relations/schema.sx")
(load "lib/relations/engine.sx")
(load "lib/relations/api.sx")
(load "lib/relations/explain.sx")
(load "lib/relations/federation.sx")
(load "lib/relations/tree.sx")
RELS
}
# scheme + flow stack (durable suite)
flow_loads() {
cat << 'FLOW'
(load "lib/guest/lex.sx")
(load "lib/guest/reflective/env.sx")
(load "lib/guest/reflective/quoting.sx")
(load "lib/scheme/parser.sx")
(load "lib/scheme/eval.sx")
(load "lib/scheme/runtime.sx")
(load "lib/flow/spec.sx")
(load "lib/flow/store.sx")
(load "lib/flow/remote.sx")
(load "lib/flow/host.sx")
(load "lib/flow/api.sx")
FLOW
}
suite_loads() {
local suite=$1
base_loads
case "$suite" in
branch)
relations_loads
echo '(load "lib/agentic/branch.sx")'
;;
trace)
relations_loads
echo '(load "lib/agentic/branch.sx")'
echo '(load "lib/agentic/trace.sx")'
;;
durable)
relations_loads
flow_loads
echo '(load "lib/agentic/branch.sx")'
echo '(load "lib/agentic/trace.sx")'
echo '(load "lib/agentic/durable.sx")'
;;
esac
}
run_suite() {
local suite=$1
local file="lib/agentic/tests/${suite}.sx"
local TMP
TMP=$(mktemp)
{
echo "(epoch 1)"
suite_loads "$suite"
echo "(epoch 2)"
echo '(eval "(define agentic-test-pass 0)")'
echo '(eval "(define agentic-test-fail 0)")'
echo '(eval "(define agentic-test-failures (list))")'
echo '(eval "(define agentic-test (fn (name got expected) (if (equal? got expected) (set! agentic-test-pass (+ agentic-test-pass 1)) (begin (set! agentic-test-fail (+ agentic-test-fail 1)) (set! agentic-test-failures (append agentic-test-failures (list (list name (inspect got) (inspect expected)))))))))")'
echo "(epoch 3)"
echo "(load \"${file}\")"
echo "(epoch 4)"
echo '(eval "(list agentic-test-pass agentic-test-fail)")'
} > "$TMP"
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 agentic-sx 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))"
} > "$OUT_JSON"
printf '}\n' >> "$OUT_JSON"
# scoreboard.md
{
printf '# agentic-sx Conformance Scoreboard\n\n'
printf '_Generated by `lib/agentic/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 ]

235
lib/agentic/durable.sx Normal file
View File

@@ -0,0 +1,235 @@
; lib/agentic/durable.sx — agentic-sx Phase 4: long agent sessions as
; DURABLE flow workflows. Deterministic replay IS the durability mechanism:
; every transition re-runs a self-contained flow program (the session's
; defflow source + flow/start + a replay of every recorded resume value),
; so the only durable state is a plain record {:flow :input :resumes ...}
; in the persist kv store — restart-safe by construction, and forking an
; agent run is literally copying the record (both replays then diverge).
; Effects are data: a suspended session exposes its suspend tag / typed
; (request kind payload) envelope to the host as plain SX values.
; Transitions also land in the agent's Phase-3 trace buffer, so the session
; history travels with the agent's next commit.
; Convention for session flows: suspend tags are quoted symbols, decision
; values are numbers/strings/lists of those (see agentic/scm-lit).
; Requires: lib/agentic/trace.sx (and its deps), lib/flow/* (+ scheme stack).
; ---- SX -> Scheme literal (numbers, strings, booleans, lists; nil = ()) ----
(define
agentic/scm-lit
(fn
(v)
(cond
((nil? v) "(list)")
((= v true) "#t")
((= v false) "#f")
((number? v) (str v))
((string? v) (str "\"" v "\""))
((list? v) (str "(list " (join " " (map agentic/scm-lit v)) ")"))
(else "(list)"))))
; ---- Scheme -> SX: unbox {:scm-string ...} recursively ----
(define
agentic/scm-out
(fn
(v)
(cond
((and (dict? v) (has-key? v :scm-string)) (get v :scm-string))
((list? v) (map agentic/scm-out v))
(else v))))
; ---- kv keys (namespaced under the repo prefix) ----
(define
agentic/session-def-key
(fn
(sp name)
(str (get (agentic/space-repo sp) :prefix) "/session-def/" name)))
(define
agentic/session-key
(fn
(sp agent)
(str (get (agentic/space-repo sp) :prefix) "/session/" agent)))
; ---- durable session flow definitions ----
(define
agentic/defsession!
(fn
(sp name scheme-src)
(begin
(persist/kv-put
(git/repo-db (agentic/space-repo sp))
(agentic/session-def-key sp name)
scheme-src)
name)))
(define
agentic/session-def
(fn
(sp name)
(persist/kv-get
(git/repo-db (agentic/space-repo sp))
(agentic/session-def-key sp name))))
(define
agentic/session-record
(fn
(sp agent)
(persist/kv-get
(git/repo-db (agentic/space-repo sp))
(agentic/session-key sp agent))))
; ---- one self-contained replay program per transition ----
; a fresh flow-run resets the flow store, so the started flow is always id 1
(define
agentic/session-program
(fn
(defs name input resumes)
(str
defs
"\n"
"(define s0 (flow/start "
name
" "
(agentic/scm-lit input)
"))\n"
(join
"\n"
(map
(fn (v) (str "(flow/resume 1 " (agentic/scm-lit v) ")"))
resumes))
"\n(list (flow/status 1) (flow/pending) (flow/result 1))")))
; replay the record, derive {:status :tag/:result}, persist record+state
(define
agentic/session-transition!
(fn
(sp agent record)
(let
((defs (agentic/session-def sp (get record :flow))))
(if
(nil? defs)
{:flow (get record :flow) :error "no-such-session-flow"}
(let
((out (flow-run (agentic/session-program defs (get record :flow) (get record :input) (get record :resumes)))))
(let
((status (agentic/scm-out (nth out 0)))
(pending (agentic/scm-out (nth out 1))))
(let
((state (cond ((= status "done") {:status "done" :result (agentic/scm-out (nth out 2))}) ((= status "suspended") {:tag (nth (nth pending 0) 1) :status "suspended"}) (else {:status status}))))
(begin
(persist/kv-put
(git/repo-db (agentic/space-repo sp))
(agentic/session-key sp agent)
(merge {:flow (get record :flow) :resumes (get record :resumes) :input (get record :input)} state))
state))))))))
; ---- lifecycle ----
(define
agentic/session-start!
(fn
(sp agent flow-name input)
(if
(nil? (agentic/head sp agent))
{:agent agent :error "no-such-agent"}
(let
((state (agentic/session-transition! sp agent {:flow flow-name :resumes (list) :input input})))
(begin
(if
(has-key? state :error)
nil
(agentic/trace! sp agent "session" (str "start " flow-name)))
state)))))
(define
agentic/session-resume!
(fn
(sp agent value)
(let
((rec (agentic/session-record sp agent)))
(cond
((nil? rec) {:agent agent :error "no-session"})
((not (= (get rec :status) "suspended")) {:agent agent :error "not-suspended"})
(else
(let
((state (agentic/session-transition! sp agent {:flow (get rec :flow) :resumes (append (get rec :resumes) (list value)) :input (get rec :input)})))
(begin
(if
(has-key? state :error)
nil
(agentic/trace!
sp
agent
"session"
(str "resume " (agentic/scm-lit value))))
state)))))))
(define
agentic/session-status
(fn
(sp agent)
(let
((r (agentic/session-record sp agent)))
(if (nil? r) "none" (get r :status)))))
(define
agentic/session-pending
(fn
(sp agent)
(let
((r (agentic/session-record sp agent)))
(if
(and (dict? r) (= (get r :status) "suspended"))
(get r :tag)
nil))))
(define
agentic/session-result
(fn
(sp agent)
(let
((r (agentic/session-record sp agent)))
(if (and (dict? r) (= (get r :status) "done")) (get r :result) nil))))
; ---- fork-an-agent-run: copy the record, replay rebuilds the run ----
; to-agent must already be spawned (branch fork) and session-free
(define
agentic/session-fork!
(fn
(sp from-agent to-agent)
(let
((rec (agentic/session-record sp from-agent)))
(cond
((nil? rec) {:agent from-agent :error "no-session"})
((nil? (agentic/head sp to-agent)) {:agent to-agent :error "no-such-agent"})
((not (nil? (agentic/session-record sp to-agent))) {:agent to-agent :error "session-exists"})
(else
(let
((state (agentic/session-transition! sp to-agent {:flow (get rec :flow) :resumes (get rec :resumes) :input (get rec :input)})))
(begin
(if
(has-key? state :error)
nil
(agentic/trace!
sp
to-agent
"session"
(str "fork " from-agent)))
state)))))))
; ---- effect-as-data helpers over (request kind payload) envelopes ----
(define
agentic/effect-request?
(fn
(tag)
(and
(list? tag)
(= (len tag) 3)
(= (nth tag 0) "flow-request"))))
(define
agentic/effect-kind
(fn (tag) (if (agentic/effect-request? tag) (nth tag 1) nil)))
(define
agentic/effect-payload
(fn (tag) (if (agentic/effect-request? tag) (nth tag 2) nil)))

160
lib/agentic/schema.sx Normal file
View File

@@ -0,0 +1,160 @@
; lib/agentic/schema.sx — agentic-sx Phase 1: the object types.
; An agentic structure IS the open-branch set of a repo: one branch = one
; agent, seeded by a briefing. All objects are plain SX dicts, typed by
; :type, content-addressed via sx-git's native CID (git/cid, git/write) —
; same store, same identity rules as blob/tree/commit/tag.
;
; Two families:
; object types — standalone: briefing, console-trace, behaviour (TAG only,
; library HELD Phase 8). :type carries the type name.
; commit kinds — agent-commit (extensible base) + subtypes spawn/finding/
; refactor/test/session-merge/decision. These ARE git
; commits (:type "commit") so the whole DAG/branch/merge
; machinery applies; the kind rides in :agent-type and
; participates in the CID like any extra commit field.
;
; Full fed-sx DefineType/SubtypeOf + federation is HELD (Phase 7) — this
; registry declares the tags and the subtype relation locally.
; Requires: lib/git/object.sx (and its persist/artdag deps).
; ---- type registry ----
(define agentic/types {:refactor {:parent "agent-commit" :kind "commit" :doc "behaviour-preserving restructure"} :console-trace {:parent nil :kind "object" :doc "console/tool output attached to a commit by cid"} :test {:parent "agent-commit" :kind "commit" :doc "adds or repairs tests"} :spawn {:parent "agent-commit" :kind "commit" :doc "genesis commit seeding an agent branch from a briefing"} :finding {:parent "agent-commit" :kind "commit" :doc "a discovered fact worth recording"} :briefing {:parent nil :kind "object" :doc "branch genesis — why an agent exists"} :decision {:parent "agent-commit" :kind "commit" :doc "records a choice and its rationale"} :session-merge {:parent "agent-commit" :kind "commit" :doc "merges another agent session's branch"} :agent-commit {:parent nil :kind "commit" :doc "extensible base for typed agent commits"} :behaviour {:parent nil :kind "object" :doc "behaviour TAG only — library HELD (Phase 8)"}})
(define
agentic/type?
(fn (name) (and (string? name) (has-key? agentic/types name))))
(define
agentic/type-info
(fn (name) (if (agentic/type? name) (get agentic/types name) nil)))
(define
agentic/type-parent
(fn
(name)
(let
((info (agentic/type-info name)))
(if (dict? info) (get info :parent) nil))))
(define
agentic/type-kind
(fn
(name)
(let
((info (agentic/type-info name)))
(if (dict? info) (get info :kind) nil))))
; reflexive + transitive subtype walk, bounded against registry cycles
(define
agentic/is-a-n?
(fn
(name ancestor depth)
(cond
((<= depth 0) false)
((not (agentic/type? name)) false)
((= name ancestor) true)
(else
(let
((p (agentic/type-parent name)))
(if
(nil? p)
false
(agentic/is-a-n? p ancestor (- depth 1))))))))
(define
agentic/is-a?
(fn (name ancestor) (agentic/is-a-n? name ancestor 10)))
; extend the registry (downstream: sx-gitea review kinds, behaviour library).
; create-only; parent must exist when given. => name | nil
(define
agentic/register-type!
(fn
(name parent kind doc)
(if
(and
(string? name)
(not (agentic/type? name))
(or (nil? parent) (agentic/type? parent)))
(begin (set! agentic/types (assoc agentic/types name {:parent parent :kind kind :doc doc})) name)
nil)))
(define
agentic/commit-kind?
(fn
(kind)
(and
(agentic/type? kind)
(= (agentic/type-kind kind) "commit")
(agentic/is-a? kind "agent-commit"))))
; all registered commit kinds (incl. the base), sorted
(define
agentic/commit-kinds
(fn
()
(sort (filter (fn (n) (agentic/commit-kind? n)) (keys agentic/types)))))
; ---- briefing — branch genesis / "why" ----
(define agentic/briefing (fn (title goal meta) (merge meta {:type "briefing" :title title :goal goal})))
(define
agentic/briefing?
(fn (obj) (and (dict? obj) (= (get obj :type) "briefing"))))
(define agentic/briefing-title (fn (obj) (get obj :title)))
(define agentic/briefing-goal (fn (obj) (get obj :goal)))
; ---- agent-commit — a git commit carrying an agentic kind ----
; kind must be a registered commit kind; :agent-type is protected, all other
; meta is open (:briefing :agent :message :behaviour-cid ... round-trip and
; participate in the CID). => commit dict | nil on unknown kind
(define
agentic/agent-commit
(fn
(tree-cid parents kind meta)
(if
(agentic/commit-kind? kind)
(git/commit tree-cid parents (merge meta {:agent-type kind}))
nil)))
(define
agentic/commit-kind
(fn (obj) (if (dict? obj) (get obj :agent-type) nil)))
(define
agentic/agent-commit?
(fn
(obj)
(and (git/commit? obj) (agentic/commit-kind? (agentic/commit-kind obj)))))
; is obj an agent-commit of (a subtype of) kind?
(define
agentic/kind-of?
(fn
(obj kind)
(and
(agentic/agent-commit? obj)
(agentic/is-a? (agentic/commit-kind obj) kind))))
(define agentic/commit-briefing (fn (obj) (get obj :briefing)))
(define agentic/commit-agent (fn (obj) (get obj :agent)))
(define agentic/commit-behaviour (fn (obj) (get obj :behaviour-cid)))
; ---- console-trace — attached to a commit by cid (binding is Phase 3) ----
(define agentic/trace-entry (fn (kind text) {:text text :kind kind}))
(define agentic/console-trace (fn (entries meta) (merge meta {:type "console-trace" :entries entries})))
(define
agentic/console-trace?
(fn (obj) (and (dict? obj) (= (get obj :type) "console-trace"))))
(define agentic/trace-entries (fn (obj) (get obj :entries)))
; ---- behaviour — TAG declared, library HELD (Phase 8) ----
(define agentic/behaviour (fn (name body meta) (merge meta {:name name :type "behaviour" :body body})))
(define
agentic/behaviour?
(fn (obj) (and (dict? obj) (= (get obj :type) "behaviour"))))

11
lib/agentic/scoreboard.json Normal file
View File

@@ -0,0 +1,11 @@
{
"suites": {
"schema": {"pass": 65, "fail": 0},
"branch": {"pass": 53, "fail": 0},
"trace": {"pass": 35, "fail": 0},
"durable": {"pass": 43, "fail": 0}
},
"total_pass": 196,
"total_fail": 0,
"total": 196
}

11
lib/agentic/scoreboard.md Normal file
View File

@@ -0,0 +1,11 @@
# agentic-sx Conformance Scoreboard
_Generated by `lib/agentic/conformance.sh`_
| Suite | Pass | Fail | Total |
|-------|-----:|-----:|------:|
| schema | 65 | 0 | 65 |
| branch | 53 | 0 | 53 |
| trace | 35 | 0 | 35 |
| durable | 43 | 0 | 43 |
| **Total** | **196** | **0** | **196** |

333
lib/agentic/tests/branch.sx Normal file
View File

@@ -0,0 +1,333 @@
; Phase 2 — branch: one branch = one agent. Fixture story: root-1 coordinates
; a refactor; lexer-1 + parser-1 spawn from its plan commit (lexer-1a nested
; under lexer-1); their sessions merge back (ff-shaped and true 3-way), then
; risky-1 collides with root-1 on plan.md and the conflict is resolved via
; merge-resolve!. Edges: sub-agent-of / reviews / merges.
(define agb-db (persist/mem-backend))
(define agb-sp (agentic/space agb-db "agentic-branch-test"))
(define agb-repo (agentic/space-repo agb-sp))
(define
agb-root-briefing
(agentic/briefing "coordinate refactor" "split parser module" {}))
(define agb-root (agentic/spawn! agb-sp "root-1" agb-root-briefing))
(agentic-test "spawn returns the agent" (get agb-root :agent) "root-1")
(agentic-test
"spawn creates the agent branch"
(contains? (git/branches agb-repo) "agents/root-1")
true)
(agentic-test
"head is the genesis"
(= (agentic/head agb-sp "root-1") (get agb-root :genesis))
true)
(agentic-test
"genesis is a spawn commit"
(agentic/commit-kind (git/read agb-repo (get agb-root :genesis)))
"spawn")
(agentic-test
"genesis records the briefing"
(agentic/commit-briefing (git/read agb-repo (get agb-root :genesis)))
(get agb-root :briefing))
(agentic-test
"briefing-of reads back the briefing"
(agentic/briefing-title (agentic/briefing-of agb-sp "root-1"))
"coordinate refactor")
(agentic-test
"root genesis has no parents"
(= (git/parents agb-repo (get agb-root :genesis)) (list))
true)
(agentic-test
"spawn is create-only"
(has-key? (agentic/spawn! agb-sp "root-1" agb-root-briefing) :conflict)
true)
(agentic-test
"agents lists the branch set"
(= (agentic/agents agb-sp) (list "root-1"))
true)
; ---- the commit verb ----
(define
agb-c1
(agentic/commit!
agb-sp
"root-1"
"decision"
(assoc {} "plan.md" "split into lexer+parser\n")
{:message "plan recorded"}))
(agentic-test "commit! returns a cid" (starts-with? agb-c1 "sx1:") true)
(agentic-test
"commit! advances the head"
(= (agentic/head agb-sp "root-1") agb-c1)
true)
(agentic-test
"commit! records the kind"
(agentic/commit-kind (git/read agb-repo agb-c1))
"decision")
(agentic-test
"briefing propagates to every commit"
(agentic/commit-briefing (git/read agb-repo agb-c1))
(get agb-root :briefing))
(agentic-test
"commit! snapshots the worktree"
(get (git/commit-files agb-repo agb-c1) "plan.md")
"split into lexer+parser\n")
(agentic-test
"unknown kind is rejected"
(get
(agentic/commit! agb-sp "root-1" "frobnicate" {} {})
:error)
"unknown-kind")
(agentic-test
"commit to unknown agent fails"
(get
(agentic/commit! agb-sp "ghost" "finding" {} {})
:error)
"no-such-agent")
(agentic-test
"session-log newest first"
(=
(agentic/session-log agb-sp "root-1")
(list agb-c1 (get agb-root :genesis)))
true)
(agentic-test
"genesis found from head"
(= (agentic/genesis agb-sp "root-1") (get agb-root :genesis))
true)
; ---- sub-agents fork at the parent head ----
(define
agb-lex-briefing
(agentic/briefing "extract lexer" "pull tokenizer into lexer.sx" {}))
(define
agb-lex
(agentic/spawn-from! agb-sp "lexer-1" agb-lex-briefing "root-1"))
(define
agb-par-briefing
(agentic/briefing "extract parser" "pull grammar into parser.sx" {}))
(define
agb-par
(agentic/spawn-from! agb-sp "parser-1" agb-par-briefing "root-1"))
(agentic-test
"spawn-from creates the sub branch"
(get agb-lex :agent)
"lexer-1")
(agentic-test
"sub genesis forks at the parent head"
(= (git/parents agb-repo (get agb-lex :genesis)) (list agb-c1))
true)
(agentic-test
"sub genesis inherits the base tree"
(get (git/commit-files agb-repo (get agb-lex :genesis)) "plan.md")
"split into lexer+parser\n")
(agentic-test
"sub-agent edges recorded"
(= (agentic/sub-agents agb-sp "root-1") (list "lexer-1" "parser-1"))
true)
(agentic-test
"parent-agent edge"
(agentic/parent-agent agb-sp "lexer-1")
"root-1")
(agentic-test
"root has no parent agent"
(agentic/parent-agent agb-sp "root-1")
nil)
(agentic-test
"spawn-from unknown parent fails"
(get (agentic/spawn-from! agb-sp "x-1" agb-lex-briefing "ghost") :error)
"no-such-agent")
(agentic-test
"agents lists all branches sorted"
(= (agentic/agents agb-sp) (list "lexer-1" "parser-1" "root-1"))
true)
(define
agb-lex2
(agentic/spawn-from!
agb-sp
"lexer-1a"
(agentic/briefing "lexer unicode" "handle utf8 in the lexer" {})
"lexer-1"))
(agentic-test
"agent-tree is transitive"
(=
(agentic/agent-tree agb-sp "root-1")
(list "lexer-1" "lexer-1a" "parser-1"))
true)
; ---- parallel session work ----
(define
agb-lc1
(agentic/commit!
agb-sp
"lexer-1"
"refactor"
(merge
(git/commit-files agb-repo (get agb-lex :genesis))
(assoc {} "lexer.sx" "(define lexer 1)\n"))
{:message "lexer extracted"}))
(define
agb-pc1
(agentic/commit!
agb-sp
"parser-1"
"refactor"
(merge
(git/commit-files agb-repo (get agb-par :genesis))
(assoc {} "parser.sx" "(define parser 1)\n"))
{:message "parser extracted"}))
(agentic-test
"fork-point of sibling agents"
(= (agentic/fork-point agb-sp "lexer-1" "parser-1") agb-c1)
true)
(agentic-test
"fork-point with itself is its head"
(= (agentic/fork-point agb-sp "lexer-1" "lexer-1") agb-lc1)
true)
(agentic-test
"fork-point with unknown agent"
(agentic/fork-point agb-sp "lexer-1" "ghost")
nil)
; ---- session merge: ff-shaped history still gets a merge commit ----
(define agb-m1 (agentic/merge-session! agb-sp "root-1" "lexer-1" {:message "absorb lexer session"}))
(agentic-test "session merge merges" (get agb-m1 :result) "merged")
(agentic-test
"merge commit has both session parents"
(= (git/parents agb-repo (get agb-m1 :cid)) (list agb-c1 agb-lc1))
true)
(agentic-test
"merge advances the into head"
(= (agentic/head agb-sp "root-1") (get agb-m1 :cid))
true)
(agentic-test
"merge commit is a session-merge"
(agentic/commit-kind (git/read agb-repo (get agb-m1 :cid)))
"session-merge")
(agentic-test
"merge names the merged agent"
(get (git/read agb-repo (get agb-m1 :cid)) :merged-agent)
"lexer-1")
(agentic-test
"merged tree carries the merged session"
(get (git/commit-files agb-repo (get agb-m1 :cid)) "lexer.sx")
"(define lexer 1)\n")
(agentic-test
"merge keeps the into briefing"
(agentic/commit-briefing (git/read agb-repo (get agb-m1 :cid)))
(get agb-root :briefing))
(agentic-test
"merges edge recorded"
(= (agentic/merged-sessions agb-sp "root-1") (list "lexer-1"))
true)
(agentic-test
"merged-into inverse"
(= (agentic/merged-into agb-sp "lexer-1") (list "root-1"))
true)
(agentic-test
"re-merge is up-to-date"
(get (agentic/merge-session! agb-sp "root-1" "lexer-1" {}) :result)
"up-to-date")
; ---- true three-way merge ----
(define agb-m2 (agentic/merge-session! agb-sp "root-1" "parser-1" {:message "absorb parser session"}))
(agentic-test "three-way session merge" (get agb-m2 :result) "merged")
(agentic-test
"three-way tree unions the sessions"
(get (git/commit-files agb-repo (get agb-m2 :cid)) "parser.sx")
"(define parser 1)\n")
(agentic-test
"three-way tree keeps ours side"
(get (git/commit-files agb-repo (get agb-m2 :cid)) "lexer.sx")
"(define lexer 1)\n")
; ---- conflicting sessions ----
(define
agb-risk
(agentic/spawn-from!
agb-sp
"risky-1"
(agentic/briefing "rewrite plan" "contentious plan edit" {})
"root-1"))
(define agb-risk-files (git/commit-files agb-repo (get agb-risk :genesis)))
(define
agb-rc1
(agentic/commit!
agb-sp
"risky-1"
"decision"
(merge agb-risk-files (assoc {} "plan.md" "risky rewrite\n"))
{:message "risky plan"}))
(define
agb-rootc2
(agentic/commit!
agb-sp
"root-1"
"decision"
(merge agb-risk-files (assoc {} "plan.md" "steady as she goes\n"))
{:message "root plan"}))
(define agb-mc (agentic/merge-session! agb-sp "root-1" "risky-1" {:message "risky merge"}))
(agentic-test
"conflicting sessions surface conflicts"
(get agb-mc :result)
"conflicts")
(agentic-test
"conflict paths name the file"
(= (get agb-mc :conflicts) (list "plan.md"))
true)
(agentic-test
"conflicted merge commits nothing"
(= (agentic/head agb-sp "root-1") agb-rootc2)
true)
(define
agb-res
(agentic/merge-resolve!
agb-sp
"root-1"
"risky-1"
(merge
agb-risk-files
(assoc {} "plan.md" "steady, with one risky idea\n"))
{:message "negotiated"}))
(agentic-test
"merge-resolve! concludes the merge"
(get agb-res :result)
"merged")
(agentic-test
"resolution advances the head"
(= (agentic/head agb-sp "root-1") (get agb-res :cid))
true)
(agentic-test
"resolution has both parents"
(= (git/parents agb-repo (get agb-res :cid)) (list agb-rootc2 agb-rc1))
true)
(agentic-test
"resolved content wins"
(get (git/commit-files agb-repo (get agb-res :cid)) "plan.md")
"steady, with one risky idea\n")
; ---- reviews + edge isolation ----
(agentic/reviews! agb-sp "parser-1" "lexer-1")
(agentic-test
"reviewers edge"
(= (agentic/reviewers agb-sp "lexer-1") (list "parser-1"))
true)
(agentic-test
"reviewing inverse"
(= (agentic/reviewing agb-sp "parser-1") (list "lexer-1"))
true)
(agentic-test
"edge kinds are isolated"
(= (agentic/sub-agents agb-sp "parser-1") (list))
true)

281
lib/agentic/tests/durable.sx Normal file
View File

@@ -0,0 +1,281 @@
; Phase 4 — durable: agent sessions as durable flow workflows. Fixture story:
; worker-1 runs the two-suspend "triage" flow to completion; worker-1b proves
; restart-safety (fresh space handles over the same backend, resume across
; the restart); worker-2's mid-flight run is FORKED to worker-2b and the two
; replays diverge; worker-3 exercises typed (request kind payload) effects
; and the trace-buffer composition with Phase 3.
; NOTE: numbers computed inside the guest are compared with = (numeric
; equality), not equal? — guest numerics box differently at the boundary.
(define agd-db (persist/mem-backend))
(define agd-sp (agentic/space agd-db "agentic-durable-test"))
(define
agd-a
(agentic/spawn!
agd-sp
"worker-1"
(agentic/briefing "long task" "run a durable session" {})))
(define
agd-b
(agentic/spawn-from!
agd-sp
"worker-1b"
(agentic/briefing "second worker" "restart survivor" {})
"worker-1"))
(agentic/defsession!
agd-sp
"triage"
"(defflow triage (sequence (lambda (x) (+ x (suspend (quote ask-priority)))) (lambda (y) (* y (suspend (quote ask-factor))))))")
; ---- literals across the guest boundary ----
(agentic-test "scm-lit numbers" (agentic/scm-lit 42) "42")
(agentic-test "scm-lit strings" (agentic/scm-lit "hi") "\"hi\"")
(agentic-test
"scm-lit lists nest"
(agentic/scm-lit (list 1 "a"))
"(list 1 \"a\")")
(agentic-test
"scm-out unboxes scheme strings"
(agentic/scm-out {:scm-string "x"})
"x")
; ---- lifecycle: start / suspend / resume / done ----
(agentic-test
"session flow source is durable"
(starts-with? (agentic/session-def agd-sp "triage") "(defflow")
true)
(agentic-test
"no session before start"
(agentic/session-status agd-sp "worker-1")
"none")
(define agd-s1 (agentic/session-start! agd-sp "worker-1" "triage" 10))
(agentic-test
"start suspends at the first effect"
(get agd-s1 :status)
"suspended")
(agentic-test "the suspend tag is data" (get agd-s1 :tag) "ask-priority")
(agentic-test
"session-status tracks the suspension"
(agentic/session-status agd-sp "worker-1")
"suspended")
(agentic-test
"session-pending exposes the tag"
(agentic/session-pending agd-sp "worker-1")
"ask-priority")
(agentic-test
"start on unknown agent fails"
(get (agentic/session-start! agd-sp "ghost" "triage" 1) :error)
"no-such-agent")
(agentic-test
"start with unknown flow fails"
(get
(agentic/session-start! agd-sp "worker-1b" "frobnicate" 1)
:error)
"no-such-session-flow")
(agentic-test
"a failed start leaves no session"
(agentic/session-status agd-sp "worker-1b")
"none")
(define agd-s2 (agentic/session-resume! agd-sp "worker-1" 5))
(agentic-test
"resume replays to the next effect"
(get agd-s2 :tag)
"ask-factor")
(agentic-test
"resume on session-less agent fails"
(get (agentic/session-resume! agd-sp "worker-1b" 1) :error)
"no-session")
(define agd-s3 (agentic/session-resume! agd-sp "worker-1" 3))
(agentic-test
"final resume completes the session"
(get agd-s3 :status)
"done")
(agentic-test
"deterministic replay computes the result"
(= (get agd-s3 :result) 45)
true)
(agentic-test
"session-status done"
(agentic/session-status agd-sp "worker-1")
"done")
(agentic-test
"session-result reads back"
(= (agentic/session-result agd-sp "worker-1") 45)
true)
(agentic-test
"resume after done fails"
(get (agentic/session-resume! agd-sp "worker-1" 9) :error)
"not-suspended")
(agentic-test
"the record keeps the full replay history"
(=
(get (agentic/session-record agd-sp "worker-1") :resumes)
(list 5 3))
true)
; ---- restart: a fresh space handle over the same backend ----
(define agd-sp2 (agentic/space agd-db "agentic-durable-test"))
(agentic-test
"restart sees the finished session"
(agentic/session-status agd-sp2 "worker-1")
"done")
(agentic-test
"restart sees the result"
(= (agentic/session-result agd-sp2 "worker-1") 45)
true)
(define
agd-s4
(agentic/session-start! agd-sp "worker-1b" "triage" 100))
(define agd-sp3 (agentic/space agd-db "agentic-durable-test"))
(agentic-test
"restart mid-flight stays suspended"
(agentic/session-status agd-sp3 "worker-1b")
"suspended")
(agentic-test
"resume across the restart replays deterministically"
(get (agentic/session-resume! agd-sp3 "worker-1b" 2) :tag)
"ask-factor")
(agentic-test
"the resumed run completes across the restart"
(=
(get (agentic/session-resume! agd-sp3 "worker-1b" 7) :result)
714)
true)
; ---- fork-an-agent-run: copy the record, replays diverge ----
(define
agd-w2
(agentic/spawn!
agd-sp
"worker-2"
(agentic/briefing "explore" "mainline run" {})))
(define
agd-w2b
(agentic/spawn-from!
agd-sp
"worker-2b"
(agentic/briefing "explore alt" "forked run" {})
"worker-2"))
(define agd-f0 (agentic/session-start! agd-sp "worker-2" "triage" 10))
(define agd-f1 (agentic/session-resume! agd-sp "worker-2" 5))
(define agd-fork (agentic/session-fork! agd-sp "worker-2" "worker-2b"))
(agentic-test
"fork replays to the same suspended state"
(get agd-fork :tag)
"ask-factor")
(agentic-test
"forked session is live"
(agentic/session-status agd-sp "worker-2b")
"suspended")
(agentic-test
"forked history is copied"
(=
(get (agentic/session-record agd-sp "worker-2b") :resumes)
(list 5))
true)
(agentic-test
"mainline resumes its own way"
(=
(get (agentic/session-resume! agd-sp "worker-2" 3) :result)
45)
true)
(agentic-test
"fork diverges independently"
(=
(get (agentic/session-resume! agd-sp "worker-2b" 100) :result)
1500)
true)
(agentic-test
"the fork's divergence never touches the mainline"
(= (agentic/session-result agd-sp "worker-2") 45)
true)
(agentic-test
"fork needs an existing session"
(get (agentic/session-fork! agd-sp "worker-1x" "worker-2b") :error)
"no-session")
(agentic-test
"fork target must be spawned"
(get (agentic/session-fork! agd-sp "worker-2" "ghost") :error)
"no-such-agent")
(agentic-test
"fork refuses to clobber a session"
(get (agentic/session-fork! agd-sp "worker-2" "worker-2b") :error)
"session-exists")
; ---- typed effects: (request kind payload) envelopes as data ----
(agentic/defsession!
agd-sp
"review-loop"
"(defflow review-loop (sequence (lambda (x) (await-human (list (quote approve?) x))) (branch (lambda (d) (eq? d 1)) (flow-const (quote shipped)) (flow-const (quote parked)))))")
(define
agd-w3
(agentic/spawn!
agd-sp
"worker-3"
(agentic/briefing "ship it" "review then ship" {})))
(define
agd-r1
(agentic/session-start! agd-sp "worker-3" "review-loop" 7))
(agentic-test
"request effects are typed envelopes"
(agentic/effect-request? (get agd-r1 :tag))
true)
(agentic-test "effect kind" (agentic/effect-kind (get agd-r1 :tag)) "human")
(agentic-test
"effect payload"
(=
(agentic/effect-payload (get agd-r1 :tag))
(list "approve?" 7))
true)
(agentic-test
"plain tags are not request envelopes"
(agentic/effect-request? "ask-priority")
false)
(agentic-test
"the human decision resumes the session"
(get (agentic/session-resume! agd-sp "worker-3" 1) :result)
"shipped")
; ---- composition with Phase 3: transitions ride the trace buffer ----
(agentic-test
"session transitions land in the trace buffer"
(len
(filter
(fn (e) (= (get e :kind) "session"))
(agentic/trace-pending agd-sp "worker-3")))
2)
(define
agd-c
(agentic/commit-with-trace!
agd-sp
"worker-3"
"decision"
(assoc {} "ship.md" "approved\n")
{:message "shipped"}))
(agentic-test
"the session history travels with the commit"
(len (agentic/trace-entries (agentic/trace-for agd-sp (get agd-c :cid))))
2)
(agentic-test
"the bound trace records the session start"
(get
(nth
(agentic/trace-entries (agentic/trace-for agd-sp (get agd-c :cid)))
0)
:text)
"start review-loop")

326
lib/agentic/tests/schema.sx Normal file
View File

@@ -0,0 +1,326 @@
; Phase 1 — schema: agentic object types as content-addressed typed objects
; over the sx-git store. Fixture: one repo, one briefing, a spawn genesis
; commit + a finding child (both real git commits), a console trace bound to
; the genesis by cid, a behaviour tag object. Reused as the assertion target.
(define ag-fix-db (persist/mem-backend))
(define ag-fix-repo (git/repo-named ag-fix-db "agentic-test"))
(define
ag-fix-briefing
(agentic/briefing "harden parser" "find tokenizer edge cases" {:author "giles"}))
(define ag-fix-briefing-cid (git/write ag-fix-repo ag-fix-briefing))
(define
ag-fix-tree-cid
(git/tree-from-files ag-fix-repo (assoc {} "notes.md" "start\n")))
(define
ag-fix-genesis
(agentic/agent-commit ag-fix-tree-cid (list) "spawn" {:message "genesis" :agent "agent-1" :briefing ag-fix-briefing-cid}))
(define ag-fix-genesis-cid (git/write ag-fix-repo ag-fix-genesis))
(define
ag-fix-finding
(agentic/agent-commit
ag-fix-tree-cid
(list ag-fix-genesis-cid)
"finding"
{:message "found tokenizer bug" :behaviour-cid "sx1:beefbeef" :agent "agent-1" :briefing ag-fix-briefing-cid}))
(define ag-fix-finding-cid (git/write ag-fix-repo ag-fix-finding))
(define
ag-fix-trace
(agentic/console-trace
(list
(agentic/trace-entry "console" "$ run tests")
(agentic/trace-entry "tool" "sx_eval (+ 1 2)"))
{:commit ag-fix-genesis-cid}))
(define ag-fix-trace-cid (git/write ag-fix-repo ag-fix-trace))
(define
ag-fix-behaviour
(agentic/behaviour "tdd-loop" "(red green refactor)" {}))
; ---- type registry ----
(agentic-test "briefing is a registered type" (agentic/type? "briefing") true)
(agentic-test
"console-trace is a registered type"
(agentic/type? "console-trace")
true)
(agentic-test "behaviour TAG is registered" (agentic/type? "behaviour") true)
(agentic-test
"agent-commit base is registered"
(agentic/type? "agent-commit")
true)
(agentic-test
"all commit subtypes registered"
(every?
(fn (n) (agentic/type? n))
(list "spawn" "finding" "refactor" "test" "session-merge" "decision"))
true)
(agentic-test
"unknown type is not registered"
(agentic/type? "frobnicate")
false)
(agentic-test "type? is nil-safe" (agentic/type? nil) false)
(agentic-test
"finding's parent is agent-commit"
(agentic/type-parent "finding")
"agent-commit")
(agentic-test
"agent-commit has no parent"
(agentic/type-parent "agent-commit")
nil)
(agentic-test
"is-a? walks subtype to base"
(agentic/is-a? "finding" "agent-commit")
true)
(agentic-test "is-a? is reflexive" (agentic/is-a? "finding" "finding") true)
(agentic-test
"is-a? rejects unrelated types"
(agentic/is-a? "finding" "briefing")
false)
(agentic-test
"object types are not commit kinds"
(agentic/is-a? "briefing" "agent-commit")
false)
(agentic-test
"commit-kind? on a subtype"
(agentic/commit-kind? "decision")
true)
(agentic-test
"commit-kind? rejects object types"
(agentic/commit-kind? "briefing")
false)
(agentic-test
"commit-kinds sorted"
(=
(agentic/commit-kinds)
(list
"agent-commit"
"decision"
"finding"
"refactor"
"session-merge"
"spawn"
"test"))
true)
(agentic-test
"register-type! extends the registry"
(begin
(agentic/register-type!
"review"
"agent-commit"
"commit"
"review of another session")
(agentic/type? "review"))
true)
(agentic-test
"registered subtype is-a agent-commit"
(agentic/is-a? "review" "agent-commit")
true)
(agentic-test
"register-type! is create-only"
(agentic/register-type! "finding" "agent-commit" "commit" "dup")
nil)
(agentic-test
"register-type! requires an existing parent"
(agentic/register-type! "orphan" "no-such-base" "commit" "x")
nil)
; ---- briefing ----
(agentic-test "briefing is typed" (get ag-fix-briefing :type) "briefing")
(agentic-test
"briefing? true on briefing"
(agentic/briefing? ag-fix-briefing)
true)
(agentic-test
"briefing? false on commit"
(agentic/briefing? ag-fix-genesis)
false)
(agentic-test
"briefing title accessor"
(agentic/briefing-title ag-fix-briefing)
"harden parser")
(agentic-test
"briefing goal accessor"
(agentic/briefing-goal ag-fix-briefing)
"find tokenizer edge cases")
(agentic-test
"briefing open meta round-trips"
(get ag-fix-briefing :author)
"giles")
(agentic-test
"briefing protected keys win over meta"
(agentic/briefing-title (agentic/briefing "real" "g" {:type "hack" :title "fake"}))
"real")
(agentic-test
"briefing cid is deterministic"
(=
ag-fix-briefing-cid
(git/cid
(agentic/briefing "harden parser" "find tokenizer edge cases" {:author "giles"})))
true)
(agentic-test
"briefing cid differs by goal"
(=
ag-fix-briefing-cid
(git/cid (agentic/briefing "harden parser" "other goal" {:author "giles"})))
false)
(agentic-test
"briefing cid carries the native scheme"
(starts-with? ag-fix-briefing-cid "sx1:")
true)
(agentic-test
"briefing round-trips through the store"
(agentic/briefing? (git/read ag-fix-repo ag-fix-briefing-cid))
true)
(agentic-test
"stored briefing title survives"
(agentic/briefing-title (git/read ag-fix-repo ag-fix-briefing-cid))
"harden parser")
(agentic-test
"git/object-type sees the briefing type"
(git/object-type (git/read ag-fix-repo ag-fix-briefing-cid))
"briefing")
; ---- agent-commit ----
(agentic-test
"agent-commit IS a git commit"
(git/commit? ag-fix-genesis)
true)
(agentic-test
"agent-commit? true on agent commit"
(agentic/agent-commit? ag-fix-genesis)
true)
(agentic-test
"agent-commit? false on plain git commit"
(agentic/agent-commit? (git/commit ag-fix-tree-cid (list) {:message "plain"}))
false)
(agentic-test
"agent-commit? false on briefing"
(agentic/agent-commit? ag-fix-briefing)
false)
(agentic-test
"commit-kind reads the subtype"
(agentic/commit-kind ag-fix-genesis)
"spawn")
(agentic-test
"kind-of? walks to the base"
(agentic/kind-of? ag-fix-finding "agent-commit")
true)
(agentic-test
"kind-of? exact kind"
(agentic/kind-of? ag-fix-finding "finding")
true)
(agentic-test
"kind-of? rejects a sibling kind"
(agentic/kind-of? ag-fix-finding "refactor")
false)
(agentic-test
"unknown kind is rejected"
(agentic/agent-commit ag-fix-tree-cid (list) "frobnicate" {})
nil)
(agentic-test
"object type rejected as commit kind"
(agentic/agent-commit ag-fix-tree-cid (list) "briefing" {})
nil)
(agentic-test
"commit-briefing links the genesis briefing"
(agentic/commit-briefing ag-fix-finding)
ag-fix-briefing-cid)
(agentic-test
"linked briefing reads back as a briefing"
(agentic/briefing?
(git/read ag-fix-repo (agentic/commit-briefing ag-fix-finding)))
true)
(agentic-test
"commit-agent accessor"
(agentic/commit-agent ag-fix-finding)
"agent-1")
(agentic-test
"behaviour-cid rides an agent-commit"
(agentic/commit-behaviour ag-fix-finding)
"sx1:beefbeef")
(agentic-test
"agentic fields participate in the cid"
(=
ag-fix-genesis-cid
(git/cid (git/commit ag-fix-tree-cid (list) {:message "genesis"})))
false)
(agentic-test
"stored agent-commit round-trips its kind"
(agentic/commit-kind (git/read ag-fix-repo ag-fix-genesis-cid))
"spawn")
(agentic-test
"git message accessor still applies"
(git/commit-message ag-fix-finding)
"found tokenizer bug")
(agentic-test
"agent-commit participates in the DAG"
(= (git/parents ag-fix-repo ag-fix-finding-cid) (list ag-fix-genesis-cid))
true)
(agentic-test
"log walks agent commits newest first"
(=
(git/log ag-fix-repo ag-fix-finding-cid)
(list ag-fix-finding-cid ag-fix-genesis-cid))
true)
; ---- console-trace ----
(agentic-test "trace is typed" (get ag-fix-trace :type) "console-trace")
(agentic-test
"console-trace? true on trace"
(agentic/console-trace? ag-fix-trace)
true)
(agentic-test
"console-trace? false on briefing"
(agentic/console-trace? ag-fix-briefing)
false)
(agentic-test
"trace holds its entries"
(len (agentic/trace-entries ag-fix-trace))
2)
(agentic-test
"trace entry kind"
(get (nth (agentic/trace-entries ag-fix-trace) 0) :kind)
"console")
(agentic-test
"trace entry text"
(get (nth (agentic/trace-entries ag-fix-trace) 1) :text)
"sx_eval (+ 1 2)")
(agentic-test
"trace names its commit by cid"
(get ag-fix-trace :commit)
ag-fix-genesis-cid)
(agentic-test
"trace cid is deterministic"
(=
ag-fix-trace-cid
(git/cid
(agentic/console-trace
(list
(agentic/trace-entry "console" "$ run tests")
(agentic/trace-entry "tool" "sx_eval (+ 1 2)"))
{:commit ag-fix-genesis-cid})))
true)
(agentic-test
"trace round-trips through the store"
(agentic/console-trace? (git/read ag-fix-repo ag-fix-trace-cid))
true)
; ---- behaviour (TAG only — library HELD Phase 8) ----
(agentic-test "behaviour is typed" (get ag-fix-behaviour :type) "behaviour")
(agentic-test
"behaviour? true on behaviour"
(agentic/behaviour? ag-fix-behaviour)
true)
(agentic-test
"behaviour tag is an object type"
(agentic/type-kind "behaviour")
"object")
(agentic-test
"behaviour is content-addressable"
(starts-with? (git/cid ag-fix-behaviour) "sx1:")
true)

289
lib/agentic/tests/trace.sx Normal file
View File

@@ -0,0 +1,289 @@
; Phase 3 — trace: console output as attached content-addressed objects.
; Fixture story: tracer-1 logs console/tool entries and commits with traces
; (drain-at-commit granularity); quiet-1 stays silent and gets a manual
; genesis trace attached + rebound; a failed commit keeps the buffer; a
; plain commit! deliberately leaves the buffer alone (agent-chosen binding).
(define agt-db (persist/mem-backend))
(define agt-sp (agentic/space agt-db "agentic-trace-test"))
(define agt-repo (agentic/space-repo agt-sp))
(define
agt-a
(agentic/spawn!
agt-sp
"tracer-1"
(agentic/briefing "trace things" "exercise the trace layer" {})))
(define
agt-b
(agentic/spawn!
agt-sp
"quiet-1"
(agentic/briefing "stay quiet" "no console output" {})))
(agentic-test
"fresh agent has an empty buffer"
(= (agentic/trace-pending agt-sp "tracer-1") (list))
true)
(agentic-test
"trace! appends to the buffer"
(agentic/trace! agt-sp "tracer-1" "console" "$ compiling")
true)
(agentic/trace! agt-sp "tracer-1" "tool" "sx_eval (+ 1 2)")
(agentic-test
"pending sees logged entries"
(len (agentic/trace-pending agt-sp "tracer-1"))
2)
(agentic-test
"pending preserves log order"
(get (nth (agentic/trace-pending agt-sp "tracer-1") 0) :text)
"$ compiling")
(agentic-test
"buffers are per agent"
(= (agentic/trace-pending agt-sp "quiet-1") (list))
true)
; ---- commit drains the buffer into an attached trace ----
(define
agt-c1
(agentic/commit-with-trace!
agt-sp
"tracer-1"
"finding"
(assoc {} "notes.md" "found it\n")
{:message "first finding"}))
(agentic-test
"commit-with-trace! commits"
(starts-with? (get agt-c1 :cid) "sx1:")
true)
(agentic-test
"commit-with-trace! attaches a trace"
(starts-with? (get agt-c1 :trace) "sx1:")
true)
(agentic-test
"commit advances the head"
(= (agentic/head agt-sp "tracer-1") (get agt-c1 :cid))
true)
(agentic-test
"trace-for finds the bound trace"
(agentic/console-trace? (agentic/trace-for agt-sp (get agt-c1 :cid)))
true)
(agentic-test
"bound trace carries the entries"
(len (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c1 :cid))))
2)
(agentic-test
"bound trace keeps entry order"
(get
(nth
(agentic/trace-entries (agentic/trace-for agt-sp (get agt-c1 :cid)))
0)
:text)
"$ compiling")
(agentic-test
"trace names its commit by cid"
(get (agentic/trace-for agt-sp (get agt-c1 :cid)) :commit)
(get agt-c1 :cid))
(agentic-test
"trace names its agent"
(get (agentic/trace-for agt-sp (get agt-c1 :cid)) :agent)
"tracer-1")
(agentic-test
"trace is NOT in the commit tree"
(=
(git/tree-names
(git/read
agt-repo
(git/commit-tree (git/read agt-repo (get agt-c1 :cid)))))
(list "notes.md"))
true)
(agentic-test
"buffer drained after commit"
(= (agentic/trace-pending agt-sp "tracer-1") (list))
true)
; ---- granularity = the commit: only entries since the last drain travel ----
(agentic/trace! agt-sp "tracer-1" "console" "$ second round")
(define
agt-c2
(agentic/commit-with-trace!
agt-sp
"tracer-1"
"refactor"
(assoc {} "notes.md" "refined\n")
{:message "second"}))
(agentic-test
"next trace carries only new entries"
(len (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c2 :cid))))
1)
(agentic-test
"next trace text"
(get
(nth
(agentic/trace-entries (agentic/trace-for agt-sp (get agt-c2 :cid)))
0)
:text)
"$ second round")
(agentic-test
"earlier trace is unchanged"
(len (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c1 :cid))))
2)
; ---- a silent commit binds nothing ----
(define
agt-c3
(agentic/commit-with-trace!
agt-sp
"tracer-1"
"decision"
(assoc {} "notes.md" "done\n")
{:message "silent"}))
(agentic-test "silent commit has no trace key" (has-key? agt-c3 :trace) false)
(agentic-test
"silent commit still commits"
(= (agentic/head agt-sp "tracer-1") (get agt-c3 :cid))
true)
(agentic-test
"trace-for nil on a traceless commit"
(agentic/trace-for agt-sp (get agt-c3 :cid))
nil)
; ---- attachment is external to the object layer ----
(agentic-test
"attached commit round-trips to the same cid"
(= (git/cid (git/read agt-repo (get agt-c1 :cid))) (get agt-c1 :cid))
true)
(agentic-test
"trace object is content-addressed"
(=
(get agt-c1 :trace)
(git/cid
(agentic/console-trace
(list
(agentic/trace-entry "console" "$ compiling")
(agentic/trace-entry "tool" "sx_eval (+ 1 2)"))
{:agent "tracer-1" :commit (get agt-c1 :cid)})))
true)
(define
agt-manual
(agentic/attach-trace!
agt-sp
(get agt-b :genesis)
(agentic/console-trace
(list (agentic/trace-entry "console" "spawn log"))
{:commit (get agt-b :genesis)})))
(agentic-test
"manual attach to any commit"
(starts-with? agt-manual "sx1:")
true)
(agentic-test
"manual attachment is found"
(= (agentic/trace-cid-for agt-sp (get agt-b :genesis)) agt-manual)
true)
(agentic-test
"attach validates the object type"
(get
(agentic/attach-trace!
agt-sp
(get agt-b :genesis)
(agentic/briefing "x" "y" {}))
:error)
"not-a-console-trace")
(define
agt-manual2
(agentic/attach-trace!
agt-sp
(get agt-b :genesis)
(agentic/console-trace
(list (agentic/trace-entry "console" "amended log"))
{:commit (get agt-b :genesis)})))
(agentic-test
"re-attach rebinds the note ref"
(= (agentic/trace-cid-for agt-sp (get agt-b :genesis)) agt-manual2)
true)
(agentic-test
"rebinding keeps the old object in the store"
(agentic/console-trace? (git/read agt-repo agt-manual))
true)
; ---- session-wide view ----
(agentic-test
"session-traces pairs commits with traces, newest first"
(=
(agentic/session-traces agt-sp "tracer-1")
(list
(list (get agt-c2 :cid) (get agt-c2 :trace))
(list (get agt-c1 :cid) (get agt-c1 :trace))))
true)
(agentic-test
"session-traces sees manual genesis attachments"
(=
(agentic/session-traces agt-sp "quiet-1")
(list (list (get agt-b :genesis) agt-manual2)))
true)
; ---- failed commits keep the buffer ----
(agentic/trace! agt-sp "tracer-1" "console" "$ doomed")
(define
agt-bad
(agentic/commit-with-trace!
agt-sp
"tracer-1"
"frobnicate"
{}
{}))
(agentic-test
"failed commit passes the error through"
(get agt-bad :error)
"unknown-kind")
(agentic-test
"failed commit keeps the buffer"
(len (agentic/trace-pending agt-sp "tracer-1"))
1)
(define
agt-c4
(agentic/commit-with-trace!
agt-sp
"tracer-1"
"test"
(assoc {} "notes.md" "recovered\n")
{:message "recover"}))
(agentic-test
"kept entries travel with the next commit"
(get
(nth
(agentic/trace-entries (agentic/trace-for agt-sp (get agt-c4 :cid)))
0)
:text)
"$ doomed")
; ---- binding is agent-chosen: plain commit! leaves the buffer alone ----
(agentic/trace! agt-sp "tracer-1" "console" "$ held back")
(define
agt-c5
(agentic/commit!
agt-sp
"tracer-1"
"decision"
(assoc {} "notes.md" "plain\n")
{:message "plain"}))
(agentic-test
"plain commit! binds nothing"
(agentic/trace-for agt-sp agt-c5)
nil)
(agentic-test
"plain commit! leaves the buffer"
(len (agentic/trace-pending agt-sp "tracer-1"))
1)

136
lib/agentic/trace.sx Normal file
View File

@@ -0,0 +1,136 @@
; lib/agentic/trace.sx — agentic-sx Phase 3: console traces as ATTACHED
; content-addressed objects. An agent's console/tool output accumulates in a
; per-agent append-only persist log stream; the commit verb drains everything
; since the last commit into a console-trace object and binds it to the new
; commit git-note style: ref "notes/trace/<commit-cid>" -> trace cid. The
; trace is NOT in the commit's tree — attaching never changes the commit cid,
; and the note is a re-bindable ref layer over immutable objects.
; Granularity = the commit, agent-chosen: whatever was logged since the last
; drain travels with the next commit.
; Requires: lib/agentic/branch.sx (and its deps).
; ---- buffer stream + drain cursor (namespaced under the repo prefix) ----
(define
agentic/trace-stream
(fn
(sp agent)
(str (get (agentic/space-repo sp) :prefix) "/trace/" agent)))
(define
agentic/trace-cursor-key
(fn
(sp agent)
(str (get (agentic/space-repo sp) :prefix) "/trace-cursor/" agent)))
; append one console/tool entry to the agent's buffer => true
(define
agentic/trace!
(fn
(sp agent kind text)
(begin
(persist/append
(git/repo-db (agentic/space-repo sp))
(agentic/trace-stream sp agent)
"trace-entry"
0
(agentic/trace-entry kind text))
true)))
; entries logged since the last drain, oldest first
(define
agentic/trace-pending
(fn
(sp agent)
(let
((db (git/repo-db (agentic/space-repo sp))))
(let
((cur (persist/kv-get db (agentic/trace-cursor-key sp agent))))
(map
(fn (e) (persist/event-data e))
(persist/read-from
db
(agentic/trace-stream sp agent)
(+ (if (nil? cur) 0 cur) 1)))))))
; advance the drain cursor to the stream's high-water mark
(define
agentic/trace-mark!
(fn
(sp agent)
(let
((db (git/repo-db (agentic/space-repo sp))))
(begin
(persist/kv-put
db
(agentic/trace-cursor-key sp agent)
(persist/last-seq db (agentic/trace-stream sp agent)))
true))))
; ---- git-note-style binding: commit cid -> trace cid ----
(define
agentic/trace-note-ref
(fn (commit-cid) (str "notes/trace/" commit-cid)))
; write the trace object and bind it to the commit => trace cid | {:error}
(define
agentic/attach-trace!
(fn
(sp commit-cid trace-obj)
(let
((repo (agentic/space-repo sp)))
(if
(not (agentic/console-trace? trace-obj))
{:error "not-a-console-trace"}
(let
((tcid (git/write repo trace-obj)))
(begin
(git/ref-set! repo (agentic/trace-note-ref commit-cid) tcid)
tcid))))))
(define
agentic/trace-cid-for
(fn
(sp commit-cid)
(git/ref-get (agentic/space-repo sp) (agentic/trace-note-ref commit-cid))))
(define
agentic/trace-for
(fn
(sp commit-cid)
(let
((tcid (agentic/trace-cid-for sp commit-cid)))
(if (nil? tcid) nil (git/read (agentic/space-repo sp) tcid)))))
; ---- the commit verb with trace binding ----
; commit! then drain the buffer into an attached console-trace.
; => {:cid cid :trace tcid} | {:cid cid} when nothing was logged
; | commit!'s {:error ...}/{:conflict ...} passthrough (buffer kept)
(define
agentic/commit-with-trace!
(fn
(sp agent kind files meta)
(let
((cid (agentic/commit! sp agent kind files meta)))
(if
(dict? cid)
cid
(let
((entries (agentic/trace-pending sp agent)))
(if
(= (len entries) 0)
{:cid cid}
(let
((tcid (agentic/attach-trace! sp cid (agentic/console-trace entries {:agent agent :commit cid}))))
(begin (agentic/trace-mark! sp agent) {:trace tcid :cid cid}))))))))
; (commit-cid trace-cid) pairs for the agent's session, newest first,
; commits without a bound trace omitted
(define
agentic/session-traces
(fn
(sp agent)
(filter
(fn (p) (not (nil? (nth p 1))))
(map
(fn (cid) (list cid (agentic/trace-cid-for sp cid)))
(agentic/session-log sp agent)))))