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)
139 isDeadOcc :: BinderInfo -> Bool
140 isDeadOcc DeadCode = True
141 isDeadOcc other = False
143 isFun :: FunOrArg -> Bool
147 isDupDanger :: DuplicationDanger -> Bool
148 isDupDanger DupDanger = True
149 isDupDanger _ = False
157 deadOccurrence :: BinderInfo
158 deadOccurrence = DeadCode
160 argOccurrence, funOccurrence :: Int -> BinderInfo
162 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
163 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
165 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
167 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
168 markMany (ManyOcc ar) = ManyOcc ar
169 markMany DeadCode = panic "markMany"
171 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
172 = OneOcc posn DupDanger in_scc n_alts ar
173 markDangerousToDup other = other
175 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
177 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
178 = OneOcc posn dup_danger InsideSCC n_alts ar
179 markInsideSCC other = other
181 addBinderInfo, orBinderInfo
182 :: BinderInfo -> BinderInfo -> BinderInfo
184 addBinderInfo DeadCode info2 = info2
185 addBinderInfo info1 DeadCode = info1
186 addBinderInfo info1 info2
187 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
189 -- (orBinderInfo orig new) is used in two situations:
190 -- First, when a variable whose occurrence info
191 -- is currently "orig" is bound to a variable whose occurrence info is "new"
192 -- eg (\new -> e) orig
193 -- What we want to do is to *worsen* orig's info to take account of new's
195 -- Second, when combining occurrence info from branches of a case
197 orBinderInfo DeadCode info2 = info2
198 orBinderInfo info1 DeadCode = info1
199 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
200 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
202 posn = combine_posns posn1 posn2
203 scc = combine_sccs scc1 scc2
204 dup = combine_dups dup1 dup2
205 alts = n_alts1 + n_alts2
208 OneOcc posn dup scc alts ar
210 orBinderInfo info1 info2
211 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
213 -- (andBinderInfo orig new) is used
214 -- when completing a let-binding
215 -- let new = ...orig...
216 -- we compute the way orig occurs in (...orig...), and then use andBinderInfo
217 -- to worsen this info by the way new occurs in the let body; then we use
218 -- that to worsen orig's currently recorded occurrence info.
220 andBinderInfo DeadCode info2 = DeadCode
221 andBinderInfo info1 DeadCode = DeadCode
222 andBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
223 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
225 posn = combine_posns posn1 posn2
226 scc = combine_sccs scc1 scc2
227 dup = combine_dups dup1 dup2
228 alts = n_alts1 + n_alts2
230 OneOcc posn dup scc alts ar_1
232 andBinderInfo info1 info2 = 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 DeadCode = ptext SLIT("Dead")
261 ppr (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
262 ppr (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")