X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=d33fd6c8c6e9f17cb43565cf2e3bdb2d81f92942;hb=3deca8f44135bd1a146902f498189af00dd4d7b4;hp=1693aa06a98334e32638b03b75eaead7df8c61ef;hpb=e95ee1f718c6915c478005aad8af81705357d6ab;p=ghc-hetmet.git diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 1693aa0..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 @@ -66,7 +66,7 @@ import Foreign import Foreign.C.String #endif -import System.Process ( runInteractiveProcess, getProcessExitCode ) +import System.Process import Control.Concurrent import FastString import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan ) @@ -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 @@ -597,9 +597,14 @@ runSomethingFiltered runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do let real_args = filter notNull (map showOpt args) - traceCmd dflags phase_name (unwords (pgm:real_args)) $ do +#if __GLASGOW_HASKELL__ >= 701 + cmdLine = showCommandForUser pgm real_args +#else + cmdLine = unwords (pgm:real_args) +#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) @@ -751,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')