X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=fb078758734dec50e6e455732c82ad00dc5ca80e;hb=edc0bafd3fcd01b85a2e8894e5dfe149eb0e0857;hp=29889db4f3dfd7baa2ae33161ab81715c1e4508d;hpb=49a8e5c021009430d373d6224b29004c7d18c408;p=ghc-hetmet.git

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 29889db..fb07875 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -18,7 +18,6 @@ module SysTools (
         runAs, runLink,          -- [Option] -> IO ()
         runMkDLL,
         runWindres,
-        runLlvmAs,
         runLlvmOpt,
         runLlvmLlc,
 
@@ -46,7 +45,6 @@ import ErrUtils
 import Panic
 import Util
 import DynFlags
-import FiniteMap
 
 import Exception
 import Data.IORef
@@ -59,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
@@ -67,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 )
@@ -223,8 +222,7 @@ initSysTools mbMinusB dflags0
                 ld_prog  = gcc_prog
 
         -- figure out llvm location. (TODO: Acutally implement).
-        ; let la_prog = "llvm-as"
-              lc_prog = "llc"
+        ; let lc_prog = "llc"
               lo_prog = "opt"
 
         ; return dflags1{
@@ -244,7 +242,6 @@ initSysTools mbMinusB dflags0
                         pgm_T   = touch_path,
                         pgm_sysman = top_dir ++ "/ghc/rts/parallel/SysMan",
                         pgm_windres = windres_path,
-                        pgm_la  = (la_prog,[]),
                         pgm_lo  = (lo_prog,[]),
                         pgm_lc  = (lc_prog,[])
                         -- Hans: this isn't right in general, but you can
@@ -392,11 +389,6 @@ runAs dflags args = do
   mb_env <- getGccEnv args1
   runSomethingFiltered dflags id "Assembler" p args1 mb_env
 
-runLlvmAs :: DynFlags -> [Option] -> IO ()
-runLlvmAs dflags args = do
-  let (p,args0) = pgm_la dflags
-  runSomething dflags "LLVM Assembler" p (args0++args)
-
 runLlvmOpt :: DynFlags -> [Option] -> IO ()
 runLlvmOpt dflags args = do
   let (p,args0) = pgm_lo dflags
@@ -480,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
@@ -523,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 ++ "_"
@@ -532,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
@@ -605,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