add displacement to Definition

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

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 ∈ Γ

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

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

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