2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 %************************************************************************
6 \section[BinderInfo]{Information attached to binders by SubstAnal}
8 %************************************************************************
11 #include "HsVersions.h"
15 FunOrArg, DuplicationDanger, InsideSCC, -- NB: all abstract (yay!)
17 inlineUnconditionally, okToInline,
19 addBinderInfo, orBinderInfo, andBinderInfo,
21 argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
22 markMany, markDangerousToDup, markInsideSCC,
24 setBinderInfoArityToZero,
26 isFun, isDupDanger -- for Simon Marlow deforestation
31 import CoreUnfold ( FormSummary(..) )
36 The @BinderInfo@ describes how a variable is used in a given scope.
38 NOTE: With SCCs we have to be careful what we unfold! We don't want to
39 change the attribution of execution costs. If we decide to unfold
40 within an SCC we can tag the definition as @DontKeepBinder@.
41 Definitions tagged as @KeepBinder@ are discarded when we enter the
46 = DeadCode -- Dead code; discard the binding.
48 | ManyOcc -- Everything else besides DeadCode and OneOccs
50 Int -- number of arguments on stack when called; this is a minimum guarantee
53 | OneOcc -- Just one occurrence (or one each in
54 -- mutually-exclusive case alts).
56 FunOrArg -- How it occurs
62 Int -- Number of mutually-exclusive case alternatives
65 -- Note that we only worry about the case-alt counts
66 -- if the OneOcc is substitutable -- that's the only
67 -- time we *use* the info; we could be more clever for
68 -- other cases if we really had to. (WDP/PS)
70 Int -- number of arguments on stack when called; minimum guarantee
72 -- In general, we are feel free to substitute unless
73 -- (a) is in an argument position (ArgOcc)
74 -- (b) is inside a lambda [or type lambda?] (DupDanger)
75 -- (c) is inside an SCC expression (InsideSCC)
76 -- (d) is in the RHS of a binding for a variable with an INLINE pragma
77 -- (because the RHS will be inlined regardless of its size)
81 = FunOcc -- An occurrence in a function position
82 | ArgOcc -- Other arg occurrence
84 -- When combining branches of a case, only report FunOcc if
85 -- both branches are FunOccs
87 data DuplicationDanger
88 = DupDanger -- Inside a non-linear lambda (that is, a lambda which
89 -- is sure to be instantiated only once), or inside
90 -- the rhs of an INLINE-pragma'd thing. Either way,
91 -- substituting a redex for this occurrence is
92 -- dangerous because it might duplicate work.
94 | NoDupDanger -- It's ok; substitution won't duplicate work.
97 = InsideSCC -- Inside an SCC; so be careful when substituting.
98 | NotInsideSCC -- It's ok.
100 noBinderInfo = ManyOcc 0 -- A non-committal value
109 :: FormSummary -- What the thing to be inlined is like
110 -> BinderInfo -- How the thing to be inlined occurs
111 -> Bool -- True => it's small enough to inline
112 -> Bool -- True => yes, inline it
114 -- Always inline bottoms
115 okToInline BottomForm occ_info small_enough
116 = True -- Unless one of the type args is unboxed??
117 -- This used to be checked for, but I can't
118 -- see why so I've left it out.
120 -- A WHNF can be inlined if it occurs once, or is small
121 okToInline form occ_info small_enough
123 = small_enough || one_occ
125 one_occ = case occ_info of
126 OneOcc _ _ _ n_alts _ -> n_alts <= 1
129 is_whnf_form VarForm = True
130 is_whnf_form ValueForm = True
131 is_whnf_form other = False
133 -- A non-WHNF can be inlined if it doesn't occur inside a lambda,
134 -- and occurs exactly once or
135 -- occurs once in each branch of a case and is small
136 okToInline OtherForm (OneOcc _ NoDupDanger _ n_alts _) small_enough
137 = n_alts <= 1 || small_enough
139 okToInline form any_occ small_enough = False
142 @inlineUnconditionally@ decides whether a let-bound thing can
143 definitely be inlined.
146 inlineUnconditionally :: Bool -> BinderInfo -> Bool
148 --inlineUnconditionally ok_to_dup DeadCode = True
149 inlineUnconditionally ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alt_occs _)
150 = n_alt_occs <= 1 || ok_to_dup
151 -- We [i.e., Patrick] don't mind the code explosion,
152 -- though. We could have a flag to limit the
153 -- damage, e.g., limit to M alternatives.
155 inlineUnconditionally _ _ = False
159 isFun :: FunOrArg -> Bool
163 isDupDanger :: DuplicationDanger -> Bool
164 isDupDanger DupDanger = True
165 isDupDanger _ = False
172 argOccurrence, funOccurrence :: Int -> BinderInfo
174 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
175 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
177 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
179 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
180 markMany (ManyOcc ar) = ManyOcc ar
181 markMany DeadCode = panic "markMany"
183 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
184 = OneOcc posn DupDanger in_scc n_alts ar
185 markDangerousToDup other = other
187 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
189 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
190 = OneOcc posn dup_danger InsideSCC n_alts ar
191 markInsideSCC other = other
193 addBinderInfo, orBinderInfo
194 :: BinderInfo -> BinderInfo -> BinderInfo
196 addBinderInfo DeadCode info2 = info2
197 addBinderInfo info1 DeadCode = info1
198 addBinderInfo info1 info2
199 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
201 -- (orBinderInfo orig new) is used when combining occurrence
202 -- info from branches of a case
204 orBinderInfo DeadCode info2 = info2
205 orBinderInfo info1 DeadCode = info1
206 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
207 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
208 = OneOcc (combine_posns posn1 posn2)
209 (combine_dups dup1 dup2)
210 (combine_sccs scc1 scc2)
213 orBinderInfo info1 info2
214 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
216 -- (andBinderInfo orig new) is used in two situations:
217 -- First, when a variable whose occurrence info
218 -- is currently "orig" is bound to a variable whose occurrence info is "new"
219 -- eg (\new -> e) orig
220 -- What we want to do is to *worsen* orig's info to take account of new's
222 -- second, when completing a let-binding
223 -- let new = ...orig...
224 -- we compute the way orig occurs in (...orig...), and then use orBinderInfo
225 -- to worsen this info by the way new occurs in the let body; then we use
226 -- that to worsen orig's currently recorded occurrence info.
228 andBinderInfo DeadCode info2 = DeadCode
229 andBinderInfo info1 DeadCode = DeadCode
230 andBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
231 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
232 = OneOcc (combine_posns posn1 posn2)
233 (combine_dups dup1 dup2)
234 (combine_sccs scc1 scc2)
236 ar_1 -- Min arity just from orig
237 andBinderInfo info1 info2 = ManyOcc (getBinderInfoArity info1)
240 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
241 combine_posns _ _ = ArgOcc
243 combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
244 combine_dups _ DupDanger = DupDanger
245 combine_dups _ _ = NoDupDanger
247 combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
248 combine_sccs _ InsideSCC = InsideSCC
249 combine_sccs _ _ = NotInsideSCC
251 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
252 setBinderInfoArityToZero DeadCode = DeadCode
253 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
254 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
258 getBinderInfoArity (DeadCode) = 0
259 getBinderInfoArity (ManyOcc i) = i
260 getBinderInfoArity (OneOcc _ _ _ _ i) = i
264 instance Outputable BinderInfo where
265 ppr sty DeadCode = ppStr "Dead"
266 ppr sty (ManyOcc ar) = ppBesides [ ppStr "Many-", ppInt ar ]
267 ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
268 = ppBesides [ ppStr "One-", pp_posn posn, ppChar '-', pp_danger dup_danger,
269 ppChar '-', pp_scc in_scc, ppChar '-', ppInt n_alts,
270 ppChar '-', ppInt ar ]
272 pp_posn FunOcc = ppStr "fun"
273 pp_posn ArgOcc = ppStr "arg"
275 pp_danger DupDanger = ppStr "*dup*"
276 pp_danger NoDupDanger = ppStr "nodup"
278 pp_scc InsideSCC = ppStr "*SCC*"
279 pp_scc NotInsideSCC = ppStr "noscc"