<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>simplCore/OccurAnal.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
%************************************************************************
%* *
\section[OccurAnal]{Occurrence analysis pass}
%* *
%************************************************************************
The occurrence analyser re-typechecks a core expression, returning a new
core expression with (hopefully) improved usage information.
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>OccurAnal</span> <span class='hs-layout'>(</span>
<a name="line-2"></a> <span class='hs-varid'>occurAnalysePgm</span><span class='hs-layout'>,</span> <span class='hs-varid'>occurAnalyseExpr</span>
<a name="line-3"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreSyn</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreFVs</span>
<a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreUtils</span> <span class='hs-layout'>(</span> <span class='hs-varid'>exprIsTrivial</span><span class='hs-layout'>,</span> <span class='hs-varid'>isDefaultAlt</span> <span class='hs-layout'>)</span>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Coercion</span> <span class='hs-layout'>(</span> <span class='hs-varid'>mkSymCoercion</span> <span class='hs-layout'>)</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span> <span class='hs-layout'>(</span> <span class='hs-varid'>localiseName</span> <span class='hs-layout'>)</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>IdInfo</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>BasicTypes</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarSet</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarEnv</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span> <span class='hs-layout'>(</span> <span class='hs-varid'>orElse</span> <span class='hs-layout'>)</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Digraph</span> <span class='hs-layout'>(</span> <span class='hs-conid'>SCC</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>stronglyConnCompFromEdgedVerticesR</span> <span class='hs-layout'>)</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelNames</span> <span class='hs-layout'>(</span> <span class='hs-varid'>buildIdKey</span><span class='hs-layout'>,</span> <span class='hs-varid'>foldrIdKey</span><span class='hs-layout'>,</span> <span class='hs-varid'>runSTRepIdKey</span><span class='hs-layout'>,</span> <span class='hs-varid'>augmentIdKey</span> <span class='hs-layout'>)</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Unique</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Unique</span> <span class='hs-layout'>)</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>UniqFM</span> <span class='hs-layout'>(</span> <span class='hs-varid'>keysUFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>intersectUFM_C</span><span class='hs-layout'>,</span> <span class='hs-varid'>foldUFM_Directly</span> <span class='hs-layout'>)</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span> <span class='hs-layout'>(</span> <span class='hs-varid'>mapAndUnzip</span> <span class='hs-layout'>)</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[OccurAnal-main]{Counting occurrences: main function}
%* *
%************************************************************************
Here's the externally-callable interface:
\begin{code}
<pre><a name="line-1"></a><a name="occurAnalysePgm"></a><span class='hs-definition'>occurAnalysePgm</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span>
<a name="line-2"></a><span class='hs-definition'>occurAnalysePgm</span> <span class='hs-varid'>binds</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>snd</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>initOccEnv</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-keyword'>where</span>
<a name="line-5"></a> <span class='hs-varid'>go</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-6"></a> <span class='hs-varid'>go</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyDetails</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-8"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>bind</span><span class='hs-conop'>:</span><span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>final_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>bind'</span> <span class='hs-varop'>++</span> <span class='hs-varid'>binds'</span><span class='hs-layout'>)</span>
<a name="line-10"></a> <span class='hs-keyword'>where</span>
<a name="line-11"></a> <span class='hs-layout'>(</span><span class='hs-varid'>bs_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>env</span> <span class='hs-varid'>binds</span>
<a name="line-12"></a> <span class='hs-layout'>(</span><span class='hs-varid'>final_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>bind'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occAnalBind</span> <span class='hs-varid'>env</span> <span class='hs-varid'>bind</span> <span class='hs-varid'>bs_usage</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="occurAnalyseExpr"></a><span class='hs-definition'>occurAnalyseExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-15"></a> <span class='hs-comment'>-- Do occurrence analysis, and discard occurence info returned</span>
<a name="line-16"></a><span class='hs-definition'>occurAnalyseExpr</span> <span class='hs-varid'>expr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>snd</span> <span class='hs-layout'>(</span><span class='hs-varid'>occAnal</span> <span class='hs-varid'>initOccEnv</span> <span class='hs-varid'>expr</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[OccurAnal-main]{Counting occurrences: main function}
%* *
%************************************************************************
Bindings
~~~~~~~~
\begin{code}
<pre><a name="line-1"></a><a name="occAnalBind"></a><span class='hs-definition'>occAnalBind</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreBind</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span> <span class='hs-comment'>-- Usage details of scope</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Of the whole let(rec)</span>
<a name="line-5"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-definition'>occAnalBind</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>binder</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-varid'>body_usage</span>
<a name="line-8"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isTyVar</span> <span class='hs-varid'>binder</span> <span class='hs-comment'>-- A type let; we don't gather usage info</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>binder</span> <span class='hs-varid'>rhs</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>binder</span> <span class='hs-varop'>`usedIn`</span> <span class='hs-varid'>body_usage</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- It's not mentioned</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- It's mentioned in the body</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage'</span> <span class='hs-varop'>+++</span> <span class='hs-varid'>addRuleUsage</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-varid'>binder</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Note [Rules are extra RHSs]</span>
<a name="line-16"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>tagged_binder</span> <span class='hs-varid'>rhs'</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-keyword'>where</span>
<a name="line-18"></a> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tagged_binder</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagBinder</span> <span class='hs-varid'>body_usage</span> <span class='hs-varid'>binder</span>
<a name="line-19"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rhs_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occAnalRhs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>tagged_binder</span> <span class='hs-varid'>rhs</span>
</pre>\end{code}
Note [Dead code]
~~~~~~~~~~~~~~~~
Dropping dead code for recursive bindings is done in a very simple way:
the entire set of bindings is dropped if none of its binders are
mentioned in its body; otherwise none are.
This seems to miss an obvious improvement.
letrec f = ...g...
g = ...f...
in
...g...
===>
letrec f = ...g...
g = ...(...g...)...
in
...g...
Now 'f' is unused! But it's OK! Dependency analysis will sort this
out into a letrec for 'g' and a 'let' for 'f', and then 'f' will get
dropped. It isn't easy to do a perfect job in one blow. Consider
letrec f = ...g...
g = ...h...
h = ...k...
k = ...m...
m = ...m...
in
...m...
Note [Loop breaking and RULES]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Loop breaking is surprisingly subtle. First read the section 4 of
"Secrets of the GHC inliner". This describes our basic plan.
However things are made quite a bit more complicated by RULES. Remember
* Note [Rules are extra RHSs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
A RULE for 'f' is like an extra RHS for 'f'. That way the "parent"
keeps the specialised "children" alive. If the parent dies
(because it isn't referenced any more), then the children will die
too (unless they are already referenced directly).
To that end, we build a Rec group for each cyclic strongly
connected component,
*treating f's rules as extra RHSs for 'f'*.
When we make the Rec groups we include variables free in *either*
LHS *or* RHS of the rule. The former might seems silly, but see
Note [Rule dependency info].
So in Example [eftInt], eftInt and eftIntFB will be put in the
same Rec, even though their 'main' RHSs are both non-recursive.
* Note [Rules are visible in their own rec group]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We want the rules for 'f' to be visible in f's right-hand side.
And we'd like them to be visible in other functions in f's Rec
group. E.g. in Example [Specialisation rules] we want f' rule
to be visible in both f's RHS, and fs's RHS.
This means that we must simplify the RULEs first, before looking
at any of the definitions. This is done by Simplify.simplRecBind,
when it calls addLetIdInfo.
* Note [Choosing loop breakers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We avoid infinite inlinings by choosing loop breakers, and
ensuring that a loop breaker cuts each loop. But what is a
"loop"? In particular, a RULE is like an equation for 'f' that
is *always* inlined if it is applicable. We do *not* disable
rules for loop-breakers. It's up to whoever makes the rules to
make sure that the rules themselves alwasys terminate. See Note
[Rules for recursive functions] in Simplify.lhs
Hence, if
f's RHS mentions g, and
g has a RULE that mentions h, and
h has a RULE that mentions f
then we *must* choose f to be a loop breaker. In general, take the
free variables of f's RHS, and augment it with all the variables
reachable by RULES from those starting points. That is the whole
reason for computing rule_fv_env in occAnalBind. (Of course we
only consider free vars that are also binders in this Rec group.)
Note that when we compute this rule_fv_env, we only consider variables
free in the *RHS* of the rule, in contrast to the way we build the
Rec group in the first place (Note [Rule dependency info])
Note that in Example [eftInt], *neither* eftInt *nor* eftIntFB is
chosen as a loop breaker, because their RHSs don't mention each other.
And indeed both can be inlined safely.
Note that the edges of the graph we use for computing loop breakers
are not the same as the edges we use for computing the Rec blocks.
That's why we compute
rec_edges for the Rec block analysis
loop_breaker_edges for the loop breaker analysis
* Note [Weak loop breakers]
~~~~~~~~~~~~~~~~~~~~~~~~~
There is a last nasty wrinkle. Suppose we have
Rec { f = f_rhs
RULE f [] = g
h = h_rhs
g = h
...more...
}
Remmber that we simplify the RULES before any RHS (see Note
[Rules are visible in their own rec group] above).
So we must *not* postInlineUnconditionally 'g', even though
its RHS turns out to be trivial. (I'm assuming that 'g' is
not choosen as a loop breaker.)
We "solve" this by making g a "weak" or "rules-only" loop breaker,
with OccInfo = IAmLoopBreaker True. A normal "strong" loop breaker
has IAmLoopBreaker False. So
Inline postInlineUnconditinoally
IAmLoopBreaker False no no
IAmLoopBreaker True yes no
other yes yes
The **sole** reason for this kind of loop breaker is so that
postInlineUnconditionally does not fire. Ugh.
* Note [Rule dependency info]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
The VarSet in a SpecInfo is used for dependency analysis in the
occurrence analyser. We must track free vars in *both* lhs and rhs.
Hence use of idRuleVars, rather than idRuleRhsVars in addRuleUsage.
Why both? Consider
x = y
RULE f x = 4
Then if we substitute y for x, we'd better do so in the
rule's LHS too, so we'd better ensure the dependency is respected
Example [eftInt]
~~~~~~~~~~~~~~~
Example (from GHC.Enum):
eftInt :: Int# -> Int# -> [Int]
eftInt x y = ...(non-recursive)...
{-# INLINE [0] eftIntFB #-}
eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
eftIntFB c n x y = ...(non-recursive)...
{-# RULES
"eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
"eftIntList" [1] eftIntFB (:) [] = eftInt
#-}
Example [Specialisation rules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this group, which is typical of what SpecConstr builds:
fs a = ....f (C a)....
f x = ....f (C a)....
{-# RULE f (C a) = fs a #-}
So 'f' and 'fs' are in the same Rec group (since f refers to fs via its RULE).
But watch out! If 'fs' is not chosen as a loop breaker, we may get an infinite loop:
- the RULE is applied in f's RHS (see Note [Self-recursive rules] in Simplify
- fs is inlined (say it's small)
- now there's another opportunity to apply the RULE
This showed up when compiling Control.Concurrent.Chan.getChanContents.
\begin{code}
<pre><a name="line-1"></a><a name="occAnalBind"></a><span class='hs-definition'>occAnalBind</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rec</span> <span class='hs-varid'>pairs</span><span class='hs-layout'>)</span> <span class='hs-varid'>body_usage</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-varid'>occAnalRec</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-varid'>sccs</span>
<a name="line-3"></a> <span class='hs-comment'>-- For a recursive group, we </span>
<a name="line-4"></a> <span class='hs-comment'>-- * occ-analyse all the RHSs</span>
<a name="line-5"></a> <span class='hs-comment'>-- * compute strongly-connected components</span>
<a name="line-6"></a> <span class='hs-comment'>-- * feed those components to occAnalRec</span>
<a name="line-7"></a> <span class='hs-keyword'>where</span>
<a name="line-8"></a> <span class='hs-comment'>-------------Dependency analysis ------------------------------</span>
<a name="line-9"></a> <span class='hs-varid'>bndr_set</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarSet</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>fst</span> <span class='hs-varid'>pairs</span><span class='hs-layout'>)</span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-varid'>sccs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>SCC</span> <span class='hs-layout'>(</span><span class='hs-conid'>Node</span> <span class='hs-conid'>Details</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-12"></a> <span class='hs-varid'>sccs</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>{-# SCC "occAnalBind.scc" #-}</span> <span class='hs-varid'>stronglyConnCompFromEdgedVerticesR</span> <span class='hs-varid'>rec_edges</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-varid'>rec_edges</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Node</span> <span class='hs-conid'>Details</span><span class='hs-keyglyph'>]</span>
<a name="line-15"></a> <span class='hs-varid'>rec_edges</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>{-# SCC "occAnalBind.assoc" #-}</span> <span class='hs-varid'>map</span> <span class='hs-varid'>make_node</span> <span class='hs-varid'>pairs</span>
<a name="line-16"></a>
<a name="line-17"></a> <span class='hs-varid'>make_node</span> <span class='hs-layout'>(</span><span class='hs-varid'>bndr</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span>
<a name="line-18"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs'</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-varid'>rhs_fvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>idUnique</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>,</span> <span class='hs-varid'>out_edges</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-keyword'>where</span>
<a name="line-20"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rhs_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occAnalRhs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span>
<a name="line-21"></a> <span class='hs-varid'>rhs_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>intersectUFM_C</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>b</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-varid'>bndr_set</span> <span class='hs-varid'>rhs_usage</span>
<a name="line-22"></a> <span class='hs-varid'>out_edges</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>keysUFM</span> <span class='hs-layout'>(</span><span class='hs-varid'>rhs_fvs</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>idRuleVars</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>)</span>
<a name="line-23"></a> <span class='hs-comment'>-- (a -> b) means a mentions b</span>
<a name="line-24"></a> <span class='hs-comment'>-- Given the usage details (a UFM that gives occ info for each free var of</span>
<a name="line-25"></a> <span class='hs-comment'>-- the RHS) we can get the list of free vars -- or rather their Int keys --</span>
<a name="line-26"></a> <span class='hs-comment'>-- by just extracting the keys from the finite map. Grimy, but fast.</span>
<a name="line-27"></a> <span class='hs-comment'>-- Previously we had this:</span>
<a name="line-28"></a> <span class='hs-comment'>-- [ bndr | bndr <- bndrs,</span>
<a name="line-29"></a> <span class='hs-comment'>-- maybeToBool (lookupVarEnv rhs_usage bndr)]</span>
<a name="line-30"></a> <span class='hs-comment'>-- which has n**2 cost, and this meant that edges_from alone</span>
<a name="line-31"></a> <span class='hs-comment'>-- consumed 10% of total runtime!</span>
<a name="line-32"></a>
<a name="line-33"></a><a name="occAnalRec"></a><span class='hs-comment'>-----------------------------</span>
<a name="line-34"></a><span class='hs-definition'>occAnalRec</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SCC</span> <span class='hs-layout'>(</span><span class='hs-conid'>Node</span> <span class='hs-conid'>Details</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-36"></a>
<a name="line-37"></a> <span class='hs-comment'>-- The NonRec case is just like a Let (NonRec ...) above</span>
<a name="line-38"></a><span class='hs-definition'>occAnalRec</span> <span class='hs-layout'>(</span><span class='hs-conid'>AcyclicSCC</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-39"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>bndr</span> <span class='hs-varop'>`usedIn`</span> <span class='hs-varid'>body_usage</span><span class='hs-layout'>)</span>
<a name="line-40"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-41"></a>
<a name="line-42"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- It's mentioned in the body</span>
<a name="line-43"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage'</span> <span class='hs-varop'>+++</span> <span class='hs-varid'>addRuleUsage</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Note [Rules are extra RHSs]</span>
<a name="line-44"></a> <span class='hs-conid'>NonRec</span> <span class='hs-varid'>tagged_bndr</span> <span class='hs-varid'>rhs</span> <span class='hs-conop'>:</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-45"></a> <span class='hs-keyword'>where</span>
<a name="line-46"></a> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tagged_bndr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagBinder</span> <span class='hs-varid'>body_usage</span> <span class='hs-varid'>bndr</span>
<a name="line-47"></a>
<a name="line-48"></a>
<a name="line-49"></a> <span class='hs-comment'>-- The Rec case is the interesting one</span>
<a name="line-50"></a> <span class='hs-comment'>-- See Note [Loop breaking]</span>
<a name="line-51"></a><span class='hs-definition'>occAnalRec</span> <span class='hs-layout'>(</span><span class='hs-conid'>CyclicSCC</span> <span class='hs-varid'>nodes</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-52"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-varop'>`usedIn`</span> <span class='hs-varid'>body_usage</span><span class='hs-layout'>)</span> <span class='hs-varid'>bndrs</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- NB: look at body_usage, not total_usage</span>
<a name="line-53"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Dead code</span>
<a name="line-54"></a>
<a name="line-55"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- At this point we always build a single Rec</span>
<a name="line-56"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>final_usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>Rec</span> <span class='hs-varid'>pairs</span> <span class='hs-conop'>:</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-57"></a>
<a name="line-58"></a> <span class='hs-keyword'>where</span>
<a name="line-59"></a> <span class='hs-varid'>bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>b</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>b</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>nodes</span><span class='hs-keyglyph'>]</span>
<a name="line-60"></a> <span class='hs-varid'>bndr_set</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>bndrs</span>
<a name="line-61"></a>
<a name="line-62"></a> <span class='hs-comment'>----------------------------</span>
<a name="line-63"></a> <span class='hs-comment'>-- Tag the binders with their occurrence info</span>
<a name="line-64"></a> <span class='hs-varid'>total_usage</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl</span> <span class='hs-varid'>add_usage</span> <span class='hs-varid'>body_usage</span> <span class='hs-varid'>nodes</span>
<a name="line-65"></a> <span class='hs-varid'>add_usage</span> <span class='hs-varid'>body_usage</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-66"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>body_usage</span> <span class='hs-varop'>+++</span> <span class='hs-varid'>addRuleUsage</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-varid'>bndr</span>
<a name="line-67"></a> <span class='hs-layout'>(</span><span class='hs-varid'>final_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>tagged_nodes</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapAccumL</span> <span class='hs-varid'>tag_node</span> <span class='hs-varid'>total_usage</span> <span class='hs-varid'>nodes</span>
<a name="line-68"></a>
<a name="line-69"></a> <span class='hs-varid'>tag_node</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Node</span> <span class='hs-conid'>Details</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-conid'>Node</span> <span class='hs-conid'>Details</span><span class='hs-layout'>)</span>
<a name="line-70"></a> <span class='hs-comment'>-- (a) Tag the binders in the details with occ info</span>
<a name="line-71"></a> <span class='hs-comment'>-- (b) Mark the binder with "weak loop-breaker" OccInfo </span>
<a name="line-72"></a> <span class='hs-comment'>-- saying "no preInlineUnconditionally" if it is used</span>
<a name="line-73"></a> <span class='hs-comment'>-- in any rule (lhs or rhs) of the recursive group</span>
<a name="line-74"></a> <span class='hs-comment'>-- See Note [Weak loop breakers]</span>
<a name="line-75"></a> <span class='hs-varid'>tag_node</span> <span class='hs-varid'>usage</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-varid'>rhs_fvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>k</span><span class='hs-layout'>,</span> <span class='hs-varid'>ks</span><span class='hs-layout'>)</span>
<a name="line-76"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>usage</span> <span class='hs-varop'>`delVarEnv`</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr2</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-varid'>rhs_fvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>k</span><span class='hs-layout'>,</span> <span class='hs-varid'>ks</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-77"></a> <span class='hs-keyword'>where</span>
<a name="line-78"></a> <span class='hs-varid'>bndr2</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>bndr</span> <span class='hs-varop'>`elemVarSet`</span> <span class='hs-varid'>all_rule_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeLoopBreaker</span> <span class='hs-conid'>True</span> <span class='hs-varid'>bndr1</span>
<a name="line-79"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bndr1</span>
<a name="line-80"></a> <span class='hs-varid'>bndr1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setBinderOcc</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>bndr</span>
<a name="line-81"></a> <span class='hs-varid'>all_rule_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bndr_set</span> <span class='hs-varop'>`intersectVarSet`</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>unionVarSet</span> <span class='hs-varop'>.</span> <span class='hs-varid'>idRuleVars</span><span class='hs-layout'>)</span>
<a name="line-82"></a> <span class='hs-varid'>emptyVarSet</span> <span class='hs-varid'>bndrs</span>
<a name="line-83"></a>
<a name="line-84"></a> <span class='hs-comment'>----------------------------</span>
<a name="line-85"></a> <span class='hs-comment'>-- Now reconstruct the cycle</span>
<a name="line-86"></a> <span class='hs-varid'>pairs</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>no_rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>reOrderCycle</span> <span class='hs-num'>0</span> <span class='hs-varid'>tagged_nodes</span> <span class='hs-conid'>[]</span>
<a name="line-87"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>reOrderRec</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-varop'>$</span>
<a name="line-88"></a> <span class='hs-varid'>stronglyConnCompFromEdgedVerticesR</span> <span class='hs-varid'>loop_breaker_edges</span>
<a name="line-89"></a>
<a name="line-90"></a> <span class='hs-comment'>-- See Note [Choosing loop breakers] for looop_breaker_edges</span>
<a name="line-91"></a> <span class='hs-varid'>loop_breaker_edges</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>mk_node</span> <span class='hs-varid'>tagged_nodes</span>
<a name="line-92"></a> <span class='hs-varid'>mk_node</span> <span class='hs-layout'>(</span><span class='hs-varid'>details</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>rhs_fvs</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>k</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>details</span><span class='hs-layout'>,</span> <span class='hs-varid'>k</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_ks</span><span class='hs-layout'>)</span>
<a name="line-93"></a> <span class='hs-keyword'>where</span>
<a name="line-94"></a> <span class='hs-varid'>new_ks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>keysUFM</span> <span class='hs-layout'>(</span><span class='hs-varid'>extendFvs</span> <span class='hs-varid'>rule_fv_env</span> <span class='hs-varid'>rhs_fvs</span> <span class='hs-varid'>rhs_fvs</span><span class='hs-layout'>)</span>
<a name="line-95"></a>
<a name="line-96"></a> <span class='hs-comment'>------------------------------------</span>
<a name="line-97"></a> <span class='hs-varid'>rule_fv_env</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IdEnv</span> <span class='hs-conid'>IdSet</span> <span class='hs-comment'>-- Variables from this group mentioned in RHS of rules</span>
<a name="line-98"></a> <span class='hs-comment'>-- Domain is *subset* of bound vars (others have no rule fvs)</span>
<a name="line-99"></a> <span class='hs-varid'>rule_fv_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rule_loop</span> <span class='hs-varid'>init_rule_fvs</span>
<a name="line-100"></a>
<a name="line-101"></a> <span class='hs-varid'>no_rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>null</span> <span class='hs-varid'>init_rule_fvs</span>
<a name="line-102"></a> <span class='hs-varid'>init_rule_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>rule_fvs</span><span class='hs-layout'>)</span>
<a name="line-103"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bndrs</span>
<a name="line-104"></a> <span class='hs-layout'>,</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>rule_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idRuleRhsVars</span> <span class='hs-varid'>b</span> <span class='hs-varop'>`intersectVarSet`</span> <span class='hs-varid'>bndr_set</span>
<a name="line-105"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isEmptyVarSet</span> <span class='hs-varid'>rule_fvs</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-106"></a>
<a name="line-107"></a> <span class='hs-varid'>rule_loop</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span><span class='hs-conid'>IdSet</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdEnv</span> <span class='hs-conid'>IdSet</span> <span class='hs-comment'>-- Finds fixpoint</span>
<a name="line-108"></a> <span class='hs-varid'>rule_loop</span> <span class='hs-varid'>fv_list</span>
<a name="line-109"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>no_change</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span>
<a name="line-110"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rule_loop</span> <span class='hs-varid'>new_fv_list</span>
<a name="line-111"></a> <span class='hs-keyword'>where</span>
<a name="line-112"></a> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarEnv</span> <span class='hs-varid'>init_rule_fvs</span>
<a name="line-113"></a> <span class='hs-layout'>(</span><span class='hs-varid'>no_change</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_fv_list</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapAccumL</span> <span class='hs-varid'>bump</span> <span class='hs-conid'>True</span> <span class='hs-varid'>fv_list</span>
<a name="line-114"></a> <span class='hs-varid'>bump</span> <span class='hs-varid'>no_change</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>fvs</span><span class='hs-layout'>)</span>
<a name="line-115"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>new_fvs</span> <span class='hs-varop'>`subVarSet`</span> <span class='hs-varid'>fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>no_change</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>fvs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-116"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>new_fvs</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>fvs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-117"></a> <span class='hs-keyword'>where</span>
<a name="line-118"></a> <span class='hs-varid'>new_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendFvs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>emptyVarSet</span> <span class='hs-varid'>fvs</span>
<a name="line-119"></a>
<a name="line-120"></a><a name="idRuleRhsVars"></a><span class='hs-definition'>idRuleRhsVars</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VarSet</span>
<a name="line-121"></a><span class='hs-comment'>-- Just the variables free on the *rhs* of a rule</span>
<a name="line-122"></a><span class='hs-comment'>-- See Note [Choosing loop breakers]</span>
<a name="line-123"></a><span class='hs-definition'>idRuleRhsVars</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>unionVarSet</span> <span class='hs-varop'>.</span> <span class='hs-varid'>ruleRhsFreeVars</span><span class='hs-layout'>)</span> <span class='hs-varid'>emptyVarSet</span> <span class='hs-layout'>(</span><span class='hs-varid'>idCoreRules</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span>
<a name="line-124"></a>
<a name="line-125"></a><a name="extendFvs"></a><span class='hs-definition'>extendFvs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IdEnv</span> <span class='hs-conid'>IdSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdSet</span>
<a name="line-126"></a><span class='hs-comment'>-- (extendFVs env fvs s) returns (fvs `union` env(s))</span>
<a name="line-127"></a><span class='hs-definition'>extendFvs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>fvs</span> <span class='hs-varid'>id_set</span>
<a name="line-128"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldUFM_Directly</span> <span class='hs-varid'>add</span> <span class='hs-varid'>fvs</span> <span class='hs-varid'>id_set</span>
<a name="line-129"></a> <span class='hs-keyword'>where</span>
<a name="line-130"></a> <span class='hs-varid'>add</span> <span class='hs-varid'>uniq</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fvs</span>
<a name="line-131"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupVarEnv_Directly</span> <span class='hs-varid'>env</span> <span class='hs-varid'>uniq</span> <span class='hs-keyword'>of</span>
<a name="line-132"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>fvs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>fvs'</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>fvs</span>
<a name="line-133"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>fvs</span>
</pre>\end{code}
@reOrderRec@ is applied to the list of (binder,rhs) pairs for a cyclic
strongly connected component (there's guaranteed to be a cycle). It returns the
same pairs, but
a) in a better order,
b) with some of the Ids having a IAmALoopBreaker pragma
The "loop-breaker" Ids are sufficient to break all cycles in the SCC. This means
that the simplifier can guarantee not to loop provided it never records an inlining
for these no-inline guys.
Furthermore, the order of the binds is such that if we neglect dependencies
on the no-inline Ids then the binds are topologically sorted. This means
that the simplifier will generally do a good job if it works from top bottom,
recording inlinings for any Ids which aren't marked as "no-inline" as it goes.
==============
[June 98: I don't understand the following paragraphs, and I've
changed the a=b case again so that it isn't a special case any more.]
Here's a case that bit me:
letrec
a = b
b = \x. BIG
in
...a...a...a....
Re-ordering doesn't change the order of bindings, but there was no loop-breaker.
My solution was to make a=b bindings record b as Many, rather like INLINE bindings.
Perhaps something cleverer would suffice.
===============
\begin{code}
<pre><a name="line-1"></a><a name="Node"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>Node</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>details</span><span class='hs-layout'>,</span> <span class='hs-conid'>Unique</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Unique</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- The Ints are gotten from the Unique,</span>
<a name="line-2"></a> <span class='hs-comment'>-- which is gotten from the Id.</span>
<a name="line-3"></a><a name="Details"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Details</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ND</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Binder</span>
<a name="line-4"></a> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- RHS</span>
<a name="line-5"></a> <span class='hs-conid'>UsageDetails</span> <span class='hs-comment'>-- Full usage from RHS (*not* including rules)</span>
<a name="line-6"></a> <span class='hs-conid'>IdSet</span> <span class='hs-comment'>-- Other binders from this Rec group mentioned on RHS</span>
<a name="line-7"></a> <span class='hs-comment'>-- (derivable from UsageDetails but cached here)</span>
<a name="line-8"></a>
<a name="line-9"></a><a name="reOrderRec"></a><span class='hs-definition'>reOrderRec</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SCC</span> <span class='hs-layout'>(</span><span class='hs-conid'>Node</span> <span class='hs-conid'>Details</span><span class='hs-layout'>)</span>
<a name="line-10"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-11"></a><span class='hs-comment'>-- Sorted into a plausible order. Enough of the Ids have</span>
<a name="line-12"></a><span class='hs-comment'>-- IAmALoopBreaker pragmas that there are no loops left.</span>
<a name="line-13"></a><span class='hs-definition'>reOrderRec</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>AcyclicSCC</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>pairs</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>bndr</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>pairs</span>
<a name="line-14"></a><span class='hs-definition'>reOrderRec</span> <span class='hs-varid'>depth</span> <span class='hs-layout'>(</span><span class='hs-conid'>CyclicSCC</span> <span class='hs-varid'>cycle</span><span class='hs-layout'>)</span> <span class='hs-varid'>pairs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>reOrderCycle</span> <span class='hs-varid'>depth</span> <span class='hs-varid'>cycle</span> <span class='hs-varid'>pairs</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="reOrderCycle"></a><span class='hs-definition'>reOrderCycle</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Node</span> <span class='hs-conid'>Details</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-17"></a><span class='hs-definition'>reOrderCycle</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-keyword'>_</span>
<a name="line-18"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"reOrderCycle"</span>
<a name="line-19"></a><span class='hs-definition'>reOrderCycle</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>bind</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>pairs</span> <span class='hs-comment'>-- Common case of simple self-recursion</span>
<a name="line-20"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>makeLoopBreaker</span> <span class='hs-conid'>False</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>pairs</span>
<a name="line-21"></a> <span class='hs-keyword'>where</span>
<a name="line-22"></a> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bind</span>
<a name="line-23"></a>
<a name="line-24"></a><span class='hs-definition'>reOrderCycle</span> <span class='hs-varid'>depth</span> <span class='hs-layout'>(</span><span class='hs-varid'>bind</span> <span class='hs-conop'>:</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-varid'>pairs</span>
<a name="line-25"></a> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-- Choose a loop breaker, mark it no-inline,</span>
<a name="line-26"></a> <span class='hs-comment'>-- do SCC analysis on the rest, and recursively sort them out</span>
<a name="line-27"></a><span class='hs-comment'>-- pprTrace "reOrderCycle" (ppr [b | (ND b _ _ _, _, _) <- bind:binds]) $</span>
<a name="line-28"></a> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>reOrderRec</span> <span class='hs-varid'>new_depth</span><span class='hs-layout'>)</span>
<a name="line-29"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>makeLoopBreaker</span> <span class='hs-conid'>False</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span>
<a name="line-30"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>chosen_binds</span><span class='hs-keyglyph'>]</span> <span class='hs-varop'>++</span> <span class='hs-varid'>pairs</span><span class='hs-layout'>)</span>
<a name="line-31"></a> <span class='hs-layout'>(</span><span class='hs-varid'>stronglyConnCompFromEdgedVerticesR</span> <span class='hs-varid'>unchosen</span><span class='hs-layout'>)</span>
<a name="line-32"></a> <span class='hs-keyword'>where</span>
<a name="line-33"></a> <span class='hs-layout'>(</span><span class='hs-varid'>chosen_binds</span><span class='hs-layout'>,</span> <span class='hs-varid'>unchosen</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>choose_loop_breaker</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>bind</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>(</span><span class='hs-varid'>score</span> <span class='hs-varid'>bind</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>binds</span>
<a name="line-34"></a>
<a name="line-35"></a> <span class='hs-varid'>approximate_loop_breaker</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>depth</span> <span class='hs-varop'>>=</span> <span class='hs-num'>2</span>
<a name="line-36"></a> <span class='hs-varid'>new_depth</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>approximate_loop_breaker</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span>
<a name="line-37"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>depth</span><span class='hs-varop'>+</span><span class='hs-num'>1</span>
<a name="line-38"></a> <span class='hs-comment'>-- After two iterations (d=0, d=1) give up</span>
<a name="line-39"></a> <span class='hs-comment'>-- and approximate, returning to d=0</span>
<a name="line-40"></a>
<a name="line-41"></a> <span class='hs-comment'>-- This loop looks for the bind with the lowest score</span>
<a name="line-42"></a> <span class='hs-comment'>-- to pick as the loop breaker. The rest accumulate in</span>
<a name="line-43"></a> <span class='hs-varid'>choose_loop_breaker</span> <span class='hs-varid'>loop_binds</span> <span class='hs-sel'>_loop_sc</span> <span class='hs-varid'>acc</span> <span class='hs-conid'>[]</span>
<a name="line-44"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>loop_binds</span><span class='hs-layout'>,</span> <span class='hs-varid'>acc</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Done</span>
<a name="line-45"></a>
<a name="line-46"></a> <span class='hs-comment'>-- If approximate_loop_breaker is True, we pick *all*</span>
<a name="line-47"></a> <span class='hs-comment'>-- nodes with lowest score, else just one</span>
<a name="line-48"></a> <span class='hs-comment'>-- See Note [Complexity of loop breaking]</span>
<a name="line-49"></a> <span class='hs-varid'>choose_loop_breaker</span> <span class='hs-varid'>loop_binds</span> <span class='hs-varid'>loop_sc</span> <span class='hs-varid'>acc</span> <span class='hs-layout'>(</span><span class='hs-varid'>bind</span> <span class='hs-conop'>:</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-50"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>sc</span> <span class='hs-varop'><</span> <span class='hs-varid'>loop_sc</span> <span class='hs-comment'>-- Lower score so pick this new one</span>
<a name="line-51"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>choose_loop_breaker</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>bind</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>sc</span> <span class='hs-layout'>(</span><span class='hs-varid'>loop_binds</span> <span class='hs-varop'>++</span> <span class='hs-varid'>acc</span><span class='hs-layout'>)</span> <span class='hs-varid'>binds</span>
<a name="line-52"></a>
<a name="line-53"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>approximate_loop_breaker</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>sc</span> <span class='hs-varop'>==</span> <span class='hs-varid'>loop_sc</span>
<a name="line-54"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>choose_loop_breaker</span> <span class='hs-layout'>(</span><span class='hs-varid'>bind</span> <span class='hs-conop'>:</span> <span class='hs-varid'>loop_binds</span><span class='hs-layout'>)</span> <span class='hs-varid'>loop_sc</span> <span class='hs-varid'>acc</span> <span class='hs-varid'>binds</span>
<a name="line-55"></a>
<a name="line-56"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- Higher score so don't pick it</span>
<a name="line-57"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>choose_loop_breaker</span> <span class='hs-varid'>loop_binds</span> <span class='hs-varid'>loop_sc</span> <span class='hs-layout'>(</span><span class='hs-varid'>bind</span> <span class='hs-conop'>:</span> <span class='hs-varid'>acc</span><span class='hs-layout'>)</span> <span class='hs-varid'>binds</span>
<a name="line-58"></a> <span class='hs-keyword'>where</span>
<a name="line-59"></a> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>score</span> <span class='hs-varid'>bind</span>
<a name="line-60"></a>
<a name="line-61"></a> <span class='hs-varid'>score</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Node</span> <span class='hs-conid'>Details</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-comment'>-- Higher score => less likely to be picked as loop breaker</span>
<a name="line-62"></a> <span class='hs-varid'>score</span> <span class='hs-layout'>(</span><span class='hs-conid'>ND</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-63"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>workerExists</span> <span class='hs-layout'>(</span><span class='hs-varid'>idWorkerInfo</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>10</span>
<a name="line-64"></a> <span class='hs-comment'>-- Note [Worker inline loop]</span>
<a name="line-65"></a>
<a name="line-66"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>exprIsTrivial</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>5</span> <span class='hs-comment'>-- Practically certain to be inlined</span>
<a name="line-67"></a> <span class='hs-comment'>-- Used to have also: && not (isExportedId bndr)</span>
<a name="line-68"></a> <span class='hs-comment'>-- But I found this sometimes cost an extra iteration when we have</span>
<a name="line-69"></a> <span class='hs-comment'>-- rec { d = (a,b); a = ...df...; b = ...df...; df = d }</span>
<a name="line-70"></a> <span class='hs-comment'>-- where df is the exported dictionary. Then df makes a really</span>
<a name="line-71"></a> <span class='hs-comment'>-- bad choice for loop breaker</span>
<a name="line-72"></a>
<a name="line-73"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>is_con_app</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>3</span> <span class='hs-comment'>-- Data types help with cases</span>
<a name="line-74"></a> <span class='hs-comment'>-- Note [Constructor applictions]</span>
<a name="line-75"></a>
<a name="line-76"></a><span class='hs-comment'>-- If an Id is marked "never inline" then it makes a great loop breaker</span>
<a name="line-77"></a><span class='hs-comment'>-- The only reason for not checking that here is that it is rare</span>
<a name="line-78"></a><span class='hs-comment'>-- and I've never seen a situation where it makes a difference,</span>
<a name="line-79"></a><span class='hs-comment'>-- so it probably isn't worth the time to test on every binder</span>
<a name="line-80"></a><span class='hs-comment'>-- | isNeverActive (idInlinePragma bndr) = -10</span>
<a name="line-81"></a>
<a name="line-82"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>inlineCandidate</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>2</span> <span class='hs-comment'>-- Likely to be inlined</span>
<a name="line-83"></a> <span class='hs-comment'>-- Note [Inline candidates]</span>
<a name="line-84"></a>
<a name="line-85"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>neverUnfold</span> <span class='hs-layout'>(</span><span class='hs-varid'>idUnfolding</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>1</span>
<a name="line-86"></a> <span class='hs-comment'>-- the Id has some kind of unfolding</span>
<a name="line-87"></a>
<a name="line-88"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span>
<a name="line-89"></a>
<a name="line-90"></a> <span class='hs-varid'>inlineCandidate</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-91"></a> <span class='hs-varid'>inlineCandidate</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-conid'>InlineMe</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-92"></a> <span class='hs-varid'>inlineCandidate</span> <span class='hs-varid'>id</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isOneOcc</span> <span class='hs-layout'>(</span><span class='hs-varid'>idOccInfo</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span>
<a name="line-93"></a>
<a name="line-94"></a> <span class='hs-comment'>-- Note [conapp]</span>
<a name="line-95"></a> <span class='hs-comment'>--</span>
<a name="line-96"></a> <span class='hs-comment'>-- It's really really important to inline dictionaries. Real</span>
<a name="line-97"></a> <span class='hs-comment'>-- example (the Enum Ordering instance from GHC.Base):</span>
<a name="line-98"></a> <span class='hs-comment'>--</span>
<a name="line-99"></a> <span class='hs-comment'>-- rec f = \ x -> case d of (p,q,r) -> p x</span>
<a name="line-100"></a> <span class='hs-comment'>-- g = \ x -> case d of (p,q,r) -> q x</span>
<a name="line-101"></a> <span class='hs-comment'>-- d = (v, f, g)</span>
<a name="line-102"></a> <span class='hs-comment'>--</span>
<a name="line-103"></a> <span class='hs-comment'>-- Here, f and g occur just once; but we can't inline them into d.</span>
<a name="line-104"></a> <span class='hs-comment'>-- On the other hand we *could* simplify those case expressions if</span>
<a name="line-105"></a> <span class='hs-comment'>-- we didn't stupidly choose d as the loop breaker.</span>
<a name="line-106"></a> <span class='hs-comment'>-- But we won't because constructor args are marked "Many".</span>
<a name="line-107"></a> <span class='hs-comment'>-- Inlining dictionaries is really essential to unravelling</span>
<a name="line-108"></a> <span class='hs-comment'>-- the loops in static numeric dictionaries, see GHC.Float.</span>
<a name="line-109"></a>
<a name="line-110"></a> <span class='hs-comment'>-- Cheap and cheerful; the simplifer moves casts out of the way</span>
<a name="line-111"></a> <span class='hs-comment'>-- The lambda case is important to spot x = /\a. C (f a)</span>
<a name="line-112"></a> <span class='hs-comment'>-- which comes up when C is a dictionary constructor and</span>
<a name="line-113"></a> <span class='hs-comment'>-- f is a default method.</span>
<a name="line-114"></a> <span class='hs-comment'>-- Example: the instance for Show (ST s a) in GHC.ST</span>
<a name="line-115"></a> <span class='hs-comment'>--</span>
<a name="line-116"></a> <span class='hs-comment'>-- However we *also* treat (\x. C p q) as a con-app-like thing,</span>
<a name="line-117"></a> <span class='hs-comment'>-- Note [Closure conversion]</span>
<a name="line-118"></a> <span class='hs-varid'>is_con_app</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isDataConWorkId</span> <span class='hs-varid'>v</span>
<a name="line-119"></a> <span class='hs-varid'>is_con_app</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>is_con_app</span> <span class='hs-varid'>f</span>
<a name="line-120"></a> <span class='hs-varid'>is_con_app</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>is_con_app</span> <span class='hs-varid'>e</span>
<a name="line-121"></a> <span class='hs-varid'>is_con_app</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>is_con_app</span> <span class='hs-varid'>e</span>
<a name="line-122"></a> <span class='hs-varid'>is_con_app</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-123"></a>
<a name="line-124"></a><a name="makeLoopBreaker"></a><span class='hs-definition'>makeLoopBreaker</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span>
<a name="line-125"></a><span class='hs-comment'>-- Set the loop-breaker flag: see Note [Weak loop breakers]</span>
<a name="line-126"></a><span class='hs-definition'>makeLoopBreaker</span> <span class='hs-varid'>weak</span> <span class='hs-varid'>bndr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setIdOccInfo</span> <span class='hs-varid'>bndr</span> <span class='hs-layout'>(</span><span class='hs-conid'>IAmALoopBreaker</span> <span class='hs-varid'>weak</span><span class='hs-layout'>)</span>
</pre>\end{code}
Note [Complexity of loop breaking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The loop-breaking algorithm knocks out one binder at a time, and
performs a new SCC analysis on the remaining binders. That can
behave very badly in tightly-coupled groups of bindings; in the
worst case it can be (N**2)*log N, because it does a full SCC
on N, then N-1, then N-2 and so on.
To avoid this, we switch plans after 2 (or whatever) attempts:
Plan A: pick one binder with the lowest score, make it
a loop breaker, and try again
Plan B: pick *all* binders with the lowest score, make them
all loop breakers, and try again
Since there are only a small finite number of scores, this will
terminate in a constant number of iterations, rather than O(N)
iterations.
You might thing that it's very unlikely, but RULES make it much
more likely. Here's a real example from Trac #1969:
Rec { $dm = \d.\x. op d
{-# RULES forall d. $dm Int d = $s$dm1
forall d. $dm Bool d = $s$dm2 #-}
dInt = MkD .... opInt ...
dInt = MkD .... opBool ...
opInt = $dm dInt
opBool = $dm dBool
$s$dm1 = \x. op dInt
$s$dm2 = \x. op dBool }
The RULES stuff means that we can't choose $dm as a loop breaker
(Note [Choosing loop breakers]), so we must choose at least (say)
opInt *and* opBool, and so on. The number of loop breakders is
linear in the number of instance declarations.
Note [INLINE pragmas]
~~~~~~~~~~~~~~~~~~~~~
Never choose a function with an INLINE pramga as the loop breaker!
If such a function is mutually-recursive with a non-INLINE thing,
then the latter should be the loop-breaker.
A particular case is wrappers generated by the demand analyser.
If you make then into a loop breaker you may get an infinite
inlining loop. For example:
rec {
$wfoo x = ....foo x....
{-loop brk-} foo x = ...$wfoo x...
}
The interface file sees the unfolding for $wfoo, and sees that foo is
strict (and hence it gets an auto-generated wrapper). Result: an
infinite inlining in the importing scope. So be a bit careful if you
change this. A good example is Tree.repTree in
nofib/spectral/minimax. If the repTree wrapper is chosen as the loop
breaker then compiling Game.hs goes into an infinite loop (this
happened when we gave is_con_app a lower score than inline candidates).
Note [Constructor applications]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's really really important to inline dictionaries. Real
example (the Enum Ordering instance from GHC.Base):
rec f = \ x -> case d of (p,q,r) -> p x
g = \ x -> case d of (p,q,r) -> q x
d = (v, f, g)
Here, f and g occur just once; but we can't inline them into d.
On the other hand we *could* simplify those case expressions if
we didn't stupidly choose d as the loop breaker.
But we won't because constructor args are marked "Many".
Inlining dictionaries is really essential to unravelling
the loops in static numeric dictionaries, see GHC.Float.
Note [Closure conversion]
~~~~~~~~~~~~~~~~~~~~~~~~~
We treat (\x. C p q) as a high-score candidate in the letrec scoring algorithm.
The immediate motivation came from the result of a closure-conversion transformation
which generated code like this:
data Clo a b = forall c. Clo (c -> a -> b) c
($:) :: Clo a b -> a -> b
Clo f env $: x = f env x
rec { plus = Clo plus1 ()
; plus1 _ n = Clo plus2 n
; plus2 Zero n = n
; plus2 (Succ m) n = Succ (plus $: m $: n) }
If we inline 'plus' and 'plus1', everything unravels nicely. But if
we choose 'plus1' as the loop breaker (which is entirely possible
otherwise), the loop does not unravel nicely.
@occAnalRhs@ deals with the question of bindings where the Id is marked
by an INLINE pragma. For these we record that anything which occurs
in its RHS occurs many times. This pessimistically assumes that ths
inlined binder also occurs many times in its scope, but if it doesn't
we'll catch it next time round. At worst this costs an extra simplifier pass.
ToDo: try using the occurrence info for the inline'd binder.
[March 97] We do the same for atomic RHSs. Reason: see notes with reOrderRec.
[June 98, SLPJ] I've undone this change; I don't understand it. See notes with reOrderRec.
\begin{code}
<pre><a name="line-1"></a><a name="occAnalRhs"></a><span class='hs-definition'>occAnalRhs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Binder and rhs</span>
<a name="line-3"></a> <span class='hs-comment'>-- For non-recs the binder is alrady tagged</span>
<a name="line-4"></a> <span class='hs-comment'>-- with occurrence info</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-definition'>occAnalRhs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>id</span> <span class='hs-varid'>rhs</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>rhs</span>
<a name="line-9"></a> <span class='hs-keyword'>where</span>
<a name="line-10"></a> <span class='hs-varid'>ctxt</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>certainly_inline</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rhsCtxt</span> <span class='hs-varid'>env</span>
<a name="line-12"></a> <span class='hs-comment'>-- Note that we generally use an rhsCtxt. This tells the occ anal n</span>
<a name="line-13"></a> <span class='hs-comment'>-- that it's looking at an RHS, which has an effect in occAnalApp</span>
<a name="line-14"></a> <span class='hs-comment'>--</span>
<a name="line-15"></a> <span class='hs-comment'>-- But there's a problem. Consider</span>
<a name="line-16"></a> <span class='hs-comment'>-- x1 = a0 : []</span>
<a name="line-17"></a> <span class='hs-comment'>-- x2 = a1 : x1</span>
<a name="line-18"></a> <span class='hs-comment'>-- x3 = a2 : x2</span>
<a name="line-19"></a> <span class='hs-comment'>-- g = f x3</span>
<a name="line-20"></a> <span class='hs-comment'>-- First time round, it looks as if x1 and x2 occur as an arg of a</span>
<a name="line-21"></a> <span class='hs-comment'>-- let-bound constructor ==> give them a many-occurrence.</span>
<a name="line-22"></a> <span class='hs-comment'>-- But then x3 is inlined (unconditionally as it happens) and</span>
<a name="line-23"></a> <span class='hs-comment'>-- next time round, x2 will be, and the next time round x1 will be</span>
<a name="line-24"></a> <span class='hs-comment'>-- Result: multiple simplifier iterations. Sigh.</span>
<a name="line-25"></a> <span class='hs-comment'>-- Crude solution: use rhsCtxt for things that occur just once...</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-varid'>certainly_inline</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>idOccInfo</span> <span class='hs-varid'>id</span> <span class='hs-keyword'>of</span>
<a name="line-28"></a> <span class='hs-conid'>OneOcc</span> <span class='hs-varid'>in_lam</span> <span class='hs-varid'>one_br</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>not</span> <span class='hs-varid'>in_lam</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>one_br</span>
<a name="line-29"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="addRuleUsage"></a><span class='hs-definition'>addRuleUsage</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span>
<a name="line-2"></a><span class='hs-comment'>-- Add the usage from RULES in Id to the usage</span>
<a name="line-3"></a><span class='hs-definition'>addRuleUsage</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>id</span>
<a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldVarSet</span> <span class='hs-varid'>add</span> <span class='hs-varid'>usage</span> <span class='hs-layout'>(</span><span class='hs-varid'>idRuleVars</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span>
<a name="line-5"></a> <span class='hs-comment'>-- idRuleVars here: see Note [Rule dependency info]</span>
<a name="line-6"></a> <span class='hs-keyword'>where</span>
<a name="line-7"></a> <span class='hs-varid'>add</span> <span class='hs-varid'>v</span> <span class='hs-varid'>u</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addOneOcc</span> <span class='hs-varid'>u</span> <span class='hs-varid'>v</span> <span class='hs-conid'>NoOccInfo</span>
<a name="line-8"></a> <span class='hs-comment'>-- Give a non-committal binder info (i.e manyOcc) because</span>
<a name="line-9"></a> <span class='hs-comment'>-- a) Many copies of the specialised thing can appear</span>
<a name="line-10"></a> <span class='hs-comment'>-- b) We don't want to substitute a BIG expression inside a RULE</span>
<a name="line-11"></a> <span class='hs-comment'>-- even if that's the only occurrence of the thing</span>
<a name="line-12"></a> <span class='hs-comment'>-- (Same goes for INLINE.)</span>
</pre>\end{code}
Expressions
~~~~~~~~~~~
\begin{code}
<pre><a name="line-1"></a><a name="occAnal"></a><span class='hs-definition'>occAnal</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Gives info only about the "interesting" Ids</span>
<a name="line-4"></a> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>occAnal</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyDetails</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span>
<a name="line-7"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkOneOcc</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v</span> <span class='hs-conid'>False</span><span class='hs-layout'>,</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span>
<a name="line-8"></a> <span class='hs-comment'>-- At one stage, I gathered the idRuleVars for v here too,</span>
<a name="line-9"></a> <span class='hs-comment'>-- which in a way is the right thing to do.</span>
<a name="line-10"></a> <span class='hs-comment'>-- But that went wrong right after specialisation, when</span>
<a name="line-11"></a> <span class='hs-comment'>-- the *occurrences* of the overloaded function didn't have any</span>
<a name="line-12"></a> <span class='hs-comment'>-- rules in them, so the *specialised* versions looked as if they</span>
<a name="line-13"></a> <span class='hs-comment'>-- weren't used at all.</span>
</pre>\end{code}
We regard variables that occur as constructor arguments as "dangerousToDup":
\begin{verbatim}
module A where
f x = let y = expensive x in
let z = (True,y) in
(case z of {(p,q)->q}, case z of {(p,q)->q})
\end{verbatim}
We feel free to duplicate the WHNF (True,y), but that means
that y may be duplicated thereby.
If we aren't careful we duplicate the (expensive x) call!
Constructors are rather like lambdas in this way.
\begin{code}
<pre><a name="line-1"></a><a name="occAnal"></a><span class='hs-definition'>occAnal</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>expr</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyDetails</span><span class='hs-layout'>,</span> <span class='hs-varid'>expr</span><span class='hs-layout'>)</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="occAnal"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-conid'>InlineMe</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-3"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mapVarEnv</span> <span class='hs-varid'>markMany</span> <span class='hs-varid'>usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>Note</span> <span class='hs-conid'>InlineMe</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-layout'>}</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-varid'>note</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>SCC</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-8"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mapVarEnv</span> <span class='hs-varid'>markInsideSCC</span> <span class='hs-varid'>usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>Note</span> <span class='hs-varid'>note</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-layout'>}</span>
<a name="line-10"></a>
<a name="line-11"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-varid'>note</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-13"></a> <span class='hs-layout'>(</span><span class='hs-varid'>usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>Note</span> <span class='hs-varid'>note</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-layout'>}</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Cast</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>co</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>expr</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>expr'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-18"></a> <span class='hs-layout'>(</span><span class='hs-varid'>markRhsUds</span> <span class='hs-varid'>env</span> <span class='hs-conid'>True</span> <span class='hs-varid'>usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>Cast</span> <span class='hs-varid'>expr'</span> <span class='hs-varid'>co</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-comment'>-- If we see let x = y `cast` co</span>
<a name="line-20"></a> <span class='hs-comment'>-- then mark y as 'Many' so that we don't</span>
<a name="line-21"></a> <span class='hs-comment'>-- immediately inline y again.</span>
<a name="line-22"></a> <span class='hs-layout'>}</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="occAnal"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>app</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occAnalApp</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>collectArgs</span> <span class='hs-varid'>app</span><span class='hs-layout'>)</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-comment'>-- Ignore type variables altogether</span>
<a name="line-5"></a><span class='hs-comment'>-- (a) occurrences inside type lambdas only not marked as InsideLam</span>
<a name="line-6"></a><span class='hs-comment'>-- (b) type variables not in environment</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>x</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isTyVar</span> <span class='hs-varid'>x</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-10"></a> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>Lam</span> <span class='hs-varid'>x</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-layout'>}</span>
<a name="line-12"></a>
<a name="line-13"></a><span class='hs-comment'>-- For value lambdas we do a special hack. Consider</span>
<a name="line-14"></a><span class='hs-comment'>-- (\x. \y. ...x...)</span>
<a name="line-15"></a><span class='hs-comment'>-- If we did nothing, x is used inside the \y, so would be marked</span>
<a name="line-16"></a><span class='hs-comment'>-- as dangerous to dup. But in the common case where the abstraction</span>
<a name="line-17"></a><span class='hs-comment'>-- is applied to two arguments this is over-pessimistic.</span>
<a name="line-18"></a><span class='hs-comment'>-- So instead, we just mark each binder with its occurrence</span>
<a name="line-19"></a><span class='hs-comment'>-- info in the *body* of the multiple lambda.</span>
<a name="line-20"></a><span class='hs-comment'>-- Then, the simplifier is careful when partially applying lambdas.</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>expr</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-23"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>env_body</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-24"></a> <span class='hs-keyword'>let</span>
<a name="line-25"></a> <span class='hs-layout'>(</span><span class='hs-varid'>final_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>tagged_binders</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagBinders</span> <span class='hs-varid'>body_usage</span> <span class='hs-varid'>binders</span>
<a name="line-26"></a> <span class='hs-comment'>-- URGH! Sept 99: we don't seem to be able to use binders' here, because</span>
<a name="line-27"></a> <span class='hs-comment'>-- we get linear-typed things in the resulting program that we can't handle yet.</span>
<a name="line-28"></a> <span class='hs-comment'>-- (e.g. PrelShow) TODO</span>
<a name="line-29"></a>
<a name="line-30"></a> <span class='hs-varid'>really_final_usage</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>linear</span> <span class='hs-keyword'>then</span>
<a name="line-31"></a> <span class='hs-varid'>final_usage</span>
<a name="line-32"></a> <span class='hs-keyword'>else</span>
<a name="line-33"></a> <span class='hs-varid'>mapVarEnv</span> <span class='hs-varid'>markInsideLam</span> <span class='hs-varid'>final_usage</span>
<a name="line-34"></a> <span class='hs-keyword'>in</span>
<a name="line-35"></a> <span class='hs-layout'>(</span><span class='hs-varid'>really_final_usage</span><span class='hs-layout'>,</span>
<a name="line-36"></a> <span class='hs-varid'>mkLams</span> <span class='hs-varid'>tagged_binders</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-37"></a> <span class='hs-keyword'>where</span>
<a name="line-38"></a> <span class='hs-varid'>env_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vanillaCtxt</span> <span class='hs-varid'>env</span> <span class='hs-comment'>-- Body is (no longer) an RhsContext</span>
<a name="line-39"></a> <span class='hs-layout'>(</span><span class='hs-varid'>binders</span><span class='hs-layout'>,</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>collectBinders</span> <span class='hs-varid'>expr</span>
<a name="line-40"></a> <span class='hs-varid'>binders'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>oneShotGroup</span> <span class='hs-varid'>env</span> <span class='hs-varid'>binders</span>
<a name="line-41"></a> <span class='hs-varid'>linear</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>all</span> <span class='hs-varid'>is_one_shot</span> <span class='hs-varid'>binders'</span>
<a name="line-42"></a> <span class='hs-varid'>is_one_shot</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isId</span> <span class='hs-varid'>b</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>isOneShotBndr</span> <span class='hs-varid'>b</span>
<a name="line-43"></a>
<a name="line-44"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Case</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>alts</span><span class='hs-layout'>)</span>
<a name="line-45"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occ_anal_scrut</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>alts</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>scrut_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>scrut'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-46"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>mapAndUnzip</span> <span class='hs-varid'>occ_anal_alt</span> <span class='hs-varid'>alts</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>alts_usage_s</span><span class='hs-layout'>,</span> <span class='hs-varid'>alts'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-47"></a> <span class='hs-keyword'>let</span>
<a name="line-48"></a> <span class='hs-varid'>alts_usage</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr1</span> <span class='hs-varid'>combineAltsUsageDetails</span> <span class='hs-varid'>alts_usage_s</span>
<a name="line-49"></a> <span class='hs-varid'>alts_usage'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addCaseBndrUsage</span> <span class='hs-varid'>alts_usage</span>
<a name="line-50"></a> <span class='hs-layout'>(</span><span class='hs-varid'>alts_usage1</span><span class='hs-layout'>,</span> <span class='hs-varid'>tagged_bndr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagBinder</span> <span class='hs-varid'>alts_usage'</span> <span class='hs-varid'>bndr</span>
<a name="line-51"></a> <span class='hs-varid'>total_usage</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>scrut_usage</span> <span class='hs-varop'>+++</span> <span class='hs-varid'>alts_usage1</span>
<a name="line-52"></a> <span class='hs-keyword'>in</span>
<a name="line-53"></a> <span class='hs-varid'>total_usage</span> <span class='hs-varop'>`seq`</span> <span class='hs-layout'>(</span><span class='hs-varid'>total_usage</span><span class='hs-layout'>,</span> <span class='hs-conid'>Case</span> <span class='hs-varid'>scrut'</span> <span class='hs-varid'>tagged_bndr</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>alts'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-54"></a> <span class='hs-keyword'>where</span>
<a name="line-55"></a> <span class='hs-comment'>-- Note [Case binder usage] </span>
<a name="line-56"></a> <span class='hs-comment'>-- ~~~~~~~~~~~~~~~~~~~~~~~~</span>
<a name="line-57"></a> <span class='hs-comment'>-- The case binder gets a usage of either "many" or "dead", never "one".</span>
<a name="line-58"></a> <span class='hs-comment'>-- Reason: we like to inline single occurrences, to eliminate a binding,</span>
<a name="line-59"></a> <span class='hs-comment'>-- but inlining a case binder *doesn't* eliminate a binding.</span>
<a name="line-60"></a> <span class='hs-comment'>-- We *don't* want to transform</span>
<a name="line-61"></a> <span class='hs-comment'>-- case x of w { (p,q) -> f w }</span>
<a name="line-62"></a> <span class='hs-comment'>-- into</span>
<a name="line-63"></a> <span class='hs-comment'>-- case x of w { (p,q) -> f (p,q) }</span>
<a name="line-64"></a> <span class='hs-varid'>addCaseBndrUsage</span> <span class='hs-varid'>usage</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupVarEnv</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>bndr</span> <span class='hs-keyword'>of</span>
<a name="line-65"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>usage</span>
<a name="line-66"></a> <span class='hs-conid'>Just</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>extendVarEnv</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>bndr</span> <span class='hs-conid'>NoOccInfo</span>
<a name="line-67"></a>
<a name="line-68"></a> <span class='hs-varid'>alt_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkAltEnv</span> <span class='hs-varid'>env</span> <span class='hs-varid'>bndr_swap</span>
<a name="line-69"></a> <span class='hs-comment'>-- Consider x = case v of { True -> (p,q); ... }</span>
<a name="line-70"></a> <span class='hs-comment'>-- Then it's fine to inline p and q</span>
<a name="line-71"></a>
<a name="line-72"></a> <span class='hs-varid'>bndr_swap</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>scrut</span> <span class='hs-keyword'>of</span>
<a name="line-73"></a> <span class='hs-conid'>Var</span> <span class='hs-varid'>v</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>v</span><span class='hs-layout'>,</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>)</span>
<a name="line-74"></a> <span class='hs-conid'>Cast</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-varid'>co</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>v</span><span class='hs-layout'>,</span> <span class='hs-conid'>Cast</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkSymCoercion</span> <span class='hs-varid'>co</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-75"></a> <span class='hs-sel'>_other</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
<a name="line-76"></a>
<a name="line-77"></a> <span class='hs-varid'>occ_anal_alt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occAnalAlt</span> <span class='hs-varid'>alt_env</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>bndr_swap</span>
<a name="line-78"></a>
<a name="line-79"></a> <span class='hs-varid'>occ_anal_scrut</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>alt1</span> <span class='hs-conop'>:</span> <span class='hs-varid'>other_alts</span><span class='hs-layout'>)</span>
<a name="line-80"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>other_alts</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isDefaultAlt</span> <span class='hs-varid'>alt1</span><span class='hs-layout'>)</span>
<a name="line-81"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkOneOcc</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v</span> <span class='hs-conid'>True</span><span class='hs-layout'>,</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- The 'True' says that the variable occurs</span>
<a name="line-82"></a> <span class='hs-comment'>-- in an interesting context; the case has</span>
<a name="line-83"></a> <span class='hs-comment'>-- at least one non-default alternative</span>
<a name="line-84"></a> <span class='hs-varid'>occ_anal_scrut</span> <span class='hs-varid'>scrut</span> <span class='hs-sel'>_alts</span>
<a name="line-85"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occAnal</span> <span class='hs-layout'>(</span><span class='hs-varid'>vanillaCtxt</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>scrut</span> <span class='hs-comment'>-- No need for rhsCtxt</span>
<a name="line-86"></a>
<a name="line-87"></a><span class='hs-definition'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-varid'>bind</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-88"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>body_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-89"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnalBind</span> <span class='hs-varid'>env</span> <span class='hs-varid'>bind</span> <span class='hs-varid'>body_usage</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>final_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_binds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-90"></a> <span class='hs-layout'>(</span><span class='hs-varid'>final_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkLets</span> <span class='hs-varid'>new_binds</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-91"></a>
<a name="line-92"></a><a name="occAnalArgs"></a><span class='hs-definition'>occAnalArgs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-93"></a><span class='hs-definition'>occAnalArgs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>args</span>
<a name="line-94"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>mapAndUnzip</span> <span class='hs-layout'>(</span><span class='hs-varid'>occAnal</span> <span class='hs-varid'>arg_env</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg_uds_s</span><span class='hs-layout'>,</span> <span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-95"></a> <span class='hs-layout'>(</span><span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varop'>+++</span><span class='hs-layout'>)</span> <span class='hs-varid'>emptyDetails</span> <span class='hs-varid'>arg_uds_s</span><span class='hs-layout'>,</span> <span class='hs-varid'>args'</span><span class='hs-layout'>)</span><span class='hs-layout'>}</span>
<a name="line-96"></a> <span class='hs-keyword'>where</span>
<a name="line-97"></a> <span class='hs-varid'>arg_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vanillaCtxt</span> <span class='hs-varid'>env</span>
</pre>\end{code}
Applications are dealt with specially because we want
the "build hack" to work.
\begin{code}
<pre><a name="line-1"></a><a name="occAnalApp"></a><span class='hs-definition'>occAnalApp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Expr</span> <span class='hs-conid'>CoreBndr</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>CoreBndr</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-conid'>Expr</span> <span class='hs-conid'>CoreBndr</span><span class='hs-layout'>)</span>
<a name="line-4"></a><span class='hs-definition'>occAnalApp</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>fun</span><span class='hs-layout'>,</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-5"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>args_stuff</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>args_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-6"></a> <span class='hs-keyword'>let</span>
<a name="line-7"></a> <span class='hs-varid'>final_args_uds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>markRhsUds</span> <span class='hs-varid'>env</span> <span class='hs-varid'>is_pap</span> <span class='hs-varid'>args_uds</span>
<a name="line-8"></a> <span class='hs-keyword'>in</span>
<a name="line-9"></a> <span class='hs-layout'>(</span><span class='hs-varid'>fun_uds</span> <span class='hs-varop'>+++</span> <span class='hs-varid'>final_args_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>fun</span><span class='hs-layout'>)</span> <span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-10"></a> <span class='hs-keyword'>where</span>
<a name="line-11"></a> <span class='hs-varid'>fun_uniq</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idUnique</span> <span class='hs-varid'>fun</span>
<a name="line-12"></a> <span class='hs-varid'>fun_uds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkOneOcc</span> <span class='hs-varid'>env</span> <span class='hs-varid'>fun</span> <span class='hs-layout'>(</span><span class='hs-varid'>valArgCount</span> <span class='hs-varid'>args</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-varid'>is_pap</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isConLikeId</span> <span class='hs-varid'>fun</span> <span class='hs-varop'>||</span> <span class='hs-varid'>valArgCount</span> <span class='hs-varid'>args</span> <span class='hs-varop'><</span> <span class='hs-varid'>idArity</span> <span class='hs-varid'>fun</span>
<a name="line-14"></a>
<a name="line-15"></a> <span class='hs-comment'>-- Hack for build, fold, runST</span>
<a name="line-16"></a> <span class='hs-varid'>args_stuff</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>fun_uniq</span> <span class='hs-varop'>==</span> <span class='hs-varid'>buildIdKey</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>appSpecial</span> <span class='hs-varid'>env</span> <span class='hs-num'>2</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span><span class='hs-conid'>True</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>args</span>
<a name="line-17"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>fun_uniq</span> <span class='hs-varop'>==</span> <span class='hs-varid'>augmentIdKey</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>appSpecial</span> <span class='hs-varid'>env</span> <span class='hs-num'>2</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span><span class='hs-conid'>True</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>args</span>
<a name="line-18"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>fun_uniq</span> <span class='hs-varop'>==</span> <span class='hs-varid'>foldrIdKey</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>appSpecial</span> <span class='hs-varid'>env</span> <span class='hs-num'>3</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>True</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>args</span>
<a name="line-19"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>fun_uniq</span> <span class='hs-varop'>==</span> <span class='hs-varid'>runSTRepIdKey</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>appSpecial</span> <span class='hs-varid'>env</span> <span class='hs-num'>2</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>True</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>args</span>
<a name="line-20"></a> <span class='hs-comment'>-- (foldr k z xs) may call k many times, but it never</span>
<a name="line-21"></a> <span class='hs-comment'>-- shares a partial application of k; hence [False,True]</span>
<a name="line-22"></a> <span class='hs-comment'>-- This means we can optimise</span>
<a name="line-23"></a> <span class='hs-comment'>-- foldr (\x -> let v = ...x... in \y -> ...v...) z xs</span>
<a name="line-24"></a> <span class='hs-comment'>-- by floating in the v</span>
<a name="line-25"></a>
<a name="line-26"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occAnalArgs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>args</span>
<a name="line-27"></a>
<a name="line-28"></a>
<a name="line-29"></a><span class='hs-definition'>occAnalApp</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>fun</span><span class='hs-layout'>,</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-30"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-layout'>(</span><span class='hs-varid'>addAppCtxt</span> <span class='hs-varid'>env</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-varid'>fun</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>fun_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>fun'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-31"></a> <span class='hs-comment'>-- The addAppCtxt is a bit cunning. One iteration of the simplifier</span>
<a name="line-32"></a> <span class='hs-comment'>-- often leaves behind beta redexs like</span>
<a name="line-33"></a> <span class='hs-comment'>-- (\x y -> e) a1 a2</span>
<a name="line-34"></a> <span class='hs-comment'>-- Here we would like to mark x,y as one-shot, and treat the whole</span>
<a name="line-35"></a> <span class='hs-comment'>-- thing much like a let. We do this by pushing some True items</span>
<a name="line-36"></a> <span class='hs-comment'>-- onto the context stack.</span>
<a name="line-37"></a>
<a name="line-38"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnalArgs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>args</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>args_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-39"></a> <span class='hs-keyword'>let</span>
<a name="line-40"></a> <span class='hs-varid'>final_uds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fun_uds</span> <span class='hs-varop'>+++</span> <span class='hs-varid'>args_uds</span>
<a name="line-41"></a> <span class='hs-keyword'>in</span>
<a name="line-42"></a> <span class='hs-layout'>(</span><span class='hs-varid'>final_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkApps</span> <span class='hs-varid'>fun'</span> <span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-43"></a>
<a name="line-44"></a>
<a name="line-45"></a><a name="markRhsUds"></a><span class='hs-definition'>markRhsUds</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-comment'>-- Check if this is a RhsEnv</span>
<a name="line-46"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- and this is true</span>
<a name="line-47"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span> <span class='hs-comment'>-- The do markMany on this</span>
<a name="line-48"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span>
<a name="line-49"></a><span class='hs-comment'>-- We mark the free vars of the argument of a constructor or PAP</span>
<a name="line-50"></a><span class='hs-comment'>-- as "many", if it is the RHS of a let(rec).</span>
<a name="line-51"></a><span class='hs-comment'>-- This means that nothing gets inlined into a constructor argument</span>
<a name="line-52"></a><span class='hs-comment'>-- position, which is what we want. Typically those constructor</span>
<a name="line-53"></a><span class='hs-comment'>-- arguments are just variables, or trivial expressions.</span>
<a name="line-54"></a><span class='hs-comment'>--</span>
<a name="line-55"></a><span class='hs-comment'>-- This is the *whole point* of the isRhsEnv predicate</span>
<a name="line-56"></a><span class='hs-definition'>markRhsUds</span> <span class='hs-varid'>env</span> <span class='hs-varid'>is_pap</span> <span class='hs-varid'>arg_uds</span>
<a name="line-57"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isRhsEnv</span> <span class='hs-varid'>env</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>is_pap</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapVarEnv</span> <span class='hs-varid'>markMany</span> <span class='hs-varid'>arg_uds</span>
<a name="line-58"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>arg_uds</span>
<a name="line-59"></a>
<a name="line-60"></a>
<a name="line-61"></a><a name="appSpecial"></a><span class='hs-definition'>appSpecial</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span>
<a name="line-62"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CtxtTy</span> <span class='hs-comment'>-- Argument number, and context to use for it</span>
<a name="line-63"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span>
<a name="line-64"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-65"></a><span class='hs-definition'>appSpecial</span> <span class='hs-varid'>env</span> <span class='hs-varid'>n</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>args</span>
<a name="line-66"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>n</span> <span class='hs-varid'>args</span>
<a name="line-67"></a> <span class='hs-keyword'>where</span>
<a name="line-68"></a> <span class='hs-varid'>arg_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vanillaCtxt</span> <span class='hs-varid'>env</span>
<a name="line-69"></a>
<a name="line-70"></a> <span class='hs-varid'>go</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyDetails</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Too few args</span>
<a name="line-71"></a>
<a name="line-72"></a> <span class='hs-varid'>go</span> <span class='hs-num'>1</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg</span><span class='hs-conop'>:</span><span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- The magic arg</span>
<a name="line-73"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-layout'>(</span><span class='hs-varid'>setCtxtTy</span> <span class='hs-varid'>arg_env</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-varid'>arg</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>arg'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-74"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnalArgs</span> <span class='hs-varid'>env</span> <span class='hs-varid'>args</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>args_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-75"></a> <span class='hs-layout'>(</span><span class='hs-varid'>arg_uds</span> <span class='hs-varop'>+++</span> <span class='hs-varid'>args_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>arg'</span><span class='hs-conop'>:</span><span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-76"></a>
<a name="line-77"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>n</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg</span><span class='hs-conop'>:</span><span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-78"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>arg_env</span> <span class='hs-varid'>arg</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>arg'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-79"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>args_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-80"></a> <span class='hs-layout'>(</span><span class='hs-varid'>arg_uds</span> <span class='hs-varop'>+++</span> <span class='hs-varid'>args_uds</span><span class='hs-layout'>,</span> <span class='hs-varid'>arg'</span><span class='hs-conop'>:</span><span class='hs-varid'>args'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
</pre>\end{code}
Note [Binder swap]
~~~~~~~~~~~~~~~~~~
We do these two transformations right here:
(1) case x of b { pi -> ri }
==>
case x of b { pi -> let x=b in ri }
(2) case (x |> co) of b { pi -> ri }
==>
case (x |> co) of b { pi -> let x = b |> sym co in ri }
Why (2)? See Note [Case of cast]
In both cases, in a particular alternative (pi -> ri), we only
add the binding if
(a) x occurs free in (pi -> ri)
(ie it occurs in ri, but is not bound in pi)
(b) the pi does not bind b (or the free vars of co)
We need (a) and (b) for the inserted binding to be correct.
For the alternatives where we inject the binding, we can transfer
all x's OccInfo to b. And that is the point.
Notice that
* The deliberate shadowing of 'x'.
* That (a) rapidly becomes false, so no bindings are injected.
The reason for doing these transformations here is because it allows
us to adjust the OccInfo for 'x' and 'b' as we go.
* Suppose the only occurrences of 'x' are the scrutinee and in the
ri; then this transformation makes it occur just once, and hence
get inlined right away.
* If we do this in the Simplifier, we don't know whether 'x' is used
in ri, so we are forced to pessimistically zap b's OccInfo even
though it is typically dead (ie neither it nor x appear in the
ri). There's nothing actually wrong with zapping it, except that
it's kind of nice to know which variables are dead. My nose
tells me to keep this information as robustly as possible.
The Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding
{x=b}; it's Nothing if the binder-swap doesn't happen.
There is a danger though. Consider
let v = x +# y
in case (f v) of w -> ...v...v...
And suppose that (f v) expands to just v. Then we'd like to
use 'w' instead of 'v' in the alternative. But it may be too
late; we may have substituted the (cheap) x+#y for v in the
same simplifier pass that reduced (f v) to v.
I think this is just too bad. CSE will recover some of it.
Note [Binder swap on GlobalId scrutinees]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When the scrutinee is a GlobalId we must take care in two ways
i) In order to *know* whether 'x' occurs free in the RHS, we need its
occurrence info. BUT, we don't gather occurrence info for
GlobalIds. That's what the (small) occ_scrut_ids set in OccEnv is
for: it says "gather occurrence info for these.
ii) We must call localiseId on 'x' first, in case it's a GlobalId, or
has an External Name. See, for example, SimplEnv Note [Global Ids in
the substitution].
Historical note [no-case-of-case]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We *used* to suppress the binder-swap in case expressoins when
-fno-case-of-case is on. Old remarks:
"This happens in the first simplifier pass,
and enhances full laziness. Here's the bad case:
f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )
If we eliminate the inner case, we trap it inside the I# v -> arm,
which might prevent some full laziness happening. I've seen this
in action in spectral/cichelli/Prog.hs:
[(m,n) | m <- [1..max], n <- [1..max]]
Hence the check for NoCaseOfCase."
However, now the full-laziness pass itself reverses the binder-swap, so this
check is no longer necessary.
Historical note [Suppressing the case binder-swap]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This old note describes a problem that is also fixed by doing the
binder-swap in OccAnal:
There is another situation when it might make sense to suppress the
case-expression binde-swap. If we have
case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }
...other cases .... }
We'll perform the binder-swap for the outer case, giving
case x of w1 { DEFAULT -> case w1 of w2 { A -> e1; B -> e2 }
...other cases .... }
But there is no point in doing it for the inner case, because w1 can't
be inlined anyway. Furthermore, doing the case-swapping involves
zapping w2's occurrence info (see paragraphs that follow), and that
forces us to bind w2 when doing case merging. So we get
case x of w1 { A -> let w2 = w1 in e1
B -> let w2 = w1 in e2
...other cases .... }
This is plain silly in the common case where w2 is dead.
Even so, I can't see a good way to implement this idea. I tried
not doing the binder-swap if the scrutinee was already evaluated
but that failed big-time:
data T = MkT !Int
case v of w { MkT x ->
case x of x1 { I# y1 ->
case x of x2 { I# y2 -> ...
Notice that because MkT is strict, x is marked "evaluated". But to
eliminate the last case, we must either make sure that x (as well as
x1) has unfolding MkT y1. THe straightforward thing to do is to do
the binder-swap. So this whole note is a no-op.
It's fixed by doing the binder-swap in OccAnal because we can do the
binder-swap unconditionally and still get occurrence analysis
information right.
Note [Case of cast]
~~~~~~~~~~~~~~~~~~~
Consider case (x `cast` co) of b { I# ->
... (case (x `cast` co) of {...}) ...
We'd like to eliminate the inner case. That is the motivation for
equation (2) in Note [Binder swap]. When we get to the inner case, we
inline x, cancel the casts, and away we go.
Note [Binders in case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
case x of y { (a,b) -> f y }
We treat 'a', 'b' as dead, because they don't physically occur in the
case alternative. (Indeed, a variable is dead iff it doesn't occur in
its scope in the output of OccAnal.) This invariant is It really
helpe to know when binders are unused. See esp the call to
isDeadBinder in Simplify.mkDupableAlt
In this example, though, the Simplifier will bring 'a' and 'b' back to
life, beause it binds 'y' to (a,b) (imagine got inlined and
scrutinised y).
\begin{code}
<pre><a name="line-1"></a><a name="occAnalAlt"></a><span class='hs-definition'>occAnalAlt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreBndr</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Note [Binder swap]</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreAlt</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-conid'>Alt</span> <span class='hs-conid'>IdWithOccInfo</span><span class='hs-layout'>)</span>
<a name="line-6"></a><span class='hs-definition'>occAnalAlt</span> <span class='hs-varid'>env</span> <span class='hs-varid'>case_bndr</span> <span class='hs-varid'>mb_scrut_var</span> <span class='hs-layout'>(</span><span class='hs-varid'>con</span><span class='hs-layout'>,</span> <span class='hs-varid'>bndrs</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>occAnal</span> <span class='hs-varid'>env</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>rhs_usage</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-8"></a> <span class='hs-keyword'>let</span>
<a name="line-9"></a> <span class='hs-layout'>(</span><span class='hs-varid'>alt_usg</span><span class='hs-layout'>,</span> <span class='hs-varid'>tagged_bndrs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagBinders</span> <span class='hs-varid'>rhs_usage</span> <span class='hs-varid'>bndrs</span>
<a name="line-10"></a> <span class='hs-varid'>bndrs'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagged_bndrs</span> <span class='hs-comment'>-- See Note [Binders in case alternatives]</span>
<a name="line-11"></a> <span class='hs-keyword'>in</span>
<a name="line-12"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>mb_scrut_var</span> <span class='hs-keyword'>of</span>
<a name="line-13"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>scrut_var</span><span class='hs-layout'>,</span> <span class='hs-varid'>scrut_rhs</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- See Note [Binder swap]</span>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>scrut_var</span> <span class='hs-varop'>`localUsedIn`</span> <span class='hs-varid'>alt_usg</span> <span class='hs-comment'>-- (a) Fast path, usually false</span>
<a name="line-15"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>any</span> <span class='hs-varid'>shadowing</span> <span class='hs-varid'>bndrs</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- (b) </span>
<a name="line-16"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>addOneOcc</span> <span class='hs-varid'>usg_wo_scrut</span> <span class='hs-varid'>case_bndr</span> <span class='hs-conid'>NoOccInfo</span><span class='hs-layout'>,</span>
<a name="line-17"></a> <span class='hs-comment'>-- See Note [Case binder usage] for the NoOccInfo</span>
<a name="line-18"></a> <span class='hs-layout'>(</span><span class='hs-varid'>con</span><span class='hs-layout'>,</span> <span class='hs-varid'>bndrs'</span><span class='hs-layout'>,</span> <span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>scrut_var2</span> <span class='hs-varid'>scrut_rhs</span><span class='hs-layout'>)</span> <span class='hs-varid'>rhs'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-keyword'>where</span>
<a name="line-20"></a> <span class='hs-varid'>scrut_var1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLocalId</span> <span class='hs-layout'>(</span><span class='hs-varid'>localiseName</span> <span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>scrut_var</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>scrut_var</span><span class='hs-layout'>)</span>
<a name="line-21"></a> <span class='hs-comment'>-- Localise the scrut_var before shadowing it; we're making a </span>
<a name="line-22"></a> <span class='hs-comment'>-- new binding for it, and it might have an External Name, or</span>
<a name="line-23"></a> <span class='hs-comment'>-- even be a GlobalId; Note [Binder swap on GlobalId scrutinees]</span>
<a name="line-24"></a> <span class='hs-comment'>-- Also we don't want any INLILNE or NOINLINE pragmas!</span>
<a name="line-25"></a>
<a name="line-26"></a> <span class='hs-layout'>(</span><span class='hs-varid'>usg_wo_scrut</span><span class='hs-layout'>,</span> <span class='hs-varid'>scrut_var2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagBinder</span> <span class='hs-varid'>alt_usg</span> <span class='hs-varid'>scrut_var1</span>
<a name="line-27"></a> <span class='hs-varid'>shadowing</span> <span class='hs-varid'>bndr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bndr</span> <span class='hs-varop'>`elemVarSet`</span> <span class='hs-varid'>rhs_fvs</span>
<a name="line-28"></a> <span class='hs-varid'>rhs_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exprFreeVars</span> <span class='hs-varid'>scrut_rhs</span>
<a name="line-29"></a>
<a name="line-30"></a> <span class='hs-sel'>_other</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>alt_usg</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>con</span><span class='hs-layout'>,</span> <span class='hs-varid'>bndrs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[OccurAnal-types]{OccEnv}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="OccEnv"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>OccEnv</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_encl</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>OccEncl</span> <span class='hs-comment'>-- Enclosing context information</span>
<a name="line-3"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>CtxtTy</span> <span class='hs-comment'>-- Tells about linearity</span>
<a name="line-4"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>occ_scrut_ids</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>GblScrutIds</span> <span class='hs-layout'>}</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="GblScrutIds"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>GblScrutIds</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>IdSet</span> <span class='hs-comment'>-- GlobalIds that are scrutinised, and for which</span>
<a name="line-7"></a> <span class='hs-comment'>-- we want to gather occurence info; see</span>
<a name="line-8"></a> <span class='hs-comment'>-- Note [Binder swap for GlobalId scrutinee]</span>
<a name="line-9"></a> <span class='hs-comment'>-- No need to prune this if there's a shadowing binding</span>
<a name="line-10"></a> <span class='hs-comment'>-- because it's OK for it to be too big</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-comment'>-- OccEncl is used to control whether to inline into constructor arguments</span>
<a name="line-13"></a><span class='hs-comment'>-- For example:</span>
<a name="line-14"></a><span class='hs-comment'>-- x = (p,q) -- Don't inline p or q</span>
<a name="line-15"></a><span class='hs-comment'>-- y = /\a -> (p a, q a) -- Still don't inline p or q</span>
<a name="line-16"></a><span class='hs-comment'>-- z = f (p,q) -- Do inline p,q; it may make a rule fire</span>
<a name="line-17"></a><span class='hs-comment'>-- So OccEncl tells enought about the context to know what to do when</span>
<a name="line-18"></a><span class='hs-comment'>-- we encounter a contructor application or PAP.</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="OccEncl"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>OccEncl</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccRhs</span> <span class='hs-comment'>-- RHS of let(rec), albeit perhaps inside a type lambda</span>
<a name="line-22"></a> <span class='hs-comment'>-- Don't inline into constructor args here</span>
<a name="line-23"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>OccVanilla</span> <span class='hs-comment'>-- Argument of function, body of lambda, scruintee of case etc.</span>
<a name="line-24"></a> <span class='hs-comment'>-- Do inline into constructor args here</span>
<a name="line-25"></a>
<a name="line-26"></a><a name="CtxtTy"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>CtxtTy</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Bool</span><span class='hs-keyglyph'>]</span>
<a name="line-27"></a> <span class='hs-comment'>-- [] No info</span>
<a name="line-28"></a> <span class='hs-comment'>--</span>
<a name="line-29"></a> <span class='hs-comment'>-- True:ctxt Analysing a function-valued expression that will be</span>
<a name="line-30"></a> <span class='hs-comment'>-- applied just once</span>
<a name="line-31"></a> <span class='hs-comment'>--</span>
<a name="line-32"></a> <span class='hs-comment'>-- False:ctxt Analysing a function-valued expression that may</span>
<a name="line-33"></a> <span class='hs-comment'>-- be applied many times; but when it is,</span>
<a name="line-34"></a> <span class='hs-comment'>-- the CtxtTy inside applies</span>
<a name="line-35"></a>
<a name="line-36"></a><a name="initOccEnv"></a><span class='hs-definition'>initOccEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span>
<a name="line-37"></a><span class='hs-definition'>initOccEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_encl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccRhs</span>
<a name="line-38"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-39"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>occ_scrut_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyVarSet</span> <span class='hs-layout'>}</span>
<a name="line-40"></a>
<a name="line-41"></a><a name="vanillaCtxt"></a><span class='hs-definition'>vanillaCtxt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccEnv</span>
<a name="line-42"></a><span class='hs-definition'>vanillaCtxt</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_encl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccVanilla</span><span class='hs-layout'>,</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-43"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>occ_scrut_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occ_scrut_ids</span> <span class='hs-varid'>env</span> <span class='hs-layout'>}</span>
<a name="line-44"></a>
<a name="line-45"></a><a name="rhsCtxt"></a><span class='hs-definition'>rhsCtxt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccEnv</span>
<a name="line-46"></a><span class='hs-definition'>rhsCtxt</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_encl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccRhs</span><span class='hs-layout'>,</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-47"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>occ_scrut_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occ_scrut_ids</span> <span class='hs-varid'>env</span> <span class='hs-layout'>}</span>
<a name="line-48"></a>
<a name="line-49"></a><a name="mkAltEnv"></a><span class='hs-definition'>mkAltEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccEnv</span>
<a name="line-50"></a><span class='hs-comment'>-- Does two things: a) makes the occ_ctxt = OccVanilla</span>
<a name="line-51"></a><span class='hs-comment'>-- b) extends the scrut_ids if necessary</span>
<a name="line-52"></a><span class='hs-definition'>mkAltEnv</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>scrut_id</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-53"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isLocalId</span> <span class='hs-varid'>scrut_id</span><span class='hs-layout'>)</span>
<a name="line-54"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_encl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccVanilla</span>
<a name="line-55"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>occ_scrut_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendVarSet</span> <span class='hs-layout'>(</span><span class='hs-varid'>occ_scrut_ids</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>scrut_id</span>
<a name="line-56"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-varid'>env</span> <span class='hs-layout'>}</span>
<a name="line-57"></a><span class='hs-definition'>mkAltEnv</span> <span class='hs-varid'>env</span> <span class='hs-keyword'>_</span>
<a name="line-58"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isRhsEnv</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_encl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccVanilla</span> <span class='hs-layout'>}</span>
<a name="line-59"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span>
<a name="line-60"></a>
<a name="line-61"></a><a name="setCtxtTy"></a><span class='hs-definition'>setCtxtTy</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CtxtTy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccEnv</span>
<a name="line-62"></a><span class='hs-definition'>setCtxtTy</span> <span class='hs-varid'>env</span> <span class='hs-varid'>ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>}</span>
<a name="line-63"></a>
<a name="line-64"></a><a name="isRhsEnv"></a><span class='hs-definition'>isRhsEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-65"></a><span class='hs-definition'>isRhsEnv</span> <span class='hs-layout'>(</span><span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_encl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccRhs</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-66"></a><span class='hs-definition'>isRhsEnv</span> <span class='hs-layout'>(</span><span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_encl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OccVanilla</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-67"></a>
<a name="line-68"></a><a name="oneShotGroup"></a><span class='hs-definition'>oneShotGroup</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBndr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBndr</span><span class='hs-keyglyph'>]</span>
<a name="line-69"></a> <span class='hs-comment'>-- The result binders have one-shot-ness set that they might not have had originally.</span>
<a name="line-70"></a> <span class='hs-comment'>-- This happens in (build (\cn -> e)). Here the occurrence analyser</span>
<a name="line-71"></a> <span class='hs-comment'>-- linearity context knows that c,n are one-shot, and it records that fact in</span>
<a name="line-72"></a> <span class='hs-comment'>-- the binder. This is useful to guide subsequent float-in/float-out tranformations</span>
<a name="line-73"></a>
<a name="line-74"></a><span class='hs-definition'>oneShotGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-varid'>bndrs</span>
<a name="line-75"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>bndrs</span> <span class='hs-conid'>[]</span>
<a name="line-76"></a> <span class='hs-keyword'>where</span>
<a name="line-77"></a> <span class='hs-varid'>go</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>rev_bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>reverse</span> <span class='hs-varid'>rev_bndrs</span>
<a name="line-78"></a>
<a name="line-79"></a> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>lin_ctxt</span><span class='hs-conop'>:</span><span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>bndr</span><span class='hs-conop'>:</span><span class='hs-varid'>bndrs</span><span class='hs-layout'>)</span> <span class='hs-varid'>rev_bndrs</span>
<a name="line-80"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isId</span> <span class='hs-varid'>bndr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>bndrs</span> <span class='hs-layout'>(</span><span class='hs-varid'>bndr'</span><span class='hs-conop'>:</span><span class='hs-varid'>rev_bndrs</span><span class='hs-layout'>)</span>
<a name="line-81"></a> <span class='hs-keyword'>where</span>
<a name="line-82"></a> <span class='hs-varid'>bndr'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>lin_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setOneShotLambda</span> <span class='hs-varid'>bndr</span>
<a name="line-83"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bndr</span>
<a name="line-84"></a>
<a name="line-85"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>bndr</span><span class='hs-conop'>:</span><span class='hs-varid'>bndrs</span><span class='hs-layout'>)</span> <span class='hs-varid'>rev_bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>bndrs</span> <span class='hs-layout'>(</span><span class='hs-varid'>bndr</span><span class='hs-conop'>:</span><span class='hs-varid'>rev_bndrs</span><span class='hs-layout'>)</span>
<a name="line-86"></a>
<a name="line-87"></a><a name="addAppCtxt"></a><span class='hs-definition'>addAppCtxt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>CoreBndr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccEnv</span>
<a name="line-88"></a><span class='hs-definition'>addAppCtxt</span> <span class='hs-varid'>env</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>OccEnv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span>
<a name="line-89"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span> <span class='hs-layout'>{</span> <span class='hs-varid'>occ_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>replicate</span> <span class='hs-layout'>(</span><span class='hs-varid'>valArgCount</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-conid'>True</span> <span class='hs-varop'>++</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[OccurAnal-types]{OccEnv}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="UsageDetails"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>UsageDetails</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>IdEnv</span> <span class='hs-conid'>OccInfo</span> <span class='hs-comment'>-- A finite map from ids to their usage</span>
<a name="line-2"></a> <span class='hs-comment'>-- INVARIANT: never IAmDead</span>
<a name="line-3"></a> <span class='hs-comment'>-- (Deadness is signalled by not being in the map at all)</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="+++"></a><span class='hs-layout'>(</span><span class='hs-varop'>+++</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>combineAltsUsageDetails</span>
<a name="line-6"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-layout'>(</span><span class='hs-varop'>+++</span><span class='hs-layout'>)</span> <span class='hs-varid'>usage1</span> <span class='hs-varid'>usage2</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>plusVarEnv_C</span> <span class='hs-varid'>addOccInfo</span> <span class='hs-varid'>usage1</span> <span class='hs-varid'>usage2</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="combineAltsUsageDetails"></a><span class='hs-definition'>combineAltsUsageDetails</span> <span class='hs-varid'>usage1</span> <span class='hs-varid'>usage2</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>plusVarEnv_C</span> <span class='hs-varid'>orOccInfo</span> <span class='hs-varid'>usage1</span> <span class='hs-varid'>usage2</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="addOneOcc"></a><span class='hs-definition'>addOneOcc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span>
<a name="line-15"></a><span class='hs-definition'>addOneOcc</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>id</span> <span class='hs-varid'>info</span>
<a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>plusVarEnv_C</span> <span class='hs-varid'>addOccInfo</span> <span class='hs-varid'>usage</span> <span class='hs-layout'>(</span><span class='hs-varid'>unitVarEnv</span> <span class='hs-varid'>id</span> <span class='hs-varid'>info</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-comment'>-- ToDo: make this more efficient</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="emptyDetails"></a><span class='hs-definition'>emptyDetails</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span>
<a name="line-20"></a><span class='hs-definition'>emptyDetails</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyVarEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span><span class='hs-layout'>)</span>
<a name="line-21"></a>
<a name="line-22"></a><a name="localUsedIn"></a><span class='hs-definition'>localUsedIn</span><span class='hs-layout'>,</span> <span class='hs-varid'>usedIn</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-23"></a><a name="localUsedIn"></a><span class='hs-definition'>v</span> <span class='hs-varop'>`localUsedIn`</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>v</span> <span class='hs-varop'>`elemVarEnv`</span> <span class='hs-varid'>details</span>
<a name="line-24"></a><a name="usedIn"></a><span class='hs-definition'>v</span> <span class='hs-varop'>`usedIn`</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isExportedId</span> <span class='hs-varid'>v</span> <span class='hs-varop'>||</span> <span class='hs-varid'>v</span> <span class='hs-varop'>`localUsedIn`</span> <span class='hs-varid'>details</span>
<a name="line-25"></a>
<a name="line-26"></a><a name="IdWithOccInfo"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>IdWithOccInfo</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Id</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="tagBinders"></a><span class='hs-definition'>tagBinders</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span> <span class='hs-comment'>-- Of scope</span>
<a name="line-29"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Binders</span>
<a name="line-30"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Details with binders removed</span>
<a name="line-31"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>IdWithOccInfo</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Tagged binders</span>
<a name="line-32"></a>
<a name="line-33"></a><span class='hs-definition'>tagBinders</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>binders</span>
<a name="line-34"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-35"></a> <span class='hs-varid'>usage'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>usage</span> <span class='hs-varop'>`delVarEnvList`</span> <span class='hs-varid'>binders</span>
<a name="line-36"></a> <span class='hs-varid'>uss</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>setBinderOcc</span> <span class='hs-varid'>usage</span><span class='hs-layout'>)</span> <span class='hs-varid'>binders</span>
<a name="line-37"></a> <span class='hs-keyword'>in</span>
<a name="line-38"></a> <span class='hs-varid'>usage'</span> <span class='hs-varop'>`seq`</span> <span class='hs-layout'>(</span><span class='hs-varid'>usage'</span><span class='hs-layout'>,</span> <span class='hs-varid'>uss</span><span class='hs-layout'>)</span>
<a name="line-39"></a>
<a name="line-40"></a><a name="tagBinder"></a><span class='hs-definition'>tagBinder</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span> <span class='hs-comment'>-- Of scope</span>
<a name="line-41"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Binders</span>
<a name="line-42"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageDetails</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Details with binders removed</span>
<a name="line-43"></a> <span class='hs-conid'>IdWithOccInfo</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Tagged binders</span>
<a name="line-44"></a>
<a name="line-45"></a><span class='hs-definition'>tagBinder</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>binder</span>
<a name="line-46"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-47"></a> <span class='hs-varid'>usage'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>usage</span> <span class='hs-varop'>`delVarEnv`</span> <span class='hs-varid'>binder</span>
<a name="line-48"></a> <span class='hs-varid'>binder'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setBinderOcc</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>binder</span>
<a name="line-49"></a> <span class='hs-keyword'>in</span>
<a name="line-50"></a> <span class='hs-varid'>usage'</span> <span class='hs-varop'>`seq`</span> <span class='hs-layout'>(</span><span class='hs-varid'>usage'</span><span class='hs-layout'>,</span> <span class='hs-varid'>binder'</span><span class='hs-layout'>)</span>
<a name="line-51"></a>
<a name="line-52"></a><a name="setBinderOcc"></a><span class='hs-definition'>setBinderOcc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UsageDetails</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreBndr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreBndr</span>
<a name="line-53"></a><span class='hs-definition'>setBinderOcc</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>bndr</span>
<a name="line-54"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isTyVar</span> <span class='hs-varid'>bndr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bndr</span>
<a name="line-55"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isExportedId</span> <span class='hs-varid'>bndr</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>idOccInfo</span> <span class='hs-varid'>bndr</span> <span class='hs-keyword'>of</span>
<a name="line-56"></a> <span class='hs-conid'>NoOccInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>bndr</span>
<a name="line-57"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>setIdOccInfo</span> <span class='hs-varid'>bndr</span> <span class='hs-conid'>NoOccInfo</span>
<a name="line-58"></a> <span class='hs-comment'>-- Don't use local usage info for visible-elsewhere things</span>
<a name="line-59"></a> <span class='hs-comment'>-- BUT *do* erase any IAmALoopBreaker annotation, because we're</span>
<a name="line-60"></a> <span class='hs-comment'>-- about to re-generate it and it shouldn't be "sticky"</span>
<a name="line-61"></a>
<a name="line-62"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setIdOccInfo</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>occ_info</span>
<a name="line-63"></a> <span class='hs-keyword'>where</span>
<a name="line-64"></a> <span class='hs-varid'>occ_info</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lookupVarEnv</span> <span class='hs-varid'>usage</span> <span class='hs-varid'>bndr</span> <span class='hs-varop'>`orElse`</span> <span class='hs-conid'>IAmDead</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Operations over OccInfo}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="mkOneOcc"></a><span class='hs-definition'>mkOneOcc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>InterestingCxt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UsageDetails</span>
<a name="line-2"></a><span class='hs-definition'>mkOneOcc</span> <span class='hs-varid'>env</span> <span class='hs-varid'>id</span> <span class='hs-varid'>int_cxt</span>
<a name="line-3"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isLocalId</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unitVarEnv</span> <span class='hs-varid'>id</span> <span class='hs-layout'>(</span><span class='hs-conid'>OneOcc</span> <span class='hs-conid'>False</span> <span class='hs-conid'>True</span> <span class='hs-varid'>int_cxt</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>id</span> <span class='hs-varop'>`elemVarSet`</span> <span class='hs-varid'>occ_scrut_ids</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unitVarEnv</span> <span class='hs-varid'>id</span> <span class='hs-conid'>NoOccInfo</span>
<a name="line-5"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyDetails</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="markMany"></a><span class='hs-definition'>markMany</span><span class='hs-layout'>,</span> <span class='hs-varid'>markInsideLam</span><span class='hs-layout'>,</span> <span class='hs-varid'>markInsideSCC</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccInfo</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-definition'>markMany</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>NoOccInfo</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="markInsideSCC"></a><span class='hs-definition'>markInsideSCC</span> <span class='hs-varid'>occ</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>markMany</span> <span class='hs-varid'>occ</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="markInsideLam"></a><span class='hs-definition'>markInsideLam</span> <span class='hs-layout'>(</span><span class='hs-conid'>OneOcc</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>one_br</span> <span class='hs-varid'>int_cxt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OneOcc</span> <span class='hs-conid'>True</span> <span class='hs-varid'>one_br</span> <span class='hs-varid'>int_cxt</span>
<a name="line-14"></a><span class='hs-definition'>markInsideLam</span> <span class='hs-varid'>occ</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occ</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="addOccInfo"></a><span class='hs-definition'>addOccInfo</span><span class='hs-layout'>,</span> <span class='hs-varid'>orOccInfo</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccInfo</span>
<a name="line-17"></a>
<a name="line-18"></a><span class='hs-definition'>addOccInfo</span> <span class='hs-varid'>a1</span> <span class='hs-varid'>a2</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isDeadOcc</span> <span class='hs-varid'>a1</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isDeadOcc</span> <span class='hs-varid'>a2</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-conid'>NoOccInfo</span> <span class='hs-comment'>-- Both branches are at least One</span>
<a name="line-20"></a> <span class='hs-comment'>-- (Argument is never IAmDead)</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-comment'>-- (orOccInfo orig new) is used</span>
<a name="line-23"></a><span class='hs-comment'>-- when combining occurrence info from branches of a case</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="orOccInfo"></a><span class='hs-definition'>orOccInfo</span> <span class='hs-layout'>(</span><span class='hs-conid'>OneOcc</span> <span class='hs-varid'>in_lam1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>int_cxt1</span><span class='hs-layout'>)</span>
<a name="line-26"></a> <span class='hs-layout'>(</span><span class='hs-conid'>OneOcc</span> <span class='hs-varid'>in_lam2</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>int_cxt2</span><span class='hs-layout'>)</span>
<a name="line-27"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OneOcc</span> <span class='hs-layout'>(</span><span class='hs-varid'>in_lam1</span> <span class='hs-varop'>||</span> <span class='hs-varid'>in_lam2</span><span class='hs-layout'>)</span>
<a name="line-28"></a> <span class='hs-conid'>False</span> <span class='hs-comment'>-- False, because it occurs in both branches</span>
<a name="line-29"></a> <span class='hs-layout'>(</span><span class='hs-varid'>int_cxt1</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>int_cxt2</span><span class='hs-layout'>)</span>
<a name="line-30"></a><span class='hs-definition'>orOccInfo</span> <span class='hs-varid'>a1</span> <span class='hs-varid'>a2</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isDeadOcc</span> <span class='hs-varid'>a1</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isDeadOcc</span> <span class='hs-varid'>a2</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-31"></a> <span class='hs-conid'>NoOccInfo</span>
</pre>\end{code}
</body>
</html>
