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