Add new flag for unarised STG dumps

Previously -ddump-stg would dump pre and post-unarise STGs. Now we have
a new flag for post-unarise STG and -ddump-stg only dumps coreToStg
output.

STG dump flags after this commit:

- -ddump-stg: Dumps CoreToStg output
- -ddump-stg-unarised: Unarise output
- -ddump-stg-final: STG right before code gen (includes CSE and lambda
  lifting)

5 files changed, 21 insertions, 45 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0079ec3d80..70f50f2a8b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -454,8 +454,9 @@ data DumpFlag
    | Opt_D_dump_simpl_iterations
    | Opt_D_dump_spec
    | Opt_D_dump_prep
-   | Opt_D_dump_stg
-   | Opt_D_dump_stg_final
+   | Opt_D_dump_stg -- CoreToStg output
+   | Opt_D_dump_stg_unarised -- STG after unarise
+   | Opt_D_dump_stg_final -- STG after stg2stg
    | Opt_D_dump_call_arity
    | Opt_D_dump_exitify
    | Opt_D_dump_stranal
@@ -3396,6 +3397,8 @@ dynamic_flags_deps = [
         (setDumpFlag Opt_D_dump_prep)
   , make_ord_flag defGhcFlag "ddump-stg"
         (setDumpFlag Opt_D_dump_stg)
+  , make_ord_flag defGhcFlag "ddump-stg-unarised"
+        (setDumpFlag Opt_D_dump_stg_unarised)
   , make_ord_flag defGhcFlag "ddump-stg-final"
         (setDumpFlag Opt_D_dump_stg_final)
   , make_ord_flag defGhcFlag "ddump-call-arity"
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 8cbc394f33..83aa4264f1 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1548,8 +1548,7 @@ doCodeGen hsc_env this_mod data_tycons
     let dflags = hsc_dflags hsc_env
 
     let stg_binds_w_fvs = annTopBindingsFreeVars stg_binds
-    dumpIfSet_dyn dflags Opt_D_dump_stg_final
-                  "STG for code gen:" (pprGenStgTopBindings stg_binds_w_fvs)
+
     let cmm_stream :: Stream IO CmmGroup ()
         cmm_stream = {-# SCC "StgToCmm" #-}
             StgToCmm.codeGen dflags this_mod data_tycons
diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs
index 81665a8735..c2f145df11 100644
--- a/compiler/simplStg/SimplStg.hs
+++ b/compiler/simplStg/SimplStg.hs
@@ -48,22 +48,23 @@ stg2stg :: DynFlags                  -- includes spec of what stg-to-stg passes
         -> IO [StgTopBinding]        -- output program
 
 stg2stg dflags this_mod binds
-  = do  { showPass dflags "Stg2Stg"
+  = do  { dump_when Opt_D_dump_stg "STG:" binds
+        ; showPass dflags "Stg2Stg"
         ; us <- mkSplitUniqSupply 'g'
 
         -- Do the main business!
         ; binds' <- runStgM us $
             foldM do_stg_pass binds (getStgToDo dflags)
 
-        ; dump_when Opt_D_dump_stg "STG syntax:" binds'
+        ; dump_when Opt_D_dump_stg_final "Final STG:" binds'
 
         ; return binds'
    }
 
   where
-    stg_linter what
+    stg_linter unarised
       | gopt Opt_DoStgLinting dflags
-      = lintStgTopBindings dflags this_mod what
+      = lintStgTopBindings dflags this_mod unarised
       | otherwise
       = \ _whodunnit _binds -> return ()
 
@@ -87,10 +88,10 @@ stg2stg dflags this_mod binds
             end_pass "StgLiftLams" binds'
 
           StgUnarise -> do
-            liftIO (dump_when Opt_D_dump_stg "Pre unarise:" binds)
             us <- getUniqueSupplyM
             liftIO (stg_linter False "Pre-unarise" binds)
             let binds' = unarise us binds
+            liftIO (dump_when Opt_D_dump_stg_unarised "Unarised STG:" binds')
             liftIO (stg_linter True "Unarise" binds')
             return binds'
 
diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst
index f8e862e5f0..0955af1270 100644
--- a/docs/users_guide/debugging.rst
+++ b/docs/users_guide/debugging.rst
@@ -369,10 +369,10 @@ STG representation
 These flags dump various phases of GHC's STG pipeline.
 
 .. ghc-flag:: -ddump-stg
-    :shortdesc: Dump final STG
+    :shortdesc: Show CoreToStg output
     :type: dynamic
 
-    Dump output of STG-to-STG passes
+    Show the output of CoreToStg pass.
 
 .. ghc-flag:: -dverbose-stg2stg
     :shortdesc: Show output from each STG-to-STG pass
@@ -380,6 +380,12 @@ These flags dump various phases of GHC's STG pipeline.
 
     Show the output of the intermediate STG-to-STG pass. (*lots* of output!)
 
+.. ghc-flag:: -ddump-stg-unarised
+    :shortdesc: Show unarised STG
+    :type: dynamic
+
+    Show the output of the unarise pass.
+
 .. ghc-flag:: -ddump-stg-final
     :shortdesc: Show output of last STG pass.
     :type: dynamic
diff --git a/testsuite/tests/simplCore/should_compile/noinline01.stderr b/testsuite/tests/simplCore/should_compile/noinline01.stderr
index 21c94d0eb3..413a7a98e0 100644
--- a/testsuite/tests/simplCore/should_compile/noinline01.stderr
+++ b/testsuite/tests/simplCore/should_compile/noinline01.stderr
@@ -1,38 +1,5 @@
 
-==================== Pre unarise: ====================
-Noinline01.f [InlPrag=INLINE (sat-args=1)]
-  :: forall p. p -> GHC.Types.Bool
-[GblId, Arity=1, Caf=NoCafRefs, Str=<L,A>, Unf=OtherCon []] =
-    \r [eta] GHC.Types.True [];
-
-Noinline01.g :: GHC.Types.Bool
-[GblId] =
-    \u [] Noinline01.f GHC.Types.False;
-
-Noinline01.$trModule4 :: GHC.Prim.Addr#
-[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
-    "main"#;
-
-Noinline01.$trModule3 :: GHC.Types.TrName
-[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
-    CCS_DONT_CARE GHC.Types.TrNameS! [Noinline01.$trModule4];
-
-Noinline01.$trModule2 :: GHC.Prim.Addr#
-[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
-    "Noinline01"#;
-
-Noinline01.$trModule1 :: GHC.Types.TrName
-[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
-    CCS_DONT_CARE GHC.Types.TrNameS! [Noinline01.$trModule2];
-
-Noinline01.$trModule :: GHC.Types.Module
-[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] =
-    CCS_DONT_CARE GHC.Types.Module! [Noinline01.$trModule3
-                                     Noinline01.$trModule1];
-
-
-
-==================== STG syntax: ====================
+==================== STG: ====================
 Noinline01.f [InlPrag=INLINE (sat-args=1)]
   :: forall p. p -> GHC.Types.Bool
 [GblId, Arity=1, Caf=NoCafRefs, Str=<L,A>, Unf=OtherCon []] =