Refactor temp files cleanup

Remove filesToNotIntermediateClean from DynFlags, create a data type
FilesToClean, and change filesToClean in DynFlags to be a FilesToClean.

Modify SysTools.newTempName and the Temporary constructor of
PipelineMonad.PipelineOutput to take a TempFileLifetime, which specifies
whether a temp file should live until the end of GhcMonad.withSession,
or until the next time cleanIntermediateTempFiles is called.

These changes allow the cleaning of intermediate files in GhcMake to be
much more efficient.

HscTypes.hptObjs is removed as it is no longer used.

A new performance test T13701 is added, which passes both with and
without -keep-tmp-files.  The test fails by 25% without the patch, and
passes when -keep-tmp-files is added.

Note that there are still at two hotspots caused by
algorithms quadratic in the number of modules, however neither of them
allocate. They are:

* DriverPipeline.compileOne'.needsLinker
* GhcMake.getModLoop

DriverPipeline.compileOne'.needsLinker is changed slightly to improve
the situation.

I don't like adding these Types to DynFlags, but they need to be seen by
Dynflags, SysTools and PipelineMonad. The alternative seems to be to
create a new module.

Reviewers: austin, hvr, bgamari, dfeuer, niteria, simonmar, erikd

Reviewed By: simonmar

Subscribers: rwbarton, thomie

GHC Trac Issues: #13701

Differential Revision: https://phabricator.haskell.org/D3620

1 files changed, 21 insertions, 0 deletions

diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index 64d23c7e41..c0127b2a27 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/main/ErrUtils.hs
@@ -52,6 +52,7 @@ module ErrUtils (
         debugTraceMsg,
         ghcExit,
         prettyPrintGhcErrors,
+        traceCmd
     ) where
 
 #include "HsVersions.h"
@@ -673,3 +674,23 @@ isWarnMsgFatal :: DynFlags -> WarnMsg -> Bool
 isWarnMsgFatal dflags ErrMsg{errMsgReason = Reason wflag}
   = wopt_fatal wflag dflags
 isWarnMsgFatal dflags _ = gopt Opt_WarnIsError dflags
+
+traceCmd :: DynFlags -> String -> String -> IO a -> IO a
+-- trace the command (at two levels of verbosity)
+traceCmd dflags phase_name cmd_line action
+ = do   { let verb = verbosity dflags
+        ; showPass dflags phase_name
+        ; debugTraceMsg dflags 3 (text cmd_line)
+        ; case flushErr dflags of
+              FlushErr io -> io
+
+           -- And run it!
+        ; action `catchIO` handle_exn verb
+        }
+  where
+    handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
+                              ; debugTraceMsg dflags 2
+                                (text "Failed:"
+                                 <+> text cmd_line
+                                 <+> text (show exn))
+                              ; throwGhcExceptionIO (ProgramError (show exn))}