Skip to content

Commit 03ce34f

Browse files
claudehyperpolymath
authored andcommitted
proof(merkle): Stage 1 helper lemmas (index / splitAt / transport)
Reusable, total Vect/Fin lemmas underpinning buildMerkleTree correctness: indexAppendLeft, indexAppendRight, indexReplace (transport cancellation), finToNatReplace, splitAtConcat. idris2 0.8.0 --check green. The buildGetLeaf assembly that consumes them is in progress. https://claude.ai/code/session_011z2t8zAxfcCNLJzU7YdpBQ
1 parent f271f7a commit 03ce34f

1 file changed

Lines changed: 45 additions & 0 deletions

File tree

ochrance-core/Ochrance/Scratch.idr

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
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

Comments
 (0)