White space only

[ghc-hetmet.git] / compiler / cmm / CmmParse.y

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 5466e16..9d83e2f 100644 (file)
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -30,6 +30,7 @@ import CgCallConv
 import CgClosure
 import CostCentre
 
+import BlockId
 import Cmm
 import PprCmm
 import CmmUtils
@@ -52,11 +53,14 @@ import FastString
 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
@@ -470,10 +474,10 @@ cmm_kind_exprs :: { [ExtFCode CmmActual] }
        | 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 -}                   { [] }
@@ -497,10 +501,10 @@ cmm_formals :: { [ExtFCode CmmFormal] }
        | 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;
@@ -762,6 +766,7 @@ stmtMacros = listToUFM [
   ( 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)])
 
@@ -922,13 +927,13 @@ foreignCall conv_string results_code expr_code args_code vols safety ret
                    (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 _
@@ -1088,7 +1093,7 @@ initEnv = listToUFM [
     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
@@ -1098,14 +1103,17 @@ parseCmmFile dflags filename = do
                -- 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"
 }