diff --git a/TODO.md b/TODO.md index 7ab55cc..826f812 100644 --- a/TODO.md +++ b/TODO.md @@ -17,6 +17,7 @@ - [ ] Duplicate data constructors point to `data` - [ ] Allow Qualified names in surface syntax - Don't disambiguate on type for now + - [ ] Could we disambiguate just Data constructors on type? - [x] change "in prefix position" and "trailing operator" errors to do sections - [ ] maybe add fat arrows, I keep wanting to type them, `{{...}}` is a little ugly - There may be ambiguity issues at the parsing level, but we don't have typecase, so. diff --git a/src/Lib/Elab.newt b/src/Lib/Elab.newt index 36751c0..d9fada3 100644 --- a/src/Lib/Elab.newt +++ b/src/Lib/Elab.newt @@ -636,10 +636,8 @@ freshMeta ctx fc ty kind = do -- I tried checking Auto immediately if CheckAll, but there isn't enough information yet. pure $ applyBDs 0 (Meta fc qn) ctx.bds where - -- hope I got the right order here :) applyBDs : Int -> Tm -> List BD -> Tm applyBDs k t Nil = t - -- review the order here applyBDs k t (Bound :: xs) = App emptyFC (applyBDs (1 + k) t xs) (Bnd emptyFC k) applyBDs k t (Defined :: xs) = applyBDs (1 + k) t xs @@ -1353,32 +1351,33 @@ showDef ctx names n v = do pure "= \{vv}" -- desugar do -undo : FC -> List DoStmt -> M Raw -undo prev Nil = error prev "do block must end in expression" -undo prev ((DoExpr fc tm) :: Nil) = pure tm --- TODO decide if we want to use >> or just >>= -undo prev ((DoExpr fc tm) :: xs) = do - xs' <- undo fc xs - -- output is bigger, not sure if it helps inference or not +undo : List DoStmt -> M Raw +-- Should be unreachable in practice +undo Nil = error emptyFC "do block must end in expression" +undo ((DoExpr fc tm) :: Nil) = pure tm +undo (tm :: Nil) = error (getFC tm) "do block must end in expression" +undo ((DoExpr fc tm) :: xs) = do + xs' <- undo xs + -- Not sure if it helps inference or not (and now fails with erasure thing) -- pure $ RApp fc (RApp fc (RVar fc "_>>_") tm Explicit) xs' Explicit - pure $ RApp fc (RApp fc (RVar fc "_>>=_") tm Explicit) (RLam fc (BI fc "_" Explicit Many) xs') Explicit -undo prev ((DoLet fc nm tm) :: xs) = RLet fc nm (RImplicit fc) tm <$> undo fc xs -undo prev ((DoArrow fc left@(RVar fc' nm) right Nil) :: xs) = do + pure $ RApp fc (RApp fc (RVar fc "bind") tm Explicit) (RLam fc (BI fc "_" Explicit Many) xs') Explicit +undo ((DoLet fc nm tm) :: xs) = RLet fc nm (RImplicit fc) tm <$> undo xs +undo ((DoArrow fc left@(RVar fc' nm) right Nil) :: xs) = do top <- getTop case lookupRaw nm top of Just _ => do let nm = "$sc" - xs' <- undo fc xs + xs' <- undo xs rest <- pure $ RCase fc (RVar fc nm) Nothing (MkAlt left (Just xs') :: Nil) pure $ RApp fc (RApp fc (RVar fc "_>>=_") right Explicit) (RLam fc (BI fc nm Explicit Many) rest) Explicit Nothing => do - xs' <- undo fc xs + xs' <- undo xs pure $ RApp fc (RApp fc (RVar fc "_>>=_") right Explicit) (RLam fc (BI fc' nm Explicit Many) xs') Explicit -undo prev ((DoArrow fc left right alts) :: xs) = do +undo ((DoArrow fc left right alts) :: xs) = do let nm = "$sc" - xs' <- undo fc xs + xs' <- undo xs rest <- pure $ RCase fc (RVar fc nm) Nothing (MkAlt left (Just xs') :: alts) pure $ RApp fc (RApp fc (RVar fc "_>>=_") right Explicit) (RLam fc (BI fc nm Explicit Many) rest) Explicit @@ -1453,8 +1452,8 @@ check ctx tm ty = do let tm' = RCase fc a Nothing (MkAlt (RVar (getFC b) "True") (Just b) :: MkAlt (RVar (getFC c) "False") (Just c) :: Nil) in check ctx tm' ty (RDo fc stmts, ty) => do - stmts' <- undo fc stmts - check ctx stmts' ty + body <- undo stmts + check ctx body ty (RCase fc rsc mty alts, ty) => do (sc, scty) <- case mty of Nothing => infer ctx rsc @@ -1535,9 +1534,8 @@ check ctx tm ty = do sc <- check (extend ctx nm' a) tm ty' pure $ Lam (getFC tm) nm' Auto rig sc - (tm,ty) => do + (tm, ty) => do (tm', ty') <- infer ctx tm - -- REVIEW - should we look at `tm` to know how many to insert? Is there a case where this helps? (tm', ty') <- insert ctx tm' ty' let names = map fst ctx.types diff --git a/src/Lib/Erasure.newt b/src/Lib/Erasure.newt index d05c9e2..b234091 100644 --- a/src/Lib/Erasure.newt +++ b/src/Lib/Erasure.newt @@ -96,8 +96,7 @@ erase env t sp = case t of (Bnd fc k) => do case getAt (cast k) env of Nothing => error fc "bad index \{show k}" - -- This is working, but empty FC - Just (nm, Zero, ty) => error fc "used erased value \{show nm} (FIXME FC may be wrong here)" + Just (nm, Zero, ty) => error fc "used erased value \{show nm} (FIXME FC may be wrong here - see Elab.lookupName)" Just (nm, Many, ty) => eraseSpine env t sp ty (UU fc) => eraseSpine env t sp (Just $ UU fc) (Lit fc lit) => eraseSpine env t sp Nothing diff --git a/src/Lib/Syntax.newt b/src/Lib/Syntax.newt index 976c932..4abbc94 100644 --- a/src/Lib/Syntax.newt +++ b/src/Lib/Syntax.newt @@ -35,6 +35,11 @@ data DoStmt : U where DoLet : (fc : FC) -> String -> Raw -> DoStmt DoArrow : (fc : FC) -> Raw -> Raw -> List RCaseAlt -> DoStmt +instance HasFC DoStmt where + getFC (DoExpr fc _) = fc + getFC (DoArrow fc _ _ _) = fc + getFC (DoLet fc _ _) = fc + Decl : U data Raw : U where RVar : (fc : FC) -> (nm : Name) -> Raw diff --git a/src/Prelude.newt b/src/Prelude.newt index cb3bd8e..b082053 100644 --- a/src/Prelude.newt +++ b/src/Prelude.newt @@ -3,7 +3,7 @@ module Prelude id : ∀ a. a → a id x = x -the : (a : U) → a → a +the : (0 a : U) → a → a the _ a = a const : ∀ a b. a → b → a