diff --git a/lib/Quox/Definition.idr b/lib/Quox/Definition.idr index 693012a..53becaf 100644 --- a/lib/Quox/Definition.idr +++ b/lib/Quox/Definition.idr @@ -2,6 +2,7 @@ module Quox.Definition import public Quox.No import public Quox.Syntax +import Quox.Displace import public Data.SortedMap import public Quox.Loc import Control.Eff @@ -45,13 +46,21 @@ parameters {d, n : Nat} (.type) : Definition -> Term d n g.type = g.type0 // shift0 d // shift0 n + public export %inline + (.typeAt) : Definition -> Universe -> Term d n + g.typeAt u = displace u g.type + public export %inline (.term) : Definition -> Maybe (Term d n) g.term = g.body0.term0 <&> \t => t // shift0 d // shift0 n public export %inline - toElim : Definition -> Maybe $ Elim d n - toElim def = pure $ Ann !def.term def.type def.loc + (.termAt) : Definition -> Universe -> Maybe (Term d n) + g.termAt u = displace u <$> g.term + + public export %inline + toElim : Definition -> Universe -> Maybe $ Elim d n + toElim def u = pure $ Ann !(def.termAt u) (def.typeAt u) def.loc public export %inline @@ -76,5 +85,5 @@ DefsState = StateL DEFS Definitions public export %inline -lookupElim : {d, n : Nat} -> Name -> Definitions -> Maybe (Elim d n) -lookupElim x defs = toElim !(lookup x defs) +lookupElim : {d, n : Nat} -> Name -> Universe -> Definitions -> Maybe (Elim d n) +lookupElim x u defs = toElim !(lookup x defs) u diff --git a/lib/Quox/Typechecker.idr b/lib/Quox/Typechecker.idr index ef0138a..92c8a5e 100644 --- a/lib/Quox/Typechecker.idr +++ b/lib/Quox/Typechecker.idr @@ -327,7 +327,7 @@ mutual expectCompatQ loc sg.fst g.qty.fst -- then Ψ | Γ ⊢ σ · x ⇒ A ⊳ 𝟎 let Val d = ctx.dimLen; Val n = ctx.termLen - pure $ InfRes {type = displace u g.type, qout = zeroFor ctx} + pure $ InfRes {type = g.typeAt u, qout = zeroFor ctx} infer' ctx sg (B i _) = -- if x : A ∈ Γ diff --git a/lib/Quox/Whnf/ComputeElimType.idr b/lib/Quox/Whnf/ComputeElimType.idr index 91c4d07..dcc5246 100644 --- a/lib/Quox/Whnf/ComputeElimType.idr +++ b/lib/Quox/Whnf/ComputeElimType.idr @@ -22,7 +22,7 @@ computeElimType defs ctx e {ne} = F {x, u, loc} => do let Just def = lookup x defs | Nothing => throw $ NotInScope loc x - pure $ displace u def.type + pure $ def.typeAt u B {i, _} => pure $ ctx.tctx !! i diff --git a/lib/Quox/Whnf/Interface.idr b/lib/Quox/Whnf/Interface.idr index 4406d7d..5b0aae6 100644 --- a/lib/Quox/Whnf/Interface.idr +++ b/lib/Quox/Whnf/Interface.idr @@ -193,8 +193,8 @@ mutual ||| 7. a closure public export isRedexE : RedexTest Elim - isRedexE defs (F {x, _}) {d, n} = - isJust $ lookupElim x defs {d, n} + isRedexE defs (F {x, u, _}) {d, n} = + isJust $ lookupElim x u defs {d, n} isRedexE _ (B {}) = False isRedexE defs (App {fun, _}) = isRedexE defs fun || isLamHead fun diff --git a/lib/Quox/Whnf/Main.idr b/lib/Quox/Whnf/Main.idr index 020f1f0..0502fa1 100644 --- a/lib/Quox/Whnf/Main.idr +++ b/lib/Quox/Whnf/Main.idr @@ -16,8 +16,8 @@ export covering CanWhnf Elim Interface.isRedexE covering CanWhnf Elim Interface.isRedexE where - whnf defs ctx (F x u loc) with (lookupElim x defs) proof eq - _ | Just y = whnf defs ctx $ setLoc loc $ displace u y + whnf defs ctx (F x u loc) with (lookupElim x u defs) proof eq + _ | Just y = whnf defs ctx $ setLoc loc y _ | Nothing = pure $ Element (F x u loc) $ rewrite eq in Ah whnf _ _ (B i loc) = pure $ nred $ B i loc