X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=fb078758734dec50e6e455732c82ad00dc5ca80e;hb=9ba922ee06b048774d7a82964867ff768a78126e;hp=12b73d3bf259a0c47c5cadba0ec230ea8364c717;hpb=f1a72b2938cc289c9a3879301ab445ec9efd63dd;p=ghc-hetmet.git diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 12b73d3..fb07875 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -45,7 +45,6 @@ import ErrUtils import Panic import Util import DynFlags -import FiniteMap import Exception import Data.IORef @@ -58,6 +57,7 @@ import System.IO.Error as IO import System.Directory import Data.Char import Data.List +import qualified Data.Map as Map #ifndef mingw32_HOST_OS import qualified System.Posix.Internals @@ -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 ) @@ -472,8 +472,8 @@ cleanTempDirs dflags = unless (dopt Opt_KeepTmpFiles dflags) $ do let ref = dirsToClean dflags ds <- readIORef ref - removeTmpDirs dflags (eltsFM ds) - writeIORef ref emptyFM + removeTmpDirs dflags (Map.elems ds) + writeIORef ref Map.empty cleanTempFiles :: DynFlags -> IO () cleanTempFiles dflags @@ -515,7 +515,7 @@ getTempDir :: DynFlags -> IO FilePath getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) = do let ref = dirsToClean dflags mapping <- readIORef ref - case lookupFM mapping tmp_dir of + case Map.lookup tmp_dir mapping of Nothing -> do x <- getProcessID let prefix = tmp_dir "ghc" ++ show x ++ "_" @@ -524,7 +524,7 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) mkTempDir x = let dirname = prefix ++ show x in do createDirectory dirname - let mapping' = addToFM mapping tmp_dir dirname + let mapping' = Map.insert tmp_dir dirname mapping writeIORef ref mapping' debugTraceMsg dflags 2 (ptext (sLit "Created temporary directory:") <+> text dirname) return dirname @@ -597,7 +597,12 @@ 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 rc <- builderMainLoop dflags filter_fn pgm real_args mb_env