2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 %************************************************************************
6 \section[BinderInfo]{Information attached to binders by SubstAnal}
8 %************************************************************************
13 FunOrArg, DuplicationDanger, InsideSCC, -- NB: all abstract (yay!)
15 addBinderInfo, orBinderInfo, andBinderInfo,
17 deadOccurrence, argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
19 markMany, markDangerousToDup, markInsideSCC,
21 setBinderInfoArityToZero,
23 okToInline, isOneOcc, isOneFunOcc, isOneSafeFunOcc, isDeadOcc,
25 isFun, isDupDanger -- for Simon Marlow deforestation
28 #include "HsVersions.h"
31 import GlaExts ( Int(..), (+#) )
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
106 isOneOcc :: BinderInfo -> Bool
107 isOneOcc (OneOcc _ _ _ _ _) = True
108 isOneOcc other_bind = False
110 isOneFunOcc :: BinderInfo -> Bool
111 isOneFunOcc (OneOcc FunOcc _ _ _ _) = True
112 isOneFunOcc other_bind = False
114 isOneSafeFunOcc :: Bool -> BinderInfo -> Bool
115 isOneSafeFunOcc ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alts _)
116 = ok_to_dup || n_alts <= 1
117 isOneSafeFunOcc ok_to_dup other_bind = False
119 isDeadOcc :: BinderInfo -> Bool
120 isDeadOcc DeadCode = True
121 isDeadOcc other = False
123 isFun :: FunOrArg -> Bool
127 isDupDanger :: DuplicationDanger -> Bool
128 isDupDanger DupDanger = True
129 isDupDanger _ = False
134 okToInline :: Bool -- The thing is WHNF or bottom;
135 -> Bool -- It's small enough to duplicate the code
137 -> Bool -- True <=> inline it
139 -- A non-WHNF can be inlined if it doesn't occur inside a lambda,
140 -- and occurs exactly once or
141 -- occurs once in each branch of a case and is small
142 okToInline False small_enough (OneOcc _ NoDupDanger _ n_alts _)
143 = n_alts <= 1 || small_enough
145 -- If the thing isn't a redex, there's no danger of duplicating work,
146 -- so we can inline if it occurs once, or is small
147 okToInline True small_enough occ_info
148 = one_occ || small_enough
150 one_occ = case occ_info of
151 OneOcc _ _ _ n_alts _ -> n_alts <= 1
154 okToInline whnf_or_bot small_enough any_occ = False
161 deadOccurrence :: BinderInfo
162 deadOccurrence = DeadCode
164 argOccurrence, funOccurrence :: Int -> BinderInfo
166 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
167 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
169 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
171 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
172 markMany (ManyOcc ar) = ManyOcc ar
173 markMany DeadCode = panic "markMany"
175 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
176 = OneOcc posn DupDanger in_scc n_alts ar
177 markDangerousToDup other = other
179 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
181 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
182 = OneOcc posn dup_danger InsideSCC n_alts ar
183 markInsideSCC other = other
185 addBinderInfo, orBinderInfo
186 :: BinderInfo -> BinderInfo -> BinderInfo
188 addBinderInfo DeadCode info2 = info2
189 addBinderInfo info1 DeadCode = info1
190 addBinderInfo info1 info2
191 = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
192 (I# i#) -> ManyOcc (I# i#)
193 -- ManyOcc min (getBinderInfoArity info1) (getBinderInfoArity info2))
195 -- (orBinderInfo orig new) is used when combining occurrence
196 -- info from branches of a case
198 orBinderInfo DeadCode info2 = info2
199 orBinderInfo info1 DeadCode = info1
200 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
201 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
203 -- Seriously maligned in order to make it stricter,
204 -- let's hope it is worth it..
205 posn = combine_posns posn1 posn2
206 scc = combine_sccs scc1 scc2
207 dup = combine_dups dup1 dup2
208 alts = n_alts1 + n_alts2
212 cont1 = case scc of { InsideSCC -> cont2; _ -> cont2 }
213 cont2 = case dup of { DupDanger -> cont3; _ -> cont3 }
214 cont3 = case alts of { (I# 0#) -> cont4; _ -> cont4 }
215 cont4 = case ar of { (I# 0#) -> cont5; _ -> cont5 }
216 cont5 = OneOcc posn dup scc alts ar
218 case posn of { FunOcc -> cont1; _ -> cont1 }
219 orBinderInfo info1 info2
220 = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
221 (I# i#) -> ManyOcc (I# i#)
223 -- (andBinderInfo orig new) is used in two situations:
224 -- First, when a variable whose occurrence info
225 -- is currently "orig" is bound to a variable whose occurrence info is "new"
226 -- eg (\new -> e) orig
227 -- What we want to do is to *worsen* orig's info to take account of new's
229 -- second, when completing a let-binding
230 -- let new = ...orig...
231 -- we compute the way orig occurs in (...orig...), and then use orBinderInfo
232 -- to worsen this info by the way new occurs in the let body; then we use
233 -- that to worsen orig's currently recorded occurrence info.
235 andBinderInfo DeadCode info2 = DeadCode
236 andBinderInfo info1 DeadCode = DeadCode
237 andBinderInfo (OneOcc posn1 dup1 scc1 (I# n_alts1#) (I# ar_1#))
238 (OneOcc posn2 dup2 scc2 (I# n_alts2#) ar_2)
240 -- Perversly maligned in order to make it stricter.
241 posn = combine_posns posn1 posn2
242 scc = combine_sccs scc1 scc2
243 dup = combine_dups dup1 dup2
244 alts = I# (n_alts1# +# n_alts2#)
247 cont1 = case scc of { InsideSCC -> cont2; _ -> cont2 }
248 cont2 = case dup of { DupDanger -> cont3; _ -> cont3 }
249 cont3 = case alts of { (I# 0#) -> cont4; _ -> cont4 }
250 cont4 = OneOcc posn dup scc alts (I# ar_1#)
252 case posn of {FunOcc -> cont1; _ -> cont1}
254 andBinderInfo info1 info2 =
255 case getBinderInfoArity info1 of
256 (I# i#) -> ManyOcc (I# i#)
257 --ManyOcc (getBinderInfoArity info1)
260 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
261 combine_posns _ _ = ArgOcc
263 combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
264 combine_dups _ DupDanger = DupDanger
265 combine_dups _ _ = NoDupDanger
267 combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
268 combine_sccs _ InsideSCC = InsideSCC
269 combine_sccs _ _ = NotInsideSCC
271 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
272 setBinderInfoArityToZero DeadCode = DeadCode
273 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
274 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
278 getBinderInfoArity (DeadCode) = 0
279 getBinderInfoArity (ManyOcc i) = i
280 getBinderInfoArity (OneOcc _ _ _ _ i) = i
284 instance Outputable BinderInfo where
285 ppr DeadCode = ptext SLIT("Dead")
286 ppr (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
287 ppr (OneOcc posn dup_danger in_scc n_alts ar)
288 = hcat [ ptext SLIT("One-"), pp_posn posn, char '-', pp_danger dup_danger,
289 char '-', pp_scc in_scc, char '-', int n_alts,
292 pp_posn FunOcc = ptext SLIT("fun")
293 pp_posn ArgOcc = ptext SLIT("arg")
295 pp_danger DupDanger = ptext SLIT("*dup*")
296 pp_danger NoDupDanger = ptext SLIT("nodup")
298 pp_scc InsideSCC = ptext SLIT("*SCC*")
299 pp_scc NotInsideSCC = ptext SLIT("noscc")