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)

3 files changed, 12 insertions, 9 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'