Commit 6ec2304f authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix an long-standing bug in OccurAnal

This bug was beautifully characterised in Trac #12776,
which showed a small program for which the inliner went
into an infinite loop.  Eeek.

It turned out to be a genuine and long-standing bug in
the occurrence analyer, specifically in the bit that
identifies loop breakers.  In this line

  pairs | isEmptyVarSet weak_fvs
        = reOrderNodes   0 bndr_set weak_fvs tagged_nodes []
        | otherwise
        = loopBreakNodes 0 bndr_set weak_fvs loop_breaker_edges []

the 'tagged_nodes' should be 'loop_breaker_edges'.
That's it!

The diff looks a lot bigger because I did some work on
comments and variable naming, but that's all it is.  We
were using the wrong set of dependencies!

I'm astonished that this bug has not caused more trouble.
It dates back to at least 2011 and maybe further.
parent f8c966c7
...@@ -131,76 +131,55 @@ them out from the imp_rule_edges comprehension. ...@@ -131,76 +131,55 @@ them out from the imp_rule_edges comprehension.
{- {-
************************************************************************ ************************************************************************
* * * *
\subsection[OccurAnal-main]{Counting occurrences: main function} Bindings
* * * *
************************************************************************ ************************************************************************
Bindings Note [Recursive bindings: the grand plan]
~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-} When we come across a binding group
Rec { x1 = r1; ...; xn = rn }
we treat it like this (occAnalRecBind):
type ImpRuleEdges = IdEnv IdSet -- Mapping from FVs of imported RULE LHSs to RHS FVs 1. Occurrence-analyse each right hand side, and build a
"Details" for each binding to capture the results.
noImpRuleEdges :: ImpRuleEdges Wrap the details in a Node (details, node-id, dep-node-ids),
noImpRuleEdges = emptyVarEnv where node-id is just the unique of the binder, and
dep-node-ids lists all binders on which this binding depends.
We'll call these the "scope edges".
See Note [Forming the Rec groups].
occAnalBind :: OccEnv -- The incoming OccEnv All this is done by makeNode.
-> ImpRuleEdges
-> CoreBind
-> UsageDetails -- Usage details of scope
-> (UsageDetails, -- Of the whole let(rec)
[CoreBind])
occAnalBind env top_env (NonRec binder rhs) body_usage 2. Do SCC-analysis on these Nodes. Each SCC will become a new Rec or
= occAnalNonRecBind env top_env binder rhs body_usage NonRec. The key property is that every free variable of a binding
occAnalBind env top_env (Rec pairs) body_usage is accounted for by the scope edges, so that when we are done
= occAnalRecBind env top_env pairs body_usage everything is still in scope.
----------------- 3. For each Cyclic SCC of the scope-edge SCC-analysis in (2), we
occAnalNonRecBind :: OccEnv -> ImpRuleEdges -> Var -> CoreExpr identify suitable loop-breakers to ensure that inlining terminates.
-> UsageDetails -> (UsageDetails, [CoreBind]) This is done by occAnalRec.
occAnalNonRecBind env imp_rule_edges binder rhs body_usage
| isTyVar binder -- A type let; we don't gather usage info
= (body_usage, [NonRec binder rhs])
| not (binder `usedIn` body_usage) -- It's not mentioned 4. To do so we form a new set of Nodes, with the same details, but
= (body_usage, []) different edges, the "loop-breaker nodes". The loop-breaker nodes
have both more and fewer depedencies than the scope edges
(see Note [Choosing loop breakers])
| otherwise -- It's mentioned in the body More edges: if f calls g, and g has an active rule that mentions h
= (body_usage' +++ rhs_usage4, [NonRec tagged_binder rhs']) then we add an edge from f -> h
where
(body_usage', tagged_binder) = tagBinder body_usage binder
(rhs_usage1, rhs') = occAnalNonRecRhs env tagged_binder rhs
rhs_usage2 = addIdOccs rhs_usage1 (idUnfoldingVars binder)
rhs_usage3 = addIdOccs rhs_usage2 (idRuleVars binder) Fewer edges: we only include dependencies on active rules, on rule
-- See Note [Rules are extra RHSs] and Note [Rule dependency info] RHSs (not LHSs) and if there is an INLINE pragma only
on the stable unfolding (and vice versa). The scope
edges must be much more inclusive.
rhs_usage4 = maybe rhs_usage3 (addIdOccs rhs_usage3) $ 5. The "weak fvs" of a node are, by definition:
lookupVarEnv imp_rule_edges binder the scope fvs - the loop-breaker fvs
-- See Note [Preventing loops due to imported functions rules] See Note [Weak loop breakers], and the nd_weak field of Details
----------------- 6. Having formed the loop-breaker nodes
occAnalRecBind :: OccEnv -> ImpRuleEdges -> [(Var,CoreExpr)]
-> UsageDetails -> (UsageDetails, [CoreBind])
occAnalRecBind env imp_rule_edges pairs body_usage
= foldr occAnalRec (body_usage, []) sccs
-- For a recursive group, we
-- * occ-analyse all the RHSs
-- * compute strongly-connected components
-- * feed those components to occAnalRec
where
bndr_set = mkVarSet (map fst pairs)
sccs :: [SCC (Node Details)]
sccs = {-# SCC "occAnalBind.scc" #-}
stronglyConnCompFromEdgedVerticesUniqR nodes
nodes :: [Node Details]
nodes = {-# SCC "occAnalBind.assoc" #-}
map (makeNode env imp_rule_edges bndr_set) pairs
{-
Note [Dead code] Note [Dead code]
~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~
Dropping dead code for a cyclic Strongly Connected Component is done Dropping dead code for a cyclic Strongly Connected Component is done
...@@ -346,7 +325,7 @@ are not the same as the edges we use for computing the Rec blocks. ...@@ -346,7 +325,7 @@ are not the same as the edges we use for computing the Rec blocks.
That's why we compute That's why we compute
- rec_edges for the Rec block analysis - rec_edges for the Rec block analysis
- loop_breaker_edges for the loop breaker analysis - loop_breaker_nodes for the loop breaker analysis
* Note [Finding rule RHS free vars] * Note [Finding rule RHS free vars]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...@@ -403,7 +382,7 @@ That's why we compute ...@@ -403,7 +382,7 @@ That's why we compute
A "missing free variable" x is one that is mentioned in an RHS or A "missing free variable" x is one that is mentioned in an RHS or
INLINE or RULE of a binding in the Rec group, but where the INLINE or RULE of a binding in the Rec group, but where the
dependency on x may not show up in the loop_breaker_edges (see dependency on x may not show up in the loop_breaker_nodes (see
note [Choosing loop breakers} above). note [Choosing loop breakers} above).
A normal "strong" loop breaker has IAmLoopBreaker False. So A normal "strong" loop breaker has IAmLoopBreaker False. So
...@@ -658,6 +637,68 @@ But watch out! If 'fs' is not chosen as a loop breaker, we may get an infinite ...@@ -658,6 +637,68 @@ But watch out! If 'fs' is not chosen as a loop breaker, we may get an infinite
This showed up when compiling Control.Concurrent.Chan.getChanContents. This showed up when compiling Control.Concurrent.Chan.getChanContents.
-} -}
type ImpRuleEdges = IdEnv IdSet -- Mapping from FVs of imported RULE LHSs to RHS FVs
noImpRuleEdges :: ImpRuleEdges
noImpRuleEdges = emptyVarEnv
occAnalBind :: OccEnv -- The incoming OccEnv
-> ImpRuleEdges
-> CoreBind
-> UsageDetails -- Usage details of scope
-> (UsageDetails, -- Of the whole let(rec)
[CoreBind])
occAnalBind env top_env (NonRec binder rhs) body_usage
= occAnalNonRecBind env top_env binder rhs body_usage
occAnalBind env top_env (Rec pairs) body_usage
= occAnalRecBind env top_env pairs body_usage
-----------------
occAnalNonRecBind :: OccEnv -> ImpRuleEdges -> Var -> CoreExpr
-> UsageDetails -> (UsageDetails, [CoreBind])
occAnalNonRecBind env imp_rule_edges binder rhs body_usage
| isTyVar binder -- A type let; we don't gather usage info
= (body_usage, [NonRec binder rhs])
| not (binder `usedIn` body_usage) -- It's not mentioned
= (body_usage, [])
| otherwise -- It's mentioned in the body
= (body_usage' +++ rhs_usage4, [NonRec tagged_binder rhs'])
where
(body_usage', tagged_binder) = tagBinder body_usage binder
(rhs_usage1, rhs') = occAnalNonRecRhs env tagged_binder rhs
rhs_usage2 = addIdOccs rhs_usage1 (idUnfoldingVars binder)
rhs_usage3 = addIdOccs rhs_usage2 (idRuleVars binder)
-- See Note [Rules are extra RHSs] and Note [Rule dependency info]
rhs_usage4 = maybe rhs_usage3 (addIdOccs rhs_usage3) $
lookupVarEnv imp_rule_edges binder
-- See Note [Preventing loops due to imported functions rules]
-----------------
occAnalRecBind :: OccEnv -> ImpRuleEdges -> [(Var,CoreExpr)]
-> UsageDetails -> (UsageDetails, [CoreBind])
occAnalRecBind env imp_rule_edges pairs body_usage
= foldr occAnalRec (body_usage, []) sccs
-- For a recursive group, we
-- * occ-analyse all the RHSs
-- * compute strongly-connected components
-- * feed those components to occAnalRec
-- See Note [Recursive bindings: the grand plan]
where
bndr_set = mkVarSet (map fst pairs)
sccs :: [SCC (Node Details)]
sccs = {-# SCC "occAnalBind.scc" #-}
stronglyConnCompFromEdgedVerticesUniqR nodes
nodes :: [Node Details]
nodes = {-# SCC "occAnalBind.assoc" #-}
map (makeNode env imp_rule_edges bndr_set) pairs
type Node details = (details, Unique, [Unique]) -- The Ints are gotten from the Unique, type Node details = (details, Unique, [Unique]) -- The Ints are gotten from the Unique,
-- which is gotten from the Id. -- which is gotten from the Id.
data Details data Details
...@@ -676,7 +717,7 @@ data Details ...@@ -676,7 +717,7 @@ data Details
, nd_weak :: IdSet -- Binders of this Rec that are mentioned in nd_uds , nd_weak :: IdSet -- Binders of this Rec that are mentioned in nd_uds
-- but are *not* in nd_inl. These are the ones whose -- but are *not* in nd_inl. These are the ones whose
-- dependencies might not be respected by loop_breaker_edges -- dependencies might not be respected by loop_breaker_nodes
-- See Note [Weak loop breakers] -- See Note [Weak loop breakers]
, nd_active_rule_fvs :: IdSet -- Free variables of the RHS of active RULES , nd_active_rule_fvs :: IdSet -- Free variables of the RHS of active RULES
...@@ -692,6 +733,7 @@ instance Outputable Details where ...@@ -692,6 +733,7 @@ instance Outputable Details where
]) ])
makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> Node Details makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> Node Details
-- See Note [Recursive bindings: the grand plan]
makeNode env imp_rule_edges bndr_set (bndr, rhs) makeNode env imp_rule_edges bndr_set (bndr, rhs)
= (details, varUnique bndr, nonDetKeysUFM node_fvs) = (details, varUnique bndr, nonDetKeysUFM node_fvs)
-- It's OK to use nonDetKeysUFM here as stronglyConnCompFromEdgedVerticesR -- It's OK to use nonDetKeysUFM here as stronglyConnCompFromEdgedVerticesR
...@@ -763,6 +805,7 @@ occAnalRec (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs, nd_uds = rhs_uds}, _, ...@@ -763,6 +805,7 @@ occAnalRec (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs, nd_uds = rhs_uds}, _,
(body_uds', tagged_bndr) = tagBinder body_uds bndr (body_uds', tagged_bndr) = tagBinder body_uds bndr
-- The Rec case is the interesting one -- The Rec case is the interesting one
-- See Note [Recursive bindings: the grand plan]
-- See Note [Loop breaking] -- See Note [Loop breaking]
occAnalRec (CyclicSCC nodes) (body_uds, binds) occAnalRec (CyclicSCC nodes) (body_uds, binds)
| not (any (`usedIn` body_uds) bndrs) -- NB: look at body_uds, not total_uds | not (any (`usedIn` body_uds) bndrs) -- NB: look at body_uds, not total_uds
...@@ -771,42 +814,49 @@ occAnalRec (CyclicSCC nodes) (body_uds, binds) ...@@ -771,42 +814,49 @@ occAnalRec (CyclicSCC nodes) (body_uds, binds)
| otherwise -- At this point we always build a single Rec | otherwise -- At this point we always build a single Rec
= -- pprTrace "occAnalRec" (vcat = -- pprTrace "occAnalRec" (vcat
-- [ text "weak_fvs" <+> ppr weak_fvs -- [ text "weak_fvs" <+> ppr weak_fvs
-- , text "tagged nodes" <+> ppr tagged_nodes -- , text "tagged details" <+> ppr tagged_details_s
-- , text "lb edges" <+> ppr loop_breaker_edges]) -- , text "lb nodes" <+> ppr loop_breaker_nodes])
(final_uds, Rec pairs : binds) (final_uds, Rec pairs : binds)
where where
bndrs = [b | (ND { nd_bndr = b }, _, _) <- nodes] details_s :: [Details]
bndr_set = mkVarSet bndrs details_s = map fstOf3 nodes
bndrs = [b | (ND { nd_bndr = b }) <- details_s]
---------------------------- bndr_set = mkVarSet bndrs
-- Tag the binders with their occurrence info
tagged_nodes = map tag_node nodes ----------------------------
total_uds = foldl add_uds body_uds nodes -- Tag the binders with their occurrence info
tagged_details_s :: [Details]
tagged_details_s = map tag_details details_s
total_uds = foldl add_uds body_uds details_s
final_uds = total_uds `minusVarEnv` bndr_set final_uds = total_uds `minusVarEnv` bndr_set
add_uds usage_so_far (nd, _, _) = usage_so_far +++ nd_uds nd add_uds usage_so_far nd = usage_so_far +++ nd_uds nd
tag_node :: Node Details -> Node Details tag_details :: Details -> Details
tag_node (details@ND { nd_bndr = bndr }, k, ks) tag_details details@(ND { nd_bndr = bndr })
| let bndr1 = setBinderOcc total_uds bndr | let bndr1 = setBinderOcc total_uds bndr
= (details { nd_bndr = bndr1 }, k, ks) = details { nd_bndr = bndr1 }
--------------------------- ---------------------------
-- Now reconstruct the cycle -- Now reconstruct the cycle
pairs :: [(Id,CoreExpr)] pairs :: [(Id,CoreExpr)]
pairs | isEmptyVarSet weak_fvs = reOrderNodes 0 bndr_set weak_fvs tagged_nodes [] pairs | isEmptyVarSet weak_fvs = reOrderNodes 0 bndr_set weak_fvs loop_breaker_nodes []
| otherwise = loopBreakNodes 0 bndr_set weak_fvs loop_breaker_edges [] | otherwise = loopBreakNodes 0 bndr_set weak_fvs loop_breaker_nodes []
-- If weak_fvs is empty, the loop_breaker_edges will include all -- If weak_fvs is empty, the loop_breaker_nodes will include
-- the edges in tagged_nodes, so there isn't any point in doing -- all the edges in the original scope edges [remember,
-- a fresh SCC computation that will yield a single CyclicSCC result. -- weak_fvs is the difference between scope edges and
-- lb-edges], so a fresh SCC computation would yield a
-- single CyclicSCC result; and reOrderNodes deals with
-- exactly that case
weak_fvs :: VarSet weak_fvs :: VarSet
weak_fvs = mapUnionVarSet (nd_weak . fstOf3) nodes weak_fvs = mapUnionVarSet nd_weak details_s
-- See Note [Choosing loop breakers] for loop_breaker_edges -- See Note [Choosing loop breakers] for loop_breaker_nodes
loop_breaker_edges = map mk_node tagged_nodes loop_breaker_nodes :: [Node Details]
mk_node (details@(ND { nd_inl = inl_fvs }), k, _) loop_breaker_nodes = map mk_lb_node tagged_details_s
= (details, k, nonDetKeysUFM (extendFvs_ rule_fv_env inl_fvs)) mk_lb_node details@(ND { nd_bndr = b, nd_inl = inl_fvs })
= (details, varUnique b, nonDetKeysUFM (extendFvs_ rule_fv_env inl_fvs))
-- It's OK to use nonDetKeysUFM here as -- It's OK to use nonDetKeysUFM here as
-- stronglyConnCompFromEdgedVerticesR is still deterministic with edges -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges
-- in nondeterministic order as explained in -- in nondeterministic order as explained in
...@@ -820,9 +870,9 @@ occAnalRec (CyclicSCC nodes) (body_uds, binds) ...@@ -820,9 +870,9 @@ occAnalRec (CyclicSCC nodes) (body_uds, binds)
rule_fv_env = transClosureFV (mkVarEnv init_rule_fvs) rule_fv_env = transClosureFV (mkVarEnv init_rule_fvs)
init_rule_fvs -- See Note [Finding rule RHS free vars] init_rule_fvs -- See Note [Finding rule RHS free vars]
= [ (b, trimmed_rule_fvs) = [ (b, trimmed_rule_fvs)
| (ND { nd_bndr = b, nd_active_rule_fvs = rule_fvs },_,_) <- nodes | ND { nd_bndr = b, nd_active_rule_fvs = rule_fvs } <- details_s
, let trimmed_rule_fvs = rule_fvs `intersectVarSet` bndr_set , let trimmed_rule_fvs = rule_fvs `intersectVarSet` bndr_set
, not (isEmptyVarSet trimmed_rule_fvs)] , not (isEmptyVarSet trimmed_rule_fvs) ]
{- {-
@loopBreakSCC@ is applied to the list of (binder,rhs) pairs for a cyclic @loopBreakSCC@ is applied to the list of (binder,rhs) pairs for a cyclic
...@@ -849,9 +899,9 @@ mk_loop_breaker (ND { nd_bndr = bndr, nd_rhs = rhs}, _, _) ...@@ -849,9 +899,9 @@ mk_loop_breaker (ND { nd_bndr = bndr, nd_rhs = rhs}, _, _)
mk_non_loop_breaker :: VarSet -> Node Details -> Binding mk_non_loop_breaker :: VarSet -> Node Details -> Binding
-- See Note [Weak loop breakers] -- See Note [Weak loop breakers]
mk_non_loop_breaker used_in_rules (ND { nd_bndr = bndr, nd_rhs = rhs}, _, _) mk_non_loop_breaker weak_fvs (ND { nd_bndr = bndr, nd_rhs = rhs}, _, _)
| bndr `elemVarSet` used_in_rules = (setIdOccInfo bndr weakLoopBreaker, rhs) | bndr `elemVarSet` weak_fvs = (setIdOccInfo bndr weakLoopBreaker, rhs)
| otherwise = (bndr, rhs) | otherwise = (bndr, rhs)
udFreeVars :: VarSet -> UsageDetails -> VarSet udFreeVars :: VarSet -> UsageDetails -> VarSet
-- Find the subset of bndrs that are mentioned in uds -- Find the subset of bndrs that are mentioned in uds
...@@ -874,13 +924,13 @@ loopBreakNodes depth bndr_set weak_fvs nodes binds ...@@ -874,13 +924,13 @@ loopBreakNodes depth bndr_set weak_fvs nodes binds
loop_break_scc scc binds loop_break_scc scc binds
= case scc of = case scc of
AcyclicSCC node -> mk_non_loop_breaker weak_fvs node : binds AcyclicSCC node -> mk_non_loop_breaker weak_fvs node : binds
CyclicSCC [node] -> mk_loop_breaker node : binds
CyclicSCC nodes -> reOrderNodes depth bndr_set weak_fvs nodes binds CyclicSCC nodes -> reOrderNodes depth bndr_set weak_fvs nodes binds
reOrderNodes :: Int -> VarSet -> VarSet -> [Node Details] -> [Binding] -> [Binding] reOrderNodes :: Int -> VarSet -> VarSet -> [Node Details] -> [Binding] -> [Binding]
-- Choose a loop breaker, mark it no-inline, -- Choose a loop breaker, mark it no-inline,
-- do SCC analysis on the rest, and recursively sort them out -- do SCC analysis on the rest, and recursively sort them out
reOrderNodes _ _ _ [] _ = panic "reOrderNodes" reOrderNodes _ _ _ [] _ = panic "reOrderNodes"
reOrderNodes _ _ _ [node] binds = mk_loop_breaker node : binds
reOrderNodes depth bndr_set weak_fvs (node : nodes) binds reOrderNodes depth bndr_set weak_fvs (node : nodes) binds
= -- pprTrace "reOrderNodes" (text "unchosen" <+> ppr unchosen $$ = -- pprTrace "reOrderNodes" (text "unchosen" <+> ppr unchosen $$
-- text "chosen" <+> ppr chosen_nodes) $ -- text "chosen" <+> ppr chosen_nodes) $
......
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