Commit e0419565 authored by's avatar

Improve optimisation of cost centres

This patch fixes test failures for the profiling way for drv001.
The problem was that the arity of a function was decreasing during
"optimisation" because of interaction with SCC annotations.
In particular
      f = /\a. scc "f" (h x)    -- where h had arity 2
and h gets inlined, led to
      f = /\a. scc "f" let v = scc "f" x in \y. <blah>

Two main changes:

1.  exprIsTrivial now says True for (scc "f" x)
    See Note [SCCs are trivial] in CoreUtils

2.  The simplifier eliminates nested pushing of the same cost centre:
  	scc "f" (...(scc "f" e)...) 
  	==>  scc "f" (...e...)

parent 7d73a107
......@@ -430,6 +430,8 @@ filters down the matching alternatives in Simplify.rebuildCase.
applications. Note that primop Ids aren't considered
trivial unless
Note [Variable are trivial]
There used to be a gruesome test for (hasNoBinding v) in the
Var case:
exprIsTrivial (Var v) | hasNoBinding v = idArity v == 0
......@@ -441,19 +443,22 @@ completely un-applied primops and foreign-call Ids are sufficiently
rare that I plan to allow them to be duplicated and put up with
saturating them.
SCC notes. We do not treat (_scc_ "foo" x) as trivial, because
a) it really generates code, (and a heap object when it's
a function arg) to capture the cost centre
b) see the note [SCC-and-exprIsTrivial] in Simplify.simplLazyBind
Note [SCCs are trivial]
We used not to treat (_scc_ "foo" x) as trivial, because it really
generates code, (and a heap object when it's a function arg) to
capture the cost centre. However, the profiling system discounts the
allocation costs for such "boxing thunks" whereas the extra costs of
*not* inlining otherwise-trivial bindings can be high, and are hard to
exprIsTrivial :: CoreExpr -> Bool
exprIsTrivial (Var _) = True -- See notes above
exprIsTrivial (Var _) = True -- See Note [Variables are trivial]
exprIsTrivial (Type _) = True
exprIsTrivial (Lit lit) = litIsTrivial lit
exprIsTrivial (App e arg) = not (isRuntimeArg arg) && exprIsTrivial e
exprIsTrivial (Note (SCC _) _) = False -- See notes above
exprIsTrivial (Note _ e) = exprIsTrivial e
exprIsTrivial (Note _ e) = exprIsTrivial e -- See Note [SCCs are trivial]
exprIsTrivial (Cast e _) = exprIsTrivial e
exprIsTrivial (Lam b body) = not (isRuntimeVar b) && exprIsTrivial body
exprIsTrivial _ = False
......@@ -21,7 +21,7 @@ module CostCentre (
noCostCentre, noCCAttached,
noCCSAttached, isCurrentCCS, isSubsumedCCS, currentOrSubsumedCCS,
isDerivedFromCurrentCCS, maybeSingletonCCS,
decomposeCCS, pushCCisNop,
mkUserCC, mkAutoCC, mkAllCafsCC,
mkSingletonCCS, dupifyCC, pushCCOnCCS,
......@@ -209,6 +209,13 @@ currentOrSubsumedCCS _ = False
maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre
maybeSingletonCCS (PushCC cc NoCCS) = Just cc
maybeSingletonCCS _ = Nothing
pushCCisNop :: CostCentre -> CostCentreStack -> Bool
-- (pushCCisNop cc ccs) = True => pushing cc on ccs is a no-op
-- It's safe to return False, but the optimiser can remove
-- redundant pushes if this function returns True.
pushCCisNop cc (PushCC cc' _) = cc == cc'
pushCCisNop _ _ = False
Building cost centres
......@@ -29,7 +29,7 @@ import CoreUtils
import CoreArity ( exprArity )
import Rules ( lookupRule, getRules )
import BasicTypes ( isMarkedStrict, Arity )
import CostCentre ( currentCCS )
import CostCentre ( currentCCS, pushCCisNop )
import TysPrim ( realWorldStatePrimTy )
import PrelInfo ( realWorldPrimId )
import BasicTypes ( TopLevelFlag(..), isTopLevel,
......@@ -1004,6 +1004,9 @@ simplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont
simplNote :: SimplEnv -> Note -> CoreExpr -> SimplCont
-> SimplM (SimplEnv, OutExpr)
simplNote env (SCC cc) e cont
| pushCCisNop cc (getEnclosingCC env) -- scc "f" (...(scc "f" e)...)
= simplExprF env e cont -- ==> scc "f" (...e...)
| otherwise
= do { e' <- simplExpr (setEnclosingCC env currentCCS) e
; rebuild env (mkSCC cc e') cont }
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