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.

4 files changed, 24 insertions, 5 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