module UHC.Light.Compiler.CoreRun.Parser
( parseModFromString )
where
import UHC.Light.Compiler.Base.Common
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 $ scan corerunScanOpts (initPos $ take 80 str) str of
(res, []) -> Right res
(_, errs) -> Left $ map show errs
type CRParser hp = PlainParser Token hp
pMod :: CRParser Mod
pMod
= (\nm nr sz main bs -> mkMod nm nr sz bs main)
<$ pMODULE <*> pMaybe (mkHNm "Main") id pDollNm <*> pInt <* pCOMMA <*> pInt <* pRARROW <*> pExp <* pSEMI
<*> pList (pExp <* pSEMI)
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"
<|> mkLocLevRef <$ pKeyTk "l"
) <* pDOT <*> pInt <* pDOT <*> pInt
pS = pDOT
*> ( RRef_Tag <$ pKeyTk "tag"
<|> flip RRef_Fld <$> pInt
)