agentic-sx Phase 1: schema — typed agentic objects over sx-git store (TDD)
Type registry (briefing / console-trace / behaviour TAG / agent-commit + spawn/finding/refactor/test/session-merge/decision subtypes) with reflexive transitive is-a? and create-only register-type!. Agent commits ARE git commits (:agent-type rides as an open field, participates in the CID, DAG machinery applies unchanged). 65/65. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
191
lib/agentic/conformance.sh
Executable file
191
lib/agentic/conformance.sh
Executable 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)
|
||||||
|
|
||||||
|
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 ]
|
||||||
160
lib/agentic/schema.sx
Normal file
160
lib/agentic/schema.sx
Normal 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"))))
|
||||||
8
lib/agentic/scoreboard.json
Normal file
8
lib/agentic/scoreboard.json
Normal file
@@ -0,0 +1,8 @@
|
|||||||
|
{
|
||||||
|
"suites": {
|
||||||
|
"schema": {"pass": 65, "fail": 0}
|
||||||
|
},
|
||||||
|
"total_pass": 65,
|
||||||
|
"total_fail": 0,
|
||||||
|
"total": 65
|
||||||
|
}
|
||||||
8
lib/agentic/scoreboard.md
Normal file
8
lib/agentic/scoreboard.md
Normal file
@@ -0,0 +1,8 @@
|
|||||||
|
# agentic-sx Conformance Scoreboard
|
||||||
|
|
||||||
|
_Generated by `lib/agentic/conformance.sh`_
|
||||||
|
|
||||||
|
| Suite | Pass | Fail | Total |
|
||||||
|
|-------|-----:|-----:|------:|
|
||||||
|
| schema | 65 | 0 | 65 |
|
||||||
|
| **Total** | **65** | **0** | **65** |
|
||||||
326
lib/agentic/tests/schema.sx
Normal file
326
lib/agentic/tests/schema.sx
Normal 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)
|
||||||
Reference in New Issue
Block a user