add check for #[main] type
This commit is contained in:
parent
dd697ba56e
commit
b7dc5ffdc4
1 changed files with 15 additions and 4 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue