module DDC.Source.Tetra.Parser.Module
(
pModule
, pTypeSig
, pTop)
where
import DDC.Source.Tetra.Parser.Exp
import DDC.Source.Tetra.Compounds
import DDC.Source.Tetra.DataDef
import DDC.Source.Tetra.Module
import DDC.Source.Tetra.Exp
import DDC.Core.Lexer.Tokens
import DDC.Base.Pretty
import Control.Monad
import qualified DDC.Base.Parser as P
import DDC.Core.Parser
( Parser
, Context (..)
, pModuleName
, pName
, pVar
, pTok, pTokSP)
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 KExport
pTok KBraceBra
vars <- P.sepEndBy1 pVar (pTok KSemiColon)
pTok KBraceKet
return vars
, return []]
tImports
<- liftM concat $ P.many (pImportSpecs c)
pTok KWhere
pTok KBraceBra
tops <- P.sepEndBy (pTop c) (pTok KSemiColon)
pTok KBraceKet
return $ Module
{ moduleName = name
, moduleExportTypes = []
, moduleExportValues = tExports
, moduleImportModules = []
, moduleImportTypes = [(n, s) | ImportType n s <- tImports]
, moduleImportValues = [(n, s) | ImportValue n s <- tImports]
, moduleTops = tops }
pTypeSig
:: Ord n
=> Context -> Parser n (n, Type n)
pTypeSig c
= do var <- pVar
pTokSP (KOp ":")
t <- pType c
return (var, t)
data ImportSpec n
= ImportType n (ImportSource n)
| ImportValue n (ImportSource n)
pImportSpecs
:: (Ord n, Pretty n)
=> Context -> Parser n [ImportSpec n]
pImportSpecs c
= do pTok KImport
pTok KForeign
src <- liftM (renderIndent . ppr) pName
P.choice
[
do pTok KType
pTok KBraceBra
sigs <- P.sepEndBy1 (pImportType c src) (pTok KSemiColon)
pTok KBraceKet
return sigs
, do pTok KValue
pTok KBraceBra
sigs <- P.sepEndBy1 (pImportValue c src) (pTok KSemiColon)
pTok KBraceKet
return sigs
]
pImportType
:: (Ord n, Pretty n)
=> Context -> String -> Parser n (ImportSpec n)
pImportType c src
| "abstract" <- src
= do n <- pName
pTokSP (KOp ":")
k <- pType c
return (ImportType n (ImportSourceAbstract k))
| otherwise
= P.unexpected "import mode for foreign type"
pImportValue
:: (Ord n, Pretty n)
=> Context -> String -> Parser n (ImportSpec n)
pImportValue c src
| "c" <- src
= do n <- pName
pTokSP (KOp ":")
k <- pType c
let symbol = renderIndent (ppr n)
return (ImportValue n (ImportSourceSea symbol k))
| otherwise
= P.unexpected "import mode for foreign value"
pTop :: Ord n
=> Context -> Parser n (Top P.SourcePos n)
pTop c
= P.choice
[ do
(b, x) <- pLetBinding c
let Just sp = takeAnnotOfExp x
return $ TopBind sp b x
, do pData c
]
pData :: Ord n
=> Context -> Parser n (Top P.SourcePos n)
pData c
= do sp <- pTokSP KData
n <- pName
ps <- liftM concat $ P.many (pDataParam c)
P.choice
[
do pTok KWhere
pTok KBraceBra
ctors <- P.sepEndBy1 (pDataCtor c) (pTok KSemiColon)
pTok KBraceKet
return $ TopData sp (DataDef n ps ctors)
, do return $ TopData sp (DataDef n ps [])
]
pDataParam :: Ord n => Context -> Parser n [Bind n]
pDataParam c
= do pTok KRoundBra
ns <- P.many1 pName
pTokSP (KOp ":")
k <- pType c
pTok KRoundKet
return [BName n k | n <- ns]
pDataCtor :: Ord n => Context -> Parser n (DataCtor n)
pDataCtor c
= do n <- pName
pTokSP (KOp ":")
t <- pType c
let (tsArg, tResult)
= takeTFunArgResult t
return $ DataCtor
{ dataCtorName = n
, dataCtorFieldTypes = tsArg
, dataCtorResultType = tResult }