X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=e44ed6d7b3a8e27f67acf91439bd94d43faa8a65;hb=80ce44f764633347ea15b570e3f758b6e7aecd63;hp=594407e766d2ec210ffc87bd4f3ab5b07f4e78dd;hpb=ee565d464248078a4f2d46f98667aa4fcdc56db4;p=ghc-hetmet.git

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 594407e..e44ed6d 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -37,31 +37,26 @@ module SysTools (
 
 #include "HsVersions.h"
 
-import DriverPhases     ( isHaskellUserSrcFilename )
+import DriverPhases
 import Config
 import Outputable
-import ErrUtils		( putMsg, debugTraceMsg, showPass, Severity(..), Messages )
-import Panic		( GhcException(..) )
-import Util		( Suffix, global, notNull, consIORef, joinFileName,
-			  normalisePath, pgmPath, platformPath, joinFileExt )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt, Option(..),
-			  setTmpDir, defaultDynFlags )
-
-import EXCEPTION	( throwDyn, finally )
-import DATA_IOREF	( IORef, readIORef, writeIORef )
-import DATA_INT
-    
-import Monad		( when, unless )
-import System		( ExitCode(..), getEnv, system )
-import IO		( try, catch, hGetContents,
-			  openFile, hPutStr, hClose, hFlush, IOMode(..), 
-			  stderr, ioError, isDoesNotExistError,
-			  isAlreadyExistsError )
-import Directory	( doesFileExist, removeFile,
-			  createDirectory, removeDirectory )
-import Maybe		( isJust )
-import List             ( partition )
-import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, eltsFM )
+import ErrUtils
+import Panic
+import Util
+import DynFlags
+import FiniteMap
+
+import Control.Exception
+import Data.IORef
+import Data.Int
+import Control.Monad
+import System.Exit
+import System.Environment
+import System.IO
+import SYSTEM_IO_ERROR as IO
+import System.Directory
+import Data.Maybe
+import Data.List
 
 -- GHC <= 4.08 didn't have rawSystem, and runs into problems with long command
 -- lines on mingw32, so we disallow it now.
@@ -86,12 +81,12 @@ import Text.Regex
 
 #if __GLASGOW_HASKELL__ < 603
 -- rawSystem comes from libghccompat.a in stage1
-import Compat.RawSystem	( rawSystem )
+import Compat.RawSystem ( rawSystem )
+import System.Cmd       ( system )
 import GHC.IOBase       ( IOErrorType(..) ) 
-import System.IO.Error  ( ioeGetErrorType )
 #else
+import System.Cmd       ( rawSystem, system )
 import System.Process	( runInteractiveProcess, getProcessExitCode )
-import System.IO        ( hSetBuffering, hGetLine, BufferMode(..) )
 import Control.Concurrent( forkIO, newChan, readChan, writeChan )
 import Data.Char        ( isSpace )
 import FastString       ( mkFastString )
@@ -499,22 +494,25 @@ GLOBAL_VAR(v_DirsToClean, emptyFM, FiniteMap FilePath FilePath )
 \begin{code}
 cleanTempDirs :: DynFlags -> IO ()
 cleanTempDirs dflags
-   = do ds <- readIORef v_DirsToClean
+   = unless (dopt Opt_KeepTmpFiles dflags)
+   $ do ds <- readIORef v_DirsToClean
         removeTmpDirs dflags (eltsFM ds)
         writeIORef v_DirsToClean emptyFM
 
 cleanTempFiles :: DynFlags -> IO ()
 cleanTempFiles dflags
-   = do fs <- readIORef v_FilesToClean
-	removeTmpFiles dflags fs
-	writeIORef v_FilesToClean []
+   = unless (dopt Opt_KeepTmpFiles dflags)
+   $ do fs <- readIORef v_FilesToClean
+        removeTmpFiles dflags fs
+        writeIORef v_FilesToClean []
 
 cleanTempFilesExcept :: DynFlags -> [FilePath] -> IO ()
 cleanTempFilesExcept dflags dont_delete
-   = do files <- readIORef v_FilesToClean
-	let (to_keep, to_delete) = partition (`elem` dont_delete) files
-	removeTmpFiles dflags to_delete
-	writeIORef v_FilesToClean to_keep
+   = unless (dopt Opt_KeepTmpFiles dflags)
+   $ do files <- readIORef v_FilesToClean
+        let (to_keep, to_delete) = partition (`elem` dont_delete) files
+        removeTmpFiles dflags to_delete
+        writeIORef v_FilesToClean to_keep
 
 
 -- find a temporary name that doesn't already exist.