quox/lib/Quox/Thin/Base.idr

81 lines
1.9 KiB
Idris

module Quox.Thin.Base
import Data.Fin
import Data.DPair
%default total
||| "order preserving embeddings", for recording a correspondence between a
||| smaller scope and part of a larger one. the third argument is a bitmask
||| representing this OPE, unique for a given `n`.
public export
data OPE : (m, n, mask : Nat) -> Type where
[search m n]
Stop : OPE 0 0 0
Drop : OPE m n mask -> mask' = mask + mask -> OPE m (S n) mask'
Keep : OPE m n mask -> mask' = (S (mask + mask)) -> OPE (S m) (S n) mask'
%name OPE ope
export
Show (OPE m n mask) where
showPrec d Stop = "Stop"
showPrec d (Drop ope Refl) = showCon d "Drop" $ showArg ope ++ " Refl"
showPrec d (Keep ope Refl) = showCon d "Keep" $ showArg ope ++ " Refl"
public export %inline
drop : OPE m n mask -> OPE m (S n) (mask + mask)
drop ope = Drop ope Refl
public export %inline
keep : OPE m n mask -> OPE (S m) (S n) (S (mask + mask))
keep ope = Keep ope Refl
public export
data IsStop : OPE m n mask -> Type where ItIsStop : IsStop Stop
public export
data IsDrop : OPE m n mask -> Type where ItIsDrop : IsDrop (Drop ope eq)
public export
data IsKeep : OPE m n mask -> Type where ItIsKeep : IsKeep (Keep ope eq)
export
0 zeroIsStop : (ope : OPE m 0 mask) -> IsStop ope
zeroIsStop Stop = ItIsStop
||| everything selected
public export
id : {m : Nat} -> Subset Nat (OPE m m)
id {m = 0} = Element _ Stop
id {m = S m} = Element _ $ Keep id.snd Refl
public export %inline
0 id' : OPE m m Base.id.fst
id' = id.snd
||| nothing selected
public export
zero : {m : Nat} -> OPE 0 m 0
zero {m = 0} = Stop
zero {m = S m} = Drop zero Refl
||| a single slot selected
public export
one : Fin n -> Subset Nat (OPE 1 n)
one FZ = Element _ $ keep zero
one (FS i) = Element _ $ drop (one i).snd
public export %inline
0 one' : (i : Fin n) -> OPE 1 n (one i).fst
one' i = (one i).snd
public export
record SomeOPE n where
constructor MkOPE
{mask : Nat}
0 ope : OPE m n mask