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