lookupBindGroupOcc: recommend names in the same namespace (#17593)
[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, tidyRules, tidyUnfolding
13 ) where
14
15 #include "HsVersions.h"
16
17 import GhcPrelude
18
19 import CoreSyn
20 import CoreSeq ( seqUnfolding )
21 import Id
22 import IdInfo
23 import Demand ( zapUsageEnvSig )
24 import Type( tidyType, tidyVarBndr )
25 import Coercion( tidyCo )
26 import Var
27 import VarEnv
28 import UniqFM
29 import Name hiding (tidyNameOcc)
30 import SrcLoc
31 import Maybes
32 import Data.List
33
34 {-
35 ************************************************************************
36 * *
37 \subsection{Tidying expressions, rules}
38 * *
39 ************************************************************************
40 -}
41
42 tidyBind :: TidyEnv
43 -> CoreBind
44 -> (TidyEnv, CoreBind)
45
46 tidyBind env (NonRec bndr rhs)
47 = tidyLetBndr env env bndr =: \ (env', bndr') ->
48 (env', NonRec bndr' (tidyExpr env' rhs))
49
50 tidyBind env (Rec prs)
51 = let
52 (bndrs, rhss) = unzip prs
53 (env', bndrs') = mapAccumL (tidyLetBndr env') env bndrs
54 in
55 map (tidyExpr env') rhss =: \ 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 = tidyVarBndr 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 -> (TidyEnv, Id)
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
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 -- Don't attempt to recompute arity here; this is just tidying!
197 -- Trying to do so led to #17294
198 --
199 -- Set inline-prag info so that we preseve it across
200 -- separate compilation boundaries
201 old_info = idInfo id
202 new_info = vanillaIdInfo
203 `setOccInfo` occInfo old_info
204 `setArityInfo` arityInfo old_info
205 `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info)
206 `setDemandInfo` demandInfo old_info
207 `setInlinePragInfo` inlinePragInfo old_info
208 `setUnfoldingInfo` new_unf
209
210 old_unf = unfoldingInfo old_info
211 new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
212 | otherwise = zapUnfolding old_unf
213 -- See Note [Preserve evaluatedness]
214
215 in
216 ((tidy_env', var_env'), id') }
217
218 ------------ Unfolding --------------
219 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
220 tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
221 = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }
222 where
223 (tidy_env', bndrs') = tidyBndrs tidy_env bndrs
224
225 tidyUnfolding tidy_env
226 unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
227 unf_from_rhs
228 | isStableSource src
229 = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo
230 -- This seqIt avoids a space leak: otherwise the uf_is_value,
231 -- uf_is_conlike, ... fields may retain a reference to the
232 -- pre-tidied expression forever (ToIface doesn't look at them)
233
234 | otherwise
235 = unf_from_rhs
236 where seqIt unf = seqUnfolding unf `seq` unf
237 tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon
238
239 {-
240 Note [Tidy IdInfo]
241 ~~~~~~~~~~~~~~~~~~
242 All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
243 should save some space; except that we preserve occurrence info for
244 two reasons:
245
246 (a) To make printing tidy core nicer
247
248 (b) Because we tidy RULES and InlineRules, which may then propagate
249 via --make into the compilation of the next module, and we want
250 the benefit of that occurrence analysis when we use the rule or
251 or inline the function. In particular, it's vital not to lose
252 loop-breaker info, else we get an infinite inlining loop
253
254 Note that tidyLetBndr puts more IdInfo back.
255
256 Note [Preserve evaluatedness]
257 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
258 Consider
259 data T = MkT !Bool
260 ....(case v of MkT y ->
261 let z# = case y of
262 True -> 1#
263 False -> 2#
264 in ...)
265
266 The z# binding is ok because the RHS is ok-for-speculation,
267 but Lint will complain unless it can *see* that. So we
268 preserve the evaluated-ness on 'y' in tidyBndr.
269
270 (Another alternative would be to tidy unboxed lets into cases,
271 but that seems more indirect and surprising.)
272
273 Note [Preserve OneShotInfo]
274 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
275 We keep the OneShotInfo because we want it to propagate into the interface.
276 Not all OneShotInfo is determined by a compiler analysis; some is added by a
277 call of GHC.Exts.oneShot, which is then discarded before the end of the
278 optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
279 must preserve this info in inlinings. See Note [The oneShot function] in MkId.
280
281 This applies to lambda binders only, hence it is stored in IfaceLamBndr.
282 -}
283
284 (=:) :: a -> (a -> b) -> b
285 m =: k = m `seq` k m