2 % (c) The University of Glasgow 2006
3 % (c) The AQUA Project, Glasgow University, 1996-1998
6 This module contains "tidying" code for *nested* expressions, bindings, rules.
7 The code for *top-level* bindings is in TidyPgm.
11 tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding
14 #include "HsVersions.h"
20 import TcType( tidyType, tidyCo, tidyTyVarBndr )
24 import Name hiding (tidyNameOcc)
32 %************************************************************************
34 \subsection{Tidying expressions, rules}
36 %************************************************************************
41 -> (TidyEnv, CoreBind)
43 tidyBind env (NonRec bndr rhs)
44 = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->
45 (env', NonRec bndr' (tidyExpr env' rhs))
47 tidyBind env (Rec prs)
49 (env', bndrs') = mapAccumL (tidyLetBndr env') env prs
51 map (tidyExpr env') (map snd prs) =: \ rhss' ->
52 (env', Rec (zip bndrs' rhss'))
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 (Note n e) = Note (tidyNote env n) (tidyExpr env e)
63 tidyExpr env (Cast e co) = Cast (tidyExpr env e) (tidyCo env co)
65 tidyExpr env (Let b e)
66 = tidyBind env b =: \ (env', b') ->
67 Let b' (tidyExpr env' e)
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)
74 tidyExpr env (Lam b e)
75 = tidyBndr env b =: \ (env', b) ->
76 Lam b (tidyExpr env' e)
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)
84 ------------ Notes --------------
85 tidyNote :: TidyEnv -> Note -> Note
86 tidyNote _ note = note
88 ------------ Rules --------------
89 tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
91 tidyRules env (rule : rules)
92 = tidyRule env rule =: \ rule ->
93 tidyRules env rules =: \ rules ->
96 tidyRule :: TidyEnv -> CoreRule -> CoreRule
97 tidyRule _ rule@(BuiltinRule {}) = rule
98 tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
99 ru_fn = fn, ru_rough = mb_ns })
100 = tidyBndrs env bndrs =: \ (env', bndrs) ->
101 map (tidyExpr env') args =: \ args ->
102 rule { ru_bndrs = bndrs, ru_args = args,
103 ru_rhs = tidyExpr env' rhs,
104 ru_fn = tidyNameOcc env fn,
105 ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
109 %************************************************************************
111 \subsection{Tidying non-top-level binders}
113 %************************************************************************
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
123 tidyVarOcc :: TidyEnv -> Var -> Var
124 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
126 -- tidyBndr is used for lambda and case binders
127 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
129 | isTyVar var = tidyTyVarBndr env var
130 | otherwise = tidyIdBndr env var
132 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
133 tidyBndrs env vars = mapAccumL tidyBndr env vars
135 tidyLetBndr :: TidyEnv -- Knot-tied version for unfoldings
136 -> TidyEnv -- The one to extend
137 -> (Id, CoreExpr) -> (TidyEnv, Var)
138 -- Used for local (non-top-level) let(rec)s
139 tidyLetBndr rec_tidy_env env (id,rhs)
140 = ((tidy_occ_env,new_var_env), final_id)
142 ((tidy_occ_env,var_env), new_id) = tidyIdBndr env id
143 new_var_env = extendVarEnv var_env id final_id
144 -- Override the env we get back from tidyId with the
145 -- new IdInfo so it gets propagated to the usage sites.
147 -- We need to keep around any interesting strictness and
148 -- demand info because later on we may need to use it when
149 -- converting to A-normal form.
151 -- f (g x), where f is strict in its argument, will be converted
152 -- into case (g x) of z -> f z by CorePrep, but only if f still
153 -- has its strictness info.
155 -- Similarly for the demand info - on a let binder, this tells
156 -- CorePrep to turn the let into a case.
158 -- Similarly arity info for eta expansion in CorePrep
160 -- Set inline-prag info so that we preseve it across
161 -- separate compilation boundaries
162 final_id = new_id `setIdInfo` new_info
164 new_info = idInfo new_id
165 `setArityInfo` exprArity rhs
166 `setStrictnessInfo` strictnessInfo idinfo
167 `setDemandInfo` demandInfo idinfo
168 `setInlinePragInfo` inlinePragInfo idinfo
169 `setUnfoldingInfo` new_unf
171 new_unf | isStableUnfolding unf = tidyUnfolding rec_tidy_env unf (panic "tidy_unf")
172 | otherwise = noUnfolding
173 unf = unfoldingInfo idinfo
175 -- Non-top-level variables
176 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
177 tidyIdBndr env@(tidy_env, var_env) id
178 = -- Do this pattern match strictly, otherwise we end up holding on to
179 -- stuff in the OccName.
180 case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
182 -- Give the Id a fresh print-name, *and* rename its type
183 -- The SrcLoc isn't important now,
184 -- though we could extract it from the Id
186 ty' = tidyType env (idType id)
187 name' = mkInternalName (idUnique id) occ' noSrcSpan
188 id' = mkLocalIdWithInfo name' ty' new_info
189 var_env' = extendVarEnv var_env id id'
191 -- Note [Tidy IdInfo]
192 new_info = vanillaIdInfo `setOccInfo` occInfo old_info
195 ((tidy_env', var_env'), id')
198 ------------ Unfolding --------------
199 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
200 tidyUnfolding tidy_env (DFunUnfolding ar con ids) _
201 = DFunUnfolding ar con (map (fmap (tidyExpr tidy_env)) ids)
202 tidyUnfolding tidy_env
203 unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
206 = unf { uf_tmpl = tidyExpr tidy_env unf_rhs, -- Preserves OccInfo
207 uf_src = tidySrc tidy_env src }
210 tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon
212 tidySrc :: TidyEnv -> UnfoldingSource -> UnfoldingSource
213 tidySrc tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w)
214 tidySrc _ inl_info = inl_info
219 All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
220 should save some space; except that we preserve occurrence info for
223 (a) To make printing tidy core nicer
225 (b) Because we tidy RULES and InlineRules, which may then propagate
226 via --make into the compilation of the next module, and we want
227 the benefit of that occurrence analysis when we use the rule or
228 or inline the function. In particular, it's vital not to lose
229 loop-breaker info, else we get an infinite inlining loop
231 Note that tidyLetBndr puts more IdInfo back.
235 (=:) :: a -> (a -> b) -> b