rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

start of equality type stuff

Browse source
This commit is contained in:
rhiannon morris 2023-01-21 02:34:28 +01:00
parent 8acc3aeadf
commit f097e1c091
13 changed files with 608 additions and 261 deletions
Download patch file Download diff file Expand all files Collapse all files

41
lib/Quox/Equal.idr
View file

@ -74,6 +74,11 @@ compareU : CanEqual' q _ m => Universe -> Universe -> m ()
compareU k l = unless !(compareU' k l) $
throwError $ ClashU !mode k l
export %inline
compareD : HasErr q m => Dim d -> Dim d -> m ()
compareD p q = unless (p == q) $
throwError $ ClashD p q
mutual
private covering
compareTN' : CanEqual' q _ m => Eq q =>
@ -96,14 +101,25 @@ mutual
compareTN' (Pi qty1 _ arg1 res1) (Pi qty2 _ arg2 res2) _ _ = do
unless (qty1 == qty2) $ throwError $ ClashQ qty1 qty2
compareT0 arg2 arg1 -- reversed for contravariant domain
compareTS0 res1 res2
compareST0 res1 res2
compareTN' s@(Pi {}) t _ _ = clashT s t
-- [todo] eta
compareTN' (Lam _ body1) (Lam _ body2) _ _ =
local {mode := Equal} $ compareTS0 body1 body2
local {mode := Equal} $ compareST0 body1 body2
compareTN' s@(Lam {}) t _ _ = clashT s t
compareTN' (Eq _ ty1 l1 r1) (Eq _ ty2 l2 r2) _ _ = do
compareDST0 ty1 ty2
local {mode := Equal} $ do
compareT0 l1 l2
compareT0 r1 r2
compareTN' s@(Eq {}) t _ _ = clashT s t
compareTN' (DLam _ body1) (DLam _ body2) _ _ =
compareDST0 body1 body2
compareTN' s@(DLam {}) t _ _ = clashT s t
compareTN' (CloT {}) _ ps _ = void $ ps IsCloT
compareTN' (DCloT {}) _ ps _ = void $ ps IsDCloT
@ -136,6 +152,11 @@ mutual
compareT0 arg1 arg2
compareEN' e@(_ :@ _) f _ _ = clashE e f
compareEN' (fun1 :% dim1) (fun2 :% dim2) _ _ = do
compareE0 fun1 fun2
compareD dim1 dim2
compareEN' e@(_ :% _) f _ _ = clashE e f
-- [todo] is always checking the types are equal correct?
compareEN' (tm1 :# ty1) (tm2 :# ty2) _ _ = do
compareT0 tm1 tm2
@ -179,12 +200,18 @@ mutual
compareE0 e f = compareEN (whnfE e) (whnfE f)
export covering %inline
compareTS0 : CanEqual' q _ m => Eq q =>
compareST0 : CanEqual' q _ m => Eq q =>
ScopeTerm q 0 n -> ScopeTerm q 0 n -> m ()
compareTS0 (TUnused body1) (TUnused body2) =
compareT0 body1 body2
compareTS0 body1 body2 =
compareT0 (fromScopeTerm body1) (fromScopeTerm body2)
compareST0 (TUnused body0) (TUnused body1) = compareT0 body0 body1
compareST0 body0 body1 = compareT0 body0.term body1.term
export covering %inline
compareDST0 : CanEqual' q _ m => Eq q =>
DScopeTerm q 0 n -> DScopeTerm q 0 n -> m ()
compareDST0 (DUnused body0) (DUnused body1) = compareT0 body0 body1
compareDST0 body0 body1 = do
compareT0 body0.zero body1.zero
compareT0 body0.one body1.one
private %inline