Make dynflag argument for withTiming pure.

19 times out of 20 we already have dynflags in scope.

We could just always use `return dflags`. But this is in fact not free.
When looking at some STG code I noticed that we always allocate a
closure for this expression in the heap. Clearly a waste in these cases.

For the other cases we can either just modify the callsite to
get dynflags or use the _D variants of withTiming I added which
will use getDynFlags under the hood.

1 files changed, 7 insertions, 9 deletions

diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs
index b3af87b2af..cbfa757552 100644
--- a/compiler/simplCore/SimplCore.hs
+++ b/compiler/simplCore/SimplCore.hs
@@ -36,7 +36,7 @@ import FloatIn          ( floatInwards )
 import FloatOut         ( floatOutwards )
 import FamInstEnv
 import Id
-import ErrUtils         ( withTiming )
+import ErrUtils         ( withTiming, withTimingD )
 import BasicTypes       ( CompilerPhase(..), isDefaultInlinePragma, defaultInlinePragma )
 import VarSet
 import VarEnv
@@ -410,10 +410,9 @@ runCorePasses passes guts
   where
     do_pass guts CoreDoNothing = return guts
     do_pass guts (CoreDoPasses ps) = runCorePasses ps guts
-    do_pass guts pass
-       = withTiming getDynFlags
-                    (ppr pass <+> brackets (ppr mod))
-                    (const ()) $ do
+    do_pass guts pass = do
+       withTimingD (ppr pass <+> brackets (ppr mod))
+                   (const ()) $ do
             { guts' <- lintAnnots (ppr pass) (doCorePass pass) guts
             ; endPass pass (mg_binds guts') (mg_rules guts')
             ; return guts' }
@@ -484,9 +483,8 @@ printCore dflags binds
 
 ruleCheckPass :: CompilerPhase -> String -> ModGuts -> CoreM ModGuts
 ruleCheckPass current_phase pat guts =
-    withTiming getDynFlags
-               (text "RuleCheck"<+>brackets (ppr $ mg_module guts))
-               (const ()) $ do
+    withTimingD (text "RuleCheck"<+>brackets (ppr $ mg_module guts))
+                (const ()) $ do
     { rb <- getRuleBase
     ; dflags <- getDynFlags
     ; vis_orphs <- getVisibleOrphanMods
@@ -564,7 +562,7 @@ simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
 --
 -- Also used by Template Haskell
 simplifyExpr dflags expr
-  = withTiming (pure dflags) (text "Simplify [expr]") (const ()) $
+  = withTiming dflags (text "Simplify [expr]") (const ()) $
     do  {
         ; us <-  mkSplitUniqSupply 's'