projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Added a VECTORISE pragma
[ghc-hetmet.git]
/
compiler
/
main
/
SysTools.lhs
diff --git
a/compiler/main/SysTools.lhs
b/compiler/main/SysTools.lhs
index
1693aa0
..
d33fd6c
100644
(file)
--- a/
compiler/main/SysTools.lhs
+++ b/
compiler/main/SysTools.lhs
@@
-45,8
+45,8
@@
import ErrUtils
import Panic
import Util
import DynFlags
import Panic
import Util
import DynFlags
-
import Exception
import Exception
+
import Data.IORef
import Control.Monad
import System.Exit
import Data.IORef
import Control.Monad
import System.Exit
@@
-66,7
+66,7
@@
import Foreign
import Foreign.C.String
#endif
import Foreign.C.String
#endif
-import System.Process ( runInteractiveProcess, getProcessExitCode )
+import System.Process
import Control.Concurrent
import FastString
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
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
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
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 ()
(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
(\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)
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) <-
(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)
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!
; 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')
}}
where
handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')