Make TmpFs independent of DynFlags

This is small step towards #19877. We want to make the Loader/Linker
interface more abstract to be easily reused (i.e. don't pass it
DynFlags) but the system linker uses TmpFs which required a DynFlags
value to get its temp directory. We explicitly pass the temp directory
now. Similarly TmpFs was consulting the DynFlags to decide whether to
clean or: this is now done by the caller in the driver code.

7 files changed, 34 insertions, 23 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