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.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)
=> Parser n (Module () n)
pModule
= do pTok KModule
name <- pModuleName
tExports
<- P.choice
[do pTok KExports
pTok KBraceBra
sigs <- P.sepEndBy1 pTypeSig (pTok KSemiColon)
pTok KBraceKet
return sigs
, return []]
tImportKindsTypes
<- P.choice
[do pTok KImports
pTok KBraceBra
importKinds <- P.sepEndBy pImportKindSpec (pTok KSemiColon)
importTypes <- P.sepEndBy pImportTypeSpec (pTok KSemiColon)
pTok KBraceKet
return (importKinds, importTypes)
, return ([], [])]
let (tImportKinds, tImportTypes)
= tImportKindsTypes
pTok KWith
lts <- P.sepBy1 pLets (pTok KIn)
let body = xLets () lts (xUnit ())
return $ ModuleCore
{ moduleName = name
, moduleExportKinds = Map.empty
, moduleExportTypes = Map.fromList tExports
, moduleImportKinds = Map.fromList tImportKinds
, moduleImportTypes = Map.fromList tImportTypes
, moduleBody = body }
pTypeSig :: Ord n => Parser n (n, Type n)
pTypeSig
= do var <- pVar
pTok KColonColon
t <- pType
return (var, t)
pImportKindSpec
:: (Ord n, Pretty n)
=> Parser n (n, (QualName n, Kind n))
pImportKindSpec
= pTok KType
>> P.choice
[
do qn <- pQualName
pTok KWith
n <- pName
pTok KColonColon
k <- pType
return (n, (qn, k))
, do n <- pName
pTok KColonColon
k <- pType
return (n, (QualName (ModuleName []) n, k))
]
pImportTypeSpec
:: (Ord n, Pretty n)
=> Parser n (n, (QualName n, Type n))
pImportTypeSpec
= P.choice
[
do qn <- pQualName
pTok KWith
n <- pName
pTok KColonColon
t <- pType
return (n, (qn, t))
, do n <- pName
pTok KColonColon
t <- pType
return (n, (QualName (ModuleName []) n, t))
]