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

sx-git extension: git-wire export adapter — byte-exact loose objects + SHA-1 (TDD)

Browse Source 
lib/git/sha1.sx: SHA-1 in pure SX over host bitwise prims (FIPS vectors +
multi-block verified). lib/git/export.sx: native objects -> git payloads
"<type> <len>\0<body>" with real git identity, golden-verified against git
CLI (hash-object/mktree/commit-tree/mktag with pinned idents): tree entry
sorting with dirs keyed "name/", raw 20-byte child shas, "40000" subtree
mode, :mode overrides, deterministic ident defaults, trailing-newline
message rule. export-closure/export-set emit a host-writable object table.
Adapter-at-the-edge: native model untouched; zlib/packfiles remain host-side
concerns. 25/25, total 252/252.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
giles
2026-07-03 12:46:54 +00:00
parent 7d3f267503
commit e228d462eb
6 changed files with 735 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

299
lib/git/sha1.sx Normal file
View File

@@ -0,0 +1,299 @@
; lib/git/sha1.sx — SHA-1 in pure SX (host bitwise prims, no deps).
; Exists ONLY for the git-wire export adapter: native sx-git identity stays
; sx1:/sha256 (object.sx); SHA-1 is what the exported byte format demands.
; Strings are treated as byte strings (char-code on 1-byte substrings).
(define git/sha1-mask 4294967295)
(define git/u32 (fn (x) (bitwise-and x git/sha1-mask)))
(define
git/rotl
(fn
(x n)
(git/u32
(bitwise-or
(arithmetic-shift x n)
(arithmetic-shift x (- n 32))))))
; ---- byte plumbing ----
(define
git/sha1-take
(fn
(xs n)
(if
(or (= n 0) (empty? xs))
(list)
(cons (first xs) (git/sha1-take (rest xs) (- n 1))))))
(define
git/sha1-drop
(fn
(xs n)
(if
(or (= n 0) (empty? xs))
xs
(git/sha1-drop (rest xs) (- n 1)))))
(define
git/sha1-sb
(fn
(s i n acc)
(if
(>= i n)
(reverse acc)
(git/sha1-sb
s
(+ i 1)
n
(cons (char-code (substring s i (+ i 1))) acc)))))
(define
git/sha1-str-bytes
(fn (s) (git/sha1-sb s 0 (string-length s) (list))))
(define
git/sha1-zeros
(fn
(k)
(if
(= k 0)
(list)
(cons 0 (git/sha1-zeros (- k 1))))))
(define
git/sha1-be8
(fn
(v)
(map
(fn
(sh)
(bitwise-and (arithmetic-shift v (- 0 sh)) 255))
(list
56
48
40
32
24
16
8
0))))
; append 0x80, zero-pad to 56 mod 64, then the 64-bit big-endian bit length
(define
git/sha1-pad
(fn
(bytes)
(let
((n (len bytes)))
(let
((zeros (remainder (+ (- 56 (remainder (+ n 1) 64)) 64) 64)))
(append
bytes
(append
(cons 128 (git/sha1-zeros zeros))
(git/sha1-be8 (* n 8))))))))
; ---- message schedule: w as an index-keyed dict ----
(define
git/sha1-w-init-go
(fn
(bs j w)
(if
(= j 16)
w
(git/sha1-w-init-go
(git/sha1-drop bs 4)
(+ j 1)
(assoc
w
(str j)
(bitwise-or
(arithmetic-shift (nth bs 0) 24)
(bitwise-or
(arithmetic-shift (nth bs 1) 16)
(bitwise-or
(arithmetic-shift (nth bs 2) 8)
(nth bs 3)))))))))
(define
git/sha1-w-expand
(fn
(w t)
(if
(= t 80)
w
(git/sha1-w-expand
(assoc
w
(str t)
(git/rotl
(bitwise-xor
(bitwise-xor
(get w (str (- t 3)))
(get w (str (- t 8))))
(bitwise-xor
(get w (str (- t 14)))
(get w (str (- t 16)))))
1))
(+ t 1)))))
; ---- rounds ----
(define
git/sha1-f
(fn
(t b c d)
(cond
((< t 20)
(bitwise-or
(bitwise-and b c)
(bitwise-and (bitwise-and (bitwise-not b) git/sha1-mask) d)))
((< t 40) (bitwise-xor (bitwise-xor b c) d))
((< t 60)
(bitwise-or
(bitwise-or (bitwise-and b c) (bitwise-and b d))
(bitwise-and c d)))
(else (bitwise-xor (bitwise-xor b c) d)))))
(define
git/sha1-k
(fn
(t)
(cond
((< t 20) 1518500249)
((< t 40) 1859775393)
((< t 60) 2400959708)
(else 3395469782))))
(define
git/sha1-rounds
(fn
(w t a b c d e)
(if
(= t 80)
(list a b c d e)
(git/sha1-rounds
w
(+ t 1)
(git/u32
(+
(+
(+ (+ (git/rotl a 5) (git/sha1-f t b c d)) e)
(git/sha1-k t))
(get w (str t))))
a
(git/rotl b 30)
c
d))))
(define
git/sha1-blocks
(fn
(bs hs)
(if
(empty? bs)
hs
(let
((w (git/sha1-w-expand (git/sha1-w-init-go (git/sha1-take bs 64) 0 {}) 16)))
(let
((r (git/sha1-rounds w 0 (nth hs 0) (nth hs 1) (nth hs 2) (nth hs 3) (nth hs 4))))
(git/sha1-blocks
(git/sha1-drop bs 64)
(list
(git/u32 (+ (nth hs 0) (nth r 0)))
(git/u32 (+ (nth hs 1) (nth r 1)))
(git/u32 (+ (nth hs 2) (nth r 2)))
(git/u32 (+ (nth hs 3) (nth r 3)))
(git/u32 (+ (nth hs 4) (nth r 4))))))))))
(define
git/sha1-words
(fn
(s)
(git/sha1-blocks
(git/sha1-pad (git/sha1-str-bytes s))
(list 1732584193 4023233417 2562383102 271733878 3285377520))))
; ---- digest forms ----
(define
git/sha1-word-bytes
(fn
(v)
(list
(bitwise-and (arithmetic-shift v -24) 255)
(bitwise-and (arithmetic-shift v -16) 255)
(bitwise-and (arithmetic-shift v -8) 255)
(bitwise-and v 255))))
(define
git/sha1-digest-bytes
(fn
(s)
(reduce
(fn (acc v) (append acc (git/sha1-word-bytes v)))
(list)
(git/sha1-words s))))
(define git/sha1-hexd "0123456789abcdef")
(define
git/sha1-byte-hex
(fn
(b)
(str
(substring
git/sha1-hexd
(quotient b 16)
(+ (quotient b 16) 1))
(substring
git/sha1-hexd
(remainder b 16)
(+ (remainder b 16) 1)))))
(define
git/sha1-hex
(fn
(s)
(reduce
(fn (acc b) (str acc (git/sha1-byte-hex b)))
""
(git/sha1-digest-bytes s))))
(define
git/sha1-raw
(fn
(s)
(list->string
(map (fn (b) (integer->char b)) (git/sha1-digest-bytes s)))))
; hex string -> raw bytes (tree entries embed 20 raw sha bytes)
(define
git/hex-digit-val
(fn
(c)
(let
((v (char-code c)))
(if (< v 58) (- v 48) (- v 87)))))
(define
git/hex->raw-go
(fn
(h i n acc)
(if
(>= i n)
(list->string (reverse acc))
(git/hex->raw-go
h
(+ i 2)
n
(cons
(integer->char
(+
(*
16
(git/hex-digit-val (substring h i (+ i 1))))
(git/hex-digit-val
(substring h (+ i 1) (+ i 2)))))
acc)))))
(define
git/hex->raw
(fn (h) (git/hex->raw-go h 0 (string-length h) (list))))