quox/lib/Quox/Thin/Split.idr

58 lines
1.7 KiB
Idris

module Quox.Thin.Split
import public Quox.Thin.Base
import public Quox.Thin.View
import public Quox.Thin.Eqv
import public Quox.Thin.Append
import public Quox.Thin.Cover
import Data.DPair
import Control.Relation
%default total
public export
record Chunks m n where
constructor MkChunks
{leftMask : Nat}
{rightMask : Nat}
0 left : OPE m (m + n) leftMask
0 right : OPE n (m + n) rightMask
{auto 0 isCover : Cover [left, right]}
%name Chunks chunks
export
chunks : (m, n : Nat) -> Chunks m n
chunks 0 0 = MkChunks Stop Stop
chunks 0 (S n) =
let MkChunks l r = chunks 0 n in
MkChunks (Drop l Refl) (Keep r Refl)
chunks (S m) n =
let MkChunks l r = chunks m n in
MkChunks (Keep l Refl) (Drop r Refl)
-- [todo] the masks here are just ((2 << m) - 1) << n and (2 << n) - 1
public export
record SplitAt m n1 n2 (ope : OPE m (n1 + n2) mask) where
constructor MkSplitAt
{leftMask, rightMask : Nat}
{0 leftScope, rightScope : Nat}
0 left : OPE leftScope n1 leftMask
0 right : OPE rightScope n2 rightMask
0 scopePrf : m = leftScope + rightScope
0 opePrf : ope `Eqv` (left `app'` right).snd
%name SplitAt split
export
splitAt : (n1 : Nat) -> {n2, mask : Nat} -> (0 ope : OPE m (n1 + n2) mask) ->
SplitAt m n1 n2 ope
splitAt 0 ope = MkSplitAt zero ope Refl reflexive
splitAt (S n1) ope with %syntactic (view ope)
splitAt (S n1) (Drop ope Refl) | DropV _ ope with %syntactic (splitAt n1 ope)
_ | MkSplitAt left right scopePrf opePrf =
MkSplitAt (Drop left Refl) right scopePrf (EqvDrop opePrf)
splitAt (S n1) (Keep ope Refl) | KeepV _ ope with %syntactic (splitAt n1 ope)
_ | MkSplitAt left right scopePrf opePrf =
MkSplitAt (Keep left Refl) right (cong S scopePrf) (EqvKeep opePrf)