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

box type

Browse source
This commit is contained in:
rhiannon morris 2023-03-31 19:11:35 +02:00
parent 37dd1ee76d
commit 8a9b4c23dd
15 changed files with 256 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

37
lib/Quox/Equal.idr
View file

@ -66,6 +66,8 @@ isTyCon (DLam {}) = False
isTyCon Nat = True
isTyCon Zero = False
isTyCon (Succ {}) = False
isTyCon (BOX {}) = True
isTyCon (Box {}) = False
isTyCon (E {}) = True
isTyCon (CloT {}) = False
isTyCon (DCloT {}) = False
@ -86,6 +88,8 @@ sameTyCon (Eq {}) (Eq {}) = True
sameTyCon (Eq {}) _ = False
sameTyCon Nat Nat = True
sameTyCon Nat _ = False
sameTyCon (BOX {}) (BOX {}) = True
sameTyCon (BOX {}) _ = False
sameTyCon (E {}) (E {}) = True
sameTyCon (E {}) _ = False
@ -117,6 +121,8 @@ parameters (defs : Definitions' q g)
Nat => pure False
Zero => pure False
Succ {} => pure False
BOX {ty, _} => isSubSing ty
Box {} => pure False
E (s :# _) => isSubSing s
E _ => pure False
@ -253,6 +259,19 @@ parameters (defs : Definitions' q _) {auto _ : (CanEqual q m, IsQty q)}
(E _, t) => wrongType ctx Nat t
(s, _) => wrongType ctx Nat s
compare0' ctx ty@(BOX q ty') s t = local {mode := Equal} $
case (s, t) of
-- Γ ⊢ s = t : A
-- -----------------------
-- Γ ⊢ [s] = [t] : [π.A]
(Box s, Box t) => compare0 ctx ty' s t
(E e, E f) => Elim.compare0 ctx e f
(Box _, t) => wrongType ctx ty t
(E _, t) => wrongType ctx ty t
(s, _) => wrongType ctx ty s
compare0' ctx ty@(E _) s t = do
-- a neutral type can only be inhabited by neutral values
-- e.g. an abstract value in an abstract type, bound variables, …
@ -330,6 +349,10 @@ parameters (defs : Definitions' q _) {auto _ : (CanEqual q m, IsQty q)}
-- Γ ⊢ ℕ <: ℕ
pure ()
compareType' ctx (BOX pi a) (BOX rh b) = do
expectEqualQ pi rh
compareType ctx a b
compareType' ctx (E e) (E f) = do
-- no fanciness needed here cos anything other than a neutral
-- has been inlined by whnf
@ -352,6 +375,7 @@ parameters (defs : Definitions' q _) {auto _ : (CanEqual q m, IsQty q)}
computeElimType ctx (CasePair {pair, ret, _}) _ = pure $ sub1 ret pair
computeElimType ctx (CaseEnum {tag, ret, _}) _ = pure $ sub1 ret tag
computeElimType ctx (CaseNat {nat, ret, _}) _ = pure $ sub1 ret nat
computeElimType ctx (CaseBox {box, ret, _}) _ = pure $ sub1 ret box
computeElimType ctx (f :% p) ne = do
(ty, _, _) <- expectEqE defs ctx !(computeElimType ctx f (noOr1 ne))
pure $ dsub1 ty p
@ -457,6 +481,19 @@ parameters (defs : Definitions' q _) {auto _ : (CanEqual q m, IsQty q)}
expectEqualQ epi' fpi'
compare0' ctx e@(CaseNat {}) f _ _ = clashE ctx e f
compare0' ctx (CaseBox epi e eret ebody)
(CaseBox fpi f fret fbody) ne nf =
local {mode := Equal} $ do
compare0 ctx e f
ety <- computeElimType ctx e (noOr1 ne)
compareType (extendTy zero eret.name ety ctx) eret.term fret.term
(q, ty) <- expectBOXE defs ctx ety
compare0 (extendTy (epi * q) ebody.name ty ctx)
(substCaseBoxRet ety eret)
ebody.term fbody.term
expectEqualQ epi fpi
compare0' ctx e@(CaseBox {}) f _ _ = clashE ctx e f
compare0' ctx (s :# a) (t :# b) _ _ =
Term.compare0 ctx !(bigger a b) s t
where