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

wip

Browse source
This commit is contained in:
rhiannon morris 2023-08-13 20:55:14 +02:00
parent 0dd3c231e6
commit 7a6c4c61d1
7 changed files with 201 additions and 96 deletions
Download patch file Download diff file Expand all files Collapse all files

27
lib/Quox/Equal.idr
View file

@ -521,10 +521,13 @@ parameters (defs : Definitions)
compare0 ctx e f
ety <- computeElimTypeE defs ctx e @{noOr1 ne}
compareType (extendTy Zero eret.name ety ctx) eret.term fret.term
for_ !(expectEnum defs ctx eloc ety) $ \t => do
l <- lookupArm eloc t earms
for_ (SortedMap.toList earms) $ \(t, l) => do
r <- lookupArm floc t farms
compare0 ctx (sub1 eret $ Ann (Tag t l.loc) ety l.loc) l r
-- for_ !(expectEnum defs ctx eloc ety) $ \t => do
-- l <- lookupArm eloc t earms
-- r <- lookupArm floc t farms
-- compare0 ctx (sub1 eret $ Ann (Tag t l.loc) ety l.loc) l r
expectEqualQ eloc epi fpi
where
lookupArm : Loc -> TagVal -> CaseEnumArms d n -> Equal_ (Term d n)
@ -592,16 +595,18 @@ parameters (defs : Definitions)
-- Ψ | Γ ⊢ A‹p₁/𝑖› <: B‹p₂/𝑖›
-- Ψ | Γ ⊢ A‹q₁/𝑖› <: B‹q₂/𝑖›
-- Ψ | Γ ⊢ e <: f ⇒ _
-- (non-neutral forms have the coercion already pushed in)
-- Ψ | Γ ⊢ s <: t ⇐ B‹p₂/𝑖›
-- -----------------------------------------------------------
-- Ψ | Γ ⊢ coe [𝑖 ⇒ A] @p₁ @q₁ e
-- <: coe [𝑖 ⇒ B] @p₂ @q₂ f ⇒ B‹q₂/𝑖›
compare0' ctx (Coe ty1 p1 q1 (E val1) _)
(Coe ty2 p2 q2 (E val2) _) ne nf = do
compareType ctx (dsub1 ty1 p1) (dsub1 ty2 p2)
compareType ctx (dsub1 ty1 q1) (dsub1 ty2 q2)
compare0 ctx val1 val2
-- Ψ | Γ ⊢ coe [𝑖 ⇒ A] @p₁ @q₁ s
-- <: coe [𝑖 ⇒ B] @p₂ @q₂ t ⇒ B‹q₂/𝑖›
compare0' ctx (Coe ty1 p1 q1 val1 _)
(Coe ty2 p2 q2 val2 _) ne nf = do
let typ1 = dsub1 ty1 p1; tyq1 = dsub1 ty1 q1
typ2 = dsub1 ty2 p2; tyq2 = dsub1 ty2 q2
compareType ctx typ1 typ2
compareType ctx tyq1 tyq2
let ty = case !mode of Super => typ1; _ => typ2
Term.compare0 ctx ty val1 val2
compare0' ctx e@(Coe {}) f _ _ = clashE e.loc ctx e f
-- (no neutral compositions in a closed dctx)