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

η for box

Browse source 
fixes #27
This commit is contained in:
rhiannon morris 2023-09-17 19:10:46 +02:00
parent e1257560b7
commit b85dcb5402
4 changed files with 86 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

43
lib/Quox/Equal.idr
View file

@ -140,12 +140,6 @@ compareType : Definitions -> EqContext n -> (s, t : Term 0 n) ->
Eff EqualInner ()
||| converts an elim "Γ ⊢ e" to "Γ, x ⊢ e x", for comparing with
||| a lambda "Γ ⊢ λx ⇒ t" that has been converted to "Γ, x ⊢ t".
private %inline
toLamBody : Elim d n -> Term d (S n)
toLamBody e = E $ App (weakE 1 e) (BVT 0 e.loc) e.loc
namespace Term
private covering
compare0' : (defs : Definitions) -> EqContext n ->
@ -174,13 +168,16 @@ namespace Term
(Lam {}, t) => wrongType t.loc ctx ty t
(E _, t) => wrongType t.loc ctx ty t
(s, _) => wrongType s.loc ctx ty s
where
ctx' : EqContext (S n)
ctx' = extendTy qty res.name arg ctx
where
ctx' : EqContext (S n)
ctx' = extendTy qty res.name arg ctx
eta : Loc -> Elim 0 n -> ScopeTerm 0 n -> Eff EqualInner ()
eta _ e (S _ (Y b)) = compare0 defs ctx' res.term (toLamBody e) b
eta loc e (S _ (N _)) = clashT loc ctx ty s t
toLamBody : Elim d n -> Term d (S n)
toLamBody e = E $ App (weakE 1 e) (BVT 0 e.loc) e.loc
eta : Loc -> Elim 0 n -> ScopeTerm 0 n -> Eff EqualInner ()
eta loc e (S _ (N _)) = clashT loc ctx ty s t
eta _ e (S _ (Y b)) = compare0 defs ctx' res.term (toLamBody e) b
compare0' defs ctx ty@(Sig {fst, snd, _}) s t = local_ Equal $
case (s, t) of
@ -251,18 +248,30 @@ namespace Term
(E _, t) => wrongType t.loc ctx nat t
(s, _) => wrongType s.loc ctx nat s
compare0' defs ctx ty@(BOX q ty' {}) s t = local_ Equal $
compare0' defs ctx bty@(BOX q ty {}) s t = local_ Equal $
case (s, t) of
-- Γ ⊢ s = t : A
-- -----------------------
-- Γ ⊢ [s] = [t] : [π.A]
(Box s' {}, Box t' {}) => compare0 defs ctx ty' s' t'
(Box s _, Box t _) => compare0 defs ctx ty s t
-- Γ ⊢ s = (case1 e return A of {[x] ⇒ x}) ⇐ A
-- -----------------------------------------------
-- Γ ⊢ [s] = e ⇐ [ρ.A]
(Box s loc, E f) => eta s f
(E e, Box t loc) => eta t e
(E e, E f) => ignore $ Elim.compare0 defs ctx e f
(Box {}, t) => wrongType t.loc ctx ty t
(E _, t) => wrongType t.loc ctx ty t
(s, _) => wrongType s.loc ctx ty s
(Box {}, _) => wrongType t.loc ctx bty t
(E _, _) => wrongType t.loc ctx bty t
_ => wrongType s.loc ctx bty s
where
eta : Term 0 n -> Elim 0 n -> Eff EqualInner ()
eta s e = do
nm <- mnb "inner" e.loc
let e = CaseBox One e (SN ty) (SY [< nm] (BVT 0 nm.loc)) e.loc
compare0 defs ctx ty s (E e)
compare0' defs ctx ty@(E _) s t = do
-- a neutral type can only be inhabited by neutral values