|
| 1 | +||| Stage-1 scratch: helper lemmas for buildMerkleTree correctness. |
| 2 | +||| Iterated here (no Ochrance deps) before folding into Merkle. |
| 3 | +module Ochrance.Scratch |
| 4 | + |
| 5 | +import Data.Vect |
| 6 | +import Data.Fin |
| 7 | +import Data.Fin.Split |
| 8 | +import Data.Fin.Properties |
| 9 | + |
| 10 | +%default total |
| 11 | + |
| 12 | +||| Indexing into the left half of an append: weakenN selects from xs. |
| 13 | +public export |
| 14 | +indexAppendLeft : (a : Fin m) -> (xs : Vect m e) -> (ys : Vect n e) -> |
| 15 | + index (weakenN n a) (xs ++ ys) = index a xs |
| 16 | +indexAppendLeft FZ (_ :: _) _ = Refl |
| 17 | +indexAppendLeft (FS a) (_ :: xs) ys = indexAppendLeft a xs ys |
| 18 | + |
| 19 | +||| Indexing into the right half of an append: shift selects from ys. |
| 20 | +public export |
| 21 | +indexAppendRight : {m : Nat} -> (b : Fin n) -> (xs : Vect m e) -> (ys : Vect n e) -> |
| 22 | + index (shift m b) (xs ++ ys) = index b ys |
| 23 | +indexAppendRight b [] _ = Refl |
| 24 | +indexAppendRight b (_ :: xs) ys = indexAppendRight b xs ys |
| 25 | + |
| 26 | +||| Transport cancellation: indexing a length-transported vector with the |
| 27 | +||| matching length-transported index is the same element. |
| 28 | +public export |
| 29 | +indexReplace : (eq : m = n) -> (i : Fin m) -> (v : Vect m e) -> |
| 30 | + index (replace {p = Fin} eq i) (replace {p = \x => Vect x e} eq v) = index i v |
| 31 | +indexReplace Refl _ _ = Refl |
| 32 | + |
| 33 | +||| A length transport preserves the underlying Nat of a Fin. |
| 34 | +public export |
| 35 | +finToNatReplace : (eq : m = n) -> (i : Fin m) -> |
| 36 | + finToNat (replace {p = Fin} eq i) = finToNat i |
| 37 | +finToNatReplace Refl _ = Refl |
| 38 | + |
| 39 | +||| splitAt's two halves re-append to the original (the concat half of splitAt). |
| 40 | +public export |
| 41 | +splitAtConcat : {m : Nat} -> (k : Nat) -> (xs : Vect (k + m) e) -> |
| 42 | + fst (splitAt {m} k xs) ++ snd (splitAt {m} k xs) = xs |
| 43 | +splitAtConcat Z xs = Refl |
| 44 | +splitAtConcat (S k) (x :: xs) with (splitAt {m} k xs) proof eq |
| 45 | + _ | (tk, dr) = cong (x ::) (replace {p = \z => fst z ++ snd z = xs} eq (splitAtConcat k xs)) |
0 commit comments