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