Commit 266435a7 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot

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)
parent bb0dc5a5
......@@ -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"
......
......@@ -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
......
......@@ -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'
......
......@@ -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
......
==================== 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 []] =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment