quox/tests/TermImpls.idr

116 lines
3.2 KiB
Idris
Raw Normal View History

module TermImpls
import Quox.Syntax
2023-01-08 14:44:25 -05:00
import public Quox.Pretty
private
2023-01-26 13:54:46 -05:00
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
2023-01-26 13:54:46 -05:00
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
2023-01-08 14:44:25 -05:00
Eq q => Eq (Term q d n) where
TYPE k == TYPE l = k == l
TYPE _ == _ = False
Pi qty1 _ arg1 res1 == Pi qty2 _ arg2 res2 =
qty1 == qty2 && arg1 == arg2 && res1 == res2
Pi {} == _ = False
Lam _ body1 == Lam _ body2 = body1 == body2
Lam {} == _ = False
2023-01-26 13:54:46 -05:00
Sig _ fst1 snd1 == Sig _ fst2 snd2 = fst1 == fst2 && snd1 == snd2
Sig {} == _ = False
Pair fst1 snd1 == Pair fst2 snd2 = fst1 == fst2 && snd1 == snd2
Pair {} == _ = False
2023-01-20 20:34:28 -05:00
Eq _ ty1 l1 r1 == Eq _ ty2 l2 r2 =
ty1 == ty2 && l1 == l2 && r1 == r2
Eq {} == _ = False
DLam _ body1 == DLam _ body2 = body1 == body2
DLam {} == _ = False
E e == E f = e == f
E _ == _ = False
CloT tm1 th1 == CloT tm2 th2 =
2023-01-26 13:54:46 -05:00
case eqSubstLen th1 th2 of
Just Refl => tm1 == tm2 && th1 == th2
Nothing => False
CloT {} == _ = False
DCloT tm1 th1 == DCloT tm2 th2 =
2023-01-26 13:54:46 -05:00
case eqSubstLen th1 th2 of
Just Refl => tm1 == tm2 && th1 == th2
Nothing => False
DCloT {} == _ = False
export covering
2023-01-08 14:44:25 -05:00
Eq q => Eq (Elim q 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
2023-01-26 13:54:46 -05:00
CasePair q1 p1 _ r1 _ _ b1 == CasePair q2 p2 _ r2 _ _ b2 =
q1 == q2 && p1 == p2 && r1 == r2 && b1 == b2
CasePair {} == _ = False
2023-01-20 20:34:28 -05:00
(fun1 :% dim1) == (fun2 :% dim2) = fun1 == fun2 && dim1 == dim2
(_ :% _) == _ = False
2023-01-26 13:54:46 -05:00
(tm1 :# ty1) == (tm2 :# ty2) = tm1 == tm2 && ty1 == ty2
(_ :# _) == _ = False
CloE el1 th1 == CloE el2 th2 =
2023-01-26 13:54:46 -05:00
case eqSubstLen th1 th2 of
Just Refl => el1 == el2 && th1 == th2
Nothing => False
CloE {} == _ = False
DCloE el1 th1 == DCloE el2 th2 =
2023-01-26 13:54:46 -05:00
case eqSubstLen th1 th2 of
Just Refl => el1 == el2 && th1 == th2
Nothing => False
DCloE {} == _ = False
export covering
2023-01-26 13:54:46 -05:00
Eq q => Eq (ScopeTermN s q d n) where
TUsed s == TUsed t = s == t
TUnused s == TUnused t = s == t
TUsed _ == TUnused _ = False
TUnused _ == TUsed _ = False
2023-01-20 20:34:28 -05:00
export covering
2023-01-26 13:54:46 -05:00
Eq q => Eq (DScopeTermN s q d n) where
2023-01-20 20:34:28 -05:00
DUsed s == DUsed t = s == t
DUnused s == DUnused t = s == t
DUsed _ == DUnused _ = False
DUnused _ == DUsed _ = False
export covering
2023-01-08 14:44:25 -05:00
PrettyHL q => Show (Term q d n) where
showPrec d t = showParens (d /= Open) $ prettyStr True t
export covering
2023-01-08 14:44:25 -05:00
PrettyHL q => Show (Elim q d n) where
showPrec d e = showParens (d /= Open) $ prettyStr True e