89ce692422202d3a37d9122e6628944137db065a
[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 CoreSyn
18 import CoreSeq ( seqUnfolding )
19 import CoreArity
20 import Id
21 import IdInfo
22 import Demand ( zapUsageEnvSig )
23 import Type( tidyType, tidyTyCoVarBndr )
24 import Coercion( tidyCo )
25 import Var
26 import VarEnv
27 import UniqFM
28 import Name hiding (tidyNameOcc)
29 import SrcLoc
30 import Maybes
31 import Data.List
32
33 {-
34 ************************************************************************
35 * *
36 \subsection{Tidying expressions, rules}
37 * *
38 ************************************************************************
39 -}
40
41 tidyBind :: TidyEnv
42 -> CoreBind
43 -> (TidyEnv, CoreBind)
44
45 tidyBind env (NonRec bndr rhs)
46 = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->
47 (env', NonRec bndr' (tidyExpr env' rhs))
48
49 tidyBind env (Rec prs)
50 = let
51 (env', bndrs') = mapAccumL (tidyLetBndr env') env prs
52 in
53 map (tidyExpr env') (map snd prs) =: \ rhss' ->
54 (env', Rec (zip bndrs' rhss'))
55
56
57 ------------ Expressions --------------
58 tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
59 tidyExpr env (Var v) = Var (tidyVarOcc env v)
60 tidyExpr env (Type ty) = Type (tidyType env ty)
61 tidyExpr env (Coercion co) = Coercion (tidyCo env co)
62 tidyExpr _ (Lit lit) = Lit lit
63 tidyExpr env (App f a) = App (tidyExpr env f) (tidyExpr env a)
64 tidyExpr env (Tick t e) = Tick (tidyTickish env t) (tidyExpr env e)
65 tidyExpr env (Cast e co) = Cast (tidyExpr env e) (tidyCo env co)
66
67 tidyExpr env (Let b e)
68 = tidyBind env b =: \ (env', b') ->
69 Let b' (tidyExpr env' e)
70
71 tidyExpr env (Case e b ty alts)
72 = tidyBndr env b =: \ (env', b) ->
73 Case (tidyExpr env e) b (tidyType env ty)
74 (map (tidyAlt env') alts)
75
76 tidyExpr env (Lam b e)
77 = tidyBndr env b =: \ (env', b) ->
78 Lam b (tidyExpr env' e)
79
80 ------------ Case alternatives --------------
81 tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt
82 tidyAlt env (con, vs, rhs)
83 = tidyBndrs env vs =: \ (env', vs) ->
84 (con, vs, tidyExpr env' rhs)
85
86 ------------ Tickish --------------
87 tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
88 tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)
89 tidyTickish _ other_tickish = other_tickish
90
91 ------------ Rules --------------
92 tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
93 tidyRules _ [] = []
94 tidyRules env (rule : rules)
95 = tidyRule env rule =: \ rule ->
96 tidyRules env rules =: \ rules ->
97 (rule : rules)
98
99 tidyRule :: TidyEnv -> CoreRule -> CoreRule
100 tidyRule _ rule@(BuiltinRule {}) = rule
101 tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
102 ru_fn = fn, ru_rough = mb_ns })
103 = tidyBndrs env bndrs =: \ (env', bndrs) ->
104 map (tidyExpr env') args =: \ args ->
105 rule { ru_bndrs = bndrs, ru_args = args,
106 ru_rhs = tidyExpr env' rhs,
107 ru_fn = tidyNameOcc env fn,
108 ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
109
110 {-
111 ************************************************************************
112 * *
113 \subsection{Tidying non-top-level binders}
114 * *
115 ************************************************************************
116 -}
117
118 tidyNameOcc :: TidyEnv -> Name -> Name
119 -- In rules and instances, we have Names, and we must tidy them too
120 -- Fortunately, we can lookup in the VarEnv with a name
121 tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
122 Nothing -> n
123 Just v -> idName v
124
125 tidyVarOcc :: TidyEnv -> Var -> Var
126 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
127
128 -- tidyBndr is used for lambda and case binders
129 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
130 tidyBndr env var
131 | isTyCoVar var = tidyTyCoVarBndr env var
132 | otherwise = tidyIdBndr env var
133
134 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
135 tidyBndrs env vars = mapAccumL tidyBndr env vars
136
137 -- Non-top-level variables, not covars
138 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
139 tidyIdBndr env@(tidy_env, var_env) id
140 = -- Do this pattern match strictly, otherwise we end up holding on to
141 -- stuff in the OccName.
142 case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
143 let
144 -- Give the Id a fresh print-name, *and* rename its type
145 -- The SrcLoc isn't important now,
146 -- though we could extract it from the Id
147 --
148 ty' = tidyType env (idType id)
149 name' = mkInternalName (idUnique id) occ' noSrcSpan
150 id' = mkLocalIdWithInfo name' ty' new_info
151 var_env' = extendVarEnv var_env id id'
152
153 -- Note [Tidy IdInfo]
154 new_info = vanillaIdInfo `setOccInfo` occInfo old_info
155 `setUnfoldingInfo` new_unf
156 -- see Note [Preserve OneShotInfo]
157 `setOneShotInfo` oneShotInfo old_info
158 old_info = idInfo id
159 old_unf = unfoldingInfo old_info
160 new_unf | isEvaldUnfolding old_unf = evaldUnfolding
161 | otherwise = noUnfolding
162 -- 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 new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
209 | isEvaldUnfolding old_unf = evaldUnfolding
210 -- See Note [Preserve evaluatedness]
211 | otherwise = noUnfolding
212 old_unf = unfoldingInfo old_info
213 in
214 ((tidy_env', var_env'), id') }
215
216 ------------ Unfolding --------------
217 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
218 tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
219 = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }
220 where
221 (tidy_env', bndrs') = tidyBndrs tidy_env bndrs
222
223 tidyUnfolding tidy_env
224 unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
225 unf_from_rhs
226 | isStableSource src
227 = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo
228 -- This seqIt avoids a space leak: otherwise the uf_is_value,
229 -- uf_is_conlike, ... fields may retain a reference to the
230 -- pre-tidied expression forever (ToIface doesn't look at them)
231
232 | otherwise
233 = unf_from_rhs
234 where seqIt unf = seqUnfolding unf `seq` unf
235 tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon
236
237 {-
238 Note [Tidy IdInfo]
239 ~~~~~~~~~~~~~~~~~~
240 All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
241 should save some space; except that we preserve occurrence info for
242 two reasons:
243
244 (a) To make printing tidy core nicer
245
246 (b) Because we tidy RULES and InlineRules, which may then propagate
247 via --make into the compilation of the next module, and we want
248 the benefit of that occurrence analysis when we use the rule or
249 or inline the function. In particular, it's vital not to lose
250 loop-breaker info, else we get an infinite inlining loop
251
252 Note that tidyLetBndr puts more IdInfo back.
253
254 Note [Preserve evaluatedness]
255 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
256 Consider
257 data T = MkT !Bool
258 ....(case v of MkT y ->
259 let z# = case y of
260 True -> 1#
261 False -> 2#
262 in ...)
263
264 The z# binding is ok because the RHS is ok-for-speculation,
265 but Lint will complain unless it can *see* that. So we
266 preserve the evaluated-ness on 'y' in tidyBndr.
267
268 (Another alternative would be to tidy unboxed lets into cases,
269 but that seems more indirect and surprising.)
270
271 Note [Preserve OneShotInfo]
272 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
273 We keep the OneShotInfo because we want it to propagate into the interface.
274 Not all OneShotInfo is determined by a compiler analysis; some is added by a
275 call of GHC.Exts.oneShot, which is then discarded before the end of the
276 optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
277 must preserve this info in inlinings. See Note [The oneShot function] in MkId.
278
279 This applies to lambda binders only, hence it is stored in IfaceLamBndr.
280 -}
281
282 (=:) :: a -> (a -> b) -> b
283 m =: k = m `seq` k m