149 lines
4 KiB
Idris
149 lines
4 KiB
Idris
module TermImpls
|
|
|
|
import Quox.Syntax
|
|
import public Quox.Pretty
|
|
|
|
|
|
private
|
|
eqShiftLen : Shift from1 to -> Shift from2 to -> Maybe (from1 = from2)
|
|
eqShiftLen SZ SZ = Just Refl
|
|
eqShiftLen (SS by) (SS bz) = eqShiftLen by bz
|
|
eqShiftLen _ _ = Nothing
|
|
|
|
private
|
|
eqSubstLen : Subst tm1 from1 to -> Subst tm2 from2 to -> Maybe (from1 = from2)
|
|
eqSubstLen (Shift by) (Shift bz) = eqShiftLen by bz
|
|
eqSubstLen (_ ::: th) (_ ::: ph) = cong S <$> eqSubstLen th ph
|
|
eqSubstLen _ _ = Nothing
|
|
-- maybe from1 = from2 in the last case, but this is for
|
|
-- (==), and the substs aren't equal, so who cares
|
|
|
|
mutual
|
|
export covering
|
|
Eq (Term d n) where
|
|
TYPE k == TYPE l = k == l
|
|
TYPE _ == _ = False
|
|
|
|
Pi qty1 arg1 res1 == Pi qty2 arg2 res2 =
|
|
qty1 == qty2 && arg1 == arg2 && res1.term == res2.term
|
|
Pi {} == _ = False
|
|
|
|
Lam body1 == Lam body2 = body1.term == body2.term
|
|
Lam {} == _ = False
|
|
|
|
Sig fst1 snd1 == Sig fst2 snd2 =
|
|
fst1 == fst2 && snd1.term == snd2.term
|
|
Sig {} == _ = False
|
|
|
|
Pair fst1 snd1 == Pair fst2 snd2 = fst1 == fst2 && snd1 == snd2
|
|
Pair {} == _ = False
|
|
|
|
Enum ts1 == Enum ts2 = ts1 == ts2
|
|
Enum _ == _ = False
|
|
|
|
Tag t1 == Tag t2 = t1 == t2
|
|
Tag _ == _ = False
|
|
|
|
Eq ty1 l1 r1 == Eq ty2 l2 r2 =
|
|
ty1.term == ty2.term && l1 == l2 && r1 == r2
|
|
Eq {} == _ = False
|
|
|
|
DLam body1 == DLam body2 = body1.term == body2.term
|
|
DLam {} == _ = False
|
|
|
|
Nat == Nat = True
|
|
Nat == _ = False
|
|
|
|
Zero == Zero = True
|
|
Zero == _ = False
|
|
|
|
Succ m == Succ n = m == n
|
|
Succ _ == _ = False
|
|
|
|
BOX q1 ty1 == BOX q2 ty2 = q1 == q2 && ty1 == ty2
|
|
BOX {} == _ = False
|
|
|
|
Box val1 == Box val2 = val1 == val2
|
|
Box _ == _ = False
|
|
|
|
E e == E f = e == f
|
|
E _ == _ = False
|
|
|
|
CloT tm1 th1 == CloT tm2 th2 =
|
|
case eqSubstLen th1 th2 of
|
|
Just Refl => tm1 == tm2 && th1 == th2
|
|
Nothing => False
|
|
CloT {} == _ = False
|
|
|
|
DCloT tm1 th1 == DCloT tm2 th2 =
|
|
case eqSubstLen th1 th2 of
|
|
Just Refl => tm1 == tm2 && th1 == th2
|
|
Nothing => False
|
|
DCloT {} == _ = False
|
|
|
|
export covering
|
|
Eq (Elim d n) where
|
|
F x == F y = x == y
|
|
F _ == _ = False
|
|
|
|
B i == B j = i == j
|
|
B _ == _ = False
|
|
|
|
(fun1 :@ arg1) == (fun2 :@ arg2) = fun1 == fun2 && arg1 == arg2
|
|
(_ :@ _) == _ = False
|
|
|
|
CasePair q1 p1 r1 b1 == CasePair q2 p2 r2 b2 =
|
|
q1 == q2 && p1 == p2 && r1.term == r2.term && b1.term == b2.term
|
|
CasePair {} == _ = False
|
|
|
|
CaseEnum q1 t1 r1 a1 == CaseEnum q2 t2 r2 a2 =
|
|
q1 == q2 && t1 == t2 && r1.term == r2.term && a1 == a2
|
|
CaseEnum {} == _ = False
|
|
|
|
CaseNat q1 q1' n1 r1 z1 s1 == CaseNat q2 q2' n2 r2 z2 s2 =
|
|
q1 == q2 && q1' == q2' && n1 == n2 &&
|
|
r1.term == r2.term && z1 == z2 && s1.term == s2.term
|
|
CaseNat {} == _ = False
|
|
|
|
CaseBox q1 x1 r1 b1 == CaseBox q2 x2 r2 b2 =
|
|
q1 == q2 && x1 == x2 && r1.term == r2.term && b1.term == b2.term
|
|
CaseBox {} == _ = False
|
|
|
|
(fun1 :% dim1) == (fun2 :% dim2) = fun1 == fun2 && dim1 == dim2
|
|
(_ :% _) == _ = False
|
|
|
|
(tm1 :# ty1) == (tm2 :# ty2) = tm1 == tm2 && ty1 == ty2
|
|
(_ :# _) == _ = False
|
|
|
|
TypeCase ty1 ret1 univ1 pi1 sig1 enum1 eq1 nat1 box1
|
|
==
|
|
TypeCase ty2 ret2 univ2 pi2 sig2 enum2 eq2 nat2 box2 =
|
|
ty1 == ty2 && ret1 == ret2 &&
|
|
pi1.term == pi2.term &&
|
|
sig1.term == sig2.term &&
|
|
enum1 == enum2 &&
|
|
eq1.term == eq2.term &&
|
|
nat1 == nat2 &&
|
|
box1.term == box2.term
|
|
|
|
TypeCase {} == _ = False
|
|
|
|
CloE el1 th1 == CloE el2 th2 =
|
|
case eqSubstLen th1 th2 of
|
|
Just Refl => el1 == el2 && th1 == th2
|
|
Nothing => False
|
|
CloE {} == _ = False
|
|
|
|
DCloE el1 th1 == DCloE el2 th2 =
|
|
case eqSubstLen th1 th2 of
|
|
Just Refl => el1 == el2 && th1 == th2
|
|
Nothing => False
|
|
DCloE {} == _ = False
|
|
|
|
export covering
|
|
Show (Term d n) where
|
|
showPrec d t = showParens (d /= Open) $ prettyStr True t
|
|
|
|
export covering
|
|
Show (Elim d n) where
|
|
showPrec d e = showParens (d /= Open) $ prettyStr True e
|