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 inlineUnconditionally, oneTextualOcc, oneSafeOcc,
19 combineBinderInfo, combineAltsBinderInfo,
21 argOccurrence, funOccurrence,
22 markMany, markDangerousToDup, markInsideSCC,
24 setBinderInfoArityToZero,
26 isFun, isDupDanger -- for Simon Marlow deforestation
35 The @BinderInfo@ describes how a variable is used in a given scope.
37 NOTE: With SCCs we have to be careful what we unfold! We don't want to
38 change the attribution of execution costs. If we decide to unfold
39 within an SCC we can tag the definition as @DontKeepBinder@.
40 Definitions tagged as @KeepBinder@ are discarded when we enter the
45 = DeadCode -- Dead code; discard the binding.
47 | ManyOcc -- Everything else besides DeadCode and OneOccs
49 Int -- number of arguments on stack when called
52 | OneOcc -- Just one occurrence (or one each in
53 -- mutually-exclusive case alts).
55 FunOrArg -- How it occurs
61 Int -- Number of mutually-exclusive case alternatives
64 -- Note that we only worry about the case-alt counts
65 -- if the OneOcc is substitutable -- that's the only
66 -- time we *use* the info; we could be more clever for
67 -- other cases if we really had to. (WDP/PS)
69 Int -- number of arguments on stack when called
71 -- In general, we are feel free to substitute unless
72 -- (a) is in an argument position (ArgOcc)
73 -- (b) is inside a lambda [or type lambda?] (DupDanger)
74 -- (c) is inside an SCC expression (InsideSCC)
75 -- (d) is in the RHS of a binding for a variable with an INLINE pragma
76 -- (because the RHS will be inlined regardless of its size)
80 = FunOcc -- An occurrence in a function position
81 | ArgOcc -- Other arg occurrence
83 -- When combining branches of a case, only report FunOcc if
84 -- both branches are FunOccs
86 data DuplicationDanger
87 = DupDanger -- Inside a non-linear lambda (that is, a lambda which
88 -- is sure to be instantiated only once), or inside
89 -- the rhs of an INLINE-pragma'd thing. Either way,
90 -- substituting a redex for this occurrence is
91 -- dangerous because it might duplicate work.
93 | NoDupDanger -- It's ok; substitution won't duplicate work.
96 = InsideSCC -- Inside an SCC; so be careful when substituting.
97 | NotInsideSCC -- It's ok.
104 @oneTextualOcc@ checks for one occurrence, in any position.
105 The occurrence may be inside a lambda, that's all right.
108 oneTextualOcc :: Bool -> BinderInfo -> Bool
110 oneTextualOcc ok_to_dup (OneOcc _ _ _ n_alts _) = n_alts <= 1 || ok_to_dup
111 oneTextualOcc _ other = False
114 @safeSingleOcc@ detects single occurences of values that are safe to
115 inline, {\em including} ones in an argument position.
118 oneSafeOcc :: Bool -> BinderInfo -> Bool
119 oneSafeOcc ok_to_dup (OneOcc _ NoDupDanger NotInsideSCC n_alts _)
120 = n_alts <= 1 || ok_to_dup
121 oneSafeOcc _ other = False
124 @inlineUnconditionally@ decides whether a let-bound thing can
125 definitely be inlined.
128 inlineUnconditionally :: Bool -> BinderInfo -> Bool
130 --inlineUnconditionally ok_to_dup DeadCode = True
131 inlineUnconditionally ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alt_occs _)
132 = n_alt_occs <= 1 || ok_to_dup
133 -- We [i.e., Patrick] don't mind the code explosion,
134 -- though. We could have a flag to limit the
135 -- damage, e.g., limit to M alternatives.
137 inlineUnconditionally _ _ = False
141 isFun :: FunOrArg -> Bool
145 isDupDanger :: DuplicationDanger -> Bool
146 isDupDanger DupDanger = True
147 isDupDanger _ = False
154 argOccurrence, funOccurrence :: Int -> BinderInfo
156 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
157 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
159 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
161 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
162 markMany (ManyOcc ar) = ManyOcc ar
163 markMany DeadCode = panic "markMany"
165 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
166 = OneOcc posn DupDanger in_scc n_alts ar
167 markDangerousToDup other = other
169 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
170 = OneOcc posn dup_danger InsideSCC n_alts ar
171 markInsideSCC other = other
173 combineBinderInfo, combineAltsBinderInfo
174 :: BinderInfo -> BinderInfo -> BinderInfo
176 combineBinderInfo DeadCode info2 = info2
177 combineBinderInfo info1 DeadCode = info1
178 combineBinderInfo info1 info2
179 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
181 combineAltsBinderInfo DeadCode info2 = info2
182 combineAltsBinderInfo info1 DeadCode = info1
183 combineAltsBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
184 (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
185 = OneOcc (combine_posns posn1 posn2)
186 (combine_dups dup1 dup2)
187 (combine_sccs scc1 scc2)
191 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
192 combine_posns _ _ = ArgOcc
194 combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
195 combine_dups _ DupDanger = DupDanger
196 combine_dups _ _ = NoDupDanger
198 combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
199 combine_sccs _ InsideSCC = InsideSCC
200 combine_sccs _ _ = NotInsideSCC
202 combineAltsBinderInfo info1 info2
203 = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
205 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
206 setBinderInfoArityToZero DeadCode = DeadCode
207 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
208 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
212 getBinderInfoArity (DeadCode) = 0
213 getBinderInfoArity (ManyOcc i) = i
214 getBinderInfoArity (OneOcc _ _ _ _ i) = i
218 instance Outputable BinderInfo where
219 ppr sty DeadCode = ppStr "Dead"
220 ppr sty (ManyOcc ar) = ppBesides [ ppStr "Many-", ppInt ar ]
221 ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
222 = ppBesides [ ppStr "One-", pp_posn posn, ppChar '-', pp_danger dup_danger,
223 ppChar '-', pp_scc in_scc, ppChar '-', ppInt n_alts,
224 ppChar '-', ppInt ar ]
226 pp_posn FunOcc = ppStr "fun"
227 pp_posn ArgOcc = ppStr "arg"
229 pp_danger DupDanger = ppStr "*dup*"
230 pp_danger NoDupDanger = ppStr "nodup"
232 pp_scc InsideSCC = ppStr "*SCC*"
233 pp_scc NotInsideSCC = ppStr "noscc"