diff --git a/TODO.md b/TODO.md index 986fa12..624aa84 100644 --- a/TODO.md +++ b/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 diff --git a/src/Lib/CompileExp.idr b/src/Lib/CompileExp.idr index 651a4e1..c99c359 100644 --- a/src/Lib/CompileExp.idr +++ b/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 diff --git a/src/Lib/Elab.idr b/src/Lib/Elab.idr index 2379e87..e234aae 100644 --- a/src/Lib/Elab.idr +++ b/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) - makeConst [] [] = [] + makeConstr : List Bind -> List Pattern -> List (String, Pattern) + 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 - makeConst ((MkBind nm Implicit x) :: xs) [] = (nm, PatWild emptyFC Implicit) :: makeConst xs [] - makeConst ((MkBind nm Explicit x) :: xs) [] = ?extra_binders_2 - makeConst ((MkBind nm Implicit x) :: xs) (pat :: pats) = + makeConstr [] (pat :: pats) = ?extra_patterns + makeConstr ((MkBind nm Implicit x) :: xs) [] = (nm, PatWild emptyFC Implicit) :: makeConstr xs [] + makeConstr ((MkBind nm Auto x) :: xs) [] = (nm, PatWild emptyFC Auto) :: makeConstr xs [] + 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) - else (nm, pat) :: makeConst xs pats - makeConst ((MkBind nm Explicit x) :: xs) (pat :: pats) = (nm, pat) :: makeConst xs pats + then (nm, pat) :: makeConstr xs pats + else ?explict_implicit_mismatch + 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)) - b <- MkClosure ctx.env <$> freshMeta (extend ctx ":ins" a) 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) 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")) diff --git a/src/Lib/Eval.idr b/src/Lib/Eval.idr index ca000a3..dd427b1 100644 --- a/src/Lib/Eval.idr +++ b/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 diff --git a/src/Lib/Parser.idr b/src/Lib/Parser.idr index 06963a1..2f28ea1 100644 --- a/src/Lib/Parser.idr +++ b/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) diff --git a/src/Lib/ProcessDecl.idr b/src/Lib/ProcessDecl.idr index 1ea9495..692e491 100644 --- a/src/Lib/ProcessDecl.idr +++ b/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 diff --git a/src/Lib/Syntax.idr b/src/Lib/Syntax.idr index 134d28c..e196c10 100644 --- a/src/Lib/Syntax.idr +++ b/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) = - par p 1 $ text "(" <+> text x <+> text ":" <+> asDoc p ty <+> text ")" <+> text "->" <+/> asDoc p 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 (RPi _ nm icit ty scope) = + par p 1 $ wrap icit (text (fromMaybe "_" nm) <+> text ":" <+> asDoc p ty ) <+> 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 diff --git a/src/Lib/Tokenizer.idr b/src/Lib/Tokenizer.idr index af299f6..e7ff77f 100644 --- a/src/Lib/Tokenizer.idr +++ b/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) diff --git a/src/Lib/Types.idr b/src/Lib/Types.idr index 084b2a4..bd29ecc 100644 --- a/src/Lib/Types.idr +++ b/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 ctx fc ty = do +freshMeta : Context -> FC -> Val -> MetaKind -> M Tm +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