[project @ 1996-07-19 18:36:04 by partain]
[ghc-hetmet.git] / ghc / compiler / simplCore / BinderInfo.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
3 %
4 %************************************************************************
5 %*                                                                      *
6 \section[BinderInfo]{Information attached to binders by SubstAnal}
7 %*                                                                      *
8 %************************************************************************
9
10 \begin{code}
11 #include "HsVersions.h"
12
13 module BinderInfo (
14         BinderInfo(..),
15         FunOrArg, DuplicationDanger, InsideSCC,  -- NB: all abstract (yay!)
16
17         inlineUnconditionally, okToInline,
18
19         addBinderInfo, orBinderInfo, 
20
21         argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
22         markMany, markDangerousToDup, markInsideSCC,
23         getBinderInfoArity,
24         setBinderInfoArityToZero,
25
26         isFun, isDupDanger -- for Simon Marlow deforestation
27     ) where
28
29 IMP_Ubiq(){-uitous-}
30
31 import CoreUnfold       ( FormSummary(..) )
32 import Pretty
33 import Util             ( panic )
34 \end{code}
35
36 The @BinderInfo@ describes how a variable is used in a given scope.
37
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
42 scope of an SCC.
43
44 \begin{code}
45 data BinderInfo
46   = DeadCode    -- Dead code; discard the binding.
47
48   | ManyOcc     -- Everything else besides DeadCode and OneOccs
49
50         Int     -- number of arguments on stack when called; this is a minimum guarantee
51
52
53   | OneOcc      -- Just one occurrence (or one each in
54                 -- mutually-exclusive case alts).
55
56       FunOrArg  -- How it occurs
57
58       DuplicationDanger
59
60       InsideSCC
61
62       Int       -- Number of mutually-exclusive case alternatives
63                 -- in which it occurs
64
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)
69
70       Int       -- number of arguments on stack when called; minimum guarantee
71
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)
78 --      [again, DupDanger]
79
80 data FunOrArg
81   = FunOcc      -- An occurrence in a function position
82   | ArgOcc      -- Other arg occurrence
83
84     -- When combining branches of a case, only report FunOcc if
85     -- both branches are FunOccs
86
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.
93
94   | NoDupDanger -- It's ok; substitution won't duplicate work.
95
96 data InsideSCC
97   = InsideSCC       -- Inside an SCC; so be careful when substituting.
98   | NotInsideSCC    -- It's ok.
99
100 noBinderInfo = ManyOcc 0        -- A non-committal value
101 \end{code}
102
103
104 Predicates
105 ~~~~~~~~~~
106
107 \begin{code}
108 okToInline
109         :: FormSummary  -- What the thing to be inlined is like
110         -> BinderInfo   -- How the thing to be inlined occurs
111         -> Bool         -- True => it's small enough to inline
112         -> Bool         -- True => yes, inline it
113
114 -- Always inline bottoms
115 okToInline BottomForm occ_info small_enough
116   = True        -- Unless one of the type args is unboxed??
117                 -- This used to be checked for, but I can't
118                 -- see why so I've left it out.
119
120 -- Non-WHNFs can be inlined if they occur once, or are small
121 okToInline OtherForm (OneOcc _ _ _ n_alts _) small_enough | n_alts <= 1 = True
122 okToInline OtherForm any_occ                 small_enough               = small_enough
123
124 -- A WHNF can be inlined if it doesn't occur inside a lambda,
125 -- and occurs exactly once or 
126 --     occurs once in each branch of a case and is small
127 okToInline form (OneOcc _ NoDupDanger _ n_alts _) small_enough 
128   = is_whnf_form form && 
129     (n_alts <= 1 || small_enough)
130   where
131     is_whnf_form VarForm   = True
132     is_whnf_form ValueForm = True
133     is_whnf_form other     = False
134
135 okToInline form any_occ small_enough = False
136 \end{code}
137
138 @inlineUnconditionally@ decides whether a let-bound thing can
139 definitely be inlined.
140
141 \begin{code}
142 inlineUnconditionally :: Bool -> BinderInfo -> Bool
143
144 --inlineUnconditionally ok_to_dup DeadCode = True
145 inlineUnconditionally ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alt_occs _)
146   = n_alt_occs <= 1 || ok_to_dup
147             -- We [i.e., Patrick] don't mind the code explosion,
148             -- though.  We could have a flag to limit the
149             -- damage, e.g., limit to M alternatives.
150
151 inlineUnconditionally _ _ = False
152 \end{code}
153
154 \begin{code}
155 isFun :: FunOrArg -> Bool
156 isFun FunOcc = True
157 isFun _ = False
158
159 isDupDanger :: DuplicationDanger -> Bool
160 isDupDanger DupDanger = True
161 isDupDanger _ = False
162 \end{code}
163
164
165 Construction
166 ~~~~~~~~~~~~~
167 \begin{code}
168 argOccurrence, funOccurrence :: Int -> BinderInfo
169
170 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
171 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
172
173 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
174
175 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
176 markMany (ManyOcc ar)        = ManyOcc ar
177 markMany DeadCode            = panic "markMany"
178
179 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
180   = OneOcc posn DupDanger in_scc n_alts ar
181 markDangerousToDup other = other
182
183 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
184
185 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
186   = OneOcc posn dup_danger InsideSCC n_alts ar
187 markInsideSCC other = other
188
189 addBinderInfo, orBinderInfo
190         :: BinderInfo -> BinderInfo -> BinderInfo
191
192 addBinderInfo DeadCode info2 = info2
193 addBinderInfo info1 DeadCode = info1
194 addBinderInfo info1 info2
195         = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
196
197 -- (orBinderInfo orig new) is used in two situations:
198 -- First, it combines occurrence info from branches of a case
199 --
200 -- Second, when a variable whose occurrence
201 --   info is currently "orig" is bound to a variable whose occurrence info is "new"
202 --      eg  (\new -> e) orig
203 --   What we want to do is to *worsen* orig's info to take account of new's
204
205 orBinderInfo DeadCode info2 = info2
206 orBinderInfo info1 DeadCode = info1
207 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
208                       (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
209   = OneOcc (combine_posns posn1 posn2)
210            (combine_dups  dup1  dup2)
211            (combine_sccs  scc1  scc2)
212            (n_alts1 + n_alts2)
213            (min ar_1 ar_2)
214   where
215     combine_dups DupDanger _ = DupDanger        -- Too paranoid?? ToDo
216     combine_dups _ DupDanger = DupDanger
217     combine_dups _ _         = NoDupDanger
218
219     combine_sccs InsideSCC _ = InsideSCC        -- Too paranoid?? ToDo
220     combine_sccs _ InsideSCC = InsideSCC
221     combine_sccs _ _         = NotInsideSCC
222
223 orBinderInfo info1 info2
224         = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
225
226 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
227 combine_posns _          _  = ArgOcc
228
229 {-
230 multiplyBinderInfo orig@(ManyOcc _) new
231   = ManyOcc (min (getBinderInfoArity orig) (getBinderInfoArity new))
232
233 multiplyBinderInfo orig new@(ManyOcc _)
234   = ManyOcc (min (getBinderInfoArity orig) (getBinderInfoArity new))
235
236 multiplyBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
237                    (OneOcc posn2 dup2 scc2 n_alts2 ar_2)  
238   = OneOcc (combine_posns posn1 posn2) ???
239 -}
240
241 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
242 setBinderInfoArityToZero DeadCode    = DeadCode
243 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
244 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
245 \end{code}
246
247 \begin{code}
248 getBinderInfoArity (DeadCode) = 0
249 getBinderInfoArity (ManyOcc i) = i
250 getBinderInfoArity (OneOcc _ _ _ _ i) = i
251 \end{code}
252
253 \begin{code}
254 instance Outputable BinderInfo where
255   ppr sty DeadCode     = ppStr "Dead"
256   ppr sty (ManyOcc ar) = ppBesides [ ppStr "Many-", ppInt ar ]
257   ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
258     = ppBesides [ ppStr "One-", pp_posn posn, ppChar '-', pp_danger dup_danger,
259                   ppChar '-', pp_scc in_scc,  ppChar '-', ppInt n_alts,
260                   ppChar '-', ppInt ar ]
261     where
262       pp_posn FunOcc = ppStr "fun"
263       pp_posn ArgOcc = ppStr "arg"
264
265       pp_danger DupDanger   = ppStr "*dup*"
266       pp_danger NoDupDanger = ppStr "nodup"
267
268       pp_scc InsideSCC    = ppStr "*SCC*"
269       pp_scc NotInsideSCC = ppStr "noscc"
270 \end{code}
271