60 lines
2.0 KiB
Idris
60 lines
2.0 KiB
Idris
module Quox.Thin.Comp
|
|
|
|
import public Quox.Thin.Base
|
|
import public Quox.Thin.View
|
|
import Data.Singleton
|
|
|
|
%default total
|
|
|
|
||| inductive definition of OPE composition
|
|
public export
|
|
data Comp : (l : OPE n p mask1) -> (r : OPE m n mask2) ->
|
|
(res : OPE m p mask3) -> Type where
|
|
[search l r]
|
|
StopZ : Comp Stop Stop Stop
|
|
DropZ : Comp a b c -> Comp (Drop a Refl) b (Drop c Refl)
|
|
KeepZ : Comp a b c -> Comp (Keep a Refl) (Keep b Refl) (Keep c Refl)
|
|
KDZ : Comp a b c -> Comp (Keep a Refl) (Drop b Refl) (Drop c Refl)
|
|
|
|
public export
|
|
record CompResult (ope1 : OPE n p mask1) (ope2 : OPE m n mask2) where
|
|
constructor MkComp
|
|
{mask : Nat}
|
|
{0 ope : OPE m p mask}
|
|
0 comp : Comp ope1 ope2 ope
|
|
%name CompResult comp
|
|
|
|
||| compose two OPEs, if the middle scope size is already known at runtime
|
|
export
|
|
comp' : {n, p, mask1, mask2 : Nat} ->
|
|
(0 ope1 : OPE n p mask1) -> (0 ope2 : OPE m n mask2) ->
|
|
CompResult ope1 ope2
|
|
comp' ope1 ope2 with %syntactic (view ope1) | (view ope2)
|
|
comp' Stop Stop | StopV | StopV =
|
|
MkComp StopZ
|
|
comp' (Drop ope1 Refl) ope2 | DropV _ ope1 | _ =
|
|
MkComp $ DropZ (comp' ope1 ope2).comp
|
|
comp' (Keep ope1 Refl) (Drop ope2 Refl) | KeepV _ ope1 | DropV _ ope2 =
|
|
MkComp $ KDZ (comp' ope1 ope2).comp
|
|
comp' (Keep ope1 Refl) (Keep ope2 Refl) | KeepV _ ope1 | KeepV _ ope2 =
|
|
MkComp $ KeepZ (comp' ope1 ope2).comp
|
|
|
|
||| compose two OPEs, after recomputing the middle scope size using `appOpe`
|
|
export
|
|
comp : {p, mask1, mask2 : Nat} ->
|
|
(0 ope1 : OPE n p mask1) -> (0 ope2 : OPE m n mask2) ->
|
|
CompResult ope1 ope2
|
|
comp ope1 ope2 = let Val n = appOpe p ope1 in comp' ope1 ope2
|
|
|
|
-- [todo] is there a quick way to compute the mask of comp?
|
|
|
|
export
|
|
0 (.) : (ope1 : OPE n p mask1) -> (ope2 : OPE m n mask2) ->
|
|
OPE m p (comp ope1 ope2).mask
|
|
ope1 . ope2 = (comp ope1 ope2).ope
|
|
|
|
-- export
|
|
-- 0 compMask : (ope1 : OPE n p mask1) -> (ope2 : OPE m n mask2) ->
|
|
-- (ope3 : OPE m p mask3) -> Comp ope1 ope2 ope3 ->
|
|
-- mask3 = ?aaa
|