2023-08-24 12:42:26 -04:00
|
|
|
module Quox.Whnf.ComputeElimType
|
|
|
|
|
|
|
|
import Quox.Whnf.Interface
|
|
|
|
import Quox.Displace
|
|
|
|
|
|
|
|
%default total
|
|
|
|
|
|
|
|
|
|
|
|
||| performs the minimum work required to recompute the type of an elim.
|
|
|
|
|||
|
|
|
|
||| - assumes the elim is already typechecked
|
|
|
|
||| - the return value is not reduced
|
|
|
|
export covering
|
|
|
|
computeElimType : CanWhnf Term Interface.isRedexT =>
|
|
|
|
CanWhnf Elim Interface.isRedexE =>
|
|
|
|
{d, n : Nat} ->
|
|
|
|
(defs : Definitions) -> WhnfContext d n ->
|
|
|
|
(e : Elim d n) -> (0 ne : No (isRedexE defs e)) =>
|
|
|
|
Eff Whnf (Term d n)
|
|
|
|
computeElimType defs ctx e {ne} =
|
|
|
|
case e of
|
|
|
|
F {x, u, loc} => do
|
|
|
|
let Just def = lookup x defs
|
|
|
|
| Nothing => throw $ NotInScope loc x
|
2023-08-28 13:59:36 -04:00
|
|
|
pure $ def.typeAt u
|
2023-08-24 12:42:26 -04:00
|
|
|
|
|
|
|
B {i, _} =>
|
|
|
|
pure $ ctx.tctx !! i
|
|
|
|
|
|
|
|
App {fun = f, arg = s, loc} => do
|
|
|
|
fty' <- computeElimType defs ctx f {ne = noOr1 ne}
|
|
|
|
Pi {arg, res, _} <- whnf0 defs ctx fty'
|
|
|
|
| t => throw $ ExpectedPi loc ctx.names t
|
|
|
|
pure $ sub1 res $ Ann s arg loc
|
|
|
|
|
|
|
|
CasePair {pair, ret, _} =>
|
|
|
|
pure $ sub1 ret pair
|
|
|
|
|
|
|
|
CaseEnum {tag, ret, _} =>
|
|
|
|
pure $ sub1 ret tag
|
|
|
|
|
|
|
|
CaseNat {nat, ret, _} =>
|
|
|
|
pure $ sub1 ret nat
|
|
|
|
|
|
|
|
CaseBox {box, ret, _} =>
|
|
|
|
pure $ sub1 ret box
|
|
|
|
|
|
|
|
DApp {fun = f, arg = p, loc} => do
|
|
|
|
fty' <- computeElimType defs ctx f {ne = noOr1 ne}
|
|
|
|
Eq {ty, _} <- whnf0 defs ctx fty'
|
|
|
|
| t => throw $ ExpectedEq loc ctx.names t
|
|
|
|
pure $ dsub1 ty p
|
|
|
|
|
|
|
|
Ann {ty, _} =>
|
|
|
|
pure ty
|
|
|
|
|
|
|
|
Coe {ty, q, _} =>
|
|
|
|
pure $ dsub1 ty q
|
|
|
|
|
|
|
|
Comp {ty, _} =>
|
|
|
|
pure ty
|
|
|
|
|
|
|
|
TypeCase {ret, _} =>
|
|
|
|
pure ret
|