add check for #[main] type

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