Preliminary work on autos

TODO.md

@@ -61,6 +61,7 @@
 - [ ] magic newtype? (drop in codegen)
 - [ ] records / copatterns
 - [x] vscode: syntax highlighting for String
+- [ ] add `pop` or variant of `pfunc` that maps to an operator, giving the js operator and precedence on RHS
 
 ### Parsing
 

src/Lib/CompileExp.idr

@@ -93,7 +93,7 @@ compileTerm tm@(App _ _ _) with (funArgs tm)
         -- apply (CRef "Meta\{show k}") args' [<] 0
         arity <- case meta of
                 -- maybe throw
-                (Unsolved x j ctx _) => pure 0 -- FIXME # of Bound in ctx.bds
+                (Unsolved x j ctx _ _) => pure 0 -- FIXME # of Bound in ctx.bds
                 (Solved j tm) => pure $ getArity !(quote 0 tm)
         apply (CRef "Meta\{show k}") args' [<] arity
   _ | (t@(Ref fc nm _), args) = do

src/Lib/Elab.idr

@@ -53,7 +53,7 @@ lookupDef ctx name = go 0 ctx.types ctx.env
 export
 forceMeta : Val -> M Val
 forceMeta (VMeta fc ix sp) = case !(lookupMeta ix) of
-  (Unsolved pos k xs _) => pure (VMeta fc ix sp)
+  (Unsolved pos k xs _ _) => pure (VMeta fc ix sp)
   (Solved k t) => vappSpine t sp >>= forceMeta
 forceMeta x = pure x
 
@@ -70,7 +70,7 @@ tryEval k sp =
 -- Lennart needed more forcing for recursive nat,
 forceType : Val -> M Val
 forceType (VMeta fc ix sp) = case !(lookupMeta ix) of
-  (Unsolved x k xs _) => pure (VMeta fc ix sp)
+  (Unsolved x k xs _ _) => pure (VMeta fc ix sp)
   (Solved k t) => vappSpine t sp >>= forceType
 forceType x = pure x
 
@@ -141,7 +141,7 @@ parameters (ctx: Context)
   solve : Nat -> Nat -> SnocList Val -> Val  -> M  ()
   solve l m sp t = do
     debug "solve \{show m} lvl \{show l} sp \{show sp} is \{show t}"
-    meta@(Unsolved metaFC ix ctx ty) <- lookupMeta m
+    meta@(Unsolved metaFC ix ctx ty _) <- lookupMeta m
       | _ => error (getFC t) "Meta \{show m} already solved!"
     let size = length $ filter (\x => x == Bound) $ toList ctx.bds
     debug "\{show m} size is \{show size}"
@@ -297,8 +297,15 @@ unifyCatch fc ctx ty' ty = do
 insert : (ctx : Context) -> Tm -> Val -> M (Tm, Val)
 insert ctx tm ty = do
   case !(forceMeta ty) of
+    VPi fc x Auto a b => do
+      -- FIXME mark meta as auto, maybe try to solve here?
+      m <- freshMeta ctx (getFC tm) a AutoSolve
+      debug "INSERT Auto \{pprint (names ctx) m} : \{show a}"
+      debug "TM \{pprint (names ctx) tm}"
+      mv <- eval ctx.env CBN m
+      insert ctx (App (getFC tm) tm m) !(b $$ mv)
     VPi fc x Implicit a b => do
-      m <- freshMeta ctx (getFC tm) a
+      m <- freshMeta ctx (getFC tm) a Normal
       debug "INSERT \{pprint (names ctx) m} : \{show a}"
       debug "TM \{pprint (names ctx) tm}"
       mv <- eval ctx.env CBN m
@@ -346,9 +353,11 @@ introClause : String -> Icit -> Clause -> M Clause
 introClause nm icit (MkClause fc cons (pat :: pats) expr) =
   if icit == getIcit pat then pure $ MkClause fc ((nm, pat) :: cons) pats expr
   else if icit == Implicit then pure $ MkClause fc ((nm, PatWild fc Implicit) :: cons) (pat :: pats) expr
-  else error fc "Explicit arg and implicit pattern \{show nm} \{show icit} \{show pat}"
+  else if icit == Auto then pure $ MkClause fc ((nm, PatWild fc Auto) :: cons) (pat :: pats) expr
+  else error fc "Explicit arg and \{show $ getIcit pat} pattern \{show nm}  \{show pat}"
 -- handle implicts at end?
 introClause nm Implicit (MkClause fc cons [] expr) = pure $ MkClause fc ((nm, PatWild fc Implicit) :: cons) [] expr
+introClause nm Auto (MkClause fc cons [] expr) = pure $ MkClause fc ((nm, PatWild fc Auto) :: cons) [] expr
 introClause nm icit (MkClause fc cons [] expr) = error fc "Clause size doesn't match"
 
 -- A split candidate looks like x /? Con ...
@@ -542,17 +551,21 @@ buildCase ctx prob scnm scty (dcName, arity, ty) = do
     -- We get a list of clauses back (a Problem) and then solve that
     -- If they all fail, we have a coverage issue. (Assuming the constructor is valid)
 
-    makeConst : List Bind -> List Pattern -> List (String, Pattern)
+    makeConstr : List Bind -> List Pattern -> List (String, Pattern)
-    makeConst [] [] = []
+    makeConstr [] [] = []
     -- would need M in here to throw, and I'm building stuff as I go, I suppose I could <$>
-    makeConst [] (pat :: pats) = ?extra_patterns
+    makeConstr [] (pat :: pats) = ?extra_patterns
-    makeConst ((MkBind nm Implicit x) :: xs) [] = (nm, PatWild emptyFC Implicit) :: makeConst xs []
+    makeConstr ((MkBind nm Implicit x) :: xs) [] = (nm, PatWild emptyFC Implicit) :: makeConstr xs []
-    makeConst ((MkBind nm Explicit x) :: xs) [] = ?extra_binders_2
+    makeConstr ((MkBind nm Auto x) :: xs) [] = (nm, PatWild emptyFC Auto) :: makeConstr xs []
-    makeConst ((MkBind nm Implicit x) :: xs) (pat :: pats) =
+    makeConstr ((MkBind nm Explicit x) :: xs) [] = ?extra_binders_2
+    makeConstr ((MkBind nm Explicit x) :: xs) (pat :: pats) =
       if getIcit pat == Explicit
-        then (nm, PatWild (getFC pat) Implicit) :: makeConst xs (pat :: pats)
+        then (nm, pat) :: makeConstr xs pats
-        else (nm, pat) :: makeConst xs pats
+        else ?explict_implicit_mismatch
-    makeConst ((MkBind nm Explicit x) :: xs) (pat :: pats) = (nm, pat) :: makeConst xs pats
+    makeConstr ((MkBind nm icit x) :: xs) (pat :: pats) =
+      if getIcit pat /= icit -- Implicit/Explicit Implicit/Auto, etc
+        then (nm, PatWild (getFC pat) icit) :: makeConstr xs (pat :: pats)
+        else (nm, pat) :: makeConstr xs pats
 
     -- replace constraint with constraints on parameters, or nothing if non-matching clause
     rewriteConstraint : List Bind -> List Constraint -> List Constraint -> Maybe (List Constraint)
@@ -564,7 +577,7 @@ buildCase ctx prob scnm scty (dcName, arity, ty) = do
           PatWild _ _ => Just $ c :: (xs ++ acc)
           PatLit fc lit => Nothing -- error fc "Literal \{show lit} in constructor split"
           PatCon _ _ str ys => if str == dcName
-            then Just $ (makeConst vars ys) ++ xs ++ acc
+            then Just $ (makeConstr vars ys) ++ xs ++ acc
             else Nothing
         else rewriteConstraint vars xs (c :: acc)
 
@@ -791,7 +804,7 @@ check ctx tm ty = case (tm, !(forceType ty)) of
               let ctx' = extend ctx nm a
               tm' <- check ctx' tm !(b $$ var)
               pure $ Lam fc nm tm'
-            else if icit' == Implicit then do
+            else if icit' /= Explicit then do
               let var = VVar fc (length ctx.env) [<]
               ty' <- b $$ var
               -- use nm' here if we want them automatically in scope
@@ -804,7 +817,7 @@ check ctx tm ty = case (tm, !(forceType ty)) of
 
   (tm, ty@(VPi fc nm' Implicit a b)) => do
     let names = toList $ map fst ctx.types
-    debug "XXX edge add implicit lambda {\{nm'} : \{show a}} to \{show tm} "
+    debug "XXX edge case add implicit lambda {\{nm'} : \{show a}} to \{show tm} "
     let var = VVar fc (length ctx.env) [<]
     ty' <- b $$ var
     debugM $ pure "XXX ty' is \{!(prvalCtx {ctx=(extend ctx nm' a)} ty')}"
@@ -825,9 +838,11 @@ check ctx tm ty = case (tm, !(forceType ty)) of
     -- assuming all of the implicit ty have been handled above
     let names = toList $ map fst ctx.types
     (tm', ty') <- case !(infer ctx tm) of
-      -- Kovacs doesn't insert on tm = Implicit Lam, we don't have Plicity there
+      -- Kovacs doesn't insert on tm = Implicit Lam, we don't have Plicity in Lam
       -- so I'll check the inferred type for an implicit pi
-      (tm'@(Lam{}), ty'@(VPi _ _ Implicit _ _)) => do debug "Lambda"; pure (tm', ty')
+      -- This seems wrong, the ty' is what insert runs on, so we're just short circuiting here
+      (tm'@(Lam{}), ty'@(VPi _ _ Implicit _ _)) => do debug "CheckMe 1"; pure (tm', ty')
+      (tm'@(Lam{}), ty'@(VPi _ _ Auto _ _)) => do debug "CheckMe 2"; pure (tm', ty')
       (tm', ty') => do
         debug "RUN INSERT ON \{pprint names tm'} at \{show ty'}"
         insert ctx tm' ty'
@@ -848,6 +863,7 @@ infer ctx (RVar fc nm) = go 0 ctx.types
       else go (i + 1) xs
   -- need environment of name -> type..
 infer ctx (RApp fc t u icit) = do
+  -- If the app is explicit, add any necessary metas
   (icit, t, tty) <- case the Icit icit of
       Explicit => do
         (t, tty) <- infer ctx t
@@ -856,6 +872,9 @@ infer ctx (RApp fc t u icit) = do
       Implicit => do
         (t, tty) <- infer ctx t
         pure (Implicit, t, tty)
+      Auto => do
+        (t, tty) <- infer ctx t
+        pure (Auto, t, tty)
 
   (a,b) <- case !(forceMeta tty) of
     (VPi fc str icit' a b) => if icit' == icit then pure (a,b)
@@ -865,8 +884,8 @@ infer ctx (RApp fc t u icit) = do
     -- TODO test case to cover this.
     tty => do
       debug "unify PI for \{show tty}"
-      a <- eval ctx.env CBN !(freshMeta ctx fc (VU emptyFC))
+      a <- eval ctx.env CBN !(freshMeta ctx fc (VU emptyFC) Normal)
-      b <- MkClosure ctx.env <$> freshMeta (extend ctx ":ins" a) fc (VU emptyFC)
+      b <- MkClosure ctx.env <$> freshMeta (extend ctx ":ins" a) fc (VU emptyFC) Normal
       unifyCatch fc ctx tty (VPi fc ":ins" icit a b)
       pure (a,b)
 
@@ -896,7 +915,7 @@ infer ctx (RAnn fc tm rty) = do
   pure (tm, vty)
 
 infer ctx (RLam fc nm icit tm) = do
-  a <- freshMeta ctx fc (VU emptyFC) >>= eval ctx.env CBN
+  a <- freshMeta ctx fc (VU emptyFC) Normal >>= eval ctx.env CBN
   let ctx' = extend ctx nm a
   (tm', b) <- infer ctx' tm
   debug "make lam for \{show nm} scope \{pprint (names ctx) tm'} : \{show b}"
@@ -904,9 +923,9 @@ infer ctx (RLam fc nm icit tm) = do
   -- error {ctx} [DS "can't infer lambda"]
 
 infer ctx (RImplicit fc) = do
-  ty <- freshMeta ctx fc (VU emptyFC)
+  ty <- freshMeta ctx fc (VU emptyFC) Normal
   vty <- eval ctx.env CBN ty
-  tm <- freshMeta ctx fc vty
+  tm <- freshMeta ctx fc vty Normal
   pure (tm, vty)
 
 infer ctx (RLit fc (LString str)) = pure (Lit fc (LString str), !(primType fc "String"))

src/Lib/Eval.idr

@@ -94,7 +94,7 @@ eval env mode (App _ t u) = evalSpine env mode t [!(eval env mode u)]
 eval env mode (U fc) = pure (VU fc)
 eval env mode (Meta fc i) =
   case !(lookupMeta i) of
-        (Unsolved _ k xs _) => pure $ VMeta fc i [<]
+        (Unsolved _ k xs _ _) => pure $ VMeta fc i [<]
         (Solved k t) => pure $ t
 eval env mode (Lam fc x t) = pure $ VLam fc x (MkClosure env t)
 eval env mode (Pi fc x icit a b) = pure $ VPi fc x icit !(eval env mode a) (MkClosure env b)
@@ -127,7 +127,7 @@ quote l (VVar fc k sp) = if k < l
   else ?borken
 quote l (VMeta fc i sp) =
   case !(lookupMeta i) of
-        (Unsolved _ k xs _) => quoteSp l (Meta fc i) sp
+        (Unsolved _ k xs _ _) => quoteSp l (Meta fc i) sp
         (Solved k t) => quote l !(vappSpine t sp)
 quote l (VLam fc x t) = pure $ Lam fc x !(quote (S l) !(t $$ VVar emptyFC l [<]))
 quote l (VPi fc x icit a b) = pure $ Pi fc x icit !(quote l a) !(quote (S l) !(b $$ VVar emptyFC l [<]))
@@ -161,7 +161,7 @@ solveMeta ctx ix tm = do
   where
     go : List MetaEntry -> SnocList MetaEntry -> M (List MetaEntry)
     go [] _ = error' "Meta \{show ix} not found"
-    go (meta@(Unsolved pos k _ _) :: xs) lhs = if k == ix
+    go (meta@(Unsolved pos k _ _ _) :: xs) lhs = if k == ix
       then do
         -- empty context should be ok, because this needs to be closed
         putStrLn "INFO at \{show pos}: solve \{show k} as \{!(prval tm)}"
@@ -207,7 +207,7 @@ zonkApp top l env t@(Meta fc k) sp = case !(lookupMeta k) of
     foo <- vappSpine v ([<] <>< sp')
     debug "-> result is \{show foo}"
     quote l foo
-  (Unsolved x j xs _) => pure $ appSpine t sp
+  (Unsolved x j xs _ _) => pure $ appSpine t sp
 zonkApp top l env t sp = pure $ appSpine !(zonk top l env t) sp
 
 zonkAlt : TopContext -> Nat -> Env -> CaseAlt -> M CaseAlt

src/Lib/Parser.idr

@@ -33,6 +33,13 @@ braces pa = do
   sym "}"
   pure t
 
+dbraces : Parser a -> Parser a
+dbraces pa = do
+  sym "{{"
+  t <- pa
+  sym "}}"
+  pure t
+
 
 optional : Parser a -> Parser (Maybe a)
 optional pa = Just <$> pa <|> pure Nothing
@@ -81,7 +88,9 @@ atom = RU <$> getPos <* keyword "U"
 pArg : Parser (Icit,FC,Raw)
 pArg = do
   fc <- getPos
-  (Explicit,fc,) <$> atom <|> (Implicit,fc,) <$> braces typeExpr
+  (Explicit,fc,) <$> atom
+    <|> (Implicit,fc,) <$> braces typeExpr
+    <|> (Auto,fc,) <$> dbraces typeExpr
 
 parseApp : Parser Raw
 parseApp = do
@@ -137,6 +146,7 @@ letExpr = do
 
 pLetArg : Parser (Icit, String, Maybe Raw)
 pLetArg = (Implicit,,) <$> braces (ident <|> uident) <*> optional (sym ":" >> typeExpr)
+       <|> (Auto,,) <$> dbraces (ident <|> uident) <*> optional (sym ":" >> typeExpr)
        <|> (Explicit,,) <$> parens (ident <|> uident) <*> optional (sym ":" >> typeExpr)
        <|> (Explicit,,Nothing) <$> (ident <|> uident)
        <|> (Explicit,"_",Nothing) <$ keyword "_"
@@ -169,6 +179,9 @@ patAtom = do
     <|> braces (PatVar fc Implicit <$> ident)
     <|> braces (PatWild fc Implicit <$ keyword "_")
     <|> braces (PatCon fc Implicit <$> (uident <|> token MixFix) <*> many patAtom)
+    <|> dbraces (PatVar fc Auto <$> ident)
+    <|> dbraces (PatWild fc Auto <$ keyword "_")
+    <|> dbraces (PatCon fc Auto <$> (uident <|> token MixFix) <*> many patAtom)
     <|> parens pPattern
 
 pPattern = PatCon (!getPos) Explicit <$> (uident <|> token MixFix) <*> many patAtom <|> patAtom
@@ -196,11 +209,13 @@ term =  caseExpr
     <|> lamExpr
     <|> parseOp
 
+varname : Parser String
+varname = (ident <|> uident <|> keyword "_" *> pure "_")
 
 ebind : Parser (List (FC, String, Icit, Raw))
 ebind = do
   sym "("
-  names <- some $ withPos (ident <|> uident)
+  names <- some $ withPos varname
   sym ":"
   ty <- typeExpr
   sym ")"
@@ -209,18 +224,27 @@ ebind = do
 ibind : Parser (List (FC, String, Icit, Raw))
 ibind = do
   sym "{"
-  names <- some $ withPos (ident <|> uident)
+  -- REVIEW - I have name required and type optional, which I think is the opposite of what I expect
+  names <- some $ withPos varname
   ty <- optional (sym ":" >> typeExpr)
   sym "}"
   pure $ map (\(pos,name) => (pos, name, Implicit, fromMaybe (RImplicit pos) ty)) names
 
+abind : Parser (List (FC, String, Icit, Raw))
+abind = do
+  sym "{{"
+  names <- some $ withPos varname
+  ty <- optional (sym ":" >> typeExpr)
+  sym "}}"
+  pure $ map (\(pos,name) => (pos, name, Auto, fromMaybe (RImplicit pos) ty)) names
+
 arrow : Parser Unit
 arrow = sym "->" <|> sym "→"
 
 -- Collect a bunch of binders (A : U) {y : A} -> ...
 binders : Parser Raw
 binders = do
-  binds <- many (ibind <|> try ebind)
+  binds <- many (abind <|> ibind <|> try ebind)
   arrow
   scope <- typeExpr
   pure $ foldr (uncurry mkBind) scope (join binds)

src/Lib/ProcessDecl.idr

@@ -87,7 +87,10 @@ processDecl (Def fc nm clauses) = do
 
   for_ mc.metas $ \case
     (Solved k x) => pure ()
-    (Unsolved (l,c) k ctx ty) => do
+    (Unsolved (l,c) k ctx ty User) => do
+      -- TODO print here
+      pure ()
+    (Unsolved (l,c) k ctx ty kind) => do
       -- should just print, but it's too subtle in the sea of messages
       -- we'd also need the ability to mark the whole top context as failure if we continue
       -- put a list of errors in TopContext

src/Lib/Syntax.idr

@@ -207,6 +207,7 @@ Pretty Raw where
     wrap : Icit -> Doc -> Doc
     wrap Explicit x = x
     wrap Implicit x = text "{" ++ x ++ text "}"
+    wrap Auto x = text "{{" ++ x ++ text "}}"
 
     par : Nat -> Nat -> Doc -> Doc
     par p p' d = if p' < p then text "(" ++ d ++ text ")" else d
@@ -217,12 +218,11 @@ Pretty Raw where
     -- This needs precedence and operators...
     asDoc p (RApp _ x y Explicit) = par p 2 $ asDoc 2 x <+> asDoc 3 y
     asDoc p (RApp _ x y Implicit) = par p 2 $ asDoc 2 x <+> text "{" ++ asDoc 0 y ++ text "}"
+    asDoc p (RApp _ x y Auto) = par p 2 $ asDoc 2 x <+> text "{{" ++ asDoc 0 y ++ text "}}"
     asDoc p (RU _) = text "U"
     asDoc p (RPi _ Nothing Explicit ty scope) = par p 1 $ asDoc p ty <+> text "->" <+/> asDoc p scope
-    asDoc p (RPi _ (Just x) Explicit ty scope) =
+    asDoc p (RPi _ nm icit ty scope) =
-      par p 1 $ text "(" <+> text x <+> text ":" <+> asDoc p ty <+> text ")" <+> text "->" <+/> asDoc p scope
+      par p 1 $ wrap icit (text (fromMaybe "_" nm) <+> text ":" <+> asDoc p ty ) <+> text "->" <+/> asDoc 1 scope
-    asDoc p (RPi _ nm Implicit ty scope) =
-      par p 1 $ text "{" <+> text (fromMaybe "_" nm) <+> text ":" <+> asDoc p ty <+> text "}" <+> text "->" <+/> asDoc 1 scope
     asDoc p (RLet _ x v ty scope) =
       par p 0 $ text "let" <+> text x <+> text ":" <+> asDoc p ty
           <+> text "=" <+> asDoc p v

src/Lib/Tokenizer.idr

@@ -61,6 +61,7 @@ rawTokens
   <|> match (blockComment (exact "/-") (exact "-/")) (Tok Space)
   <|> match (exact ",") (Tok Oper)
   <|> match (some opChar) checkOp
+  <|> match (exact "{{" <|> exact "}}") (Tok Keyword)
   <|> match symbol (Tok Symbol)
   <|> match spaces (Tok Space)
 

src/Lib/Types.idr

@@ -21,7 +21,7 @@ Name : Type
 Name = String
 
 public export
-data Icit = Implicit | Explicit
+data Icit = Implicit | Explicit | Auto
 
 %name Icit icit
 
@@ -29,6 +29,7 @@ export
 Show Icit where
   show Implicit = "Implicit"
   show Explicit = "Explicit"
+  show Auto = "Auto"
 
 public export
 data BD = Bound | Defined
@@ -137,6 +138,7 @@ Show Tm where
   show (U _) = "U"
   show (Pi _ str Explicit t u) = "(Pi (\{str} : \{show t}) => \{show u})"
   show (Pi _ str Implicit t u) = "(Pi {\{str} : \{show t}} => \{show u})"
+  show (Pi _ str Auto t u) = "(Pi {{\{str} : \{show t}}} => \{show u})"
   show (Case _ sc alts) = "(Case \{show sc} \{show alts})"
   show (Let _ nm t u) = "(Let \{nm} \{show t} \{show u})"
 
@@ -147,6 +149,7 @@ export
 Eq Icit where
   Implicit == Implicit = True
   Explicit == Explicit = True
+  Auto == Auto = True
   _ == _ = False
 
 ||| Eq on Tm. We've got deBruijn indices, so I'm not comparing names
@@ -182,6 +185,8 @@ pprint names tm = render 80 $ go names tm
     go names (Lam _ nm t) = text "(\\ \{nm} =>" <+> go (nm :: names) t <+> ")"
     go names (App _ t u) = text "(" <+> go names t <+> go names u <+> ")"
     go names (U _) = "U"
+    go names (Pi _ nm Auto t u) =
+      text "({{" <+> text nm <+> ":" <+> go names t <+> "}}" <+> "->" <+> go (nm :: names) u <+> ")"
     go names (Pi _ nm Implicit t u) =
       text "({" <+> text nm <+> ":" <+> go names t <+> "}" <+> "->" <+> go (nm :: names) u <+> ")"
     go names (Pi _ nm Explicit t u) =
@@ -312,7 +317,16 @@ Can I get val back? Do we need to quote? What happens if we don't?
 record Context
 
 public export
-data MetaEntry = Unsolved FC Nat Context Val | Solved Nat Val
+data MetaKind = Normal | User | AutoSolve
+
+public export
+Show MetaKind where
+  show Normal = "Normal"
+  show User = "User"
+  show AutoSolve = "Auto"
+
+public export
+data MetaEntry = Unsolved FC Nat Context Val MetaKind | Solved Nat Val
 
 
 public export
@@ -402,7 +416,7 @@ define ctx name val ty =
 export
 covering
 Show MetaEntry where
-  show (Unsolved pos k ctx ty) = "Unsolved \{show pos} \{show k} : \{show ty} \{show ctx.bds}"
+  show (Unsolved pos k ctx ty kind) = "Unsolved \{show pos} \{show k} \{show kind} : \{show ty} \{show ctx.bds}"
   show (Solved k x) = "Solved \{show k} \{show x}"
 
 export withPos : Context -> FC -> Context
@@ -429,11 +443,11 @@ error' : String -> M a
 error' msg = throwError $ E (0,0) msg
 
 export
-freshMeta : Context -> FC -> Val -> M Tm
+freshMeta : Context -> FC -> Val -> MetaKind -> M Tm
-freshMeta ctx fc ty = do
+freshMeta ctx fc ty kind = do
   mc <- readIORef ctx.metas
   putStrLn "INFO at \{show fc}: fresh meta \{show mc.next} : \{show ty}"
-  writeIORef ctx.metas $ { next $= S, metas $= (Unsolved fc mc.next ctx ty ::) } mc
+  writeIORef ctx.metas $ { next $= S, metas $= (Unsolved fc mc.next ctx ty kind ::) } mc
   pure $ applyBDs 0 (Meta emptyFC mc.next) ctx.bds
   where
     -- hope I got the right order here :)
@@ -457,7 +471,7 @@ lookupMeta ix = do
   where
     go : List MetaEntry -> M MetaEntry
     go [] = error' "Meta \{show ix} not found"
-    go (meta@(Unsolved _ k ys _) :: xs) = if k == ix then pure meta else go xs
+    go (meta@(Unsolved _ k ys _ _) :: xs) = if k == ix then pure meta else go xs
     go (meta@(Solved k x) :: xs) = if k == ix then pure meta else go xs
 
 -- we need more of topcontext later - Maybe switch it up so we're not passing