diff options
Diffstat (limited to 'compiler/GHC/Cmm')
| -rw-r--r-- | compiler/GHC/Cmm/Lexer.x | 2 | ||||
| -rw-r--r-- | compiler/GHC/Cmm/Parser.y | 14 | ||||
| -rw-r--r-- | compiler/GHC/Cmm/Parser/Monad.hs | 2 |
3 files changed, 9 insertions, 9 deletions
diff --git a/compiler/GHC/Cmm/Lexer.x b/compiler/GHC/Cmm/Lexer.x index 3828685645..85b06ea624 100644 --- a/compiler/GHC/Cmm/Lexer.x +++ b/compiler/GHC/Cmm/Lexer.x @@ -326,7 +326,7 @@ lexToken = do AlexEOF -> do let span = mkPsSpan loc1 loc1 liftP (setLastToken span 0) return (L span CmmT_EOF) - AlexError (loc2,_) -> liftP $ failLocMsgP (psRealLoc loc1) (psRealLoc loc2) (Error ErrCmmLexer []) + AlexError (loc2,_) -> liftP $ failLocMsgP (psRealLoc loc1) (psRealLoc loc2) (PsError PsErrCmmLexer []) AlexSkip inp2 _ -> do setInput inp2 lexToken diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y index b0a7465a48..c04c9b82ca 100644 --- a/compiler/GHC/Cmm/Parser.y +++ b/compiler/GHC/Cmm/Parser.y @@ -919,7 +919,7 @@ getLit _ = panic "invalid literal" -- TODO messy failure nameToMachOp :: FastString -> PD (Width -> MachOp) nameToMachOp name = case lookupUFM machOps name of - Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownPrimitive name)) [] + Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownPrimitive name)) [] Just m -> return m exprOp :: FastString -> [CmmParse CmmExpr] -> PD (CmmParse CmmExpr) @@ -1081,12 +1081,12 @@ parseSafety :: String -> PD Safety parseSafety "safe" = return PlaySafe parseSafety "unsafe" = return PlayRisky parseSafety "interruptible" = return PlayInterruptible -parseSafety str = failMsgPD $ Error (ErrCmmParser (CmmUnrecognisedSafety str)) [] +parseSafety str = failMsgPD $ PsError (PsErrCmmParser (CmmUnrecognisedSafety str)) [] parseCmmHint :: String -> PD ForeignHint parseCmmHint "ptr" = return AddrHint parseCmmHint "signed" = return SignedHint -parseCmmHint str = failMsgPD $ Error (ErrCmmParser (CmmUnrecognisedHint str)) [] +parseCmmHint str = failMsgPD $ PsError (PsErrCmmParser (CmmUnrecognisedHint str)) [] -- labels are always pointers, so we might as well infer the hint inferCmmHint :: CmmExpr -> ForeignHint @@ -1113,7 +1113,7 @@ happyError = PD $ \_ _ s -> unP srcParseFail s stmtMacro :: FastString -> [CmmParse CmmExpr] -> PD (CmmParse ()) stmtMacro fun args_code = do case lookupUFM stmtMacros fun of - Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownMacro fun)) [] + Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownMacro fun)) [] Just fcode -> return $ do args <- sequence args_code code (fcode args) @@ -1216,7 +1216,7 @@ foreignCall conv_string results_code expr_code args_code safety ret = do conv <- case conv_string of "C" -> return CCallConv "stdcall" -> return StdCallConv - _ -> failMsgPD $ Error (ErrCmmParser (CmmUnknownCConv conv_string)) [] + _ -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownCConv conv_string)) [] return $ do platform <- getPlatform results <- sequence results_code @@ -1294,7 +1294,7 @@ primCall results_code name args_code = do platform <- PD.getPlatform case lookupUFM (callishMachOps platform) name of - Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownPrimitive name)) [] + Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownPrimitive name)) [] Just f -> return $ do results <- sequence results_code args <- sequence args_code @@ -1448,7 +1448,7 @@ initEnv profile = listToUFM [ ] where platform = profilePlatform profile -parseCmmFile :: DynFlags -> HomeUnit -> FilePath -> IO (Bag Warning, Bag Error, Maybe CmmGroup) +parseCmmFile :: DynFlags -> HomeUnit -> FilePath -> IO (Bag PsWarning, Bag PsError, Maybe CmmGroup) parseCmmFile dflags home_unit filename = do buf <- hGetStringBuffer filename let diff --git a/compiler/GHC/Cmm/Parser/Monad.hs b/compiler/GHC/Cmm/Parser/Monad.hs index b8aa0180d8..77124ad1b2 100644 --- a/compiler/GHC/Cmm/Parser/Monad.hs +++ b/compiler/GHC/Cmm/Parser/Monad.hs @@ -47,7 +47,7 @@ instance Monad PD where liftP :: P a -> PD a liftP (P f) = PD $ \_ _ s -> f s -failMsgPD :: (SrcSpan -> Error) -> PD a +failMsgPD :: (SrcSpan -> PsError) -> PD a failMsgPD = liftP . failMsgP returnPD :: a -> PD a |