pass a TyContext
into equal
etc, rather than its components
This commit is contained in:
parent
065ebedf2d
commit
bee6eeacdf
5 changed files with 119 additions and 110 deletions
|
@ -285,8 +285,7 @@ parameters (defs : Definitions' q _) {auto _ : (CanEqual q m, Eq q)}
|
|||
compare0' _ e@(_ :# _) f _ _ = clashE e f
|
||||
|
||||
|
||||
parameters {auto _ : (HasDefs' q _ m, HasErr q m, Eq q)}
|
||||
(eq : DimEq d) (ctx : TContext q d n)
|
||||
parameters {auto _ : (HasDefs' q _ m, HasErr q m, Eq q)} (ctx : TyContext q d n)
|
||||
parameters (mode : EqMode)
|
||||
namespace Term
|
||||
export covering
|
||||
|
@ -294,16 +293,17 @@ parameters {auto _ : (HasDefs' q _ m, HasErr q m, Eq q)}
|
|||
compare ty s t = do
|
||||
defs <- ask
|
||||
runReaderT {m} (MakeEnv {mode}) $
|
||||
for_ (splits eq) $ \th =>
|
||||
compare0 defs (map (/// th) ctx) (ty /// th) (s /// th) (t /// th)
|
||||
for_ (splits ctx.dctx) $ \th =>
|
||||
compare0 defs (map (/// th) ctx.tctx)
|
||||
(ty /// th) (s /// th) (t /// th)
|
||||
|
||||
export covering
|
||||
compareType : (s, t : Term q d n) -> m ()
|
||||
compareType s t = do
|
||||
defs <- ask
|
||||
runReaderT {m} (MakeEnv {mode}) $
|
||||
for_ (splits eq) $ \th =>
|
||||
compareType defs (map (/// th) ctx) (s /// th) (t /// th)
|
||||
for_ (splits ctx.dctx) $ \th =>
|
||||
compareType defs (map (/// th) ctx.tctx) (s /// th) (t /// th)
|
||||
|
||||
namespace Elim
|
||||
||| you don't have to pass the type in but the arguments must still be
|
||||
|
@ -313,8 +313,8 @@ parameters {auto _ : (HasDefs' q _ m, HasErr q m, Eq q)}
|
|||
compare e f = do
|
||||
defs <- ask
|
||||
runReaderT {m} (MakeEnv {mode}) $
|
||||
for_ (splits eq) $ \th =>
|
||||
compare0 defs (map (/// th) ctx) (e /// th) (f /// th)
|
||||
for_ (splits ctx.dctx) $ \th =>
|
||||
compare0 defs (map (/// th) ctx.tctx) (e /// th) (f /// th)
|
||||
|
||||
namespace Term
|
||||
export covering %inline
|
||||
|
|
|
@ -168,9 +168,9 @@ parameters {auto _ : IsQty q} {auto _ : CanTC q m}
|
|||
-- if Ψ, i | Γ ⊢ σ · t ⇐ A ⊳ Σ
|
||||
qout <- check (extendDim ctx) sg body.term ty.term
|
||||
-- if Ψ | Γ ⊢ t‹0› = l : A‹0›
|
||||
equal ctx.dctx ctx.tctx ty.zero body.zero l
|
||||
equal ctx ty.zero body.zero l
|
||||
-- if Ψ | Γ ⊢ t‹1› = r : A‹1›
|
||||
equal ctx.dctx ctx.tctx ty.one body.one r
|
||||
equal ctx ty.one body.one r
|
||||
-- then Ψ | Γ ⊢ σ · (λᴰi ⇒ t) ⇐ Eq [i ⇒ A] l r ⊳ Σ
|
||||
pure qout
|
||||
|
||||
|
@ -178,7 +178,7 @@ parameters {auto _ : IsQty q} {auto _ : CanTC q m}
|
|||
-- if Ψ | Γ ⊢ σ · e ⇒ A' ⊳ Σ
|
||||
infres <- infer ctx sg e
|
||||
-- if Ψ | Γ ⊢ A' <: A
|
||||
subtype ctx.dctx ctx.tctx infres.type ty
|
||||
subtype ctx infres.type ty
|
||||
-- then Ψ | Γ ⊢ σ · e ⇐ A ⊳ Σ
|
||||
pure infres.qout
|
||||
|
||||
|
|
|
@ -44,6 +44,10 @@ namespace TContext
|
|||
pushD tel = map (/// shift 1) tel
|
||||
|
||||
namespace TyContext
|
||||
public export %inline
|
||||
empty : {d : Nat} -> TyContext q d 0
|
||||
empty = MkTyContext {dctx = new, tctx = [<]}
|
||||
|
||||
export %inline
|
||||
extendTyN : Telescope (Term q d) from to ->
|
||||
TyContext q d from -> TyContext q d to
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue