import Panic
import Constants
import Outputable
+import Bag ( emptyBag, unitBag )
import Control.Monad
import Data.Array
( fsLit "RET_NPP", \[a,b,c] -> emitRetUT [(NonPtrArg,a),(PtrArg,b),(PtrArg,c)]),
( fsLit "RET_NNP", \[a,b,c] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(PtrArg,c)]),
( fsLit "RET_NNN", \[a,b,c] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c)]),
+ ( fsLit "RET_NNNN", \[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c),(NonPtrArg,d)]),
( fsLit "RET_NNNP", \[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c),(PtrArg,d)]),
( fsLit "RET_NPNP", \[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(PtrArg,b),(NonPtrArg,c),(PtrArg,d)])
Var (CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordRep) ))
]
-parseCmmFile :: DynFlags -> FilePath -> IO (Maybe Cmm)
+parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe Cmm)
parseCmmFile dflags filename = do
showPass dflags "ParseCmm"
buf <- hGetStringBuffer filename
-- reset the lex_state: the Lexer monad leaves some stuff
-- in there we don't want.
case unP cmmParse init_state of
- PFailed span err -> do printError span err; return Nothing
+ PFailed span err -> do
+ let msg = mkPlainErrMsg span err
+ return ((emptyBag, unitBag msg), Nothing)
POk pst code -> do
- cmm <- initC dflags no_module (getCmm (unEC code initEnv [] >> return ()))
- let ms = getMessages pst
- printErrorsAndWarnings dflags ms
- when (errorsFound dflags ms) $ exitWith (ExitFailure 1)
- dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (ppr cmm)
- return (Just cmm)
+ cmm <- initC dflags no_module (getCmm (unEC code initEnv [] >> return ()))
+ let ms = getMessages pst
+ if (errorsFound dflags ms)
+ then return (ms, Nothing)
+ else do
+ dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (ppr cmm)
+ return (ms, Just cmm)
where
no_module = panic "parseCmmFile: no module"
}