module DDC.Core.Parser.Module
(pModule)
where
import DDC.Core.Module
import DDC.Core.Exp
import DDC.Core.Parser.Type
import DDC.Core.Parser.Exp
import DDC.Core.Parser.Context
import DDC.Core.Parser.Base
import DDC.Core.Lexer.Tokens
import DDC.Core.Compounds
import DDC.Base.Pretty
import qualified DDC.Base.Parser as P
import qualified Data.Map as Map
pModule :: (Ord n, Pretty n)
=> Context
-> Parser n (Module P.SourcePos n)
pModule c
= do sp <- pTokSP KModule
name <- pModuleName
tExports
<- P.choice
[do pTok KExports
pTok KBraceBra
sigs <- P.sepEndBy1 (pTypeSig c) (pTok KSemiColon)
pTok KBraceKet
return sigs
, return []]
tImportKindsTypes
<- P.choice
[do pTok KImports
pTok KBraceBra
importKinds <- P.sepEndBy (pImportKindSpec c) (pTok KSemiColon)
importTypes <- P.sepEndBy (pImportTypeSpec c) (pTok KSemiColon)
pTok KBraceKet
return (importKinds, importTypes)
, return ([], [])]
let (tImportKinds, tImportTypes)
= tImportKindsTypes
pTok KWith
lts <- P.sepBy1 (pLetsSP c) (pTok KIn)
let body = xLetsAnnot lts (xUnit sp)
return $ ModuleCore
{ moduleName = name
, moduleExportKinds = Map.empty
, moduleExportTypes = Map.fromList tExports
, moduleImportKinds = Map.fromList tImportKinds
, moduleImportTypes = Map.fromList tImportTypes
, moduleBody = body }
pTypeSig
:: Ord n
=> Context -> Parser n (n, Type n)
pTypeSig c
= do var <- pVar
pTok KColonColon
t <- pType c
return (var, t)
pImportKindSpec
:: (Ord n, Pretty n)
=> Context -> Parser n (n, (QualName n, Kind n))
pImportKindSpec c
= pTok KType
>> P.choice
[
do qn <- pQualName
pTok KWith
n <- pName
pTok KColonColon
k <- pType c
return (n, (qn, k))
, do n <- pName
pTok KColonColon
k <- pType c
return (n, (QualName (ModuleName []) n, k))
]
pImportTypeSpec
:: (Ord n, Pretty n)
=> Context -> Parser n (n, (QualName n, Type n))
pImportTypeSpec c
= P.choice
[
do qn <- pQualName
pTok KWith
n <- pName
pTok KColonColon
t <- pType c
return (n, (qn, t))
, do n <- pName
pTok KColonColon
t <- pType c
return (n, (QualName (ModuleName []) n, t))
]