mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-21 02:31:50 +03:00
48 lines
2.3 KiB
Idris
48 lines
2.3 KiB
Idris
|
||| N-ary congruence for reasoning
|
||
|
|
module Data.Telescope.Congruence
|
||
|
|
|
||
|
|
import Data.Telescope.Telescope
|
||
|
|
import Data.Telescope.Segment
|
||
|
|
import Data.Telescope.SimpleFun
|
||
|
|
import Data.Telescope.Fun
|
||
|
|
|
||
|
|
public export
|
||
|
|
congType : (delta : Segment n gamma)
|
||
|
|
-> (env1 : Left.Environment gamma) -> (sy1 : SimpleFun env1 delta Type) -> (lhs : Fun env1 delta sy1)
|
||
|
|
-> (env2 : Left.Environment gamma) -> (sy2 : SimpleFun env2 delta Type) -> (rhs : Fun env2 delta sy2)
|
||
|
|
-> Type
|
||
|
|
congType [] env1 sy1 lhs env2 sy2 rhs = lhs ~=~ rhs
|
||
|
|
congType (ty :: delta) env1 sy1 lhs env2 sy2 rhs =
|
||
|
|
{x1 : ty env1} -> {x2 : ty env2}
|
||
|
|
-> x1 ~=~ x2
|
||
|
|
-> congType delta
|
||
|
|
(env1 ** x1) (sy1 x1) (lhs x1)
|
||
|
|
(env2 ** x2) (sy2 x2) (rhs x2)
|
||
|
|
|
||
|
|
public export
|
||
|
|
congSegment : {n : Nat} -> (0 delta : Segment n gamma)
|
||
|
|
->(0 env1 : Left.Environment gamma)-> (0 sy1 : SimpleFun env1 delta Type) -> (0 lhs : Fun env1 delta sy1)
|
||
|
|
->(0 env2 : Left.Environment gamma)-> (0 sy2 : SimpleFun env2 delta Type) -> (0 rhs : Fun env2 delta sy2)
|
||
|
|
->(0 _ : env1 ~=~ env2) -> (0 _ : sy1 ~=~ sy2) -> (0 _ : lhs ~=~ rhs)
|
||
|
|
-> congType delta env1 sy1 lhs
|
||
|
|
env2 sy2 rhs
|
||
|
|
congSegment {n = 0 } [] env sy context env sy context Refl Refl Refl = Refl
|
||
|
|
congSegment {n = S n} (ty :: delta) env sy context env sy context Refl Refl Refl = recursiveCall
|
||
|
|
where
|
||
|
|
recursiveCall : {x1 : ty env} -> {x2 : ty env} -> x1 ~=~ x2
|
||
|
|
-> congType delta (env ** x1) (sy x1) (context x1)
|
||
|
|
(env ** x2) (sy x2) (context x2)
|
||
|
|
recursiveCall {x1=x} {x2=x} Refl = congSegment delta
|
||
|
|
(env ** x) (sy x) (context x)
|
||
|
|
(env ** x) (sy x) (context x)
|
||
|
|
Refl Refl Refl
|
||
|
|
|
||
|
|
public export
|
||
|
|
cong : {n : Nat} -> {0 delta : Segment n []} -> {0 sy : SimpleFun () delta Type}
|
||
|
|
-> (context : Fun () delta sy)
|
||
|
|
-> congType delta () sy context
|
||
|
|
() sy context
|
||
|
|
cong {n} {delta} {sy} context = congSegment delta () sy context
|
||
|
|
() sy context
|
||
|
|
Refl Refl Refl
|