From 74c252192688464e10b6f6c444cb486fde5b11d9 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Jul 2026 12:03:36 +0000 Subject: [PATCH] =?UTF-8?q?sx-git=20Phase=202:=20refs=20=E2=80=94=20branch?= =?UTF-8?q?es/tags/HEAD=20over=20persist=20kv,=20CAS=20+=20reflog=20(TDD)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Ref value = {:cid} | {:symref}; atomic moves via persist/kv-cas old-value expect, create-only branches via kv-put-new; bounded symref resolution; per-ref append-only reflog on the persist log facet. 38/38, total 76/76. Co-Authored-By: Claude Fable 5 --- lib/git/conformance.sh | 3 +- lib/git/ref.sx | 197 +++++++++++++++++++++++++++++++++++++ lib/git/scoreboard.json | 7 +- lib/git/scoreboard.md | 3 +- lib/git/tests/ref.sx | 208 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 413 insertions(+), 5 deletions(-) create mode 100644 lib/git/ref.sx create mode 100644 lib/git/tests/ref.sx diff --git a/lib/git/conformance.sh b/lib/git/conformance.sh index 62057e19..5d1e39ab 100755 --- a/lib/git/conformance.sh +++ b/lib/git/conformance.sh @@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(object) +SUITES=(object ref) OUT_JSON="lib/git/scoreboard.json" OUT_MD="lib/git/scoreboard.md" @@ -33,6 +33,7 @@ run_suite() { (load "lib/persist/kv.sx") (load "lib/artdag/dag.sx") (load "lib/git/object.sx") +(load "lib/git/ref.sx") (epoch 2) (eval "(define git-test-pass 0)") (eval "(define git-test-fail 0)") diff --git a/lib/git/ref.sx b/lib/git/ref.sx new file mode 100644 index 00000000..af9105e6 --- /dev/null +++ b/lib/git/ref.sx @@ -0,0 +1,197 @@ +; lib/git/ref.sx — sx-git Phase 2: refs as name -> cid over persist kv. +; A ref value is {:cid cid} (direct) or {:symref name} (symbolic). Atomic +; update = persist/kv-cas (old-value expect); create-only = kv-put-new. +; Every direct-ref move is recorded in an append-only reflog stream +; (persist log facet), one stream per ref name. +; Requires: lib/git/object.sx (repo handle), lib/persist/kv.sx, log.sx. + +(define git/ref-key (fn (repo name) (str (get repo :prefix) "/ref/" name))) +(define + git/reflog-stream + (fn (repo name) (str (get repo :prefix) "/reflog/" name))) + +(define + git/reflog-record! + (fn + (repo name old new) + (persist/append + (get repo :db) + (git/reflog-stream repo name) + "ref-update" + 0 + {:new new :old old}))) + +; ---- raw ref values ---- +(define + git/ref-read + (fn (repo name) (persist/kv-get (get repo :db) (git/ref-key repo name)))) +(define git/symref? (fn (v) (and (dict? v) (has-key? v :symref)))) + +; direct cid or nil — does NOT follow symrefs +(define + git/ref-get + (fn + (repo name) + (let ((v (git/ref-read repo name))) (if (dict? v) (get v :cid) nil)))) + +; ---- writes ---- +(define + git/ref-set! + (fn + (repo name cid) + (let + ((old (git/ref-get repo name))) + (begin + (persist/kv-put (get repo :db) (git/ref-key repo name) {:cid cid}) + (git/reflog-record! repo name old cid) + cid)))) + +(define + git/symref-set! + (fn + (repo name target) + (begin + (persist/kv-put (get repo :db) (git/ref-key repo name) {:symref target}) + target))) + +(define + git/ref-delete! + (fn + (repo name) + (persist/kv-delete (get repo :db) (git/ref-key repo name)))) + +; ---- resolution (symref chains, bounded) ---- +(define + git/ref-resolve-n + (fn + (repo name depth) + (if + (<= depth 0) + nil + (let + ((v (git/ref-read repo name))) + (cond + ((git/symref? v) + (git/ref-resolve-n repo (get v :symref) (- depth 1))) + ((dict? v) (get v :cid)) + (else nil)))))) + +(define + git/ref-resolve + (fn (repo name) (git/ref-resolve-n repo name 10))) + +; ---- atomic update: expected old cid (nil = must not exist) ---- +(define + git/ref-cas! + (fn + (repo name expected new) + (let + ((res (persist/kv-cas (get repo :db) (git/ref-key repo name) (if (equal? expected nil) nil {:cid expected}) {:cid new}))) + (if + (and (dict? res) (has-key? res :conflict)) + {:actual (if (dict? (get res :actual)) (get (get res :actual) :cid) nil) :conflict true} + (begin (git/reflog-record! repo name expected new) new))))) + +; ---- listing ---- +(define + git/ref-names + (fn + (repo) + (let + ((pfx (str (get repo :prefix) "/ref/"))) + (artdag/sort-strings + (map + (fn (k) (substring k (string-length pfx) (string-length k))) + (filter + (fn (k) (starts-with? k pfx)) + (persist/kv-keys (get repo :db)))))))) + +(define + git/refs-under + (fn + (repo group) + (map + (fn (n) (substring n (string-length group) (string-length n))) + (filter (fn (n) (starts-with? n group)) (git/ref-names repo))))) + +; ---- branches ---- +(define git/branch-ref (fn (name) (str "heads/" name))) + +(define + git/branch-set! + (fn (repo name cid) (git/ref-set! repo (git/branch-ref name) cid))) +(define + git/branch-get + (fn (repo name) (git/ref-get repo (git/branch-ref name)))) +(define + git/branch-cas! + (fn + (repo name expected new) + (git/ref-cas! repo (git/branch-ref name) expected new))) +(define + git/branch-delete! + (fn (repo name) (git/ref-delete! repo (git/branch-ref name)))) +(define git/branches (fn (repo) (git/refs-under repo "heads/"))) + +; create-only: conflict if the branch already exists +(define + git/branch-create! + (fn + (repo name cid) + (let + ((res (persist/kv-put-new (get repo :db) (git/ref-key repo (git/branch-ref name)) {:cid cid}))) + (if + (and (dict? res) (has-key? res :conflict)) + {:actual (get (get res :actual) :cid) :conflict true} + (begin (git/reflog-record! repo (git/branch-ref name) nil cid) cid))))) + +; ---- lightweight tag refs (annotated tag objects live in the object store) ---- +(define git/tag-refname (fn (name) (str "tags/" name))) +(define + git/tag-set! + (fn (repo name cid) (git/ref-set! repo (git/tag-refname name) cid))) +(define + git/tag-get + (fn (repo name) (git/ref-get repo (git/tag-refname name)))) +(define git/tag-names (fn (repo) (git/refs-under repo "tags/"))) + +; ---- HEAD ---- +(define + git/head-set! + (fn (repo branch) (git/symref-set! repo "HEAD" (git/branch-ref branch)))) + +(define + git/head-detach! + (fn + (repo cid) + (begin + (persist/kv-put (get repo :db) (git/ref-key repo "HEAD") {:cid cid}) + cid))) + +(define git/head (fn (repo) (git/ref-resolve repo "HEAD"))) + +; branch ref name HEAD points at, or nil when detached/unset +(define + git/head-target + (fn + (repo) + (let + ((v (git/ref-read repo "HEAD"))) + (if (git/symref? v) (get v :symref) nil)))) + +(define + git/detached? + (fn + (repo) + (let + ((v (git/ref-read repo "HEAD"))) + (and (dict? v) (has-key? v :cid))))) + +; ---- reflog: oldest-first list of {:old :new} ---- +(define + git/reflog + (fn + (repo name) + (map + (fn (e) (persist/event-data e)) + (persist/read (get repo :db) (git/reflog-stream repo name))))) diff --git a/lib/git/scoreboard.json b/lib/git/scoreboard.json index 85266dc8..b9795544 100644 --- a/lib/git/scoreboard.json +++ b/lib/git/scoreboard.json @@ -1,8 +1,9 @@ { "suites": { - "object": {"pass": 38, "fail": 0} + "object": {"pass": 38, "fail": 0}, + "ref": {"pass": 38, "fail": 0} }, - "total_pass": 38, + "total_pass": 76, "total_fail": 0, - "total": 38 + "total": 76 } diff --git a/lib/git/scoreboard.md b/lib/git/scoreboard.md index a5896131..8fc27ff7 100644 --- a/lib/git/scoreboard.md +++ b/lib/git/scoreboard.md @@ -5,4 +5,5 @@ _Generated by `lib/git/conformance.sh`_ | Suite | Pass | Fail | Total | |-------|-----:|-----:|------:| | object | 38 | 0 | 38 | -| **Total** | **38** | **0** | **38** | +| ref | 38 | 0 | 38 | +| **Total** | **76** | **0** | **76** | diff --git a/lib/git/tests/ref.sx b/lib/git/tests/ref.sx new file mode 100644 index 00000000..3d42b11b --- /dev/null +++ b/lib/git/tests/ref.sx @@ -0,0 +1,208 @@ +; Phase 2 — ref: branches/tags/HEAD as name -> cid over persist kv, symbolic +; refs, CAS updates with old-value expect, reflog. + +(define grt-db (persist/mem-backend)) +(define grt (git/repo grt-db)) +(define grt-c1 (git/write-blob grt "one")) +(define grt-c2 (git/write-blob grt "two")) +(define grt-c3 (git/write-blob grt "three")) + +; ---- direct refs ---- +(git-test "ref-get on unset ref is nil" (git/ref-get grt "heads/none") nil) +(git-test + "ref-set! returns the cid" + (git/ref-set! grt "heads/main" grt-c1) + grt-c1) +(git-test "ref-get reads it back" (git/ref-get grt "heads/main") grt-c1) +(git-test + "ref-resolve on a direct ref" + (git/ref-resolve grt "heads/main") + grt-c1) +(git-test + "ref-resolve on missing ref is nil" + (git/ref-resolve grt "nope") + nil) + +; ---- symbolic refs ---- +(git-test + "symref resolves through its target" + (begin + (git/symref-set! grt "HEAD" "heads/main") + (git/ref-resolve grt "HEAD")) + grt-c1) +(git-test + "symref chain resolves" + (begin + (git/symref-set! grt "INDIRECT" "HEAD") + (git/ref-resolve grt "INDIRECT")) + grt-c1) +(git-test + "symref cycle is bounded, resolves nil" + (begin + (git/symref-set! grt "LOOPA" "LOOPB") + (git/symref-set! grt "LOOPB" "LOOPA") + (git/ref-resolve grt "LOOPA")) + nil) +(git-test "ref-get does not follow a symref" (git/ref-get grt "HEAD") nil) +(git-test + "symref? on a raw symref value" + (git/symref? (git/ref-read grt "HEAD")) + true) + +; ---- CAS ---- +(git-test + "cas create (expected nil) succeeds" + (git/ref-cas! grt "heads/dev" nil grt-c1) + grt-c1) +(git-test + "cas create conflicts when the ref exists" + (get (git/ref-cas! grt "heads/dev" nil grt-c2) :conflict) + true) +(git-test + "cas conflict reports the actual cid" + (get (git/ref-cas! grt "heads/dev" grt-c3 grt-c2) :actual) + grt-c1) +(git-test + "cas conflict leaves the ref unchanged" + (git/ref-get grt "heads/dev") + grt-c1) +(git-test + "cas with the right expected value moves the ref" + (git/ref-cas! grt "heads/dev" grt-c1 grt-c2) + grt-c2) +(git-test "cas move is visible" (git/ref-get grt "heads/dev") grt-c2) + +; ---- delete ---- +(git-test + "ref-delete! removes the ref" + (begin + (git/ref-set! grt "heads/tmp" grt-c1) + (git/ref-delete! grt "heads/tmp") + (git/ref-get grt "heads/tmp")) + nil) + +; ---- branch conveniences ---- +(git-test + "branch-create! returns the cid" + (git/branch-create! grt "feature" grt-c1) + grt-c1) +(git-test + "branch-create! conflicts on an existing branch" + (get (git/branch-create! grt "feature" grt-c2) :conflict) + true) +(git-test "branch-get" (git/branch-get grt "feature") grt-c1) +(git-test + "branch-cas! moves the branch" + (git/branch-cas! grt "feature" grt-c1 grt-c2) + grt-c2) +(git-test + "branch-set! moves unconditionally" + (git/branch-set! grt "feature" grt-c3) + grt-c3) +(git-test + "branch-delete! removes it" + (begin (git/branch-delete! grt "feature") (git/branch-get grt "feature")) + nil) + +; ---- listing ---- +(git-test + "branches are listed sorted, tags and HEAD excluded" + (let + ((db (persist/mem-backend))) + (let + ((r (git/repo db))) + (begin + (git/branch-set! r "zeta" "sx1:z") + (git/branch-set! r "alpha" "sx1:a") + (git/tag-set! r "v1" "sx1:t") + (git/head-set! r "alpha") + (= (git/branches r) (list "alpha" "zeta"))))) + true) +(git-test + "tag-names lists tag refs" + (let + ((db (persist/mem-backend))) + (let + ((r (git/repo db))) + (begin + (git/tag-set! r "v2" "sx1:t2") + (git/tag-set! r "v1" "sx1:t1") + (= (git/tag-names r) (list "v1" "v2"))))) + true) +(git-test + "tag-get reads a tag ref" + (begin (git/tag-set! grt "v1" grt-c1) (git/tag-get grt "v1")) + grt-c1) + +; ---- HEAD ---- +(git-test + "head resolves through the current branch" + (begin + (git/branch-set! grt "main" grt-c2) + (git/head-set! grt "main") + (git/head grt)) + grt-c2) +(git-test + "moving the branch moves head" + (begin (git/branch-set! grt "main" grt-c3) (git/head grt)) + grt-c3) +(git-test + "head-target names the branch ref" + (git/head-target grt) + "heads/main") +(git-test "detached? false on a symref HEAD" (git/detached? grt) false) +(git-test + "head-detach! pins a cid" + (begin (git/head-detach! grt grt-c1) (git/head grt)) + grt-c1) +(git-test "detached? true after detach" (git/detached? grt) true) +(git-test "head-target nil when detached" (git/head-target grt) nil) + +; ---- reflog ---- +(git-test + "reflog of an untouched ref is empty" + (= (git/reflog grt "heads/quiet") (list)) + true) +(git-test + "reflog records create and moves oldest-first" + (let + ((db (persist/mem-backend))) + (let + ((r (git/repo db))) + (begin + (git/ref-set! r "heads/x" "sx1:a") + (git/ref-set! r "heads/x" "sx1:b") + (git/ref-cas! r "heads/x" "sx1:b" "sx1:c") + (= (git/reflog r "heads/x") (list {:new "sx1:a" :old nil} {:new "sx1:b" :old "sx1:a"} {:new "sx1:c" :old "sx1:b"}))))) + true) +(git-test + "branch-create! writes the first reflog entry" + (let + ((db (persist/mem-backend))) + (let + ((r (git/repo db))) + (begin + (git/branch-create! r "b" "sx1:a") + (= (git/reflog r "heads/b") (list {:new "sx1:a" :old nil}))))) + true) +(git-test + "failed cas leaves no reflog entry" + (let + ((db (persist/mem-backend))) + (let + ((r (git/repo db))) + (begin + (git/ref-set! r "heads/x" "sx1:a") + (git/ref-cas! r "heads/x" "sx1:wrong" "sx1:b") + (len (git/reflog r "heads/x"))))) + 1) + +; ---- namespacing ---- +(git-test + "refs are invisible across repo namespaces" + (let + ((db (persist/mem-backend))) + (begin + (git/branch-set! (git/repo-named db "a") "main" "sx1:a") + (git/branch-get (git/repo-named db "b") "main"))) + nil)