DynFlags: move temp file management into HscEnv (#17957)

18 files changed, 432 insertions, 323 deletions

diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index b459b7b447..8c990b16cb 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -36,7 +36,7 @@ import qualified GHC.Data.ShortText as ST
 import GHC.Data.Stream           ( Stream )
 import qualified GHC.Data.Stream as Stream
 
-import GHC.SysTools.FileCleanup
+import GHC.Utils.TmpFs
 
 
 import GHC.Utils.Error
@@ -66,23 +66,24 @@ import System.IO
 ************************************************************************
 -}
 
-codeOutput :: Logger
-           -> DynFlags
-           -> UnitState
-           -> Module
-           -> FilePath
-           -> ModLocation
-           -> (a -> ForeignStubs)
-           -> [(ForeignSrcLang, FilePath)]
-           -- ^ additional files to be compiled with the C compiler
-           -> [UnitId]
-           -> Stream IO RawCmmGroup a                       -- Compiled C--
-           -> IO (FilePath,
-                  (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),
-                  [(ForeignSrcLang, FilePath)]{-foreign_fps-},
-                  a)
-
-codeOutput logger dflags unit_state this_mod filenm location genForeignStubs foreign_fps pkg_deps
+codeOutput
+    :: Logger
+    -> TmpFs
+    -> DynFlags
+    -> UnitState
+    -> Module
+    -> FilePath
+    -> ModLocation
+    -> (a -> ForeignStubs)
+    -> [(ForeignSrcLang, FilePath)]
+    -- ^ additional files to be compiled with the C compiler
+    -> [UnitId]
+    -> Stream IO RawCmmGroup a                       -- Compiled C--
+    -> IO (FilePath,
+           (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),
+           [(ForeignSrcLang, FilePath)]{-foreign_fps-},
+           a)
+codeOutput logger tmpfs dflags unit_state this_mod filenm location genForeignStubs foreign_fps pkg_deps
   cmm_stream
   =
     do  {
@@ -117,7 +118,7 @@ codeOutput logger dflags unit_state this_mod filenm location genForeignStubs for
                  Interpreter -> panic "codeOutput: Interpreter"
                  NoBackend   -> panic "codeOutput: NoBackend"
         ; let stubs = genForeignStubs a
-        ; stubs_exist <- outputForeignStubs logger dflags unit_state this_mod location stubs
+        ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs
         ; return (filenm, stubs_exist, foreign_fps, a)
         }
 
@@ -198,13 +199,20 @@ outputLlvm logger dflags filenm cmm_stream =
 ************************************************************************
 -}
 
-outputForeignStubs :: Logger -> DynFlags -> UnitState -> Module -> ModLocation -> ForeignStubs
-                   -> IO (Bool,         -- Header file created
-                          Maybe FilePath) -- C file created
-outputForeignStubs logger dflags unit_state mod location stubs
+outputForeignStubs
+    :: Logger
+    -> TmpFs
+    -> DynFlags
+    -> UnitState
+    -> Module
+    -> ModLocation
+    -> ForeignStubs
+    -> IO (Bool,         -- Header file created
+           Maybe FilePath) -- C file created
+outputForeignStubs logger tmpfs dflags unit_state mod location stubs
  = do
    let stub_h = mkStubPaths dflags (moduleName mod) location
-   stub_c <- newTempName logger dflags TFL_CurrentModule "c"
+   stub_c <- newTempName logger tmpfs dflags TFL_CurrentModule "c"
 
    case stubs of
      NoStubs ->
diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs
index e541dfe544..23282eab27 100644
--- a/compiler/GHC/Driver/Env/Types.hs
+++ b/compiler/GHC/Driver/Env/Types.hs
@@ -22,6 +22,7 @@ import GHC.Unit.Env
 import GHC.Unit.State
 import GHC.Unit.Types
 import GHC.Utils.Logger
+import GHC.Utils.TmpFs
 import {-# SOURCE #-} GHC.Driver.Plugins
 
 import Control.Monad ( ap )
@@ -159,5 +160,8 @@ data HscEnv
 
         , hsc_hooks :: !Hooks
                 -- ^ Hooks
+
+        , hsc_tmpfs :: !TmpFs
+                -- ^ Temporary files
  }
 
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index d3695177d3..5be42094a0 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -207,6 +207,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Exception
 import GHC.Utils.Misc
 import GHC.Utils.Logger
+import GHC.Utils.TmpFs
 
 import GHC.Data.FastString
 import GHC.Data.Bag
@@ -248,6 +249,7 @@ newHscEnv dflags = do
     fc_var  <- newIORef emptyInstalledModuleEnv
     emptyLoader <- uninitializedLoader
     logger  <- initLogger
+    tmpfs   <- initTmpFs
     -- FIXME: it's sad that we have so many "unitialized" fields filled with
     -- empty stuff or lazy panics. We should have two kinds of HscEnv
     -- (initialized or not) instead and less fields that are mutable over time.
@@ -268,6 +270,7 @@ newHscEnv dflags = do
                   ,  hsc_static_plugins = []
                   ,  hsc_unit_dbs       = Nothing
                   ,  hsc_hooks          = emptyHooks
+                  ,  hsc_tmpfs          = tmpfs
                   }
 
 -- -----------------------------------------------------------------------------
@@ -1528,6 +1531,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do
             dflags = hsc_dflags hsc_env
             logger = hsc_logger hsc_env
             hooks  = hsc_hooks hsc_env
+            tmpfs  = hsc_tmpfs hsc_env
             data_tycons = filter isDataTyCon tycons
             -- cg_tycons includes newtypes, for the benefit of External Core,
             -- but we don't generate any code for newtypes
@@ -1581,7 +1585,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do
 
             (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cg_infos)
                 <- {-# SCC "codeOutput" #-}
-                  codeOutput logger dflags (hsc_units hsc_env) this_mod output_filename location
+                  codeOutput logger tmpfs dflags (hsc_units hsc_env) this_mod output_filename location
                   foreign_stubs foreign_files dependencies rawcmms1
             return (output_filename, stub_c_exists, foreign_fps, cg_infos)
 
@@ -1593,6 +1597,7 @@ hscInteractive :: HscEnv
 hscInteractive hsc_env cgguts location = do
     let dflags = hsc_dflags hsc_env
     let logger = hsc_logger hsc_env
+    let tmpfs  = hsc_tmpfs hsc_env
     let CgGuts{ -- This is the last use of the ModGuts in a compilation.
                 -- From now on, we just use the bits we need.
                cg_module   = this_mod,
@@ -1615,7 +1620,7 @@ hscInteractive hsc_env cgguts location = do
     comp_bc <- byteCodeGen hsc_env this_mod prepd_binds data_tycons mod_breaks
     ------------------ Create f-x-dynamic C-side stuff -----
     (_istub_h_exists, istub_c_exists)
-        <- outputForeignStubs logger dflags (hsc_units hsc_env) this_mod location foreign_stubs
+        <- outputForeignStubs logger tmpfs dflags (hsc_units hsc_env) this_mod location foreign_stubs
     return (istub_c_exists, comp_bc, spt_entries)
 
 ------------------------------
@@ -1625,6 +1630,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
     let dflags   = hsc_dflags hsc_env
     let logger   = hsc_logger hsc_env
     let hooks    = hsc_hooks hsc_env
+    let tmpfs    = hsc_tmpfs hsc_env
         home_unit = hsc_home_unit hsc_env
         platform  = targetPlatform dflags
         -- Make up a module name to give the NCG. We can't pass bottom here
@@ -1661,7 +1667,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
               in NoStubs `appendStubC` ip_init
 
         (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos)
-          <- codeOutput logger dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] []
+          <- codeOutput logger tmpfs dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] []
              rawCmms
         return stub_c_exists
   where
@@ -1703,14 +1709,15 @@ doCodeGen hsc_env this_mod denv data_tycons
     let dflags = hsc_dflags hsc_env
     let logger = hsc_logger hsc_env
     let hooks  = hsc_hooks hsc_env
-        platform = targetPlatform dflags
+    let tmpfs  = hsc_tmpfs hsc_env
+    let platform = targetPlatform dflags
 
     let stg_binds_w_fvs = annTopBindingsFreeVars stg_binds
 
     dumpIfSet_dyn logger dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_fvs)
 
     let stg_to_cmm = case stgToCmmHook hooks of
-                        Nothing -> StgToCmm.codeGen logger
+                        Nothing -> StgToCmm.codeGen logger tmpfs
                         Just h  -> h
 
     let cmm_stream :: Stream IO CmmGroup (CStub, ModuleLFInfos)
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index f13d13b198..bd885d9042 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -83,7 +83,7 @@ import GHC.Utils.Panic
 import GHC.Utils.Misc
 import GHC.Utils.Error
 import GHC.Utils.Logger
-import GHC.SysTools.FileCleanup
+import GHC.Utils.TmpFs
 
 import GHC.Types.Basic
 import GHC.Types.Target
@@ -568,8 +568,6 @@ load' how_much mHscMessage mod_graph = do
         -- an unstable module (#7231).
         mg = fmap (fmap ModuleNode) stable_mg ++ unstable_mg
 
-    -- clean up between compilations
-    let cleanup hsc_env = cleanCurrentModuleTempFiles (hsc_logger hsc_env) (hsc_dflags hsc_env)
     liftIO $ debugTraceMsg logger dflags 2 (hang (text "Ready for upsweep")
                                2 (ppr mg))
 
@@ -581,7 +579,7 @@ load' how_much mHscMessage mod_graph = do
 
     setSession hsc_env{ hsc_HPT = emptyHomePackageTable }
     (upsweep_ok, modsUpswept) <- withDeferredDiagnostics $
-      upsweep_fn mHscMessage pruned_hpt stable_mods cleanup mg
+      upsweep_fn mHscMessage pruned_hpt stable_mods mg
 
     -- Make modsDone be the summaries for each home module now
     -- available; this should equal the domain of hpt3.
@@ -601,7 +599,7 @@ load' how_much mHscMessage mod_graph = do
 
           -- Clean up after ourselves
           hsc_env1 <- getSession
-          liftIO $ cleanCurrentModuleTempFiles logger dflags
+          liftIO $ cleanCurrentModuleTempFiles 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.
@@ -620,6 +618,7 @@ load' how_much mHscMessage mod_graph = do
           hsc_env <- getSession
           linkresult <- liftIO $ link (ghcLink dflags)
                                       logger
+                                      (hsc_tmpfs hsc_env)
                                       (hsc_hooks hsc_env)
                                       dflags
                                       (hsc_unit_env hsc_env)
@@ -665,9 +664,9 @@ load' how_much mHscMessage mod_graph = do
                         lookupHpt hpt4 (moduleName ms_mod)
                         >>= hm_linkable
                 ]
-          liftIO $
-            changeTempFilesLifetime dflags TFL_CurrentModule unneeded_temps
-          liftIO $ cleanCurrentModuleTempFiles logger dflags
+          tmpfs <- hsc_tmpfs <$> getSession
+          liftIO $ changeTempFilesLifetime tmpfs TFL_CurrentModule unneeded_temps
+          liftIO $ cleanCurrentModuleTempFiles logger tmpfs dflags
 
           let hpt5 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
                                           hpt4
@@ -686,6 +685,7 @@ load' how_much mHscMessage mod_graph = do
           hsc_env <- getSession
           linkresult <- liftIO $ link (ghcLink dflags)
                                       logger
+                                      (hsc_tmpfs hsc_env)
                                       (hsc_hooks hsc_env)
                                       dflags
                                       (hsc_unit_env hsc_env)
@@ -1067,14 +1067,14 @@ parUpsweep
     -> Maybe Messager
     -> HomePackageTable
     -> StableModules
-    -> (HscEnv -> IO ())
     -> [SCC ModuleGraphNode]
     -> m (SuccessFlag,
           [ModuleGraphNode])
-parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
+parUpsweep n_jobs mHscMessage old_hpt stable_mods sccs = do
     hsc_env <- getSession
     let dflags = hsc_dflags hsc_env
     let logger = hsc_logger hsc_env
+    let tmpfs  = hsc_tmpfs hsc_env
 
     -- The bits of shared state we'll be using:
 
@@ -1176,18 +1176,15 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
                 -- deal with synchronously printing these messages.
                 let lcl_logger = pushLogHook (const (parLogAction log_queue)) thread_safe_logger
 
-                --
-                -- Use a local filesToClean var so that we can clean up
-                -- intermediate files in a timely fashion (as soon as
-                -- compilation for that module is finished) without having to
-                -- worry about accidentally deleting a simultaneous compile's
-                -- important files.
-                lcl_files_to_clean <- newIORef emptyFilesToClean
-                let lcl_dflags = dflags { filesToClean = lcl_files_to_clean }
+                -- Use a local TmpFs so that we can clean up intermediate files
+                -- in a timely fashion (as soon as compilation for that module
+                -- is finished) without having to worry about accidentally
+                -- deleting a simultaneous compile's important files.
+                lcl_tmpfs <- forkTmpFsFrom tmpfs
 
                 -- Unmask asynchronous exceptions and perform the thread-local
                 -- work to compile the module (see parUpsweep_one).
-                m_res <- MC.try $ unmask $ prettyPrintGhcErrors lcl_dflags $
+                m_res <- MC.try $ unmask $ prettyPrintGhcErrors dflags $
                   case mod of
                     InstantiationNode iuid -> do
                       hsc_env <- readMVar hsc_env_var
@@ -1195,8 +1192,8 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
                       pure Succeeded
                     ModuleNode ems ->
                       parUpsweep_one (emsModSummary ems) home_mod_map comp_graph_loops
-                                     lcl_logger lcl_dflags (hsc_home_unit hsc_env)
-                                     mHscMessage cleanup
+                                     lcl_logger lcl_tmpfs dflags (hsc_home_unit hsc_env)
+                                     mHscMessage
                                      par_sem hsc_env_var old_hpt_var
                                      stable_mods mod_idx (length sccs)
 
@@ -1208,7 +1205,7 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
                         -- interrupt, and the user doesn't have to be informed
                         -- about that.
                         when (fromException exc /= Just ThreadKilled)
-                             (errorMsg lcl_logger lcl_dflags (text (show exc)))
+                             (errorMsg lcl_logger dflags (text (show exc)))
                         return Failed
 
                 -- Populate the result MVar.
@@ -1220,13 +1217,8 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
                 writeLogQueue log_queue Nothing
 
                 -- Add the remaining files that weren't cleaned up to the
-                -- global filesToClean ref, for cleanup later.
-                FilesToClean
-                  { ftcCurrentModule = cm_files
-                  , ftcGhcSession = gs_files
-                  } <- readIORef (filesToClean lcl_dflags)
-                addFilesToClean dflags TFL_CurrentModule $ Set.toList cm_files
-                addFilesToClean dflags TFL_GhcSession $ Set.toList gs_files
+                -- global TmpFs, for cleanup later.
+                mergeTmpFsInto lcl_tmpfs tmpfs
 
         -- Kill all the workers, masking interrupts (since killThread is
         -- interruptible). XXX: This is not ideal.
@@ -1298,14 +1290,14 @@ parUpsweep_one
     -- ^ The list of all module loops within the compilation graph.
     -> Logger
     -- ^ The thread-local Logger
+    -> TmpFs
+    -- ^ The thread-local TmpFs
     -> DynFlags
     -- ^ The thread-local DynFlags
     -> HomeUnit
     -- ^ The home-unit
     -> Maybe Messager
     -- ^ The messager
-    -> (HscEnv -> IO ())
-    -- ^ The callback for cleaning up intermediate files
     -> QSem
     -- ^ The semaphore for limiting the number of simultaneous compiles
     -> MVar HscEnv
@@ -1320,7 +1312,7 @@ parUpsweep_one
     -- ^ The total number of modules
     -> IO SuccessFlag
     -- ^ The result of this compile
-parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_dflags home_unit mHscMessage cleanup par_sem
+parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_tmpfs lcl_dflags home_unit mHscMessage par_sem
                hsc_env_var old_hpt_var stable_mods mod_index num_mods = do
 
     let this_build_mod = mkBuildModule0 mod
@@ -1430,9 +1422,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_dflags home_unit
         let withSem sem = MC.bracket_ (waitQSem sem) (signalQSem sem)
         mb_mod_info <- withSem par_sem $
             handleSourceError (\err -> do logg err; return Nothing) $ do
-                -- Have the ModSummary and HscEnv point to our local log_action
-                -- and filesToClean var.
-                let lcl_mod = localize_mod mod
+                -- Have the HscEnv point to our local logger and tmpfs.
                 let lcl_hsc_env = localize_hsc_env hsc_env
 
                 -- Re-typecheck the loop
@@ -1440,7 +1430,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_dflags home_unit
                 -- we close a recursive module loop, see bug #12035.
                 type_env_var <- liftIO $ newIORef emptyNameEnv
                 let lcl_hsc_env' = lcl_hsc_env { hsc_type_env_var =
-                                    Just (ms_mod lcl_mod, type_env_var) }
+                                    Just (ms_mod mod, type_env_var) }
                 lcl_hsc_env'' <- case finish_loop of
                     Nothing   -> return lcl_hsc_env'
                     -- In the non-parallel case, the retypecheck prior to
@@ -1454,7 +1444,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_dflags home_unit
 
                 -- Compile the module.
                 mod_info <- upsweep_mod lcl_hsc_env'' mHscMessage old_hpt stable_mods
-                                        lcl_mod mod_index num_mods
+                                        mod mod_index num_mods
                 return (Just mod_info)
 
         case mb_mod_info of
@@ -1483,18 +1473,16 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_dflags home_unit
                     return (hsc_env'', localize_hsc_env hsc_env'')
 
                 -- Clean up any intermediate files.
-                cleanup lcl_hsc_env'
+                cleanCurrentModuleTempFiles (hsc_logger lcl_hsc_env')
+                                            (hsc_tmpfs  lcl_hsc_env')
+                                            (hsc_dflags lcl_hsc_env')
                 return Succeeded
 
   where
-    localize_mod mod
-        = mod { ms_hspp_opts = (ms_hspp_opts mod)
-                 { filesToClean = filesToClean lcl_dflags } }
-
     localize_hsc_env hsc_env
         = hsc_env { hsc_logger = lcl_logger
-                  , hsc_dflags = (hsc_dflags hsc_env)
-                     { filesToClean = filesToClean lcl_dflags } }
+                  , hsc_tmpfs  = lcl_tmpfs
+                  }
 
 -- -----------------------------------------------------------------------------
 --
@@ -1510,7 +1498,6 @@ upsweep
     => Maybe Messager
     -> HomePackageTable            -- ^ HPT from last time round (pruned)
     -> StableModules               -- ^ stable modules (see checkStability)
-    -> (HscEnv -> IO ())           -- ^ How to clean up unwanted tmp files
     -> [SCC ModuleGraphNode]       -- ^ Mods to do (the worklist)
     -> m (SuccessFlag,
           [ModuleGraphNode])
@@ -1520,7 +1507,7 @@ upsweep
        --  2. The 'HscEnv' in the monad has an updated HPT
        --  3. A list of modules which succeeded loading.
 
-upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
+upsweep mHscMessage old_hpt stable_mods sccs = do
    (res, done) <- upsweep' old_hpt emptyMG sccs 1 (length sccs)
    return (res, reverse $ mgModSummaries' done)
  where
@@ -1588,7 +1575,9 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
         hsc_env <- getSession
 
         -- Remove unwanted tmp files between compilations
-        liftIO (cleanup hsc_env)
+        liftIO $ cleanCurrentModuleTempFiles (hsc_logger hsc_env)
+                                             (hsc_tmpfs  hsc_env)
+                                             (hsc_dflags hsc_env)
 
         -- Get ready to tie the knot
         type_env_var <- liftIO $ newIORef emptyNameEnv
@@ -2274,10 +2263,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
        -- otherwise those modules will fail to compile.
        -- See Note [-fno-code mode] #8025
        let default_backend = platformDefaultBackend (targetPlatform dflags)
-           home_unit       = hsc_home_unit hsc_env
+       let home_unit       = hsc_home_unit hsc_env
+       let tmpfs           = hsc_tmpfs     hsc_env
        map1 <- case backend dflags of
-         NoBackend   -> enableCodeGenForTH logger home_unit default_backend map0
-         Interpreter -> enableCodeGenForUnboxedTuplesOrSums logger default_backend map0
+         NoBackend   -> enableCodeGenForTH logger tmpfs home_unit default_backend map0
+         Interpreter -> enableCodeGenForUnboxedTuplesOrSums logger tmpfs default_backend map0
          _           -> return map0
        if null errs
          then pure $ concat $ modNodeMapElems map1
@@ -2372,12 +2362,13 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
 -- See Note [-fno-code mode]
 enableCodeGenForTH
   :: Logger
+  -> TmpFs
   -> HomeUnit
   -> Backend
   -> ModNodeMap [Either ErrorMessages ExtendedModSummary]
   -> IO (ModNodeMap [Either ErrorMessages ExtendedModSummary])
-enableCodeGenForTH logger home_unit =
-  enableCodeGenWhen logger condition should_modify TFL_CurrentModule TFL_GhcSession
+enableCodeGenForTH logger tmpfs home_unit =
+  enableCodeGenWhen logger tmpfs condition should_modify TFL_CurrentModule TFL_GhcSession
   where
     condition = isTemplateHaskellOrQQNonBoot
     should_modify (ModSummary { ms_hspp_opts = dflags }) =
@@ -2395,11 +2386,12 @@ enableCodeGenForTH logger home_unit =
 -- or sums into GHCi while still allowing some code to be interpreted.
 enableCodeGenForUnboxedTuplesOrSums
   :: Logger
+  -> TmpFs
   -> Backend
   -> ModNodeMap [Either ErrorMessages ExtendedModSummary]
   -> IO (ModNodeMap [Either ErrorMessages ExtendedModSummary])
-enableCodeGenForUnboxedTuplesOrSums logger =
-  enableCodeGenWhen logger condition should_modify TFL_GhcSession TFL_CurrentModule
+enableCodeGenForUnboxedTuplesOrSums logger tmpfs =
+  enableCodeGenWhen logger tmpfs condition should_modify TFL_GhcSession TFL_CurrentModule
   where
     condition ms =
       unboxed_tuples_or_sums (ms_hspp_opts ms) &&
@@ -2418,6 +2410,7 @@ enableCodeGenForUnboxedTuplesOrSums logger =
 -- marking modules for code generation.
 enableCodeGenWhen
   :: Logger
+  -> TmpFs
   -> (ModSummary -> Bool)
   -> (ModSummary -> Bool)
   -> TempFileLifetime
@@ -2425,7 +2418,7 @@ enableCodeGenWhen
   -> Backend
   -> ModNodeMap [Either ErrorMessages ExtendedModSummary]
   -> IO (ModNodeMap [Either ErrorMessages ExtendedModSummary])
-enableCodeGenWhen logger condition should_modify staticLife dynLife bcknd nodemap =
+enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd nodemap =
   traverse (traverse (traverse enable_code_gen)) nodemap
   where
     enable_code_gen :: ExtendedModSummary -> IO ExtendedModSummary
@@ -2440,9 +2433,9 @@ enableCodeGenWhen logger condition should_modify staticLife dynLife bcknd nodema
       , ms_mod `Set.member` needs_codegen_set
       = do
         let new_temp_file suf dynsuf = do
-              tn <- newTempName logger dflags staticLife suf
+              tn <- newTempName logger tmpfs dflags staticLife suf
               let dyn_tn = tn -<.> dynsuf
-              addFilesToClean dflags dynLife [dyn_tn]
+              addFilesToClean tmpfs dynLife [dyn_tn]
               return tn
           -- We don't want to create .o or .hi files unless we have been asked
           -- to by the user. But we need them, so we patch their locations in
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index 57377212cb..f71b2e17b9 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -31,7 +31,7 @@ import GHC.Types.SourceError
 import GHC.Types.SrcLoc
 import Data.List (partition)
 import GHC.Data.FastString
-import GHC.SysTools.FileCleanup
+import GHC.Utils.TmpFs
 
 import GHC.Iface.Load (cannotFindModule)
 
@@ -82,7 +82,8 @@ doMkDependHS srcs = do
     when (null (depSuffixes dflags)) $ liftIO $
         throwGhcExceptionIO (ProgramError "You must specify at least one -dep-suffix")
 
-    files <- liftIO $ beginMkDependHS logger dflags
+    tmpfs <- hsc_tmpfs <$> getSession
+    files <- liftIO $ beginMkDependHS logger tmpfs dflags
 
     -- Do the downsweep to find all the modules
     targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
@@ -131,11 +132,11 @@ data MkDepFiles
             mkd_tmp_file  :: FilePath,          -- Name of the temporary file
             mkd_tmp_hdl   :: Handle }           -- Handle of the open temporary file
 
-beginMkDependHS :: Logger -> DynFlags -> IO MkDepFiles
-beginMkDependHS logger dflags = do
+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 dflags TFL_CurrentModule "dep"
+  tmp_file <- newTempName logger tmpfs 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 f2e740ac41..bf9fbe8405 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -62,7 +62,7 @@ import GHC.Parser.Header
 import GHC.Parser.Errors.Ppr
 
 import GHC.SysTools
-import GHC.SysTools.FileCleanup
+import GHC.Utils.TmpFs
 
 import GHC.Linker.ExtraObj
 import GHC.Linker.Dynamic
@@ -196,6 +196,7 @@ compileOne' m_tc_result mHscMessage
  = do
 
    let logger = hsc_logger hsc_env0
+   let tmpfs  = hsc_tmpfs hsc_env0
    debugTraceMsg logger dflags1 2 (text "compile: input file" <+> text input_fnpp)
 
    -- Run the pipeline up to codeGen (so everything up to, but not including, STG)
@@ -208,10 +209,10 @@ compileOne' m_tc_result mHscMessage
 
    let flags = hsc_dflags hsc_env0
      in do unless (gopt Opt_KeepHiFiles flags) $
-               addFilesToClean flags TFL_CurrentModule $
+               addFilesToClean tmpfs TFL_CurrentModule $
                    [ml_hi_file $ ms_location summary]
            unless (gopt Opt_KeepOFiles flags) $
-               addFilesToClean flags TFL_GhcSession $
+               addFilesToClean tmpfs TFL_GhcSession $
                    [ml_obj_file $ ms_location summary]
 
    case (status, bcknd) of
@@ -236,7 +237,7 @@ compileOne' m_tc_result mHscMessage
             let !linkable = LM (ms_hs_date summary) this_mod []
             return $! HomeModInfo iface hmi_details (Just linkable)
         (HscUpdateSig iface hmi_details, _) -> do
-            output_fn <- getOutputFilename logger next_phase
+            output_fn <- getOutputFilename logger tmpfs next_phase
                             (Temporary TFL_CurrentModule) basename dflags
                             next_phase (Just location)
 
@@ -286,7 +287,7 @@ compileOne' m_tc_result mHscMessage
                            (hs_unlinked ++ stub_o)
             return $! HomeModInfo final_iface hmi_details (Just linkable)
         (HscRecomp{}, _) -> do
-            output_fn <- getOutputFilename logger next_phase
+            output_fn <- getOutputFilename logger tmpfs next_phase
                             (Temporary TFL_CurrentModule)
                             basename dflags next_phase (Just location)
             -- We're in --make mode: finish the compilation pipeline.
@@ -418,7 +419,8 @@ compileEmptyStub dflags hsc_env basename location mod_name = do
   -- https://gitlab.haskell.org/ghc/ghc/issues/12673
   -- and https://github.com/haskell/cabal/issues/2257
   let logger = hsc_logger hsc_env
-  empty_stub <- newTempName logger dflags TFL_CurrentModule "c"
+  let tmpfs  = hsc_tmpfs hsc_env
+  empty_stub <- newTempName logger tmpfs 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))
@@ -484,6 +486,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do
 -- libraries.
 link :: GhcLink                 -- ^ interactive or batch
      -> Logger                  -- ^ Logger
+     -> TmpFs
      -> Hooks
      -> DynFlags                -- ^ dynamic flags
      -> UnitEnv                 -- ^ unit environment
@@ -498,13 +501,13 @@ link :: GhcLink                 -- ^ interactive or batch
 -- exports main, i.e., we have good reason to believe that linking
 -- will succeed.
 
-link ghcLink logger hooks dflags unit_env batch_attempt_linking hpt =
+link ghcLink logger tmpfs hooks dflags unit_env batch_attempt_linking hpt =
   case linkHook hooks of
       Nothing -> case ghcLink of
           NoLink        -> return Succeeded
-          LinkBinary    -> link' logger dflags unit_env batch_attempt_linking hpt
-          LinkStaticLib -> link' logger dflags unit_env batch_attempt_linking hpt
-          LinkDynLib    -> link' logger dflags unit_env batch_attempt_linking hpt
+          LinkBinary    -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt
+          LinkStaticLib -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt
+          LinkDynLib    -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt
           LinkInMemory
               | platformMisc_ghcWithInterpreter $ platformMisc dflags
               -> -- Not Linking...(demand linker will do the job)
@@ -519,13 +522,14 @@ panicBadLink other = panic ("link: GHC not built to link this way: " ++
                             show other)
 
 link' :: Logger
+      -> TmpFs
       -> DynFlags                -- ^ dynamic flags
       -> UnitEnv                 -- ^ unit environment
       -> Bool                    -- ^ attempt linking in batch mode?
       -> HomePackageTable        -- ^ what to link
       -> IO SuccessFlag
 
-link' logger dflags unit_env batch_attempt_linking hpt
+link' logger tmpfs dflags unit_env batch_attempt_linking hpt
    | batch_attempt_linking
    = do
         let
@@ -565,11 +569,11 @@ link' logger dflags unit_env batch_attempt_linking hpt
 
         -- Don't showPass in Batch mode; doLink will do that for us.
         let link = case ghcLink dflags of
-                LinkBinary    -> linkBinary
-                LinkStaticLib -> linkStaticLib
-                LinkDynLib    -> linkDynLibCheck
+                LinkBinary    -> linkBinary logger tmpfs
+                LinkStaticLib -> linkStaticLib logger
+                LinkDynLib    -> linkDynLibCheck logger tmpfs
                 other         -> panicBadLink other
-        link logger dflags unit_env obj_files pkg_deps
+        link dflags unit_env obj_files pkg_deps
 
         debugTraceMsg logger dflags 3 (text "link: done")
 
@@ -678,11 +682,12 @@ doLink hsc_env stop_phase o_files
         dflags   = hsc_dflags   hsc_env
         logger   = hsc_logger   hsc_env
         unit_env = hsc_unit_env hsc_env
+        tmpfs    = hsc_tmpfs    hsc_env
     in case ghcLink dflags of
         NoLink        -> return ()
-        LinkBinary    -> linkBinary         logger dflags unit_env o_files []
-        LinkStaticLib -> linkStaticLib      logger dflags unit_env o_files []
-        LinkDynLib    -> linkDynLibCheck    logger dflags unit_env o_files []
+        LinkBinary    -> linkBinary         logger tmpfs dflags unit_env o_files []
+        LinkStaticLib -> linkStaticLib      logger       dflags unit_env o_files []
+        LinkDynLib    -> linkDynLibCheck    logger tmpfs dflags unit_env o_files []
         other         -> panicBadLink other
 
 
@@ -719,6 +724,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase)
              dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
              hsc_env = hsc_env0 {hsc_dflags = dflags}
              logger = hsc_logger hsc_env
+             tmpfs  = hsc_tmpfs  hsc_env
 
              (input_basename, suffix) = splitExtension input_fn
              suffix' = drop 1 suffix -- strip off the .
@@ -766,7 +772,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase)
          input_fn' <- case (start_phase, mb_input_buf) of
              (RealPhase real_start_phase, Just input_buf) -> do
                  let suffix = phaseInputExt real_start_phase
-                 fn <- newTempName logger dflags TFL_CurrentModule suffix
+                 fn <- newTempName logger tmpfs dflags TFL_CurrentModule suffix
                  hdl <- openBinaryFile fn WriteMode
                  -- Add a LINE pragma so reported source locations will
                  -- mention the real input file, not this temp file.
@@ -869,7 +875,8 @@ pipeLoop phase input_fn = do
             return input_fn
         output ->
             do pst <- getPipeState
-               final_fn <- liftIO $ getOutputFilename logger
+               tmpfs <- hsc_tmpfs <$> getPipeSession
+               final_fn <- liftIO $ getOutputFilename logger tmpfs
                                         stopPhase output (src_basename env)
                                         dflags stopPhase (maybe_loc pst)
                when (final_fn /= input_fn) $ do
@@ -954,10 +961,11 @@ runHookedPhase pp input = do
 phaseOutputFilename :: Phase{-next phase-} -> CompPipeline FilePath
 phaseOutputFilename next_phase = do
   PipeEnv{stop_phase, src_basename, output_spec} <- getPipeEnv
-  PipeState{maybe_loc} <- getPipeState
+  PipeState{maybe_loc,hsc_env} <- getPipeState
   dflags <- getDynFlags
   logger <- getLogger
-  liftIO $ getOutputFilename logger stop_phase output_spec
+  let tmpfs = hsc_tmpfs hsc_env
+  liftIO $ getOutputFilename logger tmpfs stop_phase output_spec
                              src_basename dflags next_phase maybe_loc
 
 -- | Computes the next output filename for something in the compilation
@@ -976,17 +984,24 @@ phaseOutputFilename next_phase = do
 --         compiling; this can be used to override the default output
 --         of an object file.  (TODO: do we actually need this?)
 getOutputFilename
-  :: Logger -> Phase -> PipelineOutput -> String
-  -> DynFlags -> Phase{-next phase-} -> Maybe ModLocation -> IO FilePath
-getOutputFilename logger stop_phase output basename dflags next_phase maybe_location
+  :: Logger
+  -> TmpFs
+  -> Phase
+  -> PipelineOutput
+  -> String
+  -> DynFlags
+  -> Phase -- next phase
+  -> Maybe ModLocation
+  -> IO FilePath
+getOutputFilename logger tmpfs stop_phase output basename dflags next_phase maybe_location
  | is_last_phase, Persistent   <- output = persistent_fn
  | is_last_phase, SpecificFile <- output = case outputFile dflags of
                                            Just f -> return f
                                            Nothing ->
                                                panic "SpecificFile: No filename"
  | keep_this_output                      = persistent_fn
- | Temporary lifetime <- output          = newTempName logger dflags lifetime suffix
- | otherwise                             = newTempName logger dflags TFL_CurrentModule
+ | Temporary lifetime <- output          = newTempName logger tmpfs dflags lifetime suffix
+ | otherwise                             = newTempName logger tmpfs dflags TFL_CurrentModule
    suffix
     where
           hcsuf      = hcSuf dflags
@@ -1160,7 +1175,10 @@ runPhase (RealPhase (Cpp sf)) input_fn
         else do
             output_fn <- phaseOutputFilename (HsPp sf)
             hsc_env <- getPipeSession
-            liftIO $ doCpp logger (hsc_dflags hsc_env) (hsc_unit_env hsc_env)
+            liftIO $ doCpp logger
+                           (hsc_tmpfs hsc_env)
+                           (hsc_dflags hsc_env)
+                           (hsc_unit_env hsc_env)
                            True{-raw-}
                            input_fn output_fn
             -- re-read the pragmas now that we've preprocessed the file
@@ -1389,7 +1407,10 @@ runPhase (RealPhase CmmCpp) input_fn = do
        hsc_env <- getPipeSession
        logger <- getLogger
        output_fn <- phaseOutputFilename Cmm
-       liftIO $ doCpp logger (hsc_dflags hsc_env) (hsc_unit_env hsc_env)
+       liftIO $ doCpp logger
+                      (hsc_tmpfs hsc_env)
+                      (hsc_dflags hsc_env)
+                      (hsc_unit_env hsc_env)
                       False{-not raw-}
                       input_fn output_fn
        return (RealPhase Cmm, output_fn)
@@ -1415,6 +1436,7 @@ runPhase (RealPhase cc_phase) input_fn
         let dflags    = hsc_dflags hsc_env
         let unit_env  = hsc_unit_env hsc_env
         let home_unit = hsc_home_unit hsc_env
+        let tmpfs     = hsc_tmpfs hsc_env
         let platform  = ue_platform unit_env
         let hcc       = cc_phase `eqPhase` HCc
 
@@ -1492,7 +1514,7 @@ runPhase (RealPhase cc_phase) input_fn
         ghcVersionH <- liftIO $ getGhcVersionPathName dflags unit_env
 
         logger <- getLogger
-        liftIO $ GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger dflags (
+        liftIO $ GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags (
                         [ GHC.SysTools.FileOption "" input_fn
                         , GHC.SysTools.Option "-o"
                         , GHC.SysTools.FileOption "" output_fn
@@ -1747,7 +1769,7 @@ runPhase (RealPhase LlvmMangle) input_fn = do
 -- merge in stub objects
 
 runPhase (RealPhase MergeForeign) input_fn = do
-     PipeState{foreign_os} <- getPipeState
+     PipeState{foreign_os,hsc_env} <- getPipeState
      output_fn <- phaseOutputFilename StopLn
      liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
      if null foreign_os
@@ -1755,7 +1777,8 @@ runPhase (RealPhase MergeForeign) input_fn = do
        else do
          dflags <- getDynFlags
          logger <- getLogger
-         liftIO $ joinObjectFiles logger dflags (input_fn : foreign_os) output_fn
+         let tmpfs = hsc_tmpfs hsc_env
+         liftIO $ joinObjectFiles logger tmpfs dflags (input_fn : foreign_os) output_fn
          return (RealPhase StopLn, output_fn)
 
 -- warning suppression
@@ -1830,14 +1853,14 @@ getHCFilePackages filename =
           return []
 
 
-linkDynLibCheck :: Logger -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
-linkDynLibCheck logger dflags unit_env o_files dep_units = do
+linkDynLibCheck :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
+linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do
   when (haveRtsOptsFlags dflags) $
     putLogMsg logger dflags NoReason SevInfo noSrcSpan
       $ withPprStyle defaultUserStyle
       (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$
       text "    Call hs_init_ghc() from your main() function to set these options.")
-  linkDynLib logger dflags unit_env o_files dep_units
+  linkDynLib logger tmpfs dflags unit_env o_files dep_units
 
 
 -- -----------------------------------------------------------------------------
@@ -1846,8 +1869,8 @@ linkDynLibCheck logger dflags unit_env o_files dep_units = do
 -- | Run CPP
 --
 -- UnitState is needed to compute MIN_VERSION macros
-doCpp :: Logger -> DynFlags -> UnitEnv -> Bool -> FilePath -> FilePath -> IO ()
-doCpp logger dflags unit_env raw input_fn output_fn = do
+doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> Bool -> FilePath -> FilePath -> IO ()
+doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do
     let hscpp_opts = picPOpts dflags
     let cmdline_include_paths = includePaths dflags
     let unit_state = ue_units unit_env
@@ -1862,7 +1885,8 @@ doCpp logger dflags unit_env raw input_fn output_fn = do
     let verbFlags = getVerbFlags dflags
 
     let cpp_prog args | raw       = GHC.SysTools.runCpp logger dflags args
-                      | otherwise = GHC.SysTools.runCc Nothing logger dflags (GHC.SysTools.Option "-E" : args)
+                      | otherwise = GHC.SysTools.runCc Nothing logger tmpfs dflags
+                                        (GHC.SysTools.Option "-E" : args)
 
     let platform   = targetPlatform dflags
         targetArch = stringEncodeArch $ platformArch platform
@@ -1905,7 +1929,7 @@ doCpp logger 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 dflags TFL_CurrentModule "h"
+            then do macro_stub <- newTempName logger tmpfs 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
@@ -2035,12 +2059,12 @@ via gcc.
 
 -}
 
-joinObjectFiles :: Logger -> DynFlags -> [FilePath] -> FilePath -> IO ()
-joinObjectFiles logger dflags o_files output_fn = do
+joinObjectFiles :: Logger -> TmpFs -> DynFlags -> [FilePath] -> FilePath -> IO ()
+joinObjectFiles logger tmpfs dflags o_files output_fn = do
   let toolSettings' = toolSettings dflags
       ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'
       osInfo = platformOS (targetPlatform dflags)
-      ld_r args = GHC.SysTools.runMergeObjects logger dflags (
+      ld_r args = GHC.SysTools.runMergeObjects logger tmpfs dflags (
                         -- See Note [Produce big objects on Windows]
                         concat
                           [ [GHC.SysTools.Option "--oformat", GHC.SysTools.Option "pe-bigobj-x86-64"]
@@ -2060,14 +2084,14 @@ joinObjectFiles logger dflags o_files output_fn = do
 
   if ldIsGnuLd
      then do
-          script <- newTempName logger dflags TFL_CurrentModule "ldscript"
+          script <- newTempName logger tmpfs 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 dflags TFL_CurrentModule "filelist"
+          filelist <- newTempName logger tmpfs 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/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs
index 53d4e98b0d..4a33543527 100644
--- a/compiler/GHC/Driver/Pipeline/Monad.hs
+++ b/compiler/GHC/Driver/Pipeline/Monad.hs
@@ -22,7 +22,7 @@ import GHC.Driver.Phases
 import GHC.Driver.Env
 import GHC.Driver.Plugins
 
-import GHC.SysTools.FileCleanup (TempFileLifetime)
+import GHC.Utils.TmpFs (TempFileLifetime)
 
 import GHC.Types.SourceFile
 
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 3633edf48c..8b7ddd321d 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -209,9 +209,6 @@ module GHC.Driver.Session (
         LinkerInfo(..),
         CompilerInfo(..),
 
-        -- * File cleanup
-        FilesToClean(..), emptyFilesToClean,
-
         -- * Include specifications
         IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
 
@@ -271,9 +268,6 @@ import Control.Monad.Trans.Except
 import Data.Ord
 import Data.Char
 import Data.List (intercalate, delete, sortBy)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
 import qualified Data.Set as Set
 import System.FilePath
 import System.Directory
@@ -580,13 +574,6 @@ data DynFlags = DynFlags {
   packageEnv            :: Maybe FilePath,
         -- ^ Filepath to the package environment file (if overriding default)
 
-  -- Temporary files
-  -- These have to be IORefs, because the defaultCleanupHandler needs to
-  -- know what to clean when an exception happens
-  filesToClean          :: IORef FilesToClean,
-  dirsToClean           :: IORef (Map FilePath FilePath),
-  -- The next available suffix to uniquely name a temp file, updated atomically
-  nextTempSuffix        :: IORef Int,
 
   -- hsc dynamic flags
   dumpFlags             :: EnumSet DumpFlag,
@@ -1061,9 +1048,6 @@ initDynFlags dflags = do
      platformCanGenerateDynamicToo
          = platformOS (targetPlatform dflags) /= OSMinGW32
  refDynamicTooFailed <- newIORef (not platformCanGenerateDynamicToo)
- refNextTempSuffix <- newIORef 0
- refFilesToClean <- newIORef emptyFilesToClean
- refDirsToClean <- newIORef Map.empty
  refRtldInfo <- newIORef Nothing
  refRtccInfo <- newIORef Nothing
  wrapperNum <- newIORef emptyModuleEnv
@@ -1084,9 +1068,6 @@ initDynFlags dflags = do
        (useColor dflags, colScheme dflags)
  return dflags{
         dynamicTooFailed = refDynamicTooFailed,
-        nextTempSuffix = refNextTempSuffix,
-        filesToClean   = refFilesToClean,
-        dirsToClean    = refDirsToClean,
         nextWrapperNum = wrapperNum,
         useUnicode    = useUnicode',
         useColor      = useColor',
@@ -1212,9 +1193,6 @@ defaultDynFlags mySettings llvmConfig =
         depExcludeMods    = [],
         depSuffixes       = [],
         -- end of ghc -M values
-        nextTempSuffix = panic "defaultDynFlags: No nextTempSuffix",
-        filesToClean   = panic "defaultDynFlags: No filesToClean",
-        dirsToClean    = panic "defaultDynFlags: No dirsToClean",
         ghcVersionFile = Nothing,
         haddockOptions = Nothing,
         dumpFlags = EnumSet.empty,
@@ -4883,26 +4861,6 @@ decodeSize str
 foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
 foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
 
--- -----------------------------------------------------------------------------
--- Types for managing temporary files.
---
--- these are here because FilesToClean is used in DynFlags
-
--- | A collection of files that must be deleted before ghc exits.
--- The current collection
--- is stored in an IORef in DynFlags, 'filesToClean'.
-data FilesToClean = FilesToClean {
-  ftcGhcSession :: !(Set FilePath),
-  -- ^ Files that will be deleted at the end of runGhc(T)
-  ftcCurrentModule :: !(Set FilePath)
-  -- ^ Files that will be deleted the next time
-  -- 'FileCleanup.cleanCurrentModuleTempFiles' is called, or otherwise at the
-  -- end of the session.
-  }
-
--- | An empty FilesToClean
-emptyFilesToClean :: FilesToClean
-emptyFilesToClean = FilesToClean Set.empty Set.empty
 
 -- | Initialize the pretty-printing options
 initSDocContext :: DynFlags -> PprStyle -> SDocContext
diff --git a/compiler/GHC/Linker/Dynamic.hs b/compiler/GHC/Linker/Dynamic.hs
index 7f4d6cae21..c9d0f0db73 100644
--- a/compiler/GHC/Linker/Dynamic.hs
+++ b/compiler/GHC/Linker/Dynamic.hs
@@ -23,12 +23,13 @@ import GHC.Linker.MacOS
 import GHC.Linker.Unit
 import GHC.SysTools.Tasks
 import GHC.Utils.Logger
+import GHC.Utils.TmpFs
 
 import qualified Data.Set as Set
 import System.FilePath
 
-linkDynLib :: Logger -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
-linkDynLib logger dflags0 unit_env o_files dep_packages
+linkDynLib :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
+linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
  = do
     let platform   = ue_platform unit_env
         os         = platformOS platform
@@ -104,7 +105,7 @@ linkDynLib logger dflags0 unit_env o_files dep_packages
                             Just s -> s
                             Nothing -> "HSdll.dll"
 
-            runLink logger dflags (
+            runLink logger tmpfs dflags (
                     map Option verbFlags
                  ++ [ Option "-o"
                     , FileOption "" output_fn
@@ -164,7 +165,7 @@ linkDynLib logger dflags0 unit_env o_files dep_packages
             instName <- case dylibInstallName dflags of
                 Just n -> return n
                 Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
-            runLink logger dflags (
+            runLink logger tmpfs dflags (
                     map Option verbFlags
                  ++ [ Option "-dynamiclib"
                     , Option "-o"
@@ -206,7 +207,7 @@ linkDynLib logger dflags0 unit_env o_files dep_packages
                                 -- See Note [-Bsymbolic assumptions by GHC]
                                 ["-Wl,-Bsymbolic" | not unregisterised]
 
-            runLink logger dflags (
+            runLink logger tmpfs dflags (
                     map Option verbFlags
                  ++ libmLinkOpts
                  ++ [ Option "-o"
diff --git a/compiler/GHC/Linker/ExtraObj.hs b/compiler/GHC/Linker/ExtraObj.hs
index b8dca3e8dc..15fe7b69fd 100644
--- a/compiler/GHC/Linker/ExtraObj.hs
+++ b/compiler/GHC/Linker/ExtraObj.hs
@@ -32,6 +32,7 @@ import GHC.Utils.Error
 import GHC.Utils.Misc
 import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Logger
+import GHC.Utils.TmpFs
 
 import GHC.Driver.Session
 import GHC.Driver.Ppr
@@ -39,7 +40,6 @@ import GHC.Driver.Ppr
 import qualified GHC.Data.ShortText as ST
 
 import GHC.SysTools.Elf
-import GHC.SysTools.FileCleanup
 import GHC.SysTools.Tasks
 import GHC.SysTools.Info
 import GHC.Linker.Unit
@@ -48,13 +48,13 @@ import Control.Monad.IO.Class
 import Control.Monad
 import Data.Maybe
 
-mkExtraObj :: Logger -> DynFlags -> UnitState -> Suffix -> String -> IO FilePath
-mkExtraObj logger dflags unit_state extn xs
- = do cFile <- newTempName logger dflags TFL_CurrentModule extn
-      oFile <- newTempName logger dflags TFL_GhcSession "o"
+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"
       writeFile cFile xs
       ccInfo <- liftIO $ getCompilerInfo logger dflags
-      runCc Nothing logger dflags
+      runCc Nothing logger tmpfs dflags
             ([Option        "-c",
               FileOption "" cFile,
               Option        "-o",
@@ -87,8 +87,8 @@ mkExtraObj logger dflags unit_state extn xs
 --
 -- On Windows, when making a shared library we also may need a DllMain.
 --
-mkExtraObjToLinkIntoBinary :: Logger -> DynFlags -> UnitState -> IO (Maybe FilePath)
-mkExtraObjToLinkIntoBinary logger dflags unit_state = do
+mkExtraObjToLinkIntoBinary :: Logger -> TmpFs -> DynFlags -> UnitState -> IO (Maybe FilePath)
+mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state = do
   when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $
      logInfo logger dflags $ withPprStyle defaultUserStyle
          (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
@@ -114,7 +114,7 @@ mkExtraObjToLinkIntoBinary logger dflags unit_state = do
     _ -> mk_extra_obj exeMain
 
   where
-    mk_extra_obj = fmap Just . mkExtraObj logger dflags unit_state "c" . showSDoc dflags
+    mk_extra_obj = fmap Just . mkExtraObj logger tmpfs dflags unit_state "c" . showSDoc dflags
 
     exeMain = vcat [
         text "#include <Rts.h>",
@@ -163,12 +163,12 @@ mkExtraObjToLinkIntoBinary logger dflags unit_state = do
 -- this was included as inline assembly in the main.c file but this
 -- is pretty fragile. gas gets upset trying to calculate relative offsets
 -- that span the .note section (notably .text) when debug info is present
-mkNoteObjsToLinkIntoBinary :: Logger -> DynFlags -> UnitEnv -> [UnitId] -> IO [FilePath]
-mkNoteObjsToLinkIntoBinary logger dflags unit_env dep_packages = do
+mkNoteObjsToLinkIntoBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [UnitId] -> IO [FilePath]
+mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_packages = do
    link_info <- getLinkInfo dflags unit_env dep_packages
 
    if (platformSupportsSavingLinkOpts (platformOS platform ))
-     then fmap (:[]) $ mkExtraObj logger dflags unit_state "s" (showSDoc dflags (link_opts link_info))
+     then fmap (:[]) $ mkExtraObj logger tmpfs dflags unit_state "s" (showSDoc dflags (link_opts link_info))
      else return []
 
   where
diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index 4533bc014f..cc1fde53a3 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -58,7 +58,6 @@ import GHC.ByteCode.Asm
 import GHC.ByteCode.Types
 
 import GHC.SysTools
-import GHC.SysTools.FileCleanup
 
 import GHC.Types.Basic
 import GHC.Types.Name
@@ -71,6 +70,7 @@ import GHC.Utils.Panic
 import GHC.Utils.Misc
 import GHC.Utils.Error
 import GHC.Utils.Logger
+import GHC.Utils.TmpFs
 
 import GHC.Unit.Env
 import GHC.Unit.Finder
@@ -919,11 +919,12 @@ dynLoadObjs hsc_env pls@LoaderState{..} objs = do
     let unit_env = hsc_unit_env hsc_env
     let dflags   = hsc_dflags hsc_env
     let logger   = hsc_logger hsc_env
+    let tmpfs    = hsc_tmpfs hsc_env
     let platform = ue_platform unit_env
     let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ]
     let minus_big_ls = [ lib | Option ('-':'L':lib) <- ldInputs dflags ]
     (soFile, libPath , libName) <-
-      newTempLibName logger dflags TFL_CurrentModule (platformSOExt platform)
+      newTempLibName logger tmpfs dflags TFL_CurrentModule (platformSOExt platform)
     let
         dflags2 = dflags {
                       -- We don't want the original ldInputs in
@@ -969,10 +970,10 @@ dynLoadObjs hsc_env pls@LoaderState{..} objs = do
     -- link all "loaded packages" so symbols in those can be resolved
     -- Note: We are loading packages with local scope, so to see the
     -- symbols in this link we must link all loaded packages again.
-    linkDynLib logger dflags2 unit_env objs pkgs_loaded
+    linkDynLib logger tmpfs dflags2 unit_env objs pkgs_loaded
 
     -- if we got this far, extend the lifetime of the library file
-    changeTempFilesLifetime dflags TFL_GhcSession [soFile]
+    changeTempFilesLifetime tmpfs TFL_GhcSession [soFile]
     m <- loadDLL hsc_env soFile
     case m of
         Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos }
diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs
index 32640ddf62..4e2367f9e6 100644
--- a/compiler/GHC/Linker/Static.hs
+++ b/compiler/GHC/Linker/Static.hs
@@ -13,7 +13,6 @@ import GHC.Settings
 
 import GHC.SysTools
 import GHC.SysTools.Ar
-import GHC.SysTools.FileCleanup
 
 import GHC.Unit.Env
 import GHC.Unit.Types
@@ -23,6 +22,7 @@ import GHC.Unit.State
 import GHC.Utils.Logger
 import GHC.Utils.Monad
 import GHC.Utils.Misc
+import GHC.Utils.TmpFs
 
 import GHC.Linker.MacOS
 import GHC.Linker.Unit
@@ -64,11 +64,11 @@ it is supported by both gcc and clang. Anecdotally nvcc supports
 -Xlinker, but not -Wl.
 -}
 
-linkBinary :: Logger -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
+linkBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
 linkBinary = linkBinary' False
 
-linkBinary' :: Bool -> Logger -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
-linkBinary' staticLink logger dflags unit_env o_files dep_units = do
+linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
+linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
     let platform   = ue_platform unit_env
         unit_state = ue_units unit_env
         toolSettings' = toolSettings dflags
@@ -123,7 +123,7 @@ linkBinary' staticLink logger 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 dflags
+        tmpDir <- newTempDir logger tmpfs dflags
         sequence_ [ copyFile lib (tmpDir </> basename)
                   | (lib, basename) <- libs]
         return [ "-L" ++ tmpDir ]
@@ -138,8 +138,8 @@ linkBinary' staticLink logger dflags unit_env o_files dep_units = do
     let lib_paths = libraryPaths dflags
     let lib_path_opts = map ("-L"++) lib_paths
 
-    extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger dflags unit_state
-    noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger dflags unit_env dep_units
+    extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state
+    noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_units
 
     let
       (pre_hs_libs, post_hs_libs)
@@ -181,16 +181,16 @@ linkBinary' staticLink logger dflags unit_env o_files dep_units = do
     let extra_ld_inputs = ldInputs dflags
 
     rc_objs <- case platformOS platform of
-      OSMinGW32 | gopt Opt_GenManifest dflags -> maybeCreateManifest logger dflags output_fn
+      OSMinGW32 | gopt Opt_GenManifest dflags -> maybeCreateManifest logger tmpfs dflags output_fn
       _                                       -> return []
 
     let link dflags args | staticLink = GHC.SysTools.runLibtool logger dflags args
                          | platformOS platform == OSDarwin
                             = do
-                                 GHC.SysTools.runLink logger dflags args
+                                 GHC.SysTools.runLink logger tmpfs dflags args
                                  GHC.Linker.MacOS.runInjectRPaths logger dflags pkg_lib_paths output_fn
                          | otherwise
-                            = GHC.SysTools.runLink logger dflags args
+                            = GHC.SysTools.runLink logger tmpfs dflags args
 
     link dflags (
                        map GHC.SysTools.Option verbFlags
diff --git a/compiler/GHC/Linker/Windows.hs b/compiler/GHC/Linker/Windows.hs
index 8e1f60d2c6..8be0802002 100644
--- a/compiler/GHC/Linker/Windows.hs
+++ b/compiler/GHC/Linker/Windows.hs
@@ -6,7 +6,7 @@ where
 import GHC.Prelude
 import GHC.SysTools
 import GHC.Driver.Session
-import GHC.SysTools.FileCleanup
+import GHC.Utils.TmpFs
 import GHC.Utils.Logger
 
 import System.FilePath
@@ -14,10 +14,11 @@ import System.Directory
 
 maybeCreateManifest
    :: Logger
+   -> TmpFs
    -> DynFlags
    -> FilePath      -- ^ filename of executable
    -> IO [FilePath] -- ^ extra objects to embed, maybe
-maybeCreateManifest logger dflags exe_filename = do
+maybeCreateManifest logger tmpfs dflags exe_filename = do
    let manifest_filename = exe_filename <.> "manifest"
        manifest =
          "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n\
@@ -44,9 +45,9 @@ maybeCreateManifest logger dflags exe_filename = do
    if not (gopt Opt_EmbedManifest dflags)
       then return []
       else do
-         rc_filename <- newTempName logger dflags TFL_CurrentModule "rc"
+         rc_filename <- newTempName logger tmpfs dflags TFL_CurrentModule "rc"
          rc_obj_filename <-
-           newTempName logger dflags TFL_GhcSession (objectSuf dflags)
+           newTempName logger tmpfs 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 d4ed196c91..e66929056c 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
 
 -----------------------------------------------------------------------------
 --
@@ -61,7 +62,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Logger
 
-import GHC.SysTools.FileCleanup
+import GHC.Utils.TmpFs
 
 import GHC.Data.Stream
 import GHC.Data.OrdList
@@ -79,6 +80,7 @@ data CodeGenState = CodeGenState { codegen_used_info :: !(OrdList CmmInfoTable)
 
 
 codeGen :: Logger
+        -> TmpFs
         -> DynFlags
         -> Module
         -> InfoTableProvMap
@@ -89,7 +91,7 @@ codeGen :: Logger
         -> Stream IO CmmGroup (CStub, ModuleLFInfos)       -- Output as a stream, so codegen can
                                        -- be interleaved with output
 
-codeGen logger dflags this_mod ip_map@(InfoTableProvMap (UniqMap denv) _) data_tycons
+codeGen logger tmpfs dflags this_mod ip_map@(InfoTableProvMap (UniqMap denv) _) data_tycons
         cost_centre_info stg_binds hpc_info
   = do  {     -- cg: run the code generator, and yield the resulting CmmGroup
               -- Using an IORef to store the state is a bit crude, but otherwise
@@ -124,7 +126,7 @@ codeGen logger dflags this_mod ip_map@(InfoTableProvMap (UniqMap denv) _) data_t
                -- Note [pipeline-split-init].
         ; cg (mkModuleInit cost_centre_info this_mod hpc_info)
 
-        ; mapM_ (cg . cgTopBinding logger dflags) stg_binds
+        ; mapM_ (cg . cgTopBinding logger tmpfs dflags) stg_binds
                 -- Put datatype_stuff after code_stuff, because the
                 -- datatype closure table (for enumeration types) to
                 -- (say) PrelBase_True_closure, which is defined in
@@ -179,39 +181,38 @@ This is so that we can write the top level processing in a compositional
 style, with the increasing static environment being plumbed as a state
 variable. -}
 
-cgTopBinding :: Logger -> DynFlags -> CgStgTopBinding -> FCode ()
-cgTopBinding _logger dflags (StgTopLifted (StgNonRec id rhs))
-  = do  { let (info, fcode) = cgTopRhs dflags NonRecursive id rhs
-        ; fcode
-        ; addBindC info
-        }
-
-cgTopBinding _logger dflags (StgTopLifted (StgRec pairs))
-  = do  { let (bndrs, rhss) = unzip pairs
-        ; let pairs' = zip bndrs rhss
-              r = unzipWith (cgTopRhs dflags Recursive) pairs'
-              (infos, fcodes) = unzip r
-        ; addBindsC infos
-        ; sequence_ fcodes
-        }
-
-cgTopBinding logger dflags (StgTopStringLit id str) = do
-  let label = mkBytesLabel (idName id)
-  -- emit either a CmmString literal or dump the string in a file and emit a
-  -- CmmFileEmbed literal.
-  -- See Note [Embedding large binary blobs] in GHC.CmmToAsm.Ppr
-  let isNCG    = backend dflags == NCG
-      isSmall  = fromIntegral (BS.length str) <= binBlobThreshold dflags
-      asString = binBlobThreshold dflags == 0 || isSmall
-
-      (lit,decl) = if not isNCG || asString
-        then mkByteStringCLit label str
-        else mkFileEmbedLit label $ unsafePerformIO $ do
-               bFile <- newTempName logger dflags TFL_CurrentModule ".dat"
-               BS.writeFile bFile str
-               return bFile
-  emitDecl decl
-  addBindC (litIdInfo (targetPlatform dflags) id mkLFStringLit lit)
+cgTopBinding :: Logger -> TmpFs -> DynFlags -> CgStgTopBinding -> FCode ()
+cgTopBinding logger tmpfs dflags = \case
+    StgTopLifted (StgNonRec id rhs) -> do
+        let (info, fcode) = cgTopRhs dflags NonRecursive id rhs
+        fcode
+        addBindC info
+
+    StgTopLifted (StgRec pairs) -> do
+        let (bndrs, rhss) = unzip pairs
+        let pairs' = zip bndrs rhss
+            r = unzipWith (cgTopRhs dflags Recursive) pairs'
+            (infos, fcodes) = unzip r
+        addBindsC infos
+        sequence_ fcodes
+
+    StgTopStringLit id str -> do
+        let label = mkBytesLabel (idName id)
+        -- emit either a CmmString literal or dump the string in a file and emit a
+        -- CmmFileEmbed literal.
+        -- See Note [Embedding large binary blobs] in GHC.CmmToAsm.Ppr
+        let isNCG    = backend dflags == NCG
+            isSmall  = fromIntegral (BS.length str) <= binBlobThreshold dflags
+            asString = binBlobThreshold dflags == 0 || isSmall
+
+            (lit,decl) = if not isNCG || asString
+              then mkByteStringCLit label str
+              else mkFileEmbedLit label $ unsafePerformIO $ do
+                     bFile <- newTempName logger tmpfs dflags TFL_CurrentModule ".dat"
+                     BS.writeFile bFile str
+                     return bFile
+        emitDecl decl
+        addBindC (litIdInfo (targetPlatform dflags) id mkLFStringLit lit)
 
 
 cgTopRhs :: DynFlags -> RecFlag -> Id -> CgStgRhs -> (CgIdInfo, FCode ())
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
index df12cb4af7..1159506d18 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -10,16 +10,19 @@ module GHC.SysTools.Process where
 
 #include "HsVersions.h"
 
+import GHC.Prelude
+
+import GHC.Driver.Session
+
 import GHC.Utils.Exception
 import GHC.Utils.Error
-import GHC.Driver.Session
-import GHC.Data.FastString
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
-import GHC.Prelude
 import GHC.Utils.Misc
 import GHC.Utils.Logger
+
 import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, mkSrcSpan )
+import GHC.Data.FastString
 
 import Control.Concurrent
 import Data.Char
@@ -31,7 +34,7 @@ import System.IO
 import System.IO.Error as IO
 import System.Process
 
-import GHC.SysTools.FileCleanup
+import GHC.Utils.TmpFs
 
 -- | Enable process jobs support on Windows if it can be expected to work (e.g.
 -- @process >= 1.6.9.0@).
@@ -155,10 +158,16 @@ runSomething logger dflags phase_name pgm args =
 --     https://gcc.gnu.org/wiki/Response_Files
 --     https://gitlab.haskell.org/ghc/ghc/issues/10777
 runSomethingResponseFile
-  :: Logger -> DynFlags -> (String->String) -> String -> String -> [Option]
-  -> Maybe [(String,String)] -> IO ()
-
-runSomethingResponseFile logger dflags filter_fn phase_name pgm args mb_env =
+  :: Logger
+  -> TmpFs
+  -> DynFlags
+  -> (String->String)
+  -> String
+  -> String
+  -> [Option]
+  -> Maybe [(String,String)]
+  -> IO ()
+runSomethingResponseFile logger tmpfs dflags filter_fn phase_name pgm args mb_env =
     runSomethingWith logger dflags phase_name pgm args $ \real_args -> do
         fp <- getResponseFile real_args
         let args = ['@':fp]
@@ -166,7 +175,7 @@ runSomethingResponseFile logger dflags filter_fn phase_name pgm args mb_env =
         return (r,())
   where
     getResponseFile args = do
-      fp <- newTempName logger dflags TFL_CurrentModule "rsp"
+      fp <- newTempName logger tmpfs dflags TFL_CurrentModule "rsp"
       withFile fp WriteMode $ \h -> do
 #if defined(mingw32_HOST_OS)
           hSetEncoding h latin1
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index b802623325..694d3155c1 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -25,6 +25,7 @@ import GHC.Utils.Error
 import GHC.Utils.Outputable
 import GHC.Utils.Misc
 import GHC.Utils.Logger
+import GHC.Utils.TmpFs
 
 import Data.List (tails, isPrefixOf)
 import System.IO
@@ -62,15 +63,15 @@ runPp logger dflags args = traceToolCommand logger dflags "pp" $ do
   runSomething logger dflags "Haskell pre-processor" prog (args ++ opts)
 
 -- | Run compiler of C-like languages and raw objects (such as gcc or clang).
-runCc :: Maybe ForeignSrcLang -> Logger -> DynFlags -> [Option] -> IO ()
-runCc mLanguage logger dflags args = traceToolCommand logger dflags "cc" $ do
+runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
+runCc mLanguage logger tmpfs dflags args = traceToolCommand logger dflags "cc" $ do
   let p = pgm_c dflags
       args1 = map Option userOpts
       args2 = languageOptions ++ args ++ args1
       -- We take care to pass -optc flags in args1 last to ensure that the
       -- user can override flags passed by GHC. See #14452.
   mb_env <- getGccEnv args2
-  runSomethingResponseFile logger dflags cc_filter "C Compiler" p args2 mb_env
+  runSomethingResponseFile logger tmpfs dflags cc_filter "C Compiler" p args2 mb_env
  where
   -- discard some harmless warnings from gcc that we can't turn off
   cc_filter = unlines . doFilter . lines
@@ -239,8 +240,8 @@ figureLlvmVersion logger dflags = traceToolCommand logger dflags "llc" $ do
 
 
 
-runLink :: Logger -> DynFlags -> [Option] -> IO ()
-runLink logger dflags args = traceToolCommand logger dflags "linker" $ do
+runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
+runLink logger tmpfs dflags args = traceToolCommand logger dflags "linker" $ do
   -- See Note [Run-time linker info]
   --
   -- `-optl` args come at the end, so that later `-l` options
@@ -251,7 +252,7 @@ runLink logger dflags args = traceToolCommand logger dflags "linker" $ do
       optl_args = map Option (getOpts dflags opt_l)
       args2     = args0 ++ linkargs ++ args ++ optl_args
   mb_env <- getGccEnv args2
-  runSomethingResponseFile logger dflags ld_filter "Linker" p args2 mb_env
+  runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env
   where
     ld_filter = case (platformOS (targetPlatform dflags)) of
                   OSSolaris2 -> sunos_ld_filter
@@ -303,18 +304,23 @@ ld: warning: symbol referencing errors
     ld_warning_found = not . null . snd . ld_warn_break
 
 -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline.
-runMergeObjects :: Logger -> DynFlags -> [Option] -> IO ()
-runMergeObjects logger dflags args = traceToolCommand logger dflags "merge-objects" $ do
-  let (p,args0) = pgm_lm dflags
-      optl_args = map Option (getOpts dflags opt_lm)
-      args2     = args0 ++ args ++ optl_args
-  -- N.B. Darwin's ld64 doesn't support response files. Consequently we only
-  -- use them on Windows where they are truly necessary.
+runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
 #if defined(mingw32_HOST_OS)
-  mb_env <- getGccEnv args2
-  runSomethingResponseFile logger dflags id "Merge objects" p args2 mb_env
+runMergeObjects logger tmpfs  dflags args =
+#else
+runMergeObjects logger _tmpfs dflags args =
+#endif
+  traceToolCommand logger dflags "merge-objects" $ do
+    let (p,args0) = pgm_lm dflags
+        optl_args = map Option (getOpts dflags opt_lm)
+        args2     = args0 ++ args ++ optl_args
+    -- N.B. Darwin's ld64 doesn't support response files. Consequently we only
+    -- use them on Windows where they are truly necessary.
+#if defined(mingw32_HOST_OS)
+    mb_env <- getGccEnv args2
+    runSomethingResponseFile logger tmpfs dflags id "Merge objects" p args2 mb_env
 #else
-  runSomething logger dflags "Merge objects" p args2
+    runSomething logger dflags "Merge objects" p args2
 #endif
 
 runLibtool :: Logger -> DynFlags -> [Option] -> IO ()
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index ab45f3f373..7ae4ccb0f6 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -122,7 +122,7 @@ import GHC.Utils.Lexeme
 import GHC.Utils.Outputable
 import GHC.Utils.Logger
 
-import GHC.SysTools.FileCleanup ( newTempName, TempFileLifetime(..) )
+import GHC.Utils.TmpFs ( newTempName, TempFileLifetime(..) )
 
 import GHC.Data.FastString
 import GHC.Data.Maybe( MaybeErr(..) )
@@ -1140,7 +1140,8 @@ instance TH.Quasi TcM where
   qAddTempFile suffix = do
     dflags <- getDynFlags
     logger <- getLogger
-    liftIO $ newTempName logger dflags TFL_GhcSession suffix
+    tmpfs  <- hsc_tmpfs <$> getTopEnv
+    liftIO $ newTempName logger tmpfs dflags TFL_GhcSession suffix
 
   qAddTopDecls thds = do
       l <- getSrcSpanM
diff --git a/compiler/GHC/SysTools/FileCleanup.hs b/compiler/GHC/Utils/TmpFs.hs
index 1b73ad2812..d108f55b3b 100644
--- a/compiler/GHC/SysTools/FileCleanup.hs
+++ b/compiler/GHC/Utils/TmpFs.hs
@@ -1,11 +1,26 @@
 {-# LANGUAGE CPP #-}
-module GHC.SysTools.FileCleanup
-  ( TempFileLifetime(..)
-  , cleanTempDirs, cleanTempFiles, cleanCurrentModuleTempFiles
-  , addFilesToClean, changeTempFilesLifetime
-  , newTempName, newTempLibName, newTempDir
-  , withSystemTempDirectory, withTempDirectory
-  ) where
+
+-- | Temporary file-system management
+module GHC.Utils.TmpFs
+    ( TmpFs
+    , initTmpFs
+    , forkTmpFsFrom
+    , mergeTmpFsInto
+    , FilesToClean(..)
+    , emptyFilesToClean
+    , TempFileLifetime(..)
+    , cleanTempDirs
+    , cleanTempFiles
+    , cleanCurrentModuleTempFiles
+    , addFilesToClean
+    , changeTempFilesLifetime
+    , newTempName
+    , newTempLibName
+    , newTempDir
+    , withSystemTempDirectory
+    , withTempDirectory
+    )
+where
 
 import GHC.Prelude
 
@@ -20,7 +35,9 @@ import GHC.Driver.Phases
 import Control.Monad
 import Data.List (partition)
 import qualified Data.Set as Set
+import Data.Set (Set)
 import qualified Data.Map as Map
+import Data.Map (Map)
 import Data.IORef
 import System.Directory
 import System.FilePath
@@ -30,6 +47,40 @@ import System.IO.Error
 import qualified System.Posix.Internals
 #endif
 
+-- | Temporary file-system
+data TmpFs = TmpFs
+  { tmp_dirs_to_clean :: IORef (Map FilePath FilePath)
+      -- ^ Maps system temporary directory (passed via settings or DynFlags) to
+      -- an actual temporary directory for this process.
+      --
+      -- It's a Map probably to support changing the system temporary directory
+      -- over time.
+      --
+      -- Shared with forked TmpFs.
+
+  , tmp_next_suffix :: IORef Int
+      -- ^ The next available suffix to uniquely name a temp file, updated
+      -- atomically.
+      --
+      -- Shared with forked TmpFs.
+
+  , tmp_files_to_clean :: IORef FilesToClean
+      -- ^ Files to clean (per session or per module)
+      --
+      -- Not shared with forked TmpFs.
+  }
+
+-- | A collection of files that must be deleted before ghc exits.
+data FilesToClean = FilesToClean
+    { ftcGhcSession :: !(Set FilePath)
+        -- ^ Files that will be deleted at the end of runGhc(T)
+
+    , ftcCurrentModule :: !(Set FilePath)
+        -- ^ Files that will be deleted the next time
+        -- 'cleanCurrentModuleTempFiles' is called, or otherwise at the end of
+        -- the session.
+    }
+
 -- | Used when a temp file is created. This determines which component Set of
 -- FilesToClean will get the temp file
 data TempFileLifetime
@@ -41,20 +92,63 @@ data TempFileLifetime
   -- runGhc(T)
   deriving (Show)
 
-cleanTempDirs :: Logger -> DynFlags -> IO ()
-cleanTempDirs logger dflags
+
+-- | An empty FilesToClean
+emptyFilesToClean :: FilesToClean
+emptyFilesToClean = FilesToClean Set.empty Set.empty
+
+-- | Merge two FilesToClean
+mergeFilesToClean :: FilesToClean -> FilesToClean -> FilesToClean
+mergeFilesToClean x y = FilesToClean
+    { ftcGhcSession    = Set.union (ftcGhcSession x) (ftcGhcSession y)
+    , ftcCurrentModule = Set.union (ftcCurrentModule x) (ftcCurrentModule y)
+    }
+
+-- | Initialise an empty TmpFs
+initTmpFs :: IO TmpFs
+initTmpFs = do
+    files <- newIORef emptyFilesToClean
+    dirs  <- newIORef Map.empty
+    next  <- newIORef 0
+    return $ TmpFs
+        { tmp_files_to_clean = files
+        , tmp_dirs_to_clean  = dirs
+        , tmp_next_suffix    = next
+        }
+
+-- | Initialise an empty TmpFs sharing unique numbers and per-process temporary
+-- directories with the given TmpFs
+forkTmpFsFrom :: TmpFs -> IO TmpFs
+forkTmpFsFrom old = do
+    files <- newIORef emptyFilesToClean
+    return $ TmpFs
+        { tmp_files_to_clean = files
+        , tmp_dirs_to_clean  = tmp_dirs_to_clean old
+        , tmp_next_suffix    = tmp_next_suffix old
+        }
+
+-- | Merge the first TmpFs into the second.
+--
+-- The first TmpFs is returned emptied.
+mergeTmpFsInto :: TmpFs -> TmpFs -> IO ()
+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_
-   $ do let ref = dirsToClean dflags
+   $ do let ref = tmp_dirs_to_clean tmpfs
         ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds)
         removeTmpDirs logger dflags (Map.elems ds)
 
--- | Delete all files in @filesToClean dflags@.
-cleanTempFiles :: Logger -> DynFlags -> IO ()
-cleanTempFiles logger dflags
+-- | Delete all files in @tmp_files_to_clean@.
+cleanTempFiles :: Logger -> TmpFs -> DynFlags -> IO ()
+cleanTempFiles logger tmpfs dflags
    = unless (gopt Opt_KeepTmpFiles dflags)
    $ mask_
-   $ do let ref = filesToClean dflags
+   $ do let ref = tmp_files_to_clean tmpfs
         to_delete <- atomicModifyIORef' ref $
             \FilesToClean
                 { ftcCurrentModule = cm_files
@@ -63,15 +157,15 @@ cleanTempFiles logger dflags
                      , Set.toList cm_files ++ Set.toList gs_files)
         removeTmpFiles logger dflags to_delete
 
--- | Delete all files in @filesToClean dflags@. That have lifetime
+-- | Delete all files in @tmp_files_to_clean@. That have lifetime
 -- TFL_CurrentModule.
 -- If a file must be cleaned eventually, but must survive a
 -- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession.
-cleanCurrentModuleTempFiles :: Logger -> DynFlags -> IO ()
-cleanCurrentModuleTempFiles logger dflags
+cleanCurrentModuleTempFiles :: Logger -> TmpFs -> DynFlags -> IO ()
+cleanCurrentModuleTempFiles logger tmpfs dflags
    = unless (gopt Opt_KeepTmpFiles dflags)
    $ mask_
-   $ do let ref = filesToClean dflags
+   $ do let ref = tmp_files_to_clean tmpfs
         to_delete <- atomicModifyIORef' ref $
             \ftc@FilesToClean{ftcCurrentModule = cm_files} ->
                 (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files)
@@ -81,8 +175,8 @@ cleanCurrentModuleTempFiles logger dflags
 -- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime.
 -- If any of new_files are already tracked, they will have their lifetime
 -- updated.
-addFilesToClean :: DynFlags -> TempFileLifetime -> [FilePath] -> IO ()
-addFilesToClean dflags lifetime new_files = modifyIORef' (filesToClean dflags) $
+addFilesToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
+addFilesToClean tmpfs lifetime new_files = modifyIORef' (tmp_files_to_clean tmpfs) $
   \FilesToClean
     { ftcCurrentModule = cm_files
     , ftcGhcSession = gs_files
@@ -100,76 +194,76 @@ addFilesToClean dflags lifetime new_files = modifyIORef' (filesToClean dflags) $
 
 -- | Update the lifetime of files already being tracked. If any files are
 -- not being tracked they will be discarded.
-changeTempFilesLifetime :: DynFlags -> TempFileLifetime -> [FilePath] -> IO ()
-changeTempFilesLifetime dflags lifetime files = do
+changeTempFilesLifetime :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
+changeTempFilesLifetime tmpfs lifetime files = do
   FilesToClean
     { ftcCurrentModule = cm_files
     , ftcGhcSession = gs_files
-    } <- readIORef (filesToClean dflags)
+    } <- readIORef (tmp_files_to_clean tmpfs)
   let old_set = case lifetime of
         TFL_CurrentModule -> gs_files
         TFL_GhcSession -> cm_files
       existing_files = [f | f <- files, f `Set.member` old_set]
-  addFilesToClean dflags lifetime existing_files
+  addFilesToClean tmpfs lifetime existing_files
 
 -- Return a unique numeric temp file suffix
-newTempSuffix :: DynFlags -> IO Int
-newTempSuffix dflags =
-  atomicModifyIORef' (nextTempSuffix dflags) $ \n -> (n+1,n)
+newTempSuffix :: TmpFs -> IO Int
+newTempSuffix tmpfs =
+  atomicModifyIORef' (tmp_next_suffix tmpfs) $ \n -> (n+1,n)
 
 -- Find a temporary name that doesn't already exist.
-newTempName :: Logger -> DynFlags -> TempFileLifetime -> Suffix -> IO FilePath
-newTempName logger dflags lifetime extn
-  = do d <- getTempDir logger dflags
+newTempName :: Logger -> TmpFs -> DynFlags -> TempFileLifetime -> Suffix -> IO FilePath
+newTempName logger tmpfs dflags lifetime extn
+  = do d <- getTempDir logger tmpfs dflags
        findTempName (d </> "ghc_") -- See Note [Deterministic base name]
   where
     findTempName :: FilePath -> IO FilePath
     findTempName prefix
-      = do n <- newTempSuffix dflags
+      = do n <- newTempSuffix tmpfs
            let filename = prefix ++ show n <.> extn
            b <- doesFileExist filename
            if b then findTempName prefix
                 else do -- clean it up later
-                        addFilesToClean dflags lifetime [filename]
+                        addFilesToClean tmpfs lifetime [filename]
                         return filename
 
-newTempDir :: Logger -> DynFlags -> IO FilePath
-newTempDir logger dflags
-  = do d <- getTempDir logger dflags
+newTempDir :: Logger -> TmpFs -> DynFlags -> IO FilePath
+newTempDir logger tmpfs dflags
+  = do d <- getTempDir logger tmpfs dflags
        findTempDir (d </> "ghc_")
   where
     findTempDir :: FilePath -> IO FilePath
     findTempDir prefix
-      = do n <- newTempSuffix dflags
+      = do n <- newTempSuffix tmpfs
            let filename = prefix ++ show n
            b <- doesDirectoryExist filename
            if b then findTempDir prefix
                 else do createDirectory filename
-                        -- see mkTempDir below; this is wrong: -> consIORef (dirsToClean dflags) filename
+                        -- see mkTempDir below; this is wrong: -> consIORef (tmp_dirs_to_clean tmpfs) filename
                         return filename
 
-newTempLibName :: Logger -> DynFlags -> TempFileLifetime -> Suffix
+newTempLibName :: Logger -> TmpFs -> DynFlags -> TempFileLifetime -> Suffix
   -> IO (FilePath, FilePath, String)
-newTempLibName logger dflags lifetime extn
-  = do d <- getTempDir logger dflags
+newTempLibName logger tmpfs dflags lifetime extn
+  = do d <- getTempDir logger tmpfs dflags
        findTempName d ("ghc_")
   where
     findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
     findTempName dir prefix
-      = do n <- newTempSuffix dflags -- See Note [Deterministic base name]
+      = do n <- newTempSuffix tmpfs -- See Note [Deterministic base name]
            let libname = prefix ++ show n
                filename = dir </> "lib" ++ libname <.> extn
            b <- doesFileExist filename
            if b then findTempName dir prefix
                 else do -- clean it up later
-                        addFilesToClean dflags lifetime [filename]
+                        addFilesToClean tmpfs lifetime [filename]
                         return (filename, dir, libname)
 
 
 -- Return our temporary directory within tmp_dir, creating one if we
 -- don't have one yet.
-getTempDir :: Logger -> DynFlags -> IO FilePath
-getTempDir logger dflags = do
+getTempDir :: Logger -> TmpFs -> DynFlags -> IO FilePath
+getTempDir logger tmpfs dflags = do
     mapping <- readIORef dir_ref
     case Map.lookup tmp_dir mapping of
         Nothing -> do
@@ -179,17 +273,17 @@ getTempDir logger dflags = do
         Just dir -> return dir
   where
     tmp_dir = tmpDir dflags
-    dir_ref = dirsToClean dflags
+    dir_ref = tmp_dirs_to_clean tmpfs
 
     mkTempDir :: FilePath -> IO FilePath
     mkTempDir prefix = do
-        n <- newTempSuffix dflags
+        n <- newTempSuffix tmpfs
         let our_dir = prefix ++ show n
 
         -- 1. Speculatively create our new directory.
         createDirectory our_dir
 
-        -- 2. Update the dirsToClean mapping unless an entry already exists
+        -- 2. Update the tmp_dirs_to_clean mapping unless an entry already exists
         -- (i.e. unless another thread beat us to it).
         their_dir <- atomicModifyIORef' dir_ref $ \mapping ->
             case Map.lookup tmp_dir mapping of