Simplify callSiteInline a little
[ghc.git] / compiler / coreSyn / CoreTidy.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The AQUA Project, Glasgow University, 1996-1998
4
5
6 This module contains "tidying" code for *nested* expressions, bindings, rules.
7 The code for *top-level* bindings is in TidyPgm.
8 -}
9
10 {-# LANGUAGE CPP #-}
11 module CoreTidy (
12 tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding
13 ) where
14
15 #include "HsVersions.h"
16
17 import GhcPrelude
18
19 import CoreSyn
20 import CoreSeq ( seqUnfolding )
21 import CoreArity
22 import Id
23 import IdInfo
24 import Demand ( zapUsageEnvSig )
25 import Type( tidyType, tidyTyCoVarBndr )
26 import Coercion( tidyCo )
27 import Var
28 import VarEnv
29 import UniqFM
30 import Name hiding (tidyNameOcc)
31 import SrcLoc
32 import Maybes
33 import Data.List
34
35 {-
36 ************************************************************************
37 * *
38 \subsection{Tidying expressions, rules}
39 * *
40 ************************************************************************
41 -}
42
43 tidyBind :: TidyEnv
44 -> CoreBind
45 -> (TidyEnv, CoreBind)
46
47 tidyBind env (NonRec bndr rhs)
48 = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->
49 (env', NonRec bndr' (tidyExpr env' rhs))
50
51 tidyBind env (Rec prs)
52 = let
53 (env', bndrs') = mapAccumL (tidyLetBndr env') env prs
54 in
55 map (tidyExpr env') (map snd prs) =: \ rhss' ->
56 (env', Rec (zip bndrs' rhss'))
57
58
59 ------------ Expressions --------------
60 tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
61 tidyExpr env (Var v) = Var (tidyVarOcc env v)
62 tidyExpr env (Type ty) = Type (tidyType env ty)
63 tidyExpr env (Coercion co) = Coercion (tidyCo env co)
64 tidyExpr _ (Lit lit) = Lit lit
65 tidyExpr env (App f a) = App (tidyExpr env f) (tidyExpr env a)
66 tidyExpr env (Tick t e) = Tick (tidyTickish env t) (tidyExpr env e)
67 tidyExpr env (Cast e co) = Cast (tidyExpr env e) (tidyCo env co)
68
69 tidyExpr env (Let b e)
70 = tidyBind env b =: \ (env', b') ->
71 Let b' (tidyExpr env' e)
72
73 tidyExpr env (Case e b ty alts)
74 = tidyBndr env b =: \ (env', b) ->
75 Case (tidyExpr env e) b (tidyType env ty)
76 (map (tidyAlt env') alts)
77
78 tidyExpr env (Lam b e)
79 = tidyBndr env b =: \ (env', b) ->
80 Lam b (tidyExpr env' e)
81
82 ------------ Case alternatives --------------
83 tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt
84 tidyAlt env (con, vs, rhs)
85 = tidyBndrs env vs =: \ (env', vs) ->
86 (con, vs, tidyExpr env' rhs)
87
88 ------------ Tickish --------------
89 tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
90 tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)
91 tidyTickish _ other_tickish = other_tickish
92
93 ------------ Rules --------------
94 tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
95 tidyRules _ [] = []
96 tidyRules env (rule : rules)
97 = tidyRule env rule =: \ rule ->
98 tidyRules env rules =: \ rules ->
99 (rule : rules)
100
101 tidyRule :: TidyEnv -> CoreRule -> CoreRule
102 tidyRule _ rule@(BuiltinRule {}) = rule
103 tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
104 ru_fn = fn, ru_rough = mb_ns })
105 = tidyBndrs env bndrs =: \ (env', bndrs) ->
106 map (tidyExpr env') args =: \ args ->
107 rule { ru_bndrs = bndrs, ru_args = args,
108 ru_rhs = tidyExpr env' rhs,
109 ru_fn = tidyNameOcc env fn,
110 ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
111
112 {-
113 ************************************************************************
114 * *
115 \subsection{Tidying non-top-level binders}
116 * *
117 ************************************************************************
118 -}
119
120 tidyNameOcc :: TidyEnv -> Name -> Name
121 -- In rules and instances, we have Names, and we must tidy them too
122 -- Fortunately, we can lookup in the VarEnv with a name
123 tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
124 Nothing -> n
125 Just v -> idName v
126
127 tidyVarOcc :: TidyEnv -> Var -> Var
128 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
129
130 -- tidyBndr is used for lambda and case binders
131 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
132 tidyBndr env var
133 | isTyCoVar var = tidyTyCoVarBndr env var
134 | otherwise = tidyIdBndr env var
135
136 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
137 tidyBndrs env vars = mapAccumL tidyBndr env vars
138
139 -- Non-top-level variables, not covars
140 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
141 tidyIdBndr env@(tidy_env, var_env) id
142 = -- Do this pattern match strictly, otherwise we end up holding on to
143 -- stuff in the OccName.
144 case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
145 let
146 -- Give the Id a fresh print-name, *and* rename its type
147 -- The SrcLoc isn't important now,
148 -- though we could extract it from the Id
149 --
150 ty' = tidyType env (idType id)
151 name' = mkInternalName (idUnique id) occ' noSrcSpan
152 id' = mkLocalIdWithInfo name' ty' new_info
153 var_env' = extendVarEnv var_env id id'
154
155 -- Note [Tidy IdInfo]
156 new_info = vanillaIdInfo `setOccInfo` occInfo old_info
157 `setUnfoldingInfo` new_unf
158 -- see Note [Preserve OneShotInfo]
159 `setOneShotInfo` oneShotInfo old_info
160 old_info = idInfo id
161 old_unf = unfoldingInfo old_info
162 new_unf = zapUnfolding old_unf -- See Note [Preserve evaluatedness]
163 in
164 ((tidy_env', var_env'), id')
165 }
166
167 tidyLetBndr :: TidyEnv -- Knot-tied version for unfoldings
168 -> TidyEnv -- The one to extend
169 -> (Id, CoreExpr) -> (TidyEnv, Var)
170 -- Used for local (non-top-level) let(rec)s
171 -- Just like tidyIdBndr above, but with more IdInfo
172 tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)
173 = case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
174 let
175 ty' = tidyType env (idType id)
176 name' = mkInternalName (idUnique id) occ' noSrcSpan
177 details = idDetails id
178 id' = mkLocalVar details name' ty' new_info
179 var_env' = extendVarEnv var_env id id'
180
181 -- Note [Tidy IdInfo]
182 -- We need to keep around any interesting strictness and
183 -- demand info because later on we may need to use it when
184 -- converting to A-normal form.
185 -- eg.
186 -- f (g x), where f is strict in its argument, will be converted
187 -- into case (g x) of z -> f z by CorePrep, but only if f still
188 -- has its strictness info.
189 --
190 -- Similarly for the demand info - on a let binder, this tells
191 -- CorePrep to turn the let into a case.
192 -- But: Remove the usage demand here
193 -- (See Note [Zapping DmdEnv after Demand Analyzer] in WorkWrap)
194 --
195 -- Similarly arity info for eta expansion in CorePrep
196 --
197 -- Set inline-prag info so that we preseve it across
198 -- separate compilation boundaries
199 old_info = idInfo id
200 new_info = vanillaIdInfo
201 `setOccInfo` occInfo old_info
202 `setArityInfo` exprArity rhs
203 `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info)
204 `setDemandInfo` demandInfo old_info
205 `setInlinePragInfo` inlinePragInfo old_info
206 `setUnfoldingInfo` new_unf
207
208 old_unf = unfoldingInfo old_info
209 new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
210 | otherwise = zapUnfolding old_unf
211 -- See Note [Preserve evaluatedness]
212 in
213 ((tidy_env', var_env'), id') }
214
215 ------------ Unfolding --------------
216 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
217 tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
218 = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }
219 where
220 (tidy_env', bndrs') = tidyBndrs tidy_env bndrs
221
222 tidyUnfolding tidy_env
223 unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
224 unf_from_rhs
225 | isStableSource src
226 = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo
227 -- This seqIt avoids a space leak: otherwise the uf_is_value,
228 -- uf_is_conlike, ... fields may retain a reference to the
229 -- pre-tidied expression forever (ToIface doesn't look at them)
230
231 | otherwise
232 = unf_from_rhs
233 where seqIt unf = seqUnfolding unf `seq` unf
234 tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon
235
236 {-
237 Note [Tidy IdInfo]
238 ~~~~~~~~~~~~~~~~~~
239 All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
240 should save some space; except that we preserve occurrence info for
241 two reasons:
242
243 (a) To make printing tidy core nicer
244
245 (b) Because we tidy RULES and InlineRules, which may then propagate
246 via --make into the compilation of the next module, and we want
247 the benefit of that occurrence analysis when we use the rule or
248 or inline the function. In particular, it's vital not to lose
249 loop-breaker info, else we get an infinite inlining loop
250
251 Note that tidyLetBndr puts more IdInfo back.
252
253 Note [Preserve evaluatedness]
254 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
255 Consider
256 data T = MkT !Bool
257 ....(case v of MkT y ->
258 let z# = case y of
259 True -> 1#
260 False -> 2#
261 in ...)
262
263 The z# binding is ok because the RHS is ok-for-speculation,
264 but Lint will complain unless it can *see* that. So we
265 preserve the evaluated-ness on 'y' in tidyBndr.
266
267 (Another alternative would be to tidy unboxed lets into cases,
268 but that seems more indirect and surprising.)
269
270 Note [Preserve OneShotInfo]
271 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
272 We keep the OneShotInfo because we want it to propagate into the interface.
273 Not all OneShotInfo is determined by a compiler analysis; some is added by a
274 call of GHC.Exts.oneShot, which is then discarded before the end of the
275 optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
276 must preserve this info in inlinings. See Note [The oneShot function] in MkId.
277
278 This applies to lambda binders only, hence it is stored in IfaceLamBndr.
279 -}
280
281 (=:) :: a -> (a -> b) -> b
282 m =: k = m `seq` k m