-----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.1 2000/10/10 13:21:10 simonmar Exp $
+-- $Id: TmpFiles.hs,v 1.10 2000/12/05 12:09:43 sewardj Exp $
--
-- Temporary file management
--
Suffix,
initTempFileStorage, -- :: IO ()
cleanTempFiles, -- :: IO ()
- newTempName -- :: Suffix -> IO FilePath
+ newTempName, -- :: Suffix -> IO FilePath
+ addFilesToClean, -- :: [FilePath] -> IO ()
+ v_TmpDir
) where
-- main
import Util
-- hslibs
-import Posix
import Exception
import IOExts
#include "HsVersions.h"
-GLOBAL_VAR( v_FilesToClean, [], [String] )
-GLOBAL_VAR( v_TmpDir, cDEFAULT_TMPDIR, String )
+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 tmpdir dir)
-
+#ifndef mingw32_TARGET_OS
+ writeIORef v_TmpDir dir
+#endif
+ )
cleanTempFiles :: Bool -> IO ()
cleanTempFiles verbose = do
fs <- readIORef v_FilesToClean
let blowAway f =
- (do when verbose (hPutStrLn stderr ("removing: " ++ f))
+ (do when verbose (hPutStrLn stderr ("Removing: " ++ f))
if '*' `elem` f then system ("rm -f " ++ f) >> 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
-- 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
let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
b <- doesFileExist filename
if b then findTempName tmp_dir (x+1)
- else return filename
+ else do add v_FilesToClean filename -- clean it up later
+ return filename
+
+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)