[project @ 2001-02-12 13:33:46 by simonmar]

Clean up temporary files between compilations, but cache preprocessed
modules that we might re-use.

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 09f1db8..f136af7 100644 (file)
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -36,6 +36,7 @@ import DriverUtil     ( splitFilename3 )
 import ErrUtils                ( showPass )
 import Util
 import DriverUtil
+import TmpFiles
 import Outputable
 import Panic
 import CmdLineOpts     ( DynFlags(..) )
@@ -284,6 +285,10 @@ cmLoadModule cmstate1 rootname
            -- Easy; just relink it all.
            do when (verb >= 2) $ 
                 hPutStrLn stderr "Upsweep completely successful."
+
+             -- clean up after ourselves
+             cleanTempFilesExcept verb (ppFilesFromSummaries modsDone)
+
               linkresult 
                  <- link ghci_mode dflags a_root_is_Main ui3 pls2
               case linkresult of
@@ -321,6 +326,9 @@ cmLoadModule cmstate1 rootname
                      = map (unJust "linkables_to_link" . findModuleLinkable_maybe ui4)
                            mods_to_keep_names
 
+             -- clean up after ourselves
+             cleanTempFilesExcept verb (ppFilesFromSummaries mods_to_keep)
+
               linkresult <- link ghci_mode dflags False linkables_to_link pls2
               case linkresult of
                  LinkErrs _ _
@@ -334,6 +342,9 @@ cmLoadModule cmstate1 rootname
                                   map ms_mod mods_to_keep)
 
 
+ppFilesFromSummaries summaries
+  = [ fn | Just fn <- map (ml_hspp_file . ms_location) summaries ]
+
 -----------------------------------------------------------------------------
 -- getValidLinkables
 

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 51e5e47..263f49d 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.49 2001/01/21 16:37:06 sewardj Exp $
+-- $Id: Main.hs,v 1.50 2001/02/12 13:33:46 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -103,7 +103,7 @@ main =
    later (do  forget_it <- readIORef v_Keep_tmp_files
              unless forget_it $ do
              verb <- dynFlag verbosity
-             cleanTempFiles (verb >= 2)
+             cleanTempFiles verb
      ) $ do
        -- exceptions will be blocked while we clean the temporary files,
        -- so there shouldn't be any difficulty if we receive further

diff --git a/ghc/compiler/main/TmpFiles.hs b/ghc/compiler/main/TmpFiles.hs
index 5bd5e59..2a6eb7f 100644 (file)
--- a/ghc/compiler/main/TmpFiles.hs
+++ b/ghc/compiler/main/TmpFiles.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.14 2000/12/11 15:26:00 sewardj Exp $
+-- $Id: TmpFiles.hs,v 1.15 2001/02/12 13:33:47 simonmar Exp $
 --
 -- Temporary file management
 --
@@ -10,9 +10,11 @@
 module TmpFiles (
    Suffix,
    initTempFileStorage,  -- :: IO ()
-   cleanTempFiles,       -- :: IO ()
+   cleanTempFiles,       -- :: Int -> IO ()
+   cleanTempFilesExcept, -- :: Int -> [FilePath] -> IO ()
    newTempName,                 -- :: Suffix -> IO FilePath
    addFilesToClean,     -- :: [FilePath] -> IO ()
+   removeTmpFiles,      -- :: Int -> [FilePath] -> IO ()
    v_TmpDir
  ) where
 
@@ -46,18 +48,17 @@ initTempFileStorage = do
              return ()
           )
 
-cleanTempFiles :: Bool -> IO ()
-cleanTempFiles verbose = do
+cleanTempFiles :: Int -> IO ()
+cleanTempFiles verb = do
   fs <- readIORef v_FilesToClean
+  removeTmpFiles verb fs
 
-  let blowAway f =
-          (do  when verbose (hPutStrLn stderr ("Removing: " ++ f))
-               if '*' `elem` f then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
-                               else removeFile f)
-           `catchAllIO`
-          (\_ -> when verbose (hPutStrLn stderr 
-                               ("Warning: can't remove tmp file " ++ f)))
-  mapM_ blowAway fs
+cleanTempFilesExcept :: Int -> [FilePath] -> IO ()
+cleanTempFilesExcept verb dont_delete = do
+  fs <- readIORef v_FilesToClean
+  let leftovers = filter (`notElem` dont_delete) fs
+  removeTmpFiles verb leftovers
+  writeIORef v_FilesToClean dont_delete
 
 type Suffix = String
 
@@ -76,3 +77,16 @@ newTempName extn = do
 
 addFilesToClean :: [FilePath] -> IO ()
 addFilesToClean files = mapM_ (add v_FilesToClean) files
+
+removeTmpFiles :: Int -> [FilePath] -> IO ()
+removeTmpFiles verb fs = do
+  let verbose = verb >= 2
+      blowAway f =
+          (do  when verbose (hPutStrLn stderr ("Removing: " ++ f))
+               if '*' `elem` f 
+                 then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
+                 else removeFile f)
+           `catchAllIO`
+          (\_ -> when verbose (hPutStrLn stderr 
+                               ("Warning: can't remove tmp file " ++ f)))
+  mapM_ blowAway fs