summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs2
-rw-r--r--compiler/GHC/Driver/Main.hs3
-rw-r--r--compiler/GHC/Driver/Make.hs26
-rw-r--r--compiler/GHC/Driver/MakeFile.hs2
-rw-r--r--compiler/GHC/Driver/Pipeline.hs4
-rw-r--r--compiler/GHC/Driver/Pipeline/Execute.hs15
-rw-r--r--compiler/GHC/Driver/Session.hs5
-rw-r--r--compiler/GHC/Linker/ExtraObj.hs4
-rw-r--r--compiler/GHC/Linker/Loader.hs2
-rw-r--r--compiler/GHC/Linker/Static.hs2
-rw-r--r--compiler/GHC/Linker/Windows.hs4
-rw-r--r--compiler/GHC/StgToCmm.hs2
-rw-r--r--compiler/GHC/SysTools/Process.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs2
-rw-r--r--compiler/GHC/Utils/TmpFs.hs48
15 files changed, 65 insertions, 58 deletions
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index 291cae88d5..6108e529af 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -210,7 +210,7 @@ outputForeignStubs
outputForeignStubs logger tmpfs dflags unit_state mod location stubs
= do
let stub_h = mkStubPaths dflags (moduleName mod) location
- stub_c <- newTempName logger tmpfs dflags TFL_CurrentModule "c"
+ stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c"
case stubs of
NoStubs ->
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index cb3c82ebd1..523d39e3db 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -437,7 +437,8 @@ hscParse' mod_summary
-- - filter out the .hs/.lhs source filename if we have one
--
let n_hspp = FilePath.normalise src_filename
- srcs0 = nub $ filter (not . (tmpDir dflags `isPrefixOf`))
+ TempDir tmp_dir = tmpDir dflags
+ srcs0 = nub $ filter (not . (tmp_dir `isPrefixOf`))
$ filter (not . (== n_hspp))
$ map FilePath.normalise
$ filter (not . isPrefixOf "<")
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 2f03bcebd7..aef6953a30 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -80,7 +80,7 @@ import GHC.Data.StringBuffer
import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Exception ( AsyncException(..), evaluate )
-import GHC.Utils.Monad ( allM )
+import GHC.Utils.Monad ( allM, MonadIO )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
@@ -538,7 +538,7 @@ load' how_much mHscMessage mod_graph = do
-- Clean up after ourselves
hsc_env1 <- getSession
- liftIO $ cleanCurrentModuleTempFiles logger (hsc_tmpfs hsc_env1) dflags
+ liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags
-- Issue a warning for the confusing case where the user
-- said '-o foo' but we're not going to do any linking.
@@ -605,7 +605,7 @@ load' how_much mHscMessage mod_graph = do
]
tmpfs <- hsc_tmpfs <$> getSession
liftIO $ changeTempFilesLifetime tmpfs TFL_CurrentModule unneeded_temps
- liftIO $ cleanCurrentModuleTempFiles logger tmpfs dflags
+ liftIO $ cleanCurrentModuleTempFilesMaybe logger tmpfs dflags
let hpt5 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
hpt4
@@ -1335,9 +1335,9 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_tmpfs lcl_dflags
return (hsc_env'', localize_hsc_env hsc_env'')
-- Clean up any intermediate files.
- cleanCurrentModuleTempFiles (hsc_logger lcl_hsc_env')
- (hsc_tmpfs lcl_hsc_env')
- (hsc_dflags lcl_hsc_env')
+ cleanCurrentModuleTempFilesMaybe (hsc_logger lcl_hsc_env')
+ (hsc_tmpfs lcl_hsc_env')
+ (hsc_dflags lcl_hsc_env')
return Succeeded
where
@@ -1435,9 +1435,9 @@ upsweep mHscMessage old_hpt sccs = do
hsc_env <- getSession
-- Remove unwanted tmp files between compilations
- liftIO $ cleanCurrentModuleTempFiles (hsc_logger hsc_env)
- (hsc_tmpfs hsc_env)
- (hsc_dflags hsc_env)
+ liftIO $ cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env)
+ (hsc_tmpfs hsc_env)
+ (hsc_dflags hsc_env)
-- Get ready to tie the knot
type_env_var <- liftIO $ newIORef emptyNameEnv
@@ -2175,7 +2175,7 @@ enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd
, ms_mod `Set.member` needs_codegen_set
= do
let new_temp_file suf dynsuf = do
- tn <- newTempName logger tmpfs dflags staticLife suf
+ tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf
let dyn_tn = tn -<.> dynsuf
addFilesToClean tmpfs dynLife [dyn_tn]
return tn
@@ -2709,3 +2709,9 @@ cyclicModuleErr mss
ppr_ms :: ModSummary -> SDoc
ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>
(parens (text (msHsFilePath ms)))
+
+
+cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()
+cleanCurrentModuleTempFilesMaybe logger tmpfs dflags =
+ unless (gopt Opt_KeepTmpFiles dflags) $
+ liftIO $ cleanCurrentModuleTempFiles logger tmpfs
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index 8f53d2f598..8207b37c7b 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -136,7 +136,7 @@ beginMkDependHS :: Logger -> TmpFs -> DynFlags -> IO MkDepFiles
beginMkDependHS logger tmpfs dflags = do
-- open a new temp file in which to stuff the dependency info
-- as we go along.
- tmp_file <- newTempName logger tmpfs dflags TFL_CurrentModule "dep"
+ tmp_file <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "dep"
tmp_hdl <- openFile tmp_file WriteMode
-- open the makefile
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index cdd22b1388..26d2213a01 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -176,7 +176,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase =
Just input_buf -> do
fn <- newTempName (hsc_logger hsc_env)
(hsc_tmpfs hsc_env)
- (hsc_dflags hsc_env)
+ (tmpDir (hsc_dflags hsc_env))
TFL_CurrentModule
("buf_" ++ src_suffix pipe_env)
hdl <- openBinaryFile fn WriteMode
@@ -600,7 +600,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do
-- and https://github.com/haskell/cabal/issues/2257
let logger = hsc_logger hsc_env
let tmpfs = hsc_tmpfs hsc_env
- empty_stub <- newTempName logger tmpfs dflags TFL_CurrentModule "c"
+ empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c"
let home_unit = hsc_home_unit hsc_env
src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;"
writeFile empty_stub (showSDoc dflags (pprCode CStyle src))
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index d843f29056..57d491104e 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -157,7 +157,10 @@ runMergeForeign _pipe_env hsc_env _location input_fn foreign_os = do
else do
-- Work around a binutil < 2.31 bug where you can't merge objects if the output file
-- is one of the inputs
- new_o <- newTempName (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) TFL_CurrentModule "o"
+ new_o <- newTempName (hsc_logger hsc_env)
+ (hsc_tmpfs hsc_env)
+ (tmpDir (hsc_dflags hsc_env))
+ TFL_CurrentModule "o"
copyFile input_fn new_o
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
@@ -764,8 +767,8 @@ getOutputFilename logger tmpfs stop_phase output basename dflags next_phase mayb
Nothing ->
panic "SpecificFile: No filename"
| keep_this_output = persistent_fn
- | Temporary lifetime <- output = newTempName logger tmpfs dflags lifetime suffix
- | otherwise = newTempName logger tmpfs dflags TFL_CurrentModule
+ | Temporary lifetime <- output = newTempName logger tmpfs (tmpDir dflags) lifetime suffix
+ | otherwise = newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule
suffix
where
hcsuf = hcSuf dflags
@@ -926,7 +929,7 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do
pkgs = catMaybes (map (lookupUnit unit_state) uids)
mb_macro_include <-
if not (null pkgs) && gopt Opt_VersionMacros dflags
- then do macro_stub <- newTempName logger tmpfs dflags TFL_CurrentModule "h"
+ then do macro_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "h"
writeFile macro_stub (generatePackageVersionMacros pkgs)
-- Include version macros for every *exposed* package.
-- Without -hide-all-packages and with a package database
@@ -1069,14 +1072,14 @@ joinObjectFiles logger tmpfs dflags o_files output_fn = do
if ldIsGnuLd
then do
- script <- newTempName logger tmpfs dflags TFL_CurrentModule "ldscript"
+ script <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "ldscript"
cwd <- getCurrentDirectory
let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files
writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"
ld_r [GHC.SysTools.FileOption "" script]
else if toolSettings_ldSupportsFilelist toolSettings'
then do
- filelist <- newTempName logger tmpfs dflags TFL_CurrentModule "filelist"
+ filelist <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "filelist"
writeFile filelist $ unlines o_files
ld_r [GHC.SysTools.Option "-filelist",
GHC.SysTools.FileOption "" filelist]
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index b190fe70a9..64a1f16ebb 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -249,6 +249,7 @@ import GHC.Types.SafeHaskell
import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
import qualified GHC.Types.FieldLabel as FieldLabel
import GHC.Data.FastString
+import GHC.Utils.TmpFs
import GHC.Utils.Fingerprint
import GHC.Utils.Outputable
import GHC.Settings
@@ -791,8 +792,8 @@ toolDir :: DynFlags -> Maybe FilePath
toolDir dflags = fileSettings_toolDir $ fileSettings dflags
topDir :: DynFlags -> FilePath
topDir dflags = fileSettings_topDir $ fileSettings dflags
-tmpDir :: DynFlags -> String
-tmpDir dflags = fileSettings_tmpDir $ fileSettings dflags
+tmpDir :: DynFlags -> TempDir
+tmpDir dflags = TempDir (fileSettings_tmpDir $ fileSettings dflags)
extraGccViaCFlags :: DynFlags -> [String]
extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags
globalPackageDatabasePath :: DynFlags -> FilePath
diff --git a/compiler/GHC/Linker/ExtraObj.hs b/compiler/GHC/Linker/ExtraObj.hs
index 1bc4f4234b..163bccf3fe 100644
--- a/compiler/GHC/Linker/ExtraObj.hs
+++ b/compiler/GHC/Linker/ExtraObj.hs
@@ -49,8 +49,8 @@ import Data.Maybe
mkExtraObj :: Logger -> TmpFs -> DynFlags -> UnitState -> Suffix -> String -> IO FilePath
mkExtraObj logger tmpfs dflags unit_state extn xs
- = do cFile <- newTempName logger tmpfs dflags TFL_CurrentModule extn
- oFile <- newTempName logger tmpfs dflags TFL_GhcSession "o"
+ = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn
+ oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o"
writeFile cFile xs
ccInfo <- liftIO $ getCompilerInfo logger dflags
runCc Nothing logger tmpfs dflags
diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index 832d2b0cfd..68484eb288 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -952,7 +952,7 @@ dynLoadObjs interp hsc_env pls@LoaderState{..} objs = do
let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ]
let minus_big_ls = [ lib | Option ('-':'L':lib) <- ldInputs dflags ]
(soFile, libPath , libName) <-
- newTempLibName logger tmpfs dflags TFL_CurrentModule (platformSOExt platform)
+ newTempLibName logger tmpfs (tmpDir dflags) TFL_CurrentModule (platformSOExt platform)
let
dflags2 = dflags {
-- We don't want the original ldInputs in
diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs
index cfb83f0575..ae7a334f98 100644
--- a/compiler/GHC/Linker/Static.hs
+++ b/compiler/GHC/Linker/Static.hs
@@ -123,7 +123,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
if gopt Opt_SingleLibFolder dflags
then do
libs <- getLibs dflags unit_env dep_units
- tmpDir <- newTempDir logger tmpfs dflags
+ tmpDir <- newTempDir logger tmpfs (tmpDir dflags)
sequence_ [ copyFile lib (tmpDir </> basename)
| (lib, basename) <- libs]
return [ "-L" ++ tmpDir ]
diff --git a/compiler/GHC/Linker/Windows.hs b/compiler/GHC/Linker/Windows.hs
index 8be0802002..a791cdf007 100644
--- a/compiler/GHC/Linker/Windows.hs
+++ b/compiler/GHC/Linker/Windows.hs
@@ -45,9 +45,9 @@ maybeCreateManifest logger tmpfs dflags exe_filename = do
if not (gopt Opt_EmbedManifest dflags)
then return []
else do
- rc_filename <- newTempName logger tmpfs dflags TFL_CurrentModule "rc"
+ rc_filename <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rc"
rc_obj_filename <-
- newTempName logger tmpfs dflags TFL_GhcSession (objectSuf dflags)
+ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession (objectSuf dflags)
writeFile rc_filename $
"1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 5373e3d07f..546c270f76 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -206,7 +206,7 @@ cgTopBinding logger tmpfs dflags = \case
(lit,decl) = if not isNCG || asString
then mkByteStringCLit label str
else mkFileEmbedLit label $ unsafePerformIO $ do
- bFile <- newTempName logger tmpfs dflags TFL_CurrentModule ".dat"
+ bFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule ".dat"
BS.writeFile bFile str
return bFile
emitDecl decl
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
index 6cb322363d..63ff2c8294 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -168,7 +168,7 @@ runSomethingResponseFile logger tmpfs dflags filter_fn phase_name pgm args mb_en
return (r,())
where
getResponseFile args = do
- fp <- newTempName logger tmpfs dflags TFL_CurrentModule "rsp"
+ fp <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rsp"
withFile fp WriteMode $ \h -> do
#if defined(mingw32_HOST_OS)
hSetEncoding h latin1
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 4a5c71a85c..bcb77326e2 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -1211,7 +1211,7 @@ instance TH.Quasi TcM where
dflags <- getDynFlags
logger <- getLogger
tmpfs <- hsc_tmpfs <$> getTopEnv
- liftIO $ newTempName logger tmpfs dflags TFL_GhcSession suffix
+ liftIO $ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession suffix
qAddTopDecls thds = do
l <- getSrcSpanM
diff --git a/compiler/GHC/Utils/TmpFs.hs b/compiler/GHC/Utils/TmpFs.hs
index 2244a898ff..68284097d1 100644
--- a/compiler/GHC/Utils/TmpFs.hs
+++ b/compiler/GHC/Utils/TmpFs.hs
@@ -9,6 +9,7 @@ module GHC.Utils.TmpFs
, FilesToClean(..)
, emptyFilesToClean
, TempFileLifetime(..)
+ , TempDir (..)
, cleanTempDirs
, cleanTempFiles
, cleanCurrentModuleTempFiles
@@ -24,7 +25,6 @@ where
import GHC.Prelude
-import GHC.Driver.Session
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Utils.Logger
@@ -32,7 +32,6 @@ import GHC.Utils.Misc
import GHC.Utils.Exception as Exception
import GHC.Driver.Phases
-import Control.Monad
import Data.List (partition)
import qualified Data.Set as Set
import Data.Set (Set)
@@ -92,6 +91,7 @@ data TempFileLifetime
-- runGhc(T)
deriving (Show)
+newtype TempDir = TempDir FilePath
-- | An empty FilesToClean
emptyFilesToClean :: FilesToClean
@@ -135,19 +135,17 @@ mergeTmpFsInto src dst = do
src_files <- atomicModifyIORef' (tmp_files_to_clean src) (\s -> (emptyFilesToClean, s))
atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergeFilesToClean src_files s, ()))
-cleanTempDirs :: Logger -> TmpFs -> DynFlags -> IO ()
-cleanTempDirs logger tmpfs dflags
- = unless (gopt Opt_KeepTmpFiles dflags)
- $ mask_
+cleanTempDirs :: Logger -> TmpFs -> IO ()
+cleanTempDirs logger tmpfs
+ = mask_
$ do let ref = tmp_dirs_to_clean tmpfs
ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds)
removeTmpDirs logger (Map.elems ds)
-- | Delete all files in @tmp_files_to_clean@.
-cleanTempFiles :: Logger -> TmpFs -> DynFlags -> IO ()
-cleanTempFiles logger tmpfs dflags
- = unless (gopt Opt_KeepTmpFiles dflags)
- $ mask_
+cleanTempFiles :: Logger -> TmpFs -> IO ()
+cleanTempFiles logger tmpfs
+ = mask_
$ do let ref = tmp_files_to_clean tmpfs
to_delete <- atomicModifyIORef' ref $
\FilesToClean
@@ -161,10 +159,9 @@ cleanTempFiles logger tmpfs dflags
-- TFL_CurrentModule.
-- If a file must be cleaned eventually, but must survive a
-- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession.
-cleanCurrentModuleTempFiles :: Logger -> TmpFs -> DynFlags -> IO ()
-cleanCurrentModuleTempFiles logger tmpfs dflags
- = unless (gopt Opt_KeepTmpFiles dflags)
- $ mask_
+cleanCurrentModuleTempFiles :: Logger -> TmpFs -> IO ()
+cleanCurrentModuleTempFiles logger tmpfs
+ = mask_
$ do let ref = tmp_files_to_clean tmpfs
to_delete <- atomicModifyIORef' ref $
\ftc@FilesToClean{ftcCurrentModule = cm_files} ->
@@ -212,9 +209,9 @@ newTempSuffix tmpfs =
atomicModifyIORef' (tmp_next_suffix tmpfs) $ \n -> (n+1,n)
-- Find a temporary name that doesn't already exist.
-newTempName :: Logger -> TmpFs -> DynFlags -> TempFileLifetime -> Suffix -> IO FilePath
-newTempName logger tmpfs dflags lifetime extn
- = do d <- getTempDir logger tmpfs dflags
+newTempName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix -> IO FilePath
+newTempName logger tmpfs tmp_dir lifetime extn
+ = do d <- getTempDir logger tmpfs tmp_dir
findTempName (d </> "ghc_") -- See Note [Deterministic base name]
where
findTempName :: FilePath -> IO FilePath
@@ -227,9 +224,9 @@ newTempName logger tmpfs dflags lifetime extn
addFilesToClean tmpfs lifetime [filename]
return filename
-newTempDir :: Logger -> TmpFs -> DynFlags -> IO FilePath
-newTempDir logger tmpfs dflags
- = do d <- getTempDir logger tmpfs dflags
+newTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath
+newTempDir logger tmpfs tmp_dir
+ = do d <- getTempDir logger tmpfs tmp_dir
findTempDir (d </> "ghc_")
where
findTempDir :: FilePath -> IO FilePath
@@ -242,10 +239,10 @@ newTempDir logger tmpfs dflags
-- see mkTempDir below; this is wrong: -> consIORef (tmp_dirs_to_clean tmpfs) filename
return filename
-newTempLibName :: Logger -> TmpFs -> DynFlags -> TempFileLifetime -> Suffix
+newTempLibName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix
-> IO (FilePath, FilePath, String)
-newTempLibName logger tmpfs dflags lifetime extn
- = do d <- getTempDir logger tmpfs dflags
+newTempLibName logger tmpfs tmp_dir lifetime extn
+ = do d <- getTempDir logger tmpfs tmp_dir
findTempName d ("ghc_")
where
findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
@@ -262,8 +259,8 @@ newTempLibName logger tmpfs dflags lifetime extn
-- Return our temporary directory within tmp_dir, creating one if we
-- don't have one yet.
-getTempDir :: Logger -> TmpFs -> DynFlags -> IO FilePath
-getTempDir logger tmpfs dflags = do
+getTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath
+getTempDir logger tmpfs (TempDir tmp_dir) = do
mapping <- readIORef dir_ref
case Map.lookup tmp_dir mapping of
Nothing -> do
@@ -272,7 +269,6 @@ getTempDir logger tmpfs dflags = do
mask_ $ mkTempDir prefix
Just dir -> return dir
where
- tmp_dir = tmpDir dflags
dir_ref = tmp_dirs_to_clean tmpfs
mkTempDir :: FilePath -> IO FilePath
View Lorry Controller Status