From: simonmar <unknown>
Date: Tue, 10 Oct 2000 13:21:10 +0000 (+0000)
Subject: [project @ 2000-10-10 13:21:10 by simonmar]
X-Git-Tag: Approximately_9120_patches~3653
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=015975f75c98a9ffff6881cfa13a742545765948;p=ghc-hetmet.git

[project @ 2000-10-10 13:21:10 by simonmar]
Temporary file management, broken out of the driver.
---

diff --git a/ghc/compiler/main/TmpFiles.hs b/ghc/compiler/main/TmpFiles.hs
new file mode 100644
index 0000000..5ec340b
--- /dev/null
+++ b/ghc/compiler/main/TmpFiles.hs
@@ -0,0 +1,69 @@
+-----------------------------------------------------------------------------
+-- $Id: TmpFiles.hs,v 1.1 2000/10/10 13:21:10 simonmar Exp $
+--
+-- Temporary file management
+--
+-- (c) The University of Glasgow 2000
+--
+-----------------------------------------------------------------------------
+
+module TmpFiles (
+   Suffix,
+   initTempFileStorage,  -- :: IO ()
+   cleanTempFiles,       -- :: IO ()
+   newTempName		 -- :: Suffix -> IO FilePath
+ ) where
+
+-- main
+import Config
+import Util
+
+-- hslibs
+import Posix
+import Exception
+import IOExts
+
+-- std
+import System
+import Directory
+import IO
+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 tmpdir dir)
+
+
+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 ()
+			        else removeFile f)
+	    `catchAllIO`
+	   (\_ -> when verbose (hPutStrLn stderr 
+				("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
+  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
+