giles
989dc278c1
Textual diff3 built on the Myers scripts: non-eq regions clustered by strict base-interval overlap (same-point insert pairs cluster too); one-sided clusters apply, two-sided take shared result or emit <<<<<<</|||||||/=======/ >>>>>>> markers with base section. Per-path 3-way tree merge with blob-level auto-merge and delete/modify flagging; merge-commits handles up-to-date / fast-forward / merged / conflicts, unrelated histories merge over an empty base. (Content CvRDT not reused deliberately: its state-based LWW block semantics differ from base-anchored 3-way; the path-set merge here is the same idea applied natively.) 28/28, total 187/187. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
428 lines
10 KiB
Plaintext
428 lines
10 KiB
Plaintext
; lib/git/diff.sx — sx-git Phase 5: structural tree diff + Myers line diff.
|
|
; Tree diff = files-diff over flattened trees (path -> blob cid). Blob diff =
|
|
; Myers O(ND) shortest edit script over lines, edit script ops
|
|
; {:op "eq"|"del"|"add" :line l}, rendered as unified hunks (context 3).
|
|
; Requires: lib/git/object.sx, lib/git/worktree.sx.
|
|
|
|
; ---- lines <-> data ----
|
|
(define
|
|
git/diff-take
|
|
(fn
|
|
(xs n)
|
|
(if
|
|
(or (= n 0) (empty? xs))
|
|
(list)
|
|
(cons (first xs) (git/diff-take (rest xs) (- n 1))))))
|
|
|
|
(define
|
|
git/diff-lines
|
|
(fn
|
|
(s)
|
|
(let
|
|
((parts (split s "\n")))
|
|
(if
|
|
(and
|
|
(> (len parts) 0)
|
|
(equal? (nth parts (- (len parts) 1)) ""))
|
|
(git/diff-take parts (- (len parts) 1))
|
|
parts))))
|
|
|
|
; index-keyed dict as an O(1) vector
|
|
(define
|
|
git/dvec
|
|
(fn
|
|
(xs)
|
|
(reduce
|
|
(fn (acc p) (assoc acc (str (first p)) (nth p 1)))
|
|
{}
|
|
(map-indexed (fn (i x) (list i x)) xs))))
|
|
(define git/dget (fn (v i) (get v (str i))))
|
|
|
|
; ---- Myers forward pass ----
|
|
; v: dict k(str) -> furthest x on diagonal k. Reads of k±1 always hit the
|
|
; previous round's parity, so in-round writes never corrupt the decision.
|
|
(define
|
|
git/myers-x
|
|
(fn
|
|
(v d k)
|
|
(if
|
|
(or
|
|
(= k (- 0 d))
|
|
(and
|
|
(not (= k d))
|
|
(< (git/dget v (- k 1)) (git/dget v (+ k 1)))))
|
|
(git/dget v (+ k 1))
|
|
(+ (git/dget v (- k 1)) 1))))
|
|
|
|
(define
|
|
git/myers-snake
|
|
(fn
|
|
(av bv n m x y)
|
|
(if
|
|
(and (< x n) (< y m) (equal? (git/dget av x) (git/dget bv y)))
|
|
(git/myers-snake av bv n m (+ x 1) (+ y 1))
|
|
(list x y))))
|
|
|
|
; one round d over k = -d, -d+2, ..., d; returns (v done?)
|
|
(define
|
|
git/myers-round
|
|
(fn
|
|
(av bv n m v d k)
|
|
(if
|
|
(> k d)
|
|
(list v false)
|
|
(let
|
|
((sn (git/myers-snake av bv n m (git/myers-x v d k) (- (git/myers-x v d k) k))))
|
|
(let
|
|
((v2 (assoc v (str k) (first sn))))
|
|
(if
|
|
(and (>= (first sn) n) (>= (nth sn 1) m))
|
|
(list v2 true)
|
|
(git/myers-round av bv n m v2 d (+ k 2))))))))
|
|
|
|
; trace[d] = v entering round d; returns (trace D)
|
|
(define
|
|
git/myers-run
|
|
(fn
|
|
(av bv n m v d trace)
|
|
(let
|
|
((trace2 (append trace (list v))))
|
|
(let
|
|
((res (git/myers-round av bv n m v d (- 0 d))))
|
|
(if
|
|
(nth res 1)
|
|
(list trace2 d)
|
|
(git/myers-run av bv n m (first res) (+ d 1) trace2))))))
|
|
|
|
; ---- Myers backtrack: walk (n,m) back to (0,0), cons ops into forward order ----
|
|
(define
|
|
git/myers-diag
|
|
(fn
|
|
(av x y px py ops)
|
|
(if
|
|
(and (> x px) (> y py))
|
|
(git/myers-diag
|
|
av
|
|
(- x 1)
|
|
(- y 1)
|
|
px
|
|
py
|
|
(cons {:op "eq" :line (git/dget av (- x 1))} ops))
|
|
(list x y ops))))
|
|
|
|
(define
|
|
git/myers-back
|
|
(fn
|
|
(av bv trace d x y ops)
|
|
(if
|
|
(< d 0)
|
|
ops
|
|
(let
|
|
((v (nth trace d)))
|
|
(let
|
|
((k (- x y)))
|
|
(let
|
|
((pk (if (or (= k (- 0 d)) (and (not (= k d)) (< (git/dget v (- k 1)) (git/dget v (+ k 1))))) (+ k 1) (- k 1))))
|
|
(let
|
|
((px (git/dget v pk)))
|
|
(let
|
|
((py (- px pk)))
|
|
(let
|
|
((r (git/myers-diag av x y px py ops)))
|
|
(if
|
|
(> d 0)
|
|
(git/myers-back
|
|
av
|
|
bv
|
|
trace
|
|
(- d 1)
|
|
px
|
|
py
|
|
(if
|
|
(= (first r) px)
|
|
(cons {:op "add" :line (git/dget bv py)} (nth r 2))
|
|
(cons {:op "del" :line (git/dget av px)} (nth r 2))))
|
|
(nth r 2)))))))))))
|
|
|
|
; ---- edit script over two strings ----
|
|
(define
|
|
git/diff-script-lines
|
|
(fn
|
|
(al bl)
|
|
(let
|
|
((rt (git/myers-run (git/dvec al) (git/dvec bl) (len al) (len bl) (assoc {} "1" 0) 0 (list))))
|
|
(git/myers-back
|
|
(git/dvec al)
|
|
(git/dvec bl)
|
|
(first rt)
|
|
(nth rt 1)
|
|
(len al)
|
|
(len bl)
|
|
(list)))))
|
|
|
|
(define
|
|
git/diff-script
|
|
(fn
|
|
(a-data b-data)
|
|
(git/diff-script-lines (git/diff-lines a-data) (git/diff-lines b-data))))
|
|
|
|
; reconstruction invariants: old = eq+del lines, new = eq+add lines
|
|
(define
|
|
git/diff-changes
|
|
(fn
|
|
(script)
|
|
(len (filter (fn (o) (not (equal? (get o :op) "eq"))) script))))
|
|
(define
|
|
git/diff-old-lines
|
|
(fn
|
|
(script)
|
|
(map
|
|
(fn (o) (get o :line))
|
|
(filter (fn (o) (not (equal? (get o :op) "add"))) script))))
|
|
|
|
; ---- unified rendering ----
|
|
(define
|
|
git/diff-new-lines
|
|
(fn
|
|
(script)
|
|
(map
|
|
(fn (o) (get o :line))
|
|
(filter (fn (o) (not (equal? (get o :op) "del"))) script))))
|
|
|
|
(define
|
|
git/diff-annotate
|
|
(fn
|
|
(script)
|
|
(nth
|
|
(reduce
|
|
(fn
|
|
(acc o)
|
|
(let
|
|
((a (first acc))
|
|
(b (nth acc 1))
|
|
(out (nth acc 2)))
|
|
(cond
|
|
((equal? (get o :op) "eq")
|
|
(list
|
|
(+ a 1)
|
|
(+ b 1)
|
|
(append out (list (merge o {:a a :b b})))))
|
|
((equal? (get o :op) "del")
|
|
(list
|
|
(+ a 1)
|
|
b
|
|
(append out (list (merge o {:a a :b b})))))
|
|
(else
|
|
(list
|
|
a
|
|
(+ b 1)
|
|
(append out (list (merge o {:a a :b b}))))))))
|
|
(list 1 1 (list))
|
|
script)
|
|
2)))
|
|
|
|
(define
|
|
git/diff-change-idxs
|
|
(fn
|
|
(script)
|
|
(map
|
|
(fn (p) (first p))
|
|
(filter
|
|
(fn (p) (not (equal? (get (nth p 1) :op) "eq")))
|
|
(map-indexed (fn (i o) (list i o)) script)))))
|
|
|
|
(define
|
|
git/diff-merge-ranges
|
|
(fn
|
|
(ranges)
|
|
(reduce
|
|
(fn
|
|
(acc r)
|
|
(if
|
|
(empty? acc)
|
|
(list r)
|
|
(let
|
|
((prev (nth acc (- (len acc) 1))))
|
|
(if
|
|
(<= (first r) (+ (nth prev 1) 1))
|
|
(append
|
|
(git/diff-take acc (- (len acc) 1))
|
|
(list
|
|
(list
|
|
(first prev)
|
|
(max (nth prev 1) (nth r 1)))))
|
|
(append acc (list r))))))
|
|
(list)
|
|
ranges)))
|
|
|
|
(define
|
|
git/diff-hunk-ranges
|
|
(fn
|
|
(script ctx)
|
|
(git/diff-merge-ranges
|
|
(map
|
|
(fn
|
|
(i)
|
|
(list
|
|
(max 0 (- i ctx))
|
|
(min (- (len script) 1) (+ i ctx))))
|
|
(git/diff-change-idxs script)))))
|
|
|
|
(define
|
|
git/diff-slice
|
|
(fn
|
|
(xs from to)
|
|
(map
|
|
(fn (p) (nth p 1))
|
|
(filter
|
|
(fn (p) (and (>= (first p) from) (<= (first p) to)))
|
|
(map-indexed (fn (i x) (list i x)) xs)))))
|
|
|
|
(define
|
|
git/diff-op-char
|
|
(fn
|
|
(op)
|
|
(cond ((equal? op "eq") " ") ((equal? op "del") "-") (else "+"))))
|
|
|
|
(define
|
|
git/diff-hunk-render
|
|
(fn
|
|
(ops)
|
|
(let
|
|
((acount (len (filter (fn (o) (not (equal? (get o :op) "add"))) ops)))
|
|
(bcount
|
|
(len (filter (fn (o) (not (equal? (get o :op) "del"))) ops))))
|
|
(let
|
|
((astart (if (= acount 0) (- (get (first ops) :a) 1) (get (first ops) :a)))
|
|
(bstart
|
|
(if
|
|
(= bcount 0)
|
|
(- (get (first ops) :b) 1)
|
|
(get (first ops) :b))))
|
|
(str
|
|
"@@ -"
|
|
astart
|
|
","
|
|
acount
|
|
" +"
|
|
bstart
|
|
","
|
|
bcount
|
|
" @@\n"
|
|
(reduce
|
|
(fn
|
|
(acc o)
|
|
(str acc (git/diff-op-char (get o :op)) (get o :line) "\n"))
|
|
""
|
|
ops))))))
|
|
|
|
; ---- object-level diffs ----
|
|
(define
|
|
git/diff-unified
|
|
(fn
|
|
(a-data b-data)
|
|
(let
|
|
((ann (git/diff-annotate (git/diff-script a-data b-data))))
|
|
(reduce
|
|
(fn
|
|
(acc r)
|
|
(str
|
|
acc
|
|
(git/diff-hunk-render
|
|
(git/diff-slice ann (first r) (nth r 1)))))
|
|
""
|
|
(git/diff-hunk-ranges ann 3)))))
|
|
|
|
(define
|
|
git/blob-diff
|
|
(fn
|
|
(repo b1 b2)
|
|
(git/diff-script
|
|
(git/blob-data (git/read repo b1))
|
|
(git/blob-data (git/read repo b2)))))
|
|
|
|
(define
|
|
git/tree-diff
|
|
(fn
|
|
(repo t1 t2)
|
|
(git/files-diff (git/tree-flatten repo t1) (git/tree-flatten repo t2))))
|
|
|
|
; ---- whole-commit unified render: added, deleted, then modified paths ----
|
|
(define
|
|
git/commit-diff
|
|
(fn
|
|
(repo c1 c2)
|
|
(git/tree-diff
|
|
repo
|
|
(git/commit-tree (git/read repo c1))
|
|
(git/commit-tree (git/read repo c2)))))
|
|
|
|
(define
|
|
git/diff-path-data
|
|
(fn
|
|
(repo flat path)
|
|
(if
|
|
(has-key? flat path)
|
|
(git/blob-data (git/read repo (get flat path)))
|
|
"")))
|
|
|
|
(define
|
|
git/commit-diff-unified
|
|
(fn
|
|
(repo c1 c2)
|
|
(let
|
|
((f1 (git/tree-flatten repo (git/commit-tree (git/read repo c1))))
|
|
(f2 (git/tree-flatten repo (git/commit-tree (git/read repo c2)))))
|
|
(let
|
|
((d (git/files-diff f1 f2)))
|
|
(str
|
|
(reduce
|
|
(fn
|
|
(acc p)
|
|
(str
|
|
acc
|
|
"diff --sx a/"
|
|
p
|
|
" b/"
|
|
p
|
|
"\n--- /dev/null\n+++ b/"
|
|
p
|
|
"\n"
|
|
(git/diff-unified "" (git/diff-path-data repo f2 p))))
|
|
""
|
|
(get d :added))
|
|
(reduce
|
|
(fn
|
|
(acc p)
|
|
(str
|
|
acc
|
|
"diff --sx a/"
|
|
p
|
|
" b/"
|
|
p
|
|
"\n--- a/"
|
|
p
|
|
"\n+++ /dev/null\n"
|
|
(git/diff-unified (git/diff-path-data repo f1 p) "")))
|
|
""
|
|
(get d :deleted))
|
|
(reduce
|
|
(fn
|
|
(acc p)
|
|
(str
|
|
acc
|
|
"diff --sx a/"
|
|
p
|
|
" b/"
|
|
p
|
|
"\n--- a/"
|
|
p
|
|
"\n+++ b/"
|
|
p
|
|
"\n"
|
|
(git/diff-unified
|
|
(git/diff-path-data repo f1 p)
|
|
(git/diff-path-data repo f2 p))))
|
|
""
|
|
(get d :modified)))))))
|