; 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))))