1{-
2(c) The University of Glasgow 2006
3(c) The AQUA Project, Glasgow University, 1996-1998
4
5
6This module contains "tidying" code for *nested* expressions, bindings, rules.
7The code for *top-level* bindings is in TidyPgm.
8-}
9
10{-# LANGUAGE CPP #-}
11module CoreTidy (
12        tidyExpr, tidyRules, tidyUnfolding
13    ) where
14
15#include "HsVersions.h"
16
17import GhcPrelude
18
19import CoreSyn
20import CoreSeq ( seqUnfolding )
21import Id
22import IdInfo
23import Demand ( zapUsageEnvSig )
24import Type( tidyType, tidyVarBndr )
25import Coercion( tidyCo )
26import Var
27import VarEnv
28import UniqFM
29import Name hiding (tidyNameOcc)
30import SrcLoc
31import Maybes
32import Data.List
33
34{-
35************************************************************************
36*                                                                      *
37\subsection{Tidying expressions, rules}
38*                                                                      *
39************************************************************************
40-}
41
42tidyBind :: TidyEnv
43         -> CoreBind
44         ->  (TidyEnv, CoreBind)
45
46tidyBind env (NonRec bndr rhs)
47  = tidyLetBndr env env bndr =: \ (env', bndr') ->
48    (env', NonRec bndr' (tidyExpr env' rhs))
49
50tidyBind 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  --------------
60tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
61tidyExpr env (Var v)       = Var (tidyVarOcc env v)
62tidyExpr env (Type ty)     = Type (tidyType env ty)
63tidyExpr env (Coercion co) = Coercion (tidyCo env co)
64tidyExpr _   (Lit lit)     = Lit lit
65tidyExpr env (App f a)     = App (tidyExpr env f) (tidyExpr env a)
66tidyExpr env (Tick t e)    = Tick (tidyTickish env t) (tidyExpr env e)
67tidyExpr env (Cast e co)   = Cast (tidyExpr env e) (tidyCo env co)
68
69tidyExpr env (Let b e)
70  = tidyBind env b      =: \ (env', b') ->
71    Let b' (tidyExpr env' e)
72
73tidyExpr 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
78tidyExpr env (Lam b e)
79  = tidyBndr env b      =: \ (env', b) ->
80    Lam b (tidyExpr env' e)
81
82------------  Case alternatives  --------------
83tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt
84tidyAlt env (con, vs, rhs)
85  = tidyBndrs env vs    =: \ (env', vs) ->
86    (con, vs, tidyExpr env' rhs)
87
88------------  Tickish  --------------
89tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
90tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)
91tidyTickish _   other_tickish       = other_tickish
92
93------------  Rules  --------------
94tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
95tidyRules _   [] = []
96tidyRules env (rule : rules)
97  = tidyRule env rule           =: \ rule ->
98    tidyRules env rules         =: \ rules ->
99    (rule : rules)
100
101tidyRule :: TidyEnv -> CoreRule -> CoreRule
102tidyRule _   rule@(BuiltinRule {}) = rule
103tidyRule 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
120tidyNameOcc :: 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
123tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
124                                Nothing -> n
125                                Just v  -> idName v
126
127tidyVarOcc :: TidyEnv -> Var -> Var
128tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
129
130-- tidyBndr is used for lambda and case binders
131tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
132tidyBndr env var
133  | isTyCoVar var = tidyVarBndr env var
134  | otherwise     = tidyIdBndr env var
135
136tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
137tidyBndrs env vars = mapAccumL tidyBndr env vars
138
139-- Non-top-level variables, not covars
140tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
141tidyIdBndr 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
167tidyLetBndr :: 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
172tidyLetBndr 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  --------------
219tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
220tidyUnfolding 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
225tidyUnfolding 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
237tidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon
238
239{-
240Note [Tidy IdInfo]
241~~~~~~~~~~~~~~~~~~
242All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
243should save some space; except that we preserve occurrence info for
244two 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
254Note that tidyLetBndr puts more IdInfo back.
255
256Note [Preserve evaluatedness]
257~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
258Consider
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
266The z# binding is ok because the RHS is ok-for-speculation,
267but Lint will complain unless it can *see* that.  So we
268preserve the evaluated-ness on 'y' in tidyBndr.
269
270(Another alternative would be to tidy unboxed lets into cases,
271but that seems more indirect and surprising.)
272
273Note [Preserve OneShotInfo]
274~~~~~~~~~~~~~~~~~~~~~~~~~~~
275We keep the OneShotInfo because we want it to propagate into the interface.
276Not all OneShotInfo is determined by a compiler analysis; some is added by a
277call of GHC.Exts.oneShot, which is then discarded before the end of the
278optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
279must preserve this info in inlinings. See Note [The oneShot function] in MkId.
280
281This applies to lambda binders only, hence it is stored in IfaceLamBndr.
282-}
283
284(=:) :: a -> (a -> b) -> b
285m =: k = m `seq` k m
286