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
14 #include "HsVersions.h"
24 import Name hiding (tidyNameOcc)
32 %************************************************************************
34 \subsection{Tidying expressions, rules}
36 %************************************************************************
41 -> (TidyEnv, CoreBind)
43 tidyBind env (NonRec bndr rhs)
44 = tidyLetBndr env (bndr,rhs) =: \ (env', bndr') ->
45 (env', NonRec bndr' (tidyExpr env' rhs))
47 tidyBind env (Rec prs)
48 = mapAccumL tidyLetBndr env prs =: \ (env', bndrs') ->
49 map (tidyExpr env') (map snd prs) =: \ rhss' ->
50 (env', Rec (zip bndrs' rhss'))
53 ------------ Expressions --------------
54 tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
55 tidyExpr env (Var v) = Var (tidyVarOcc env v)
56 tidyExpr env (Type ty) = Type (tidyType env ty)
57 tidyExpr _ (Lit lit) = Lit lit
58 tidyExpr env (App f a) = App (tidyExpr env f) (tidyExpr env a)
59 tidyExpr env (Note n e) = Note (tidyNote env n) (tidyExpr env e)
60 tidyExpr env (Cast e co) = Cast (tidyExpr env e) (tidyType env co)
62 tidyExpr env (Let b e)
63 = tidyBind env b =: \ (env', b') ->
64 Let b' (tidyExpr env' e)
66 tidyExpr env (Case e b ty alts)
67 = tidyBndr env b =: \ (env', b) ->
68 Case (tidyExpr env e) b (tidyType env ty)
69 (map (tidyAlt b env') alts)
71 tidyExpr env (Lam b e)
72 = tidyBndr env b =: \ (env', b) ->
73 Lam b (tidyExpr env' e)
75 ------------ Case alternatives --------------
76 tidyAlt :: CoreBndr -> TidyEnv -> CoreAlt -> CoreAlt
77 tidyAlt _case_bndr env (con, vs, rhs)
78 = tidyBndrs env vs =: \ (env', vs) ->
79 (con, vs, tidyExpr env' rhs)
81 ------------ Notes --------------
82 tidyNote :: TidyEnv -> Note -> Note
83 tidyNote _ note = note
85 ------------ Rules --------------
86 tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
88 tidyRules env (rule : rules)
89 = tidyRule env rule =: \ rule ->
90 tidyRules env rules =: \ rules ->
93 tidyRule :: TidyEnv -> CoreRule -> CoreRule
94 tidyRule _ rule@(BuiltinRule {}) = rule
95 tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
96 ru_fn = fn, ru_rough = mb_ns })
97 = tidyBndrs env bndrs =: \ (env', bndrs) ->
98 map (tidyExpr env') args =: \ args ->
99 rule { ru_bndrs = bndrs, ru_args = args,
100 ru_rhs = tidyExpr env' rhs,
101 ru_fn = tidyNameOcc env fn,
102 ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
106 %************************************************************************
108 \subsection{Tidying non-top-level binders}
110 %************************************************************************
113 tidyNameOcc :: TidyEnv -> Name -> Name
114 -- In rules and instances, we have Names, and we must tidy them too
115 -- Fortunately, we can lookup in the VarEnv with a name
116 tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
120 tidyVarOcc :: TidyEnv -> Var -> Var
121 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
123 -- tidyBndr is used for lambda and case binders
124 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
126 | isTyVar var = tidyTyVarBndr env var
127 | otherwise = tidyIdBndr env var
129 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
130 tidyBndrs env vars = mapAccumL tidyBndr env vars
132 tidyLetBndr :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
133 -- Used for local (non-top-level) let(rec)s
134 tidyLetBndr env (id,rhs)
135 = ((tidy_env,new_var_env), final_id)
137 ((tidy_env,var_env), new_id) = tidyIdBndr env id
139 -- We need to keep around any interesting strictness and
140 -- demand info because later on we may need to use it when
141 -- converting to A-normal form.
143 -- f (g x), where f is strict in its argument, will be converted
144 -- into case (g x) of z -> f z by CorePrep, but only if f still
145 -- has its strictness info.
147 -- Similarly for the demand info - on a let binder, this tells
148 -- CorePrep to turn the let into a case.
150 -- Similarly arity info for eta expansion in CorePrep
152 -- Set inline-prag info so that we preseve it across
153 -- separate compilation boundaries
154 final_id = new_id `setIdInfo` new_info
156 new_info = idInfo new_id
157 `setArityInfo` exprArity rhs
158 `setStrictnessInfo` strictnessInfo idinfo
159 `setDemandInfo` demandInfo idinfo
160 `setInlinePragInfo` inlinePragInfo idinfo
162 -- Override the env we get back from tidyId with the new IdInfo
163 -- so it gets propagated to the usage sites.
164 new_var_env = extendVarEnv var_env id final_id
166 -- Non-top-level variables
167 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
168 tidyIdBndr env@(tidy_env, var_env) id
169 = -- Do this pattern match strictly, otherwise we end up holding on to
170 -- stuff in the OccName.
171 case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
173 -- Give the Id a fresh print-name, *and* rename its type
174 -- The SrcLoc isn't important now,
175 -- though we could extract it from the Id
177 ty' = tidyType env (idType id)
178 name' = mkInternalName (idUnique id) occ' noSrcSpan
179 id' = mkLocalIdWithInfo name' ty' new_info
180 var_env' = extendVarEnv var_env id id'
182 -- Note [Tidy IdInfo]
183 new_info = vanillaIdInfo `setOccInfo` occInfo old_info
186 ((tidy_env', var_env'), id')
192 All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
193 should save some space; except that we preserve occurrence info for
196 (a) To make printing tidy core nicer
198 (b) Because we tidy RULES and InlineRules, which may then propagate
199 via --make into the compilation of the next module, and we want
200 the benefit of that occurrence analysis when we use the rule or
201 or inline the function. In particular, it's vital not to lose
202 loop-breaker info, else we get an infinite inlining loop
204 Note that tidyLetBndr puts more IdInfo back.
208 (=:) :: a -> (a -> b) -> b