Include the way string in the file name for dump files.

This can be disabled by `-fno-dump-with-ways` if not desired.
Finally we will be able to look at both profiled and non-profiled dumps
when compiling with dump flags and we compile in both ways.

10 files changed, 42 insertions, 8 deletions

diff --git a/compiler/GHC/Driver/Config/Logger.hs b/compiler/GHC/Driver/Config/Logger.hs
index c448a7d58e..1bffa5f368 100644
--- a/compiler/GHC/Driver/Config/Logger.hs
+++ b/compiler/GHC/Driver/Config/Logger.hs
@@ -23,7 +23,9 @@ initLogFlags dflags = LogFlags
   , log_dump_dir             = dumpDir dflags
   , log_dump_prefix          = dumpPrefix dflags
   , log_dump_prefix_override = dumpPrefixForce dflags
+  , log_with_ways            = gopt Opt_DumpWithWays dflags
   , log_enable_debug         = not (hasNoDebugOutput dflags)
   , log_verbosity            = verbosity dflags
+  , log_ways                 = Just $ ways dflags
   }
 
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index fef0fb4d90..209e6d1776 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -147,6 +147,7 @@ data GeneralFlag
 -- See Note [Updating flag description in the User's Guide]
 
    = Opt_DumpToFile                     -- ^ Append dump output to files instead of stdout.
+   | Opt_DumpWithWays                   -- ^ Use foo.ways.<dumpFlag> instead of foo.<dumpFlag>
    | Opt_D_dump_minimal_imports
    | Opt_DoCoreLinting
    | Opt_DoLinearCoreLinting
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 256cb67b7a..00e7c726dd 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3362,6 +3362,9 @@ fFlagsDeps = [
   flagSpec "defer-typed-holes"                Opt_DeferTypedHoles,
   flagSpec "defer-out-of-scope-variables"     Opt_DeferOutOfScopeVariables,
   flagSpec "diagnostics-show-caret"           Opt_DiagnosticsShowCaret,
+  -- With-ways needs to be reversible hence why its made via flagSpec unlike
+  -- other debugging flags.
+  flagSpec "dump-with-ways"                   Opt_DumpWithWays,
   flagSpec "dicts-cheap"                      Opt_DictsCheap,
   flagSpec "dicts-strict"                     Opt_DictsStrict,
   depFlagSpec "dmd-tx-dict-sel"
@@ -3756,7 +3759,8 @@ defaultFlags settings
       Opt_SharedImplib,
       Opt_SimplPreInlining,
       Opt_VersionMacros,
-      Opt_RPath
+      Opt_RPath,
+      Opt_DumpWithWays
     ]
 
     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
diff --git a/compiler/GHC/Utils/Logger.hs b/compiler/GHC/Utils/Logger.hs
index 5593425b53..878e6d52f4 100644
--- a/compiler/GHC/Utils/Logger.hs
+++ b/compiler/GHC/Utils/Logger.hs
@@ -101,6 +101,7 @@ import Control.Monad
 import Control.Concurrent.MVar
 import System.IO.Unsafe
 import Debug.Trace (trace)
+import GHC.Platform.Ways
 
 ---------------------------------------------------------------
 -- Log flags
@@ -118,8 +119,10 @@ data LogFlags = LogFlags
   , log_dump_dir             :: !(Maybe FilePath)   -- ^ Dump directory
   , log_dump_prefix          :: !FilePath           -- ^ Normal dump path ("basename.")
   , log_dump_prefix_override :: !(Maybe FilePath)   -- ^ Overriden dump path
+  , log_with_ways            :: !Bool               -- ^ Use different dump files names for different ways
   , log_enable_debug         :: !Bool               -- ^ Enable debug output
   , log_verbosity            :: !Int                -- ^ Verbosity level
+  , log_ways                 :: !(Maybe Ways)         -- ^ Current ways (to name dump files)
   }
 
 -- | Default LogFlags
@@ -135,8 +138,10 @@ defaultLogFlags = LogFlags
   , log_dump_dir             = Nothing
   , log_dump_prefix          = ""
   , log_dump_prefix_override = Nothing
+  , log_with_ways           = True
   , log_enable_debug         = False
   , log_verbosity            = 0
+  , log_ways                 = Nothing
   }
 
 -- | Test if a DumpFlag is enabled
@@ -462,7 +467,8 @@ dumpSDocWithStyle dumps log_action sty logflags flag hdr doc =
 -- file, otherwise 'Nothing'.
 withDumpFileHandle :: DumpCache -> LogFlags -> DumpFlag -> (Maybe Handle -> IO ()) -> IO ()
 withDumpFileHandle dumps logflags flag action = do
-    let mFile = chooseDumpFile logflags flag
+    let dump_ways = log_ways logflags
+    let mFile = chooseDumpFile logflags dump_ways flag
     case mFile of
       Just fileName -> do
         gd <- readIORef dumps
@@ -482,14 +488,20 @@ withDumpFileHandle dumps logflags flag action = do
       Nothing -> action Nothing
 
 -- | Choose where to put a dump file based on LogFlags and DumpFlag
-chooseDumpFile :: LogFlags -> DumpFlag -> Maybe FilePath
-chooseDumpFile logflags flag
+chooseDumpFile :: LogFlags -> Maybe Ways -> DumpFlag -> Maybe FilePath
+chooseDumpFile logflags ways flag
     | log_dump_to_file logflags || forced_to_file
-    = Just $ setDir (getPrefix ++ dump_suffix)
+    = Just $ setDir (getPrefix ++ way_infix ++ dump_suffix)
 
     | otherwise
     = Nothing
   where
+    way_infix = case ways of
+      _ | not (log_with_ways logflags) -> ""
+      Nothing -> ""
+      Just ws
+        | null ws || null (waysTag ws) -> ""
+        | otherwise -> waysTag ws ++ "."
     (forced_to_file, dump_suffix) = case flag of
         -- -dth-dec-file dumps expansions of TH
         -- splices into MODULE.th.hs even when
diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst
index 0d418b3dfd..abc685099b 100644
--- a/docs/users_guide/debugging.rst
+++ b/docs/users_guide/debugging.rst
@@ -44,6 +44,17 @@ Dumping out compiler intermediate structures
     ``-ddump-file-prefix=Foo`` will cause the output from
     :ghc-flag:`-ddump-simpl` to be dumped to :file:`Foo.dump-simpl`.
 
+.. ghc-flag:: -fdump-with-ways
+    :shortdesc: Include the tag of the enabled ways in the extension of dump files.
+    :type: dynamic
+
+    :default: enabled
+
+
+    When compiling Main.hs with profiling and without this will now produce
+    ``Main.p.dump-simpl`` and ``Main.dump-simpl`` instead of overwriting the
+    output of one way with the output of another.
+
 .. ghc-flag:: -ddump-json
     :shortdesc: Dump error messages as JSON documents
     :type: dynamic
diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs
index 611cf54c6a..76dc04133a 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -43,7 +43,7 @@ runTestGhcFlags = do
     -- Take flags to send to the Haskell compiler from test.mk.
     -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
     unwords <$> sequence
-        [ pure " -dcore-lint -dstg-lint -dcmm-lint -no-user-package-db -rtsopts"
+        [ pure " -dcore-lint -dstg-lint -dcmm-lint -no-user-package-db -fno-dump-with-ways -rtsopts"
         , pure ghcOpts
         , pure ghcExtraFlags
         , ifMinGhcVer "711" "-fno-warn-missed-specialisations"
diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk
index 18928316f8..dbe03286ce 100644
--- a/testsuite/mk/test.mk
+++ b/testsuite/mk/test.mk
@@ -37,7 +37,7 @@ endif
 
 # TEST_HC_OPTS is passed to every invocation of TEST_HC
 # in nested Makefiles
-TEST_HC_OPTS = -dcore-lint -dstg-lint -dcmm-lint \
+TEST_HC_OPTS = -dcore-lint -dstg-lint -dcmm-lint -fno-dump-with-ways \
 			   -no-user-package-db -rtsopts $(EXTRA_HC_OPTS)
 
 # Don't warn about missing specialisations. They can only occur with `-O`, but
diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout
index db6a7b955e..9b13afa9de 100644
--- a/testsuite/tests/ghci/scripts/ghci024.stdout
+++ b/testsuite/tests/ghci/scripts/ghci024.stdout
@@ -5,6 +5,7 @@ with the following modifiers:
 GHCi-specific dynamic flag settings:
 other dynamic, non-language, flag settings:
   -fno-diagnostics-show-caret
+  -fno-dump-with-ways
   -fexternal-dynamic-refs
   -fignore-optim-changes
   -fignore-hpc-changes
diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 b/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
index a693b73aaf..bc008a3ddc 100644
--- a/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
+++ b/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
@@ -5,6 +5,7 @@ with the following modifiers:
 GHCi-specific dynamic flag settings:
 other dynamic, non-language, flag settings:
   -fno-diagnostics-show-caret
+  -fno-dump-with-ways
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
diff --git a/testsuite/tests/ghci/should_run/T16012.script b/testsuite/tests/ghci/should_run/T16012.script
index 2394e9c0ec..fd36138910 100644
--- a/testsuite/tests/ghci/should_run/T16012.script
+++ b/testsuite/tests/ghci/should_run/T16012.script
@@ -1,6 +1,8 @@
 -- We expect the allocation counter to be initialized to zero and to count down.
 -- As ghc expressions are executed in their own thread a call to getAllocationCounter
 -- should always return a reasonably low result.
+-- The actual number is somewhat arbitrary. If this fails because the value is slightly over
+-- the threshold below it's fine to increase the threshold!
 
 n <- System.Mem.getAllocationCounter
-if (n < 0 && n >= -200000) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n)
+if (n < 0 && n >= -222222) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n)