Enhance pass result forcing

When we use `withTiming` we need to force the results of each timed pass
to better represent the time spent in each phase. This patch forces
some results that weren't before.

It also retrieve timings for the CoreToStg and WriteIface passes.

2 files changed, 13 insertions, 4 deletions

diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index 7c17bad4ad..3eb714405c 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -192,7 +192,7 @@ corePrepPgm :: HscEnv -> Module -> ModLocation -> CoreProgram -> [TyCon]
 corePrepPgm hsc_env this_mod mod_loc binds data_tycons =
     withTiming logger dflags
                (text "CorePrep"<+>brackets (ppr this_mod))
-               (const ()) $ do
+               (\(a,b) -> a `seqList` b `seq` ()) $ do
     us <- mkSplitUniqSupply 's'
     initialCorePrepEnv <- mkInitialCorePrepEnv hsc_env
 
@@ -221,7 +221,7 @@ corePrepExpr :: HscEnv -> CoreExpr -> IO CoreExpr
 corePrepExpr hsc_env expr = do
     let dflags = hsc_dflags hsc_env
     let logger = hsc_logger hsc_env
-    withTiming logger dflags (text "CorePrep [expr]") (const ()) $ do
+    withTiming logger dflags (text "CorePrep [expr]") (\e -> e `seq` ()) $ do
       us <- mkSplitUniqSupply 's'
       initialCorePrepEnv <- mkInitialCorePrepEnv hsc_env
       let new_expr = initUs_ us (cpeBodyNF initialCorePrepEnv expr)
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 5be42094a0..393c31fa0b 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -977,8 +977,13 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
             in  addBootSuffix_maybe (mi_boot iface) with_hi
 
         write_iface dflags' iface =
+          let !iface_name = buildIfName (hiSuf dflags')
+          in
           {-# SCC "writeIface" #-}
-          writeIface logger dflags' (buildIfName (hiSuf dflags')) iface
+          withTiming logger dflags'
+              (text "WriteIface"<+>brackets (text iface_name))
+              (const ())
+              (writeIface logger dflags' iface_name iface)
 
     when (write_interface || force_write_interface) $ do
 
@@ -1542,10 +1547,14 @@ hscGenHardCode hsc_env cgguts location output_filename = do
         (prepd_binds, local_ccs) <- {-# SCC "CorePrep" #-}
                        corePrepPgm hsc_env this_mod location
                                    core_binds data_tycons
+
         -----------------  Convert to STG ------------------
         (stg_binds, denv, (caf_ccs, caf_cc_stacks))
             <- {-# SCC "CoreToStg" #-}
-               myCoreToStg logger dflags this_mod location prepd_binds
+               withTiming logger dflags
+                   (text "CoreToStg"<+>brackets (ppr this_mod))
+                   (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ())
+                   (myCoreToStg logger dflags this_mod location prepd_binds)
 
         let cost_centre_info =
               (S.toList local_ccs ++ caf_ccs, caf_cc_stacks)