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
33 The @BinderInfo@ describes how a variable is used in a given scope.
35 NOTE: With SCCs we have to be careful what we unfold! We don't want to
36 change the attribution of execution costs. If we decide to unfold
37 within an SCC we can tag the definition as @DontKeepBinder@.
38 Definitions tagged as @KeepBinder@ are discarded when we enter the
43 = DeadCode -- Dead code; discard the binding.
45 | ManyOcc -- Everything else besides DeadCode and OneOccs
47 Int -- number of arguments on stack when called; this is a minimum guarantee
50 | OneOcc -- Just one occurrence (or one each in
51 -- mutually-exclusive case alts).
53 FunOrArg -- How it occurs
59 Int -- Number of mutually-exclusive case alternatives
62 -- Note that we only worry about the case-alt counts
63 -- if the OneOcc is substitutable -- that's the only
64 -- time we *use* the info; we could be more clever for
65 -- other cases if we really had to. (WDP/PS)
67 Int -- number of arguments on stack when called; minimum guarantee
69 -- In general, we are feel free to substitute unless
70 -- (a) is in an argument position (ArgOcc)
71 -- (b) is inside a lambda [or type lambda?] (DupDanger)
72 -- (c) is inside an SCC expression (InsideSCC)
73 -- (d) is in the RHS of a binding for a variable with an INLINE pragma
74 -- (because the RHS will be inlined regardless of its size)
78 = FunOcc -- An occurrence in a function position
79 | ArgOcc -- Other arg occurrence
81 -- When combining branches of a case, only report FunOcc if
82 -- both branches are FunOccs
84 data DuplicationDanger
85 = DupDanger -- Inside a non-linear lambda (that is, a lambda which
86 -- is sure to be instantiated only once), or inside
87 -- the rhs of an INLINE-pragma'd thing. Either way,
88 -- substituting a redex for this occurrence is
89 -- dangerous because it might duplicate work.
91 | NoDupDanger -- It's ok; substitution won't duplicate work.
94 = InsideSCC -- Inside an SCC; so be careful when substituting.
95 | NotInsideSCC -- It's ok.
97 noBinderInfo = ManyOcc 0 -- A non-committal value
103 isFun :: FunOrArg -> Bool
107 isDupDanger :: DuplicationDanger -> Bool
108 isDupDanger DupDanger = True
109 isDupDanger _ = False
112 @inlineUnconditionally@ decides whether a let-bound thing can
113 definitely be inlined.
118 inlineUnconditionally :: Bool -> BinderInfo -> Bool
120 --inlineUnconditionally ok_to_dup DeadCode = True
121 inlineUnconditionally ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alt_occs _)
122 = n_alt_occs <= 1 || ok_to_dup
123 -- We [i.e., Patrick] don't mind the code explosion,
124 -- though. We could have a flag to limit the
125 -- damage, e.g., limit to M alternatives.
127 inlineUnconditionally _ _ = False
135 argOccurrence, funOccurrence :: Int -> BinderInfo
137 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
138 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
140 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
142 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
143 markMany (ManyOcc ar) = ManyOcc ar
144 markMany DeadCode = panic "markMany"
146 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
147 = OneOcc posn DupDanger in_scc n_alts ar
148 markDangerousToDup other = other
150 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
152 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
153 = OneOcc posn dup_danger InsideSCC n_alts ar
154 markInsideSCC other = other
156 addBinderInfo, orBinderInfo
157 :: BinderInfo -> BinderInfo -> BinderInfo
159 addBinderInfo DeadCode info2 = info2
160 addBinderInfo info1 DeadCode = info1
161 addBinderInfo info1 info2
162 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
164 -- (orBinderInfo orig new) is used when combining occurrence
165 -- info from branches of a case
167 orBinderInfo DeadCode info2 = info2
168 orBinderInfo info1 DeadCode = info1
169 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
170 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
171 = OneOcc (combine_posns posn1 posn2)
172 (combine_dups dup1 dup2)
173 (combine_sccs scc1 scc2)
176 orBinderInfo info1 info2
177 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
179 -- (andBinderInfo orig new) is used in two situations:
180 -- First, when a variable whose occurrence info
181 -- is currently "orig" is bound to a variable whose occurrence info is "new"
182 -- eg (\new -> e) orig
183 -- What we want to do is to *worsen* orig's info to take account of new's
185 -- second, when completing a let-binding
186 -- let new = ...orig...
187 -- we compute the way orig occurs in (...orig...), and then use orBinderInfo
188 -- to worsen this info by the way new occurs in the let body; then we use
189 -- that to worsen orig's currently recorded occurrence info.
191 andBinderInfo DeadCode info2 = DeadCode
192 andBinderInfo info1 DeadCode = DeadCode
193 andBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
194 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
195 = OneOcc (combine_posns posn1 posn2)
196 (combine_dups dup1 dup2)
197 (combine_sccs scc1 scc2)
199 ar_1 -- Min arity just from orig
200 andBinderInfo info1 info2 = ManyOcc (getBinderInfoArity info1)
203 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
204 combine_posns _ _ = ArgOcc
206 combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
207 combine_dups _ DupDanger = DupDanger
208 combine_dups _ _ = NoDupDanger
210 combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
211 combine_sccs _ InsideSCC = InsideSCC
212 combine_sccs _ _ = NotInsideSCC
214 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
215 setBinderInfoArityToZero DeadCode = DeadCode
216 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
217 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
221 getBinderInfoArity (DeadCode) = 0
222 getBinderInfoArity (ManyOcc i) = i
223 getBinderInfoArity (OneOcc _ _ _ _ i) = i
227 instance Outputable BinderInfo where
228 ppr sty DeadCode = ppStr "Dead"
229 ppr sty (ManyOcc ar) = ppBesides [ ppStr "Many-", ppInt ar ]
230 ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
231 = ppBesides [ ppStr "One-", pp_posn posn, ppChar '-', pp_danger dup_danger,
232 ppChar '-', pp_scc in_scc, ppChar '-', ppInt n_alts,
233 ppChar '-', ppInt ar ]
235 pp_posn FunOcc = ppStr "fun"
236 pp_posn ArgOcc = ppStr "arg"
238 pp_danger DupDanger = ppStr "*dup*"
239 pp_danger NoDupDanger = ppStr "nodup"
241 pp_scc InsideSCC = ppStr "*SCC*"
242 pp_scc NotInsideSCC = ppStr "noscc"