From 5126e7cd4594d05cd78bcaccf044a30c0051fd9b Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Tue, 7 Sep 2010 21:48:40 +0000 Subject: [PATCH] Better simplifier counting --- compiler/simplCore/CoreMonad.lhs | 27 ++++++++++--------- compiler/simplCore/SimplCore.lhs | 54 ++++++++++++++++++++------------------ 2 files changed, 43 insertions(+), 38 deletions(-) diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs index 8e75a7b..7f43ce5 100644 --- a/compiler/simplCore/CoreMonad.lhs +++ b/compiler/simplCore/CoreMonad.lhs @@ -15,7 +15,7 @@ module CoreMonad ( getCoreToDo, dumpSimplPhase, -- * Counting - SimplCount, doSimplTick, doFreeSimplTick, + SimplCount, doSimplTick, doFreeSimplTick, simplCountN, pprSimplCount, plusSimplCount, zeroSimplCount, isZeroSimplCount, Tick(..), -- * The monad @@ -545,9 +545,7 @@ plusSimplCount :: SimplCount -> SimplCount -> SimplCount \begin{code} data SimplCount - = VerySimplZero -- These two are used when - | VerySimplNonZero -- we are only interested in - -- termination info + = VerySimplCount !Int -- Used when don't want detailed stats | SimplCount { ticks :: !Int, -- Total ticks @@ -563,6 +561,10 @@ data SimplCount type TickCounts = FiniteMap Tick Int +simplCountN :: SimplCount -> Int +simplCountN (VerySimplCount n) = n +simplCountN (SimplCount { ticks = n }) = n + zeroSimplCount dflags -- This is where we decide whether to do -- the VerySimpl version or the full-stats version @@ -570,11 +572,10 @@ zeroSimplCount dflags = SimplCount {ticks = 0, details = emptyFM, n_log = 0, log1 = [], log2 = []} | otherwise - = VerySimplZero + = VerySimplCount 0 -isZeroSimplCount VerySimplZero = True -isZeroSimplCount (SimplCount { ticks = 0 }) = True -isZeroSimplCount _ = False +isZeroSimplCount (VerySimplCount n) = n==0 +isZeroSimplCount (SimplCount { ticks = n }) = n==0 doFreeSimplTick tick sc@SimplCount { details = dts } = sc { details = dts `addTick` tick } @@ -586,7 +587,7 @@ doSimplTick tick sc@SimplCount { ticks = tks, details = dts, n_log = nl, log1 = where sc1 = sc { ticks = tks+1, details = dts `addTick` tick } -doSimplTick _ _ = VerySimplNonZero -- The very simple case +doSimplTick _ (VerySimplCount n) = VerySimplCount (n+1) -- Don't use plusFM_C because that's lazy, and we want to @@ -608,11 +609,11 @@ plusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 }) | null (log2 sc2) = sc2 { log2 = log1 sc1 } | otherwise = sc2 -plusSimplCount VerySimplZero VerySimplZero = VerySimplZero -plusSimplCount _ _ = VerySimplNonZero +plusSimplCount (VerySimplCount n) (VerySimplCount m) = VerySimplCount (n+m) +plusSimplCount _ _ = panic "plusSimplCount" + -- We use one or the other consistently -pprSimplCount VerySimplZero = ptext (sLit "Total ticks: ZERO!") -pprSimplCount VerySimplNonZero = ptext (sLit "Total ticks: NON-ZERO!") +pprSimplCount (VerySimplCount n) = ptext (sLit "Total ticks:") <+> int n pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 }) = vcat [ptext (sLit "Total ticks: ") <+> int tks, blankLine, diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 4df489b..9eba8e1 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -461,41 +461,42 @@ simplifyPgmIO pass@(CoreDoSimplify mode max_iterations switches) hsc_env us hpt_rule_base guts@(ModGuts { mg_binds = binds, mg_rules = rules , mg_fam_inst_env = fam_inst_env }) - = do { - (termination_msg, it_count, counts_out, guts') - <- do_iteration us 1 (zeroSimplCount dflags) binds rules ; + = do { (termination_msg, it_count, counts_out, guts') + <- do_iteration us 1 [] binds rules - Err.dumpIfSet (dump_phase && dopt Opt_D_dump_simpl_stats dflags) + ; Err.dumpIfSet (dump_phase && dopt Opt_D_dump_simpl_stats dflags) "Simplifier statistics for following pass" (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations", blankLine, - pprSimplCount counts_out]); + pprSimplCount counts_out]) - return (counts_out, guts') + ; return (counts_out, guts') } where dflags = hsc_dflags hsc_env dump_phase = dumpSimplPhase dflags mode sw_chkr = isAmongSimpl switches do_iteration :: UniqSupply - -> Int -- Counts iterations - -> SimplCount -- Logs optimisations performed - -> [CoreBind] -- Bindings in - -> [CoreRule] -- and orphan rules + -> Int -- Counts iterations + -> [SimplCount] -- Counts from earlier iterations, reversed + -> [CoreBind] -- Bindings in + -> [CoreRule] -- and orphan rules -> IO (String, Int, SimplCount, ModGuts) - do_iteration us iteration_no counts binds rules + do_iteration us iteration_no counts_so_far binds rules -- iteration_no is the number of the iteration we are -- about to begin, with '1' for the first | iteration_no > max_iterations -- Stop if we've run out of iterations - = WARN(debugIsOn && (max_iterations > 2), - text ("Simplifier still going after " ++ - show max_iterations ++ - " iterations; bailing out. Size = " ++ show (coreBindsSize binds) ++ "\n" )) + = WARN( debugIsOn && (max_iterations > 2) + , ptext (sLit "Simplifier baling out after") <+> int max_iterations + <+> ptext (sLit "iterations") + <+> brackets (pprWithCommas (int . simplCountN) (reverse counts_so_far)) + <+> ptext (sLit "Size =") <+> int (coreBindsSize binds) ) + -- Subtract 1 from iteration_no to get the -- number of iterations we actually completed - return ("Simplifier bailed out", iteration_no - 1, counts, - guts { mg_binds = binds, mg_rules = rules }) + return ("Simplifier baled out", iteration_no - 1, total_counts, + guts { mg_binds = binds, mg_rules = rules }) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. @@ -526,22 +527,21 @@ simplifyPgmIO pass@(CoreDoSimplify mode max_iterations switches) -- With a let, we ended up with -- let -- t = initSmpl ... - -- counts' = snd t + -- counts1 = snd t -- in - -- case t of {(_,counts') -> if counts'=0 then ... } - -- So the conditional didn't force counts', because the + -- case t of {(_,counts1) -> if counts1=0 then ... } + -- So the conditional didn't force counts1, because the -- selection got duplicated. Sigh! case initSmpl dflags rule_base2 fam_envs us1 simpl_binds of { (env1, counts1) -> do { - let { all_counts = counts `plusSimplCount` counts1 - ; binds1 = getFloats env1 + let { binds1 = getFloats env1 ; rules1 = substRulesForImportedIds (mkCoreSubst (text "imp-rules") env1) rules } ; -- Stop if nothing happened; don't dump output if isZeroSimplCount counts1 then - return ("Simplifier reached fixed point", iteration_no, all_counts, + return ("Simplifier reached fixed point", iteration_no, total_counts, guts { mg_binds = binds1, mg_rules = rules1 }) else do { -- Short out indirections @@ -558,10 +558,14 @@ simplifyPgmIO pass@(CoreDoSimplify mode max_iterations switches) end_iteration dflags pass iteration_no counts1 binds2 rules1 ; -- Loop - do_iteration us2 (iteration_no + 1) all_counts binds2 rules1 + do_iteration us2 (iteration_no + 1) (counts1:counts_so_far) binds2 rules1 } } } } where - (us1, us2) = splitUniqSupply us + (us1, us2) = splitUniqSupply us + + -- Remember the counts_so_far are reversed + total_counts = foldr (\c acc -> acc `plusSimplCount` c) + (zeroSimplCount dflags) counts_so_far ------------------- end_iteration :: DynFlags -> CoreToDo -> Int -- 1.7.10.4