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