[project @ 2001-02-07 12:54:09 by sewardj]

[ghc-hetmet.git] / ghc / compiler / main / TmpFiles.hs

diff --git a/ghc/compiler/main/TmpFiles.hs b/ghc/compiler/main/TmpFiles.hs
index 310c747..5bd5e59 100644 (file)
--- a/ghc/compiler/main/TmpFiles.hs
+++ b/ghc/compiler/main/TmpFiles.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.3 2000/10/23 09:03:27 simonpj Exp $
+-- $Id: TmpFiles.hs,v 1.14 2000/12/11 15:26:00 sewardj Exp $
 --
 -- Temporary file management
 --
@@ -12,16 +12,16 @@ module TmpFiles (
    initTempFileStorage,  -- :: IO ()
    cleanTempFiles,       -- :: IO ()
    newTempName,                 -- :: Suffix -> IO FilePath
-   addFilesToClean      -- :: [FilePath] -> IO ()
+   addFilesToClean,     -- :: [FilePath] -> IO ()
+   v_TmpDir
  ) where
 
 -- main
-import DriverState
 import Config
 import Util
+import DriverUtil
 
 -- hslibs
--- import Posix                commented out SLPJ
 import Exception
 import IOExts
 
@@ -34,24 +34,29 @@ import Monad
 #include "HsVersions.h"
 
 GLOBAL_VAR(v_FilesToClean, [],               [String] )
+GLOBAL_VAR(v_TmpDir,       cDEFAULT_TMPDIR,  String   )
+
 
 initTempFileStorage = do
        -- check whether TMPDIR is set in the environment
    IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
-             writeIORef v_TmpDir dir)
-
+#ifndef mingw32_TARGET_OS
+             writeIORef v_TmpDir dir
+#endif
+             return ()
+          )
 
 cleanTempFiles :: Bool -> IO ()
 cleanTempFiles verbose = do
   fs <- readIORef v_FilesToClean
 
   let blowAway f =
-          (do  when verbose (hPutStrLn stderr ("removing: " ++ f))
-               if '*' `elem` f then system ("rm -f " ++ f) >> return ()
+          (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)))
+                               ("Warning: can't remove tmp file " ++ f)))
   mapM_ blowAway fs
 
 type Suffix = String
@@ -59,7 +64,7 @@ type Suffix = String
 -- find a temporary name that doesn't already exist.
 newTempName :: Suffix -> IO FilePath
 newTempName extn = do
-  x <- getProcessID
+  x <- myGetProcessID
   tmp_dir <- readIORef v_TmpDir
   findTempName tmp_dir x
   where findTempName tmp_dir x = do
@@ -71,9 +76,3 @@ newTempName extn = do
 
 addFilesToClean :: [FilePath] -> IO ()
 addFilesToClean files = mapM_ (add v_FilesToClean) files
-
-add :: IORef [a] -> a -> IO ()
-add var x = do
-  xs <- readIORef var
-  writeIORef var (x:xs)
-