diff --git a/lib/Quox/Parser/FromParser.idr b/lib/Quox/Parser/FromParser.idr index ddf8671..5a4edc7 100644 --- a/lib/Quox/Parser/FromParser.idr +++ b/lib/Quox/Parser/FromParser.idr @@ -8,6 +8,7 @@ import Quox.Parser.Syntax import Quox.Parser.Parser import public Quox.Parser.LoadFile import Quox.Typechecker +import Quox.CheckBuiltin import Data.List import Data.Maybe @@ -333,6 +334,13 @@ liftTC tc = runEff tc $ with Union.(::) \g => send g, \g => send g] +private +liftWhnf : Eff Whnf a -> Eff FromParserPure a +liftWhnf tc = runEff tc $ with Union.(::) + [handleExcept $ \e => throw $ WrapTypeError e, + \g => send g, + \g => send g] + private addDef : Has DefsState fs => Name -> Definition -> Eff fs NDefinition addDef name def = do @@ -344,7 +352,8 @@ export covering fromPDef : PDefinition -> Eff FromParserPure NDefinition fromPDef def = do name <- fromPBaseNameNS def.name - when !(getsAt DEFS $ isJust . lookup name) $ do + defs <- getAt DEFS + when (isJust $ lookup name defs) $ do throw $ AlreadyExists def.loc name gqty <- globalPQty def.qty let sqty = globalToSubj gqty @@ -352,17 +361,19 @@ fromPDef def = do PConcrete ptype pterm => do type <- traverse fromPTerm ptype term <- fromPTerm pterm - case type of + type <- case type of Just type => do ignore $ liftTC $ do checkTypeC empty type Nothing checkC empty sqty term type - addDef name $ mkDef gqty type term def.scheme def.main def.loc + pure type Nothing => do let E elim = term | _ => throw $ AnnotationNeeded term.loc empty term res <- liftTC $ inferC empty sqty elim - addDef name $ mkDef gqty res.type term def.scheme def.main def.loc + pure res.type + when def.main $ liftWhnf $ expectMainType defs type + addDef name $ mkDef gqty type term def.scheme def.main def.loc PPostulate ptype => do type <- fromPTerm ptype addDef name $ mkPostulate gqty type def.scheme def.main def.loc