81 lines
1.9 KiB
Idris
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
|