import CgClosure
import CostCentre
+import BlockId
import Cmm
import PprCmm
import CmmUtils
import Panic
import Constants
import Outputable
+import Bag ( emptyBag, unitBag )
import Control.Monad
import Data.Array
import Data.Char ( ord )
import System.Exit
+
+#include "HsVersions.h"
}
%token
| cmm_kind_expr ',' cmm_kind_exprs { $1 : $3 }
cmm_kind_expr :: { ExtFCode CmmActual }
- : expr { do e <- $1; return (CmmHinted e (inferCmmKind e)) }
+ : expr { do e <- $1; return (CmmKinded e (inferCmmKind e)) }
| expr STRING {% do h <- parseCmmKind $2;
return $ do
- e <- $1; return (CmmHinted e h) }
+ e <- $1; return (CmmKinded e h) }
exprs0 :: { [ExtFCode CmmExpr] }
: {- empty -} { [] }
| cmm_formal ',' cmm_formals { $1 : $3 }
cmm_formal :: { ExtFCode CmmFormal }
- : local_lreg { do e <- $1; return (CmmHinted e (inferCmmKind (CmmReg (CmmLocal e)))) }
+ : local_lreg { do e <- $1; return (CmmKinded e (inferCmmKind (CmmReg (CmmLocal e)))) }
| STRING local_lreg {% do h <- parseCmmKind $1;
return $ do
- e <- $2; return (CmmHinted e h) }
+ e <- $2; return (CmmKinded e h) }
local_lreg :: { ExtFCode LocalReg }
: NAME { do e <- lookupName $1;
( 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)])
(CmmCallee expr' convention) args vols NoC_SRT ret) where
unused = panic "not used by emitForeignCall'"
-adjCallTarget :: CCallConv -> CmmExpr -> [CmmHinted CmmExpr] -> CmmExpr
+adjCallTarget :: CCallConv -> CmmExpr -> [CmmKinded CmmExpr] -> CmmExpr
#ifdef mingw32_TARGET_OS
-- On Windows, we have to add the '@N' suffix to the label when making
-- a call with the stdcall calling convention.
adjCallTarget StdCallConv (CmmLit (CmmLabel lbl)) args
= CmmLit (CmmLabel (addLabelSize lbl (sum (map size args))))
- where size (CmmHinted e _) = max wORD_SIZE (machRepByteWidth (cmmExprRep e))
+ where size (CmmKinded e _) = max wORD_SIZE (machRepByteWidth (cmmExprRep e))
-- c.f. CgForeignCall.emitForeignCall
#endif
adjCallTarget _ expr _
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"
}