module UHC.Light.Compiler.CoreRun.Parser
( parseModFromString
, pMod )
where
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Opts.Base
import UHC.Light.Compiler.Base.HsName.Builtin
import UHC.Util.ScanUtils
import UHC.Light.Compiler.Scanner.Common
import UHC.Light.Compiler.Scanner.Scanner
import UU.Parsing as P
import UHC.Util.ParseUtils
import UHC.Light.Compiler.Base.Parser
import Data.Maybe
import UHC.Light.Compiler.CoreRun
parseModFromString :: String -> Either [String] Mod
parseModFromString str = case parseToResMsgs (pMod emptyEHCOpts) $ scan corerunScanOpts (initPos $ take 80 str) str of
(res, []) -> Right res
(_, errs) -> Left $ map show errs
pDifficultNm :: CRParser HsName
pDifficultNm = (\s -> mkHNm s) <$> pStr
type CRParser hp = PlainParser Token hp
pMod :: EHCOpts -> CRParser Mod
pMod _
= (\nm nr sz main is ms bs -> mkModWithImportsMetas nm nr sz is ms (crarrayFromList bs) main)
<$ pMODULE <*> pMaybe (mkHNm "Main") id pDollNm <*> pInt <* pCOMMA <*> pInt <*> pMb (pRARROW *> pExp) <* pSEMI
<*> pList (pImport <* pSEMI)
<*> pList (pMeta <* pSEMI)
<*> pList (pExp <* pSEMI)
pImport :: CRParser Import
pImport
= Import_Import <$ pIMPORT <*> pDollNm
pMeta :: CRParser Meta
pMeta
= Meta_Data <$ pDATA <*> pDifficultNm <* pEQUAL <*> pListSep pCOMMA pDataCon
pDataCon :: CRParser DataCon
pDataCon = DataCon_Con <$> pDifficultNm <* pRARROW <*> pInt
pSExp :: CRParser SExp
pSExp
= mkInt' <$> pInt
<|> (mkChar' . head) <$> pChar
<|> mkString' <$> pString
<|> mkVar' <$> pRRef
pExp :: CRParser Exp
pExp = pE
where pB = mkExp <$> pSExp
<|> pParens pE
<|> mkEval <$ pKeyTk "eval" <*> pB
<|> mkTail <$ pKeyTk "tail" <*> pB
pE = pB
<|> ( mkApp <$ pKeyTk "app" <*> pB
<|> mkTup <$ pKeyTk "alloc" <*> pInt
<|> mkFFI <$ pKeyTk "ffi" <*> pString
) <*> pParens (pListSep pCOMMA pSExp)
<|> dbg <$ pKeyTk "dbg" <*> pString
<|> mkCase <$ pCASE <*> pSExp <* pOF <*> pList1 (pRARROW *> pE <* pSEMI)
<|> mkLet <$ pLET <*> pInt <* pRARROW <*> pList1 (pE <* pSEMI) <* pIN <*> pE
<|> mkLam <$ pLAM <*> pInt <* pCOMMA <*> pInt <* pRARROW <*> pE
pRRef :: CRParser RRef
pRRef
= (\b sufs -> foldl (flip ($)) b sufs) <$> pB <*> pList_ng pS
where pB = ( ( mkLocDifRef <$ pKeyTk "d"
<|> mkGlobRef <$ pKeyTk "g"
<|> mkImpRef <$ pKeyTk "i"
<|> mkLocLevRef <$ pKeyTk "l"
) <* pDOT <*> pInt <* pDOT <*> pInt
)
<|> ( mkModRef <$ pKeyTk "m" <* pDOT <*> pInt
)
pS = pDOT
*> ( RRef_Tag <$ pKeyTk "tag"
<|> flip RRef_Fld <$> pInt
)