Make the lists of files and directories to be cleaned-up non-global

They still need to be stored in IORefs, as the exception handler needs
to know what they all are.

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 53ace5c..8f7b05c 100644 (file)
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1071,8 +1071,8 @@ runPhase SplitMangle _stop hsc_env _basename _suff input_fn _get_output_fn maybe
            dflags' = dflags { splitInfo = Just (split_s_prefix, n_files) }
 
        -- Remember to delete all these files
-       addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
-                       | n <- [1..n_files]]
+       addFilesToClean dflags' [ split_s_prefix ++ "__" ++ show n ++ ".s"
+                               | n <- [1..n_files]]
 
        return (SplitAs, dflags', maybe_loc, "**splitmangle**")
          -- we don't use the filename

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 1e405ea..b5cfb23 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -84,10 +84,11 @@ import Util
 import Maybes           ( orElse )
 import SrcLoc
 import FastString
+import FiniteMap
 import Outputable
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
-import Data.IORef       ( readIORef )
+import Data.IORef
 import Control.Monad    ( when )
 
 import Data.Char
@@ -433,6 +434,12 @@ data DynFlags = DynFlags {
   pkgDatabase           :: Maybe (UniqFM PackageConfig),
   pkgState              :: PackageState,
 
+  -- Temporary files
+  -- These have to be IORefs, because the defaultCleanupHandler needs to
+  -- know what to clean when an exception happens
+  filesToClean          :: IORef [FilePath],
+  dirsToClean           :: IORef (FiniteMap FilePath FilePath),
+
   -- hsc dynamic flags
   flags                 :: [DynFlag],
 
@@ -539,10 +546,14 @@ initDynFlags dflags = do
  ways <- readIORef v_Ways
  build_tag <- readIORef v_Build_tag
  rts_build_tag <- readIORef v_RTS_Build_tag
+ refFilesToClean <- newIORef []
+ refDirsToClean <- newIORef emptyFM
  return dflags{
         wayNames        = ways,
         buildTag        = build_tag,
-        rtsBuildTag     = rts_build_tag
+        rtsBuildTag     = rts_build_tag,
+        filesToClean    = refFilesToClean,
+        dirsToClean     = refDirsToClean
         }
 
 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
@@ -641,6 +652,8 @@ defaultDynFlags =
         depExcludeMods    = [],
         depSuffixes       = [],
         -- end of ghc -M values
+        filesToClean   = panic "defaultDynFlags: No filesToClean",
+        dirsToClean    = panic "defaultDynFlags: No dirsToClean",
         haddockOptions = Nothing,
         flags = [
             Opt_AutoLinkPackages,

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index d1fd9f7..136ab35 100644 (file)
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -525,32 +525,30 @@ getExtraViaCOpts dflags = do
 %************************************************************************
 
 \begin{code}
-GLOBAL_VAR(v_FilesToClean, [],               [String] )
-GLOBAL_VAR(v_DirsToClean, emptyFM, FiniteMap FilePath FilePath )
-\end{code}
-
-\begin{code}
 cleanTempDirs :: DynFlags -> IO ()
 cleanTempDirs dflags
    = unless (dopt Opt_KeepTmpFiles dflags)
-   $ do ds <- readIORef v_DirsToClean
+   $ do let ref = dirsToClean dflags
+        ds <- readIORef ref
         removeTmpDirs dflags (eltsFM ds)
-        writeIORef v_DirsToClean emptyFM
+        writeIORef ref emptyFM
 
 cleanTempFiles :: DynFlags -> IO ()
 cleanTempFiles dflags
    = unless (dopt Opt_KeepTmpFiles dflags)
-   $ do fs <- readIORef v_FilesToClean
+   $ do let ref = filesToClean dflags
+        fs <- readIORef ref
         removeTmpFiles dflags fs
-        writeIORef v_FilesToClean []
+        writeIORef ref []
 
 cleanTempFilesExcept :: DynFlags -> [FilePath] -> IO ()
 cleanTempFilesExcept dflags dont_delete
    = unless (dopt Opt_KeepTmpFiles dflags)
-   $ do files <- readIORef v_FilesToClean
+   $ do let ref = filesToClean dflags
+        files <- readIORef ref
         let (to_keep, to_delete) = partition (`elem` dont_delete) files
         removeTmpFiles dflags to_delete
-        writeIORef v_FilesToClean to_keep
+        writeIORef ref to_keep
 
 
 -- find a temporary name that doesn't already exist.
@@ -565,14 +563,16 @@ newTempName dflags extn
       = do let filename = (prefix ++ show x) <.> extn
            b  <- doesFileExist filename
            if b then findTempName prefix (x+1)
-                else do consIORef v_FilesToClean filename -- clean it up later
+                else do -- clean it up later
+                        consIORef (filesToClean dflags) filename
                         return filename
 
 -- return our temporary directory within tmp_dir, creating one if we
 -- don't have one yet
 getTempDir :: DynFlags -> IO FilePath
 getTempDir dflags@(DynFlags{tmpDir=tmp_dir})
-  = do mapping <- readIORef v_DirsToClean
+  = do let ref = dirsToClean dflags
+       mapping <- readIORef ref
        case lookupFM mapping tmp_dir of
            Nothing ->
                do x <- getProcessID
@@ -583,7 +583,7 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir})
                        = let dirname = prefix ++ show x
                          in do createDirectory dirname
                                let mapping' = addToFM mapping tmp_dir dirname
-                               writeIORef v_DirsToClean mapping'
+                               writeIORef ref mapping'
                                debugTraceMsg dflags 2 (ptext (sLit "Created temporary directory:") <+> text dirname)
                                return dirname
                             `IO.catch` \e ->
@@ -593,9 +593,9 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir})
                   mkTempDir 0
            Just d -> return d
 
-addFilesToClean :: [FilePath] -> IO ()
+addFilesToClean :: DynFlags -> [FilePath] -> IO ()
 -- May include wildcards [used by DriverPipeline.run_phase SplitMangle]
-addFilesToClean files = mapM_ (consIORef v_FilesToClean) files
+addFilesToClean dflags files = mapM_ (consIORef (filesToClean dflags)) files
 
 removeTmpDirs :: DynFlags -> [FilePath] -> IO ()
 removeTmpDirs dflags ds