remove redundancy in equality check

This commit is contained in:
rhiannon morris 2023-05-20 21:38:23 +02:00
parent 64de93a13c
commit e4a20cc632

View file

@ -373,17 +373,6 @@ parameters (defs : Definitions)
-- has been inlined by whnf -- has been inlined by whnf
Elim.compare0 ctx e f Elim.compare0 ctx e f
-- Ψ | Γ ⊢₀ e ⇒ Eq [𝑖 ⇒ A] s t
-- -----------------------------
-- Ψ | Γ ⊢ e @0 = s ⇒ A[0/𝑖]
-- Ψ | Γ ⊢ e @1 = s ⇒ A[1/𝑖]
private covering
replaceEnd : EqContext n ->
(e : Elim 0 n) -> Loc -> DimConst -> Loc ->
(0 ne : NotRedex defs e) -> Equal_ (Elim 0 n)
replaceEnd ctx e eloc p ploc ne = do
(ty, l, r) <- expectEq defs ctx eloc !(computeElimTypeE defs ctx e)
pure $ Ann (ends l r p) (dsub1 ty (K p ploc)) eloc
namespace Elim namespace Elim
-- [fixme] the following code ends up repeating a lot of work in the -- [fixme] the following code ends up repeating a lot of work in the
@ -408,12 +397,6 @@ parameters (defs : Definitions)
(e, f : Elim 0 n) -> (e, f : Elim 0 n) ->
(0 ne : NotRedex defs e) -> (0 nf : NotRedex defs f) -> (0 ne : NotRedex defs e) -> (0 nf : NotRedex defs f) ->
Equal_ () Equal_ ()
-- replace applied equalities with the appropriate end first
-- (see `replaceEnd`)
compare0' ctx (DApp e (K p ploc) loc) f ne nf =
compare0 ctx !(replaceEnd ctx e loc p ploc $ noOr1 ne) f
compare0' ctx e (DApp f (K q qloc) loc) ne nf =
compare0 ctx e !(replaceEnd ctx f loc q qloc $ noOr1 nf)
compare0' ctx e@(F x {}) f@(F y {}) _ _ = compare0' ctx e@(F x {}) f@(F y {}) _ _ =
unless (x == y) $ clashE e.loc ctx e f unless (x == y) $ clashE e.loc ctx e f
@ -523,6 +506,10 @@ parameters (defs : Definitions)
expectEqualQ eloc epi fpi expectEqualQ eloc epi fpi
compare0' ctx e@(CaseBox {}) f _ _ = clashE e.loc ctx e f compare0' ctx e@(CaseBox {}) f _ _ = clashE e.loc ctx e f
-- all dim apps replaced with ends by whnf
compare0' _ (DApp _ (K {}) _) _ ne _ = void $ absurd $ noOr2 $ noOr2 ne
compare0' _ _ (DApp _ (K {}) _) _ nf = void $ absurd $ noOr2 $ noOr2 nf
-- Ψ | Γ ⊢ s <: t : B -- Ψ | Γ ⊢ s <: t : B
-- -------------------------------- -- --------------------------------
-- Ψ | Γ ⊢ (s ∷ A) <: (t ∷ B) ⇒ B -- Ψ | Γ ⊢ (s ∷ A) <: (t ∷ B) ⇒ B