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, 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 _ (Lit lit) = Lit lit
60 tidyExpr env (App f a) = App (tidyExpr env f) (tidyExpr env a)
61 tidyExpr env (Note n e) = Note (tidyNote env n) (tidyExpr env e)
62 tidyExpr env (Cast e co) = Cast (tidyExpr env e) (tidyType env co)
64 tidyExpr env (Let b e)
65 = tidyBind env b =: \ (env', b') ->
66 Let b' (tidyExpr env' e)
68 tidyExpr env (Case e b ty alts)
69 = tidyBndr env b =: \ (env', b) ->
70 Case (tidyExpr env e) b (tidyType env ty)
71 (map (tidyAlt b env') alts)
73 tidyExpr env (Lam b e)
74 = tidyBndr env b =: \ (env', b) ->
75 Lam b (tidyExpr env' e)
77 ------------ Case alternatives --------------
78 tidyAlt :: CoreBndr -> TidyEnv -> CoreAlt -> CoreAlt
79 tidyAlt _case_bndr env (con, vs, rhs)
80 = tidyBndrs env vs =: \ (env', vs) ->
81 (con, vs, tidyExpr env' rhs)
83 ------------ Notes --------------
84 tidyNote :: TidyEnv -> Note -> Note
85 tidyNote _ note = note
87 ------------ Rules --------------
88 tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
90 tidyRules env (rule : rules)
91 = tidyRule env rule =: \ rule ->
92 tidyRules env rules =: \ rules ->
95 tidyRule :: TidyEnv -> CoreRule -> CoreRule
96 tidyRule _ rule@(BuiltinRule {}) = rule
97 tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
98 ru_fn = fn, ru_rough = mb_ns })
99 = tidyBndrs env bndrs =: \ (env', bndrs) ->
100 map (tidyExpr env') args =: \ args ->
101 rule { ru_bndrs = bndrs, ru_args = args,
102 ru_rhs = tidyExpr env' rhs,
103 ru_fn = tidyNameOcc env fn,
104 ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
108 %************************************************************************
110 \subsection{Tidying non-top-level binders}
112 %************************************************************************
115 tidyNameOcc :: TidyEnv -> Name -> Name
116 -- In rules and instances, we have Names, and we must tidy them too
117 -- Fortunately, we can lookup in the VarEnv with a name
118 tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
122 tidyVarOcc :: TidyEnv -> Var -> Var
123 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
125 -- tidyBndr is used for lambda and case binders
126 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
128 | isTyCoVar var = tidyTyVarBndr env var
129 | otherwise = tidyIdBndr env var
131 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
132 tidyBndrs env vars = mapAccumL tidyBndr env vars
134 tidyLetBndr :: TidyEnv -- Knot-tied version for unfoldings
135 -> TidyEnv -- The one to extend
136 -> (Id, CoreExpr) -> (TidyEnv, Var)
137 -- Used for local (non-top-level) let(rec)s
138 tidyLetBndr rec_tidy_env env (id,rhs)
139 = ((tidy_occ_env,new_var_env), final_id)
141 ((tidy_occ_env,var_env), new_id) = tidyIdBndr env id
142 new_var_env = extendVarEnv var_env id final_id
143 -- Override the env we get back from tidyId with the
144 -- new IdInfo so it gets propagated to the usage sites.
146 -- We need to keep around any interesting strictness and
147 -- demand info because later on we may need to use it when
148 -- converting to A-normal form.
150 -- f (g x), where f is strict in its argument, will be converted
151 -- into case (g x) of z -> f z by CorePrep, but only if f still
152 -- has its strictness info.
154 -- Similarly for the demand info - on a let binder, this tells
155 -- CorePrep to turn the let into a case.
157 -- Similarly arity info for eta expansion in CorePrep
159 -- Set inline-prag info so that we preseve it across
160 -- separate compilation boundaries
161 final_id = new_id `setIdInfo` new_info
163 new_info = idInfo new_id
164 `setArityInfo` exprArity rhs
165 `setStrictnessInfo` strictnessInfo idinfo
166 `setDemandInfo` demandInfo idinfo
167 `setInlinePragInfo` inlinePragInfo idinfo
168 `setUnfoldingInfo` new_unf
170 new_unf | isStableUnfolding unf = tidyUnfolding rec_tidy_env unf (panic "tidy_unf")
171 | otherwise = noUnfolding
172 unf = unfoldingInfo idinfo
174 -- Non-top-level variables
175 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
176 tidyIdBndr env@(tidy_env, var_env) id
177 = -- Do this pattern match strictly, otherwise we end up holding on to
178 -- stuff in the OccName.
179 case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
181 -- Give the Id a fresh print-name, *and* rename its type
182 -- The SrcLoc isn't important now,
183 -- though we could extract it from the Id
185 ty' = tidyType env (idType id)
186 name' = mkInternalName (idUnique id) occ' noSrcSpan
187 id' = mkLocalIdWithInfo name' ty' new_info
188 var_env' = extendVarEnv var_env id id'
190 -- Note [Tidy IdInfo]
191 new_info = vanillaIdInfo `setOccInfo` occInfo old_info
194 ((tidy_env', var_env'), id')
197 ------------ Unfolding --------------
198 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
199 tidyUnfolding tidy_env (DFunUnfolding ar con ids) _
200 = DFunUnfolding ar con (map (fmap (tidyExpr tidy_env)) ids)
201 tidyUnfolding tidy_env
202 unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
205 = unf { uf_tmpl = tidyExpr tidy_env unf_rhs, -- Preserves OccInfo
206 uf_src = tidySrc tidy_env src }
209 tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon
211 tidySrc :: TidyEnv -> UnfoldingSource -> UnfoldingSource
212 tidySrc tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w)
213 tidySrc _ inl_info = inl_info
218 All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
219 should save some space; except that we preserve occurrence info for
222 (a) To make printing tidy core nicer
224 (b) Because we tidy RULES and InlineRules, which may then propagate
225 via --make into the compilation of the next module, and we want
226 the benefit of that occurrence analysis when we use the rule or
227 or inline the function. In particular, it's vital not to lose
228 loop-breaker info, else we get an infinite inlining loop
230 Note that tidyLetBndr puts more IdInfo back.
234 (=:) :: a -> (a -> b) -> b