From: Ian Lynagh Date: Sat, 18 Dec 2010 21:33:50 +0000 (+0000) Subject: Replace uses of the old catch function with the new one X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=b00e3a6c0a82a8af3238d677f798d812cd7fd49f Replace uses of the old catch function with the new one --- diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index 9b9ca5e..cb784e8 100644 --- a/compiler/coreSyn/MkExternalCore.lhs +++ b/compiler/coreSyn/MkExternalCore.lhs @@ -27,6 +27,7 @@ import Encoding import ForeignCall import DynFlags import FastString +import Exception import Data.Char import System.IO @@ -35,10 +36,10 @@ emitExternalCore :: DynFlags -> CgGuts -> IO () emitExternalCore dflags cg_guts | dopt Opt_EmitExternalCore dflags = (do handle <- openFile corename WriteMode - hPutStrLn handle (show (mkExternalCore cg_guts)) + hPutStrLn handle (show (mkExternalCore cg_guts)) hClose handle) - `catch` (\_ -> pprPanic "Failed to open or write external core output file" - (text corename)) + `catchIO` (\_ -> pprPanic "Failed to open or write external core output file" + (text corename)) where corename = extCoreName dflags emitExternalCore _ _ | otherwise diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index fb07875..d33fd6c 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -45,8 +45,8 @@ import ErrUtils import Panic import Util import DynFlags - import Exception + import Data.IORef import Control.Monad import System.Exit @@ -528,7 +528,7 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) writeIORef ref mapping' debugTraceMsg dflags 2 (ptext (sLit "Created temporary directory:") <+> text dirname) return dirname - `IO.catch` \e -> + `catchIO` \e -> if isAlreadyExistsError e then mkTempDir (x+1) else ioError e @@ -567,7 +567,7 @@ removeTmpFiles dflags fs (non_deletees, deletees) = partition isHaskellUserSrcFilename fs removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO () -removeWith dflags remover f = remover f `IO.catch` +removeWith dflags remover f = remover f `catchIO` (\e -> let msg = if isDoesNotExistError e then ptext (sLit "Warning: deleting non-existent") <+> text f @@ -604,7 +604,7 @@ runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do #endif traceCmd dflags phase_name cmdLine $ do (exit_code, doesn'tExist) <- - IO.catch (do + catchIO (do rc <- builderMainLoop dflags filter_fn pgm real_args mb_env case rc of ExitSuccess{} -> return (rc, False) @@ -756,7 +756,7 @@ traceCmd dflags phase_name cmd_line action ; unless (dopt Opt_DryRun dflags) $ do { -- And run it! - ; action `IO.catch` handle_exn verb + ; action `catchIO` handle_exn verb }} where handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n') diff --git a/compiler/parser/ParserCoreUtils.hs b/compiler/parser/ParserCoreUtils.hs index 2c88aa7..8f67d96 100644 --- a/compiler/parser/ParserCoreUtils.hs +++ b/compiler/parser/ParserCoreUtils.hs @@ -1,5 +1,6 @@ module ParserCoreUtils where +import Exception import System.IO data ParseResult a = OkP a | FailP String @@ -19,7 +20,7 @@ failP s s' _ = FailP (s ++ ":" ++ s') getCoreModuleName :: FilePath -> IO String getCoreModuleName fpath = - catch (do + catchIO (do h <- openFile fpath ReadMode ls <- hGetContents h let mo = findMod (words ls) diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 55a1a4f5..01a293d 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -86,6 +86,7 @@ module Util ( #include "HsVersions.h" +import Exception import Panic import Data.Data @@ -99,7 +100,7 @@ import FastTypes #endif import Control.Monad ( unless ) -import System.IO.Error as IO ( catch, isDoesNotExistError ) +import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, createDirectory, getModificationTime ) import System.FilePath @@ -939,9 +940,9 @@ doesDirNameExist fpath = case takeDirectory fpath of modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime) modificationTimeIfExists f = do (do t <- getModificationTime f; return (Just t)) - `IO.catch` \e -> if isDoesNotExistError e - then return Nothing - else ioError e + `catchIO` \e -> if isDoesNotExistError e + then return Nothing + else ioError e -- split a string at the last character where 'pred' is True, -- returning a pair of strings. The first component holds the string diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 5a26324..2f3ca85 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -280,7 +280,7 @@ helpText = findEditor :: IO String findEditor = do getEnv "EDITOR" - `IO.catch` \_ -> do + `catchIO` \_ -> do #if mingw32_HOST_OS win <- System.Win32.getWindowsDirectory return (win "notepad.exe") @@ -413,7 +413,7 @@ runGHCi paths maybe_exprs = do Right hdl -> do runInputTWithPrefs defaultPrefs defaultSettings $ runCommands $ fileLoop hdl - liftIO (hClose hdl `IO.catch` \_ -> return ()) + liftIO (hClose hdl `catchIO` \_ -> return ()) where getDirectory f = case takeDirectory f of "" -> "."; d -> d diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index c0c21aa..e843d88 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -724,7 +724,7 @@ updateDBCache verbosity db = do when (verbosity > Normal) $ putStrLn ("writing cache " ++ filename) writeBinaryFileAtomic filename (map convertPackageInfoOut (packages db)) - `catch` \e -> + `catchIO` \e -> if isPermissionError e then die (filename ++ ": you don't have permission to modify this file") else ioError e @@ -1138,7 +1138,7 @@ writeNewConfig verbosity filename ipis = do $ map (show . convertPackageInfoOut) ipis fileContents = "[" ++ shown ++ "\n]" writeFileUtf8Atomic filename fileContents - `catch` \e -> + `catchIO` \e -> if isPermissionError e then die (filename ++ ": you don't have permission to modify this file") else ioError e @@ -1374,7 +1374,7 @@ findModules paths = return (concat mms) searchDir path prefix = do - fs <- getDirectoryEntries path `catch` \_ -> return [] + fs <- getDirectoryEntries path `catchIO` \_ -> return [] searchEntries path prefix fs searchEntries path prefix [] = return [] @@ -1417,7 +1417,7 @@ expandEnvVars str0 force = go str0 "" lookupEnvVar :: String -> IO String lookupEnvVar nm = - catch (System.Environment.getEnv nm) + catchIO (System.Environment.getEnv nm) (\ _ -> do dieOrForceAll force ("Unable to expand variable " ++ show nm) return "") @@ -1533,10 +1533,10 @@ installSignalHandlers = do #if mingw32_HOST_OS || mingw32_TARGET_OS throwIOIO :: Exception.IOException -> IO a throwIOIO = Exception.throwIO +#endif catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a catchIO = Exception.catch -#endif catchError :: IO a -> (String -> IO a) -> IO a catchError io handler = io `Exception.catch` handler' @@ -1624,5 +1624,5 @@ readUTF8File file = do -- removeFileSave doesn't throw an exceptions, if the file is already deleted removeFileSafe :: FilePath -> IO () removeFileSafe fn = - removeFile fn `catch` \ e -> + removeFile fn `catchIO` \ e -> when (not $ isDoesNotExistError e) $ ioError e diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs index 397a041..5655f83 100644 --- a/utils/hpc/HpcUtils.hs +++ b/utils/hpc/HpcUtils.hs @@ -23,9 +23,9 @@ readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String readFileFromPath _ filename@('/':_) _ = readFile filename readFileFromPath err filename path0 = readTheFile path0 where - readTheFile [] = err $ "could not find " ++ show filename - ++ " in path " ++ show path0 - readTheFile (dir:dirs) = - catch (do str <- readFile (dir ++ "/" ++ filename) - return str) - (\ _ -> readTheFile dirs) + readTheFile [] = err $ "could not find " ++ show filename + ++ " in path " ++ show path0 + readTheFile (dir:dirs) = + catchIO (do str <- readFile (dir ++ "/" ++ filename) + return str) + (\ _ -> readTheFile dirs)