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 addBinderInfo, orBinderInfo, andBinderInfo,
19 argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
20 markMany, markDangerousToDup, markInsideSCC,
22 setBinderInfoArityToZero,
24 isFun, isDupDanger -- for Simon Marlow deforestation
31 #if __GLASGOW_HASKELL__ >= 202
37 The @BinderInfo@ describes how a variable is used in a given scope.
39 NOTE: With SCCs we have to be careful what we unfold! We don't want to
40 change the attribution of execution costs. If we decide to unfold
41 within an SCC we can tag the definition as @DontKeepBinder@.
42 Definitions tagged as @KeepBinder@ are discarded when we enter the
47 = DeadCode -- Dead code; discard the binding.
49 | ManyOcc -- Everything else besides DeadCode and OneOccs
51 Int -- number of arguments on stack when called; this is a minimum guarantee
54 | OneOcc -- Just one occurrence (or one each in
55 -- mutually-exclusive case alts).
57 FunOrArg -- How it occurs
63 Int -- Number of mutually-exclusive case alternatives
66 -- Note that we only worry about the case-alt counts
67 -- if the OneOcc is substitutable -- that's the only
68 -- time we *use* the info; we could be more clever for
69 -- other cases if we really had to. (WDP/PS)
71 Int -- number of arguments on stack when called; minimum guarantee
73 -- In general, we are feel free to substitute unless
74 -- (a) is in an argument position (ArgOcc)
75 -- (b) is inside a lambda [or type lambda?] (DupDanger)
76 -- (c) is inside an SCC expression (InsideSCC)
77 -- (d) is in the RHS of a binding for a variable with an INLINE pragma
78 -- (because the RHS will be inlined regardless of its size)
82 = FunOcc -- An occurrence in a function position
83 | ArgOcc -- Other arg occurrence
85 -- When combining branches of a case, only report FunOcc if
86 -- both branches are FunOccs
88 data DuplicationDanger
89 = DupDanger -- Inside a non-linear lambda (that is, a lambda which
90 -- is sure to be instantiated only once), or inside
91 -- the rhs of an INLINE-pragma'd thing. Either way,
92 -- substituting a redex for this occurrence is
93 -- dangerous because it might duplicate work.
95 | NoDupDanger -- It's ok; substitution won't duplicate work.
98 = InsideSCC -- Inside an SCC; so be careful when substituting.
99 | NotInsideSCC -- It's ok.
101 noBinderInfo = ManyOcc 0 -- A non-committal value
107 isFun :: FunOrArg -> Bool
111 isDupDanger :: DuplicationDanger -> Bool
112 isDupDanger DupDanger = True
113 isDupDanger _ = False
116 @inlineUnconditionally@ decides whether a let-bound thing can
117 definitely be inlined.
122 inlineUnconditionally :: Bool -> BinderInfo -> Bool
124 --inlineUnconditionally ok_to_dup DeadCode = True
125 inlineUnconditionally ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alt_occs _)
126 = n_alt_occs <= 1 || ok_to_dup
127 -- We [i.e., Patrick] don't mind the code explosion,
128 -- though. We could have a flag to limit the
129 -- damage, e.g., limit to M alternatives.
131 inlineUnconditionally _ _ = False
139 argOccurrence, funOccurrence :: Int -> BinderInfo
141 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
142 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
144 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
146 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
147 markMany (ManyOcc ar) = ManyOcc ar
148 markMany DeadCode = panic "markMany"
150 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
151 = OneOcc posn DupDanger in_scc n_alts ar
152 markDangerousToDup other = other
154 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
156 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
157 = OneOcc posn dup_danger InsideSCC n_alts ar
158 markInsideSCC other = other
160 addBinderInfo, orBinderInfo
161 :: BinderInfo -> BinderInfo -> BinderInfo
163 addBinderInfo DeadCode info2 = info2
164 addBinderInfo info1 DeadCode = info1
165 addBinderInfo info1 info2
166 = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
167 (I# i#) -> ManyOcc (I# i#)
168 -- ManyOcc min (getBinderInfoArity info1) (getBinderInfoArity info2))
170 -- (orBinderInfo orig new) is used when combining occurrence
171 -- info from branches of a case
173 orBinderInfo DeadCode info2 = info2
174 orBinderInfo info1 DeadCode = info1
175 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
176 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
178 -- Seriously maligned in order to make it stricter,
179 -- let's hope it is worth it..
180 posn = combine_posns posn1 posn2
181 scc = combine_sccs scc1 scc2
182 dup = combine_dups dup1 dup2
183 alts = n_alts1 + n_alts2
187 cont1 = case scc of { InsideSCC -> cont2; _ -> cont2 }
188 cont2 = case dup of { DupDanger -> cont3; _ -> cont3 }
189 cont3 = case alts of { (I# 0#) -> cont4; _ -> cont4 }
190 cont4 = case ar of { (I# 0#) -> cont5; _ -> cont5 }
191 cont5 = OneOcc posn dup scc alts ar
193 case posn of { FunOcc -> cont1; _ -> cont1 }
194 orBinderInfo info1 info2
195 = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
196 (I# i#) -> ManyOcc (I# i#)
198 -- (andBinderInfo orig new) is used in two situations:
199 -- First, when a variable whose occurrence info
200 -- is currently "orig" is bound to a variable whose occurrence info is "new"
201 -- eg (\new -> e) orig
202 -- What we want to do is to *worsen* orig's info to take account of new's
204 -- second, when completing a let-binding
205 -- let new = ...orig...
206 -- we compute the way orig occurs in (...orig...), and then use orBinderInfo
207 -- to worsen this info by the way new occurs in the let body; then we use
208 -- that to worsen orig's currently recorded occurrence info.
210 andBinderInfo DeadCode info2 = DeadCode
211 andBinderInfo info1 DeadCode = DeadCode
212 andBinderInfo (OneOcc posn1 dup1 scc1 (I# n_alts1#) (I# ar_1#))
213 (OneOcc posn2 dup2 scc2 (I# n_alts2#) ar_2)
215 -- Perversly maligned in order to make it stricter.
216 posn = combine_posns posn1 posn2
217 scc = combine_sccs scc1 scc2
218 dup = combine_dups dup1 dup2
219 alts = I# (n_alts1# +# n_alts2#)
222 cont1 = case scc of { InsideSCC -> cont2; _ -> cont2 }
223 cont2 = case dup of { DupDanger -> cont3; _ -> cont3 }
224 cont3 = case alts of { (I# 0#) -> cont4; _ -> cont4 }
225 cont4 = OneOcc posn dup scc alts (I# ar_1#)
227 case posn of {FunOcc -> cont1; _ -> cont1}
229 andBinderInfo info1 info2 =
230 case getBinderInfoArity info1 of
231 (I# i#) -> ManyOcc (I# i#)
232 --ManyOcc (getBinderInfoArity info1)
235 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
236 combine_posns _ _ = ArgOcc
238 combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
239 combine_dups _ DupDanger = DupDanger
240 combine_dups _ _ = NoDupDanger
242 combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
243 combine_sccs _ InsideSCC = InsideSCC
244 combine_sccs _ _ = NotInsideSCC
246 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
247 setBinderInfoArityToZero DeadCode = DeadCode
248 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
249 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
253 getBinderInfoArity (DeadCode) = 0
254 getBinderInfoArity (ManyOcc i) = i
255 getBinderInfoArity (OneOcc _ _ _ _ i) = i
259 instance Outputable BinderInfo where
260 ppr sty DeadCode = ptext SLIT("Dead")
261 ppr sty (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
262 ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
263 = hcat [ ptext SLIT("One-"), pp_posn posn, char '-', pp_danger dup_danger,
264 char '-', pp_scc in_scc, char '-', int n_alts,
267 pp_posn FunOcc = ptext SLIT("fun")
268 pp_posn ArgOcc = ptext SLIT("arg")
270 pp_danger DupDanger = ptext SLIT("*dup*")
271 pp_danger NoDupDanger = ptext SLIT("nodup")
273 pp_scc InsideSCC = ptext SLIT("*SCC*")
274 pp_scc NotInsideSCC = ptext SLIT("noscc")