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 isOneOcc, isOneFunOcc, isOneSafeFunOcc, isOneSameSCCFunOcc,
24 isDeadOcc, isInlinableOcc,
26 isFun, isDupDanger -- for Simon Marlow deforestation
29 #include "HsVersions.h"
32 import GlaExts ( Int(..), (+#) )
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 isOneOcc :: BinderInfo -> Bool
108 isOneOcc (OneOcc _ _ _ _ _) = True
109 isOneOcc other_bind = False
111 isOneFunOcc :: BinderInfo -> Bool
112 isOneFunOcc (OneOcc FunOcc _ _ _ _) = True
113 isOneFunOcc other_bind = False
115 isOneSameSCCFunOcc :: BinderInfo -> Bool
116 isOneSameSCCFunOcc (OneOcc FunOcc _ NotInsideSCC _ _) = True
117 isOneSameSCCFunOcc other_bind = False
119 isOneSafeFunOcc :: BinderInfo -> Bool -- Completely safe
120 isOneSafeFunOcc (OneOcc FunOcc NoDupDanger NotInsideSCC n_alts _) = n_alts <= 1
121 isOneSafeFunOcc other = False
123 -- A non-WHNF can be inlined if it doesn't occur inside a lambda,
124 -- and occurs exactly once or
125 -- occurs once in each branch of a case and is small
127 -- If the thing is in WHNF, there's no danger of duplicating work,
128 -- so we can inline if it occurs once, or is small
129 isInlinableOcc :: Bool -- True <=> don't worry about dup-danger
130 -> Bool -- True <=> don't worry about code size
133 isInlinableOcc whnf small (ManyOcc _)
135 isInlinableOcc whnf small (OneOcc _ dup_danger _ n_alts _)
136 = (whnf || (case dup_danger of {NoDupDanger -> True; other -> False}))
137 && (small || n_alts <= 1)
138 isInlinableOcc _ _ DeadCode = False
140 isDeadOcc :: BinderInfo -> Bool
141 isDeadOcc DeadCode = True
142 isDeadOcc other = False
144 isFun :: FunOrArg -> Bool
148 isDupDanger :: DuplicationDanger -> Bool
149 isDupDanger DupDanger = True
150 isDupDanger _ = False
158 deadOccurrence :: BinderInfo
159 deadOccurrence = DeadCode
161 argOccurrence, funOccurrence :: Int -> BinderInfo
163 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
164 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
166 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
168 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
169 markMany (ManyOcc ar) = ManyOcc ar
170 markMany DeadCode = panic "markMany"
172 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
173 = OneOcc posn DupDanger in_scc n_alts ar
174 markDangerousToDup other = other
176 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
178 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
179 = OneOcc posn dup_danger InsideSCC n_alts ar
180 markInsideSCC other = other
182 addBinderInfo, orBinderInfo
183 :: BinderInfo -> BinderInfo -> BinderInfo
185 addBinderInfo DeadCode info2 = info2
186 addBinderInfo info1 DeadCode = info1
187 addBinderInfo info1 info2
188 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
190 -- (orBinderInfo orig new) is used in two situations:
191 -- First, when a variable whose occurrence info
192 -- is currently "orig" is bound to a variable whose occurrence info is "new"
193 -- eg (\new -> e) orig
194 -- What we want to do is to *worsen* orig's info to take account of new's
196 -- Second, when combining occurrence 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 posn = combine_posns posn1 posn2
204 scc = combine_sccs scc1 scc2
205 dup = combine_dups dup1 dup2
206 alts = n_alts1 + n_alts2
209 OneOcc posn dup scc alts ar
211 orBinderInfo info1 info2
212 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
214 -- (andBinderInfo orig new) is used
215 -- when completing a let-binding
216 -- let new = ...orig...
217 -- we compute the way orig occurs in (...orig...), and then use andBinderInfo
218 -- to worsen this info by the way new occurs in the let body; then we use
219 -- that to worsen orig's currently recorded occurrence info.
221 andBinderInfo DeadCode info2 = DeadCode
222 andBinderInfo info1 DeadCode = DeadCode
223 andBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
224 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
226 posn = combine_posns posn1 posn2
227 scc = combine_sccs scc1 scc2
228 dup = combine_dups dup1 dup2
229 alts = n_alts1 + n_alts2
231 OneOcc posn dup scc alts ar_1
233 andBinderInfo info1 info2 = ManyOcc (getBinderInfoArity info1)
236 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
237 combine_posns _ _ = ArgOcc
239 combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
240 combine_dups _ DupDanger = DupDanger
241 combine_dups _ _ = NoDupDanger
243 combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
244 combine_sccs _ InsideSCC = InsideSCC
245 combine_sccs _ _ = NotInsideSCC
247 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
248 setBinderInfoArityToZero DeadCode = DeadCode
249 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
250 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
254 getBinderInfoArity (DeadCode) = 0
255 getBinderInfoArity (ManyOcc i) = i
256 getBinderInfoArity (OneOcc _ _ _ _ i) = i
260 instance Outputable BinderInfo where
261 ppr DeadCode = ptext SLIT("Dead")
262 ppr (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
263 ppr (OneOcc posn dup_danger in_scc n_alts ar)
264 = hcat [ ptext SLIT("One-"), pp_posn posn, char '-', pp_danger dup_danger,
265 char '-', pp_scc in_scc, char '-', int n_alts,
268 pp_posn FunOcc = ptext SLIT("fun")
269 pp_posn ArgOcc = ptext SLIT("arg")
271 pp_danger DupDanger = ptext SLIT("*dup*")
272 pp_danger NoDupDanger = ptext SLIT("nodup")
274 pp_scc InsideSCC = ptext SLIT("*SCC*")
275 pp_scc NotInsideSCC = ptext SLIT("noscc")