1{- 2(c) The University of Glasgow 2006 3(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 4 5 6Utility functions on @Core@ syntax 7-} 8 9{-# LANGUAGE CPP #-} 10module CoreSubst ( 11 -- * Main data types 12 Subst(..), -- Implementation exported for supercompiler's Renaming.hs only 13 TvSubstEnv, IdSubstEnv, InScopeSet, 14 15 -- ** Substituting into expressions and related types 16 deShadowBinds, substSpec, substRulesForImportedIds, 17 substTy, substCo, substExpr, substExprSC, substBind, substBindSC, 18 substUnfolding, substUnfoldingSC, 19 lookupIdSubst, lookupTCvSubst, substIdType, substIdOcc, 20 substTickish, substDVarSet, substIdInfo, 21 22 -- ** Operations on substitutions 23 emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst, 24 extendIdSubst, extendIdSubstList, extendTCvSubst, extendTvSubstList, 25 extendSubst, extendSubstList, extendSubstWithVar, zapSubstEnv, 26 addInScopeSet, extendInScope, extendInScopeList, extendInScopeIds, 27 isInScope, setInScope, getTCvSubst, extendTvSubst, extendCvSubst, 28 delBndr, delBndrs, 29 30 -- ** Substituting and cloning binders 31 substBndr, substBndrs, substRecBndrs, substTyVarBndr, substCoVarBndr, 32 cloneBndr, cloneBndrs, cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs, 33 34 ) where 35 36#include "GhclibHsVersions.h" 37 38 39import GhcPrelude 40 41import CoreSyn 42import CoreFVs 43import CoreSeq 44import CoreUtils 45import qualified Type 46import qualified Coercion 47 48 -- We are defining local versions 49import Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList 50 , isInScope, substTyVarBndr, cloneTyVarBndr ) 51import Coercion hiding ( substCo, substCoVarBndr ) 52 53import PrelNames 54import VarSet 55import VarEnv 56import Id 57import Name ( Name ) 58import Var 59import IdInfo 60import UniqSupply 61import Maybes 62import Util 63import Outputable 64import Data.List 65 66 67 68{- 69************************************************************************ 70* * 71\subsection{Substitutions} 72* * 73************************************************************************ 74-} 75 76-- | A substitution environment, containing 'Id', 'TyVar', and 'CoVar' 77-- substitutions. 78-- 79-- Some invariants apply to how you use the substitution: 80-- 81-- 1. Note [The substitution invariant] in TyCoSubst 82-- 83-- 2. Note [Substitutions apply only once] in TyCoSubst 84data Subst 85 = Subst InScopeSet -- Variables in in scope (both Ids and TyVars) /after/ 86 -- applying the substitution 87 IdSubstEnv -- Substitution from NcIds to CoreExprs 88 TvSubstEnv -- Substitution from TyVars to Types 89 CvSubstEnv -- Substitution from CoVars to Coercions 90 91 -- INVARIANT 1: See TyCoSubst Note [The substitution invariant] 92 -- This is what lets us deal with name capture properly 93 -- It's a hard invariant to check... 94 -- 95 -- INVARIANT 2: The substitution is apply-once; see Note [Apply once] with 96 -- Types.TvSubstEnv 97 -- 98 -- INVARIANT 3: See Note [Extending the Subst] 99 100{- 101Note [Extending the Subst] 102~~~~~~~~~~~~~~~~~~~~~~~~~~ 103For a core Subst, which binds Ids as well, we make a different choice for Ids 104than we do for TyVars. 105 106For TyVars, see Note [Extending the TCvSubst] in TyCoSubst. 107 108For Ids, we have a different invariant 109 The IdSubstEnv is extended *only* when the Unique on an Id changes 110 Otherwise, we just extend the InScopeSet 111 112In consequence: 113 114* If all subst envs are empty, substExpr would be a 115 no-op, so substExprSC ("short cut") does nothing. 116 117 However, substExpr still goes ahead and substitutes. Reason: we may 118 want to replace existing Ids with new ones from the in-scope set, to 119 avoid space leaks. 120 121* In substIdBndr, we extend the IdSubstEnv only when the unique changes 122 123* If the CvSubstEnv, TvSubstEnv and IdSubstEnv are all empty, 124 substExpr does nothing (Note that the above rule for substIdBndr 125 maintains this property. If the incoming envts are both empty, then 126 substituting the type and IdInfo can't change anything.) 127 128* In lookupIdSubst, we *must* look up the Id in the in-scope set, because 129 it may contain non-trivial changes. Example: 130 (/\a. \x:a. ...x...) Int 131 We extend the TvSubstEnv with [a |-> Int]; but x's unique does not change 132 so we only extend the in-scope set. Then we must look up in the in-scope 133 set when we find the occurrence of x. 134 135* The requirement to look up the Id in the in-scope set means that we 136 must NOT take no-op short cut when the IdSubst is empty. 137 We must still look up every Id in the in-scope set. 138 139* (However, we don't need to do so for expressions found in the IdSubst 140 itself, whose range is assumed to be correct wrt the in-scope set.) 141 142Why do we make a different choice for the IdSubstEnv than the 143TvSubstEnv and CvSubstEnv? 144 145* For Ids, we change the IdInfo all the time (e.g. deleting the 146 unfolding), and adding it back later, so using the TyVar convention 147 would entail extending the substitution almost all the time 148 149* The simplifier wants to look up in the in-scope set anyway, in case it 150 can see a better unfolding from an enclosing case expression 151 152* For TyVars, only coercion variables can possibly change, and they are 153 easy to spot 154-} 155 156-- | An environment for substituting for 'Id's 157type IdSubstEnv = IdEnv CoreExpr -- Domain is NcIds, i.e. not coercions 158 159---------------------------- 160isEmptySubst :: Subst -> Bool 161isEmptySubst (Subst _ id_env tv_env cv_env) 162 = isEmptyVarEnv id_env && isEmptyVarEnv tv_env && isEmptyVarEnv cv_env 163 164emptySubst :: Subst 165emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv emptyVarEnv 166 167mkEmptySubst :: InScopeSet -> Subst 168mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv 169 170mkSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> IdSubstEnv -> Subst 171mkSubst in_scope tvs cvs ids = Subst in_scope ids tvs cvs 172 173-- | Find the in-scope set: see TyCoSubst Note [The substitution invariant] 174substInScope :: Subst -> InScopeSet 175substInScope (Subst in_scope _ _ _) = in_scope 176 177-- | Remove all substitutions for 'Id's and 'Var's that might have been built up 178-- while preserving the in-scope set 179zapSubstEnv :: Subst -> Subst 180zapSubstEnv (Subst in_scope _ _ _) = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv 181 182-- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is 183-- such that TyCoSubst Note [The substitution invariant] 184-- holds after extending the substitution like this 185extendIdSubst :: Subst -> Id -> CoreExpr -> Subst 186-- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set 187extendIdSubst (Subst in_scope ids tvs cvs) v r 188 = ASSERT2( isNonCoVarId v, ppr v $$ ppr r ) 189 Subst in_scope (extendVarEnv ids v r) tvs cvs 190 191-- | Adds multiple 'Id' substitutions to the 'Subst': see also 'extendIdSubst' 192extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst 193extendIdSubstList (Subst in_scope ids tvs cvs) prs 194 = ASSERT( all (isNonCoVarId . fst) prs ) 195 Subst in_scope (extendVarEnvList ids prs) tvs cvs 196 197-- | Add a substitution for a 'TyVar' to the 'Subst' 198-- The 'TyVar' *must* be a real TyVar, and not a CoVar 199-- You must ensure that the in-scope set is such that 200-- TyCoSubst Note [The substitution invariant] holds 201-- after extending the substitution like this. 202extendTvSubst :: Subst -> TyVar -> Type -> Subst 203extendTvSubst (Subst in_scope ids tvs cvs) tv ty 204 = ASSERT( isTyVar tv ) 205 Subst in_scope ids (extendVarEnv tvs tv ty) cvs 206 207-- | Adds multiple 'TyVar' substitutions to the 'Subst': see also 'extendTvSubst' 208extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst 209extendTvSubstList subst vrs 210 = foldl' extend subst vrs 211 where 212 extend subst (v, r) = extendTvSubst subst v r 213 214-- | Add a substitution from a 'CoVar' to a 'Coercion' to the 'Subst': 215-- you must ensure that the in-scope set satisfies 216-- TyCoSubst Note [The substitution invariant] 217-- after extending the substitution like this 218extendCvSubst :: Subst -> CoVar -> Coercion -> Subst 219extendCvSubst (Subst in_scope ids tvs cvs) v r 220 = ASSERT( isCoVar v ) 221 Subst in_scope ids tvs (extendVarEnv cvs v r) 222 223-- | Add a substitution appropriate to the thing being substituted 224-- (whether an expression, type, or coercion). See also 225-- 'extendIdSubst', 'extendTvSubst', 'extendCvSubst' 226extendSubst :: Subst -> Var -> CoreArg -> Subst 227extendSubst subst var arg 228 = case arg of 229 Type ty -> ASSERT( isTyVar var ) extendTvSubst subst var ty 230 Coercion co -> ASSERT( isCoVar var ) extendCvSubst subst var co 231 _ -> ASSERT( isId var ) extendIdSubst subst var arg 232 233extendSubstWithVar :: Subst -> Var -> Var -> Subst 234extendSubstWithVar subst v1 v2 235 | isTyVar v1 = ASSERT( isTyVar v2 ) extendTvSubst subst v1 (mkTyVarTy v2) 236 | isCoVar v1 = ASSERT( isCoVar v2 ) extendCvSubst subst v1 (mkCoVarCo v2) 237 | otherwise = ASSERT( isId v2 ) extendIdSubst subst v1 (Var v2) 238 239-- | Add a substitution as appropriate to each of the terms being 240-- substituted (whether expressions, types, or coercions). See also 241-- 'extendSubst'. 242extendSubstList :: Subst -> [(Var,CoreArg)] -> Subst 243extendSubstList subst [] = subst 244extendSubstList subst ((var,rhs):prs) = extendSubstList (extendSubst subst var rhs) prs 245 246-- | Find the substitution for an 'Id' in the 'Subst' 247lookupIdSubst :: SDoc -> Subst -> Id -> CoreExpr 248lookupIdSubst doc (Subst in_scope ids _ _) v 249 | not (isLocalId v) = Var v 250 | Just e <- lookupVarEnv ids v = e 251 | Just v' <- lookupInScope in_scope v = Var v' 252 -- Vital! See Note [Extending the Subst] 253 | otherwise = WARN( True, text "CoreSubst.lookupIdSubst" <+> doc <+> ppr v 254 $$ ppr in_scope) 255 Var v 256 257-- | Find the substitution for a 'TyVar' in the 'Subst' 258lookupTCvSubst :: Subst -> TyVar -> Type 259lookupTCvSubst (Subst _ _ tvs cvs) v 260 | isTyVar v 261 = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v 262 | otherwise 263 = mkCoercionTy $ lookupVarEnv cvs v `orElse` mkCoVarCo v 264 265delBndr :: Subst -> Var -> Subst 266delBndr (Subst in_scope ids tvs cvs) v 267 | isCoVar v = Subst in_scope ids tvs (delVarEnv cvs v) 268 | isTyVar v = Subst in_scope ids (delVarEnv tvs v) cvs 269 | otherwise = Subst in_scope (delVarEnv ids v) tvs cvs 270 271delBndrs :: Subst -> [Var] -> Subst 272delBndrs (Subst in_scope ids tvs cvs) vs 273 = Subst in_scope (delVarEnvList ids vs) (delVarEnvList tvs vs) (delVarEnvList cvs vs) 274 -- Easiest thing is just delete all from all! 275 276-- | Simultaneously substitute for a bunch of variables 277-- No left-right shadowing 278-- ie the substitution for (\x \y. e) a1 a2 279-- so neither x nor y scope over a1 a2 280mkOpenSubst :: InScopeSet -> [(Var,CoreArg)] -> Subst 281mkOpenSubst in_scope pairs = Subst in_scope 282 (mkVarEnv [(id,e) | (id, e) <- pairs, isId id]) 283 (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs]) 284 (mkVarEnv [(v,co) | (v, Coercion co) <- pairs]) 285 286------------------------------ 287isInScope :: Var -> Subst -> Bool 288isInScope v (Subst in_scope _ _ _) = v `elemInScopeSet` in_scope 289 290-- | Add the 'Var' to the in-scope set, but do not remove 291-- any existing substitutions for it 292addInScopeSet :: Subst -> VarSet -> Subst 293addInScopeSet (Subst in_scope ids tvs cvs) vs 294 = Subst (in_scope `extendInScopeSetSet` vs) ids tvs cvs 295 296-- | Add the 'Var' to the in-scope set: as a side effect, 297-- and remove any existing substitutions for it 298extendInScope :: Subst -> Var -> Subst 299extendInScope (Subst in_scope ids tvs cvs) v 300 = Subst (in_scope `extendInScopeSet` v) 301 (ids `delVarEnv` v) (tvs `delVarEnv` v) (cvs `delVarEnv` v) 302 303-- | Add the 'Var's to the in-scope set: see also 'extendInScope' 304extendInScopeList :: Subst -> [Var] -> Subst 305extendInScopeList (Subst in_scope ids tvs cvs) vs 306 = Subst (in_scope `extendInScopeSetList` vs) 307 (ids `delVarEnvList` vs) (tvs `delVarEnvList` vs) (cvs `delVarEnvList` vs) 308 309-- | Optimized version of 'extendInScopeList' that can be used if you are certain 310-- all the things being added are 'Id's and hence none are 'TyVar's or 'CoVar's 311extendInScopeIds :: Subst -> [Id] -> Subst 312extendInScopeIds (Subst in_scope ids tvs cvs) vs 313 = Subst (in_scope `extendInScopeSetList` vs) 314 (ids `delVarEnvList` vs) tvs cvs 315 316setInScope :: Subst -> InScopeSet -> Subst 317setInScope (Subst _ ids tvs cvs) in_scope = Subst in_scope ids tvs cvs 318 319-- Pretty printing, for debugging only 320 321instance Outputable Subst where 322 ppr (Subst in_scope ids tvs cvs) 323 = text "<InScope =" <+> in_scope_doc 324 $$ text " IdSubst =" <+> ppr ids 325 $$ text " TvSubst =" <+> ppr tvs 326 $$ text " CvSubst =" <+> ppr cvs 327 <> char '>' 328 where 329 in_scope_doc = pprVarSet (getInScopeVars in_scope) (braces . fsep . map ppr) 330 331{- 332************************************************************************ 333* * 334 Substituting expressions 335* * 336************************************************************************ 337-} 338 339-- | Apply a substitution to an entire 'CoreExpr'. Remember, you may only 340-- apply the substitution /once/: 341-- See Note [Substitutions apply only once] in TyCoSubst 342-- 343-- Do *not* attempt to short-cut in the case of an empty substitution! 344-- See Note [Extending the Subst] 345substExprSC :: SDoc -> Subst -> CoreExpr -> CoreExpr 346substExprSC doc subst orig_expr 347 | isEmptySubst subst = orig_expr 348 | otherwise = -- pprTrace "enter subst-expr" (doc $$ ppr orig_expr) $ 349 subst_expr doc subst orig_expr 350 351substExpr :: SDoc -> Subst -> CoreExpr -> CoreExpr 352substExpr doc subst orig_expr = subst_expr doc subst orig_expr 353 354subst_expr :: SDoc -> Subst -> CoreExpr -> CoreExpr 355subst_expr doc subst expr 356 = go expr 357 where 358 go (Var v) = lookupIdSubst (doc $$ text "subst_expr") subst v 359 go (Type ty) = Type (substTy subst ty) 360 go (Coercion co) = Coercion (substCo subst co) 361 go (Lit lit) = Lit lit 362 go (App fun arg) = App (go fun) (go arg) 363 go (Tick tickish e) = mkTick (substTickish subst tickish) (go e) 364 go (Cast e co) = Cast (go e) (substCo subst co) 365 -- Do not optimise even identity coercions 366 -- Reason: substitution applies to the LHS of RULES, and 367 -- if you "optimise" an identity coercion, you may 368 -- lose a binder. We optimise the LHS of rules at 369 -- construction time 370 371 go (Lam bndr body) = Lam bndr' (subst_expr doc subst' body) 372 where 373 (subst', bndr') = substBndr subst bndr 374 375 go (Let bind body) = Let bind' (subst_expr doc subst' body) 376 where 377 (subst', bind') = substBind subst bind 378 379 go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts) 380 where 381 (subst', bndr') = substBndr subst bndr 382 383 go_alt subst (con, bndrs, rhs) = (con, bndrs', subst_expr doc subst' rhs) 384 where 385 (subst', bndrs') = substBndrs subst bndrs 386 387-- | Apply a substitution to an entire 'CoreBind', additionally returning an updated 'Subst' 388-- that should be used by subsequent substitutions. 389substBind, substBindSC :: Subst -> CoreBind -> (Subst, CoreBind) 390 391substBindSC subst bind -- Short-cut if the substitution is empty 392 | not (isEmptySubst subst) 393 = substBind subst bind 394 | otherwise 395 = case bind of 396 NonRec bndr rhs -> (subst', NonRec bndr' rhs) 397 where 398 (subst', bndr') = substBndr subst bndr 399 Rec pairs -> (subst', Rec (bndrs' `zip` rhss')) 400 where 401 (bndrs, rhss) = unzip pairs 402 (subst', bndrs') = substRecBndrs subst bndrs 403 rhss' | isEmptySubst subst' 404 = rhss 405 | otherwise 406 = map (subst_expr (text "substBindSC") subst') rhss 407 408substBind subst (NonRec bndr rhs) 409 = (subst', NonRec bndr' (subst_expr (text "substBind") subst rhs)) 410 where 411 (subst', bndr') = substBndr subst bndr 412 413substBind subst (Rec pairs) 414 = (subst', Rec (bndrs' `zip` rhss')) 415 where 416 (bndrs, rhss) = unzip pairs 417 (subst', bndrs') = substRecBndrs subst bndrs 418 rhss' = map (subst_expr (text "substBind") subst') rhss 419 420-- | De-shadowing the program is sometimes a useful pre-pass. It can be done simply 421-- by running over the bindings with an empty substitution, because substitution 422-- returns a result that has no-shadowing guaranteed. 423-- 424-- (Actually, within a single /type/ there might still be shadowing, because 425-- 'substTy' is a no-op for the empty substitution, but that's probably OK.) 426-- 427-- [Aug 09] This function is not used in GHC at the moment, but seems so 428-- short and simple that I'm going to leave it here 429deShadowBinds :: CoreProgram -> CoreProgram 430deShadowBinds binds = snd (mapAccumL substBind emptySubst binds) 431 432{- 433************************************************************************ 434* * 435 Substituting binders 436* * 437************************************************************************ 438 439Remember that substBndr and friends are used when doing expression 440substitution only. Their only business is substitution, so they 441preserve all IdInfo (suitably substituted). For example, we *want* to 442preserve occ info in rules. 443-} 444 445-- | Substitutes a 'Var' for another one according to the 'Subst' given, returning 446-- the result and an updated 'Subst' that should be used by subsequent substitutions. 447-- 'IdInfo' is preserved by this process, although it is substituted into appropriately. 448substBndr :: Subst -> Var -> (Subst, Var) 449substBndr subst bndr 450 | isTyVar bndr = substTyVarBndr subst bndr 451 | isCoVar bndr = substCoVarBndr subst bndr 452 | otherwise = substIdBndr (text "var-bndr") subst subst bndr 453 454-- | Applies 'substBndr' to a number of 'Var's, accumulating a new 'Subst' left-to-right 455substBndrs :: Subst -> [Var] -> (Subst, [Var]) 456substBndrs subst bndrs = mapAccumL substBndr subst bndrs 457 458-- | Substitute in a mutually recursive group of 'Id's 459substRecBndrs :: Subst -> [Id] -> (Subst, [Id]) 460substRecBndrs subst bndrs 461 = (new_subst, new_bndrs) 462 where -- Here's the reason we need to pass rec_subst to subst_id 463 (new_subst, new_bndrs) = mapAccumL (substIdBndr (text "rec-bndr") new_subst) subst bndrs 464 465substIdBndr :: SDoc 466 -> Subst -- ^ Substitution to use for the IdInfo 467 -> Subst -> Id -- ^ Substitution and Id to transform 468 -> (Subst, Id) -- ^ Transformed pair 469 -- NB: unfolding may be zapped 470 471substIdBndr _doc rec_subst subst@(Subst in_scope env tvs cvs) old_id 472 = -- pprTrace "substIdBndr" (doc $$ ppr old_id $$ ppr in_scope) $ 473 (Subst (in_scope `extendInScopeSet` new_id) new_env tvs cvs, new_id) 474 where 475 id1 = uniqAway in_scope old_id -- id1 is cloned if necessary 476 id2 | no_type_change = id1 477 | otherwise = setIdType id1 (substTy subst old_ty) 478 479 old_ty = idType old_id 480 no_type_change = (isEmptyVarEnv tvs && isEmptyVarEnv cvs) || 481 noFreeVarsOfType old_ty 482 483 -- new_id has the right IdInfo 484 -- The lazy-set is because we're in a loop here, with 485 -- rec_subst, when dealing with a mutually-recursive group 486 new_id = maybeModifyIdInfo mb_new_info id2 487 mb_new_info = substIdInfo rec_subst id2 (idInfo id2) 488 -- NB: unfolding info may be zapped 489 490 -- Extend the substitution if the unique has changed 491 -- See the notes with substTyVarBndr for the delVarEnv 492 new_env | no_change = delVarEnv env old_id 493 | otherwise = extendVarEnv env old_id (Var new_id) 494 495 no_change = id1 == old_id 496 -- See Note [Extending the Subst] 497 -- it's /not/ necessary to check mb_new_info and no_type_change 498 499{- 500Now a variant that unconditionally allocates a new unique. 501It also unconditionally zaps the OccInfo. 502-} 503 504-- | Very similar to 'substBndr', but it always allocates a new 'Unique' for 505-- each variable in its output. It substitutes the IdInfo though. 506cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id) 507cloneIdBndr subst us old_id 508 = clone_id subst subst (old_id, uniqFromSupply us) 509 510-- | Applies 'cloneIdBndr' to a number of 'Id's, accumulating a final 511-- substitution from left to right 512cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id]) 513cloneIdBndrs subst us ids 514 = mapAccumL (clone_id subst) subst (ids `zip` uniqsFromSupply us) 515 516cloneBndrs :: Subst -> UniqSupply -> [Var] -> (Subst, [Var]) 517-- Works for all kinds of variables (typically case binders) 518-- not just Ids 519cloneBndrs subst us vs 520 = mapAccumL (\subst (v, u) -> cloneBndr subst u v) subst (vs `zip` uniqsFromSupply us) 521 522cloneBndr :: Subst -> Unique -> Var -> (Subst, Var) 523cloneBndr subst uniq v 524 | isTyVar v = cloneTyVarBndr subst v uniq 525 | otherwise = clone_id subst subst (v,uniq) -- Works for coercion variables too 526 527-- | Clone a mutually recursive group of 'Id's 528cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id]) 529cloneRecIdBndrs subst us ids 530 = (subst', ids') 531 where 532 (subst', ids') = mapAccumL (clone_id subst') subst 533 (ids `zip` uniqsFromSupply us) 534 535-- Just like substIdBndr, except that it always makes a new unique 536-- It is given the unique to use 537clone_id :: Subst -- Substitution for the IdInfo 538 -> Subst -> (Id, Unique) -- Substitution and Id to transform 539 -> (Subst, Id) -- Transformed pair 540 541clone_id rec_subst subst@(Subst in_scope idvs tvs cvs) (old_id, uniq) 542 = (Subst (in_scope `extendInScopeSet` new_id) new_idvs tvs new_cvs, new_id) 543 where 544 id1 = setVarUnique old_id uniq 545 id2 = substIdType subst id1 546 new_id = maybeModifyIdInfo (substIdInfo rec_subst id2 (idInfo old_id)) id2 547 (new_idvs, new_cvs) | isCoVar old_id = (idvs, extendVarEnv cvs old_id (mkCoVarCo new_id)) 548 | otherwise = (extendVarEnv idvs old_id (Var new_id), cvs) 549 550{- 551************************************************************************ 552* * 553 Types and Coercions 554* * 555************************************************************************ 556 557For types and coercions we just call the corresponding functions in 558Type and Coercion, but we have to repackage the substitution, from a 559Subst to a TCvSubst. 560-} 561 562substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar) 563substTyVarBndr (Subst in_scope id_env tv_env cv_env) tv 564 = case Type.substTyVarBndr (TCvSubst in_scope tv_env cv_env) tv of 565 (TCvSubst in_scope' tv_env' cv_env', tv') 566 -> (Subst in_scope' id_env tv_env' cv_env', tv') 567 568cloneTyVarBndr :: Subst -> TyVar -> Unique -> (Subst, TyVar) 569cloneTyVarBndr (Subst in_scope id_env tv_env cv_env) tv uniq 570 = case Type.cloneTyVarBndr (TCvSubst in_scope tv_env cv_env) tv uniq of 571 (TCvSubst in_scope' tv_env' cv_env', tv') 572 -> (Subst in_scope' id_env tv_env' cv_env', tv') 573 574substCoVarBndr :: Subst -> TyVar -> (Subst, TyVar) 575substCoVarBndr (Subst in_scope id_env tv_env cv_env) cv 576 = case Coercion.substCoVarBndr (TCvSubst in_scope tv_env cv_env) cv of 577 (TCvSubst in_scope' tv_env' cv_env', cv') 578 -> (Subst in_scope' id_env tv_env' cv_env', cv') 579 580-- | See 'Type.substTy' 581substTy :: Subst -> Type -> Type 582substTy subst ty = Type.substTyUnchecked (getTCvSubst subst) ty 583 584getTCvSubst :: Subst -> TCvSubst 585getTCvSubst (Subst in_scope _ tenv cenv) = TCvSubst in_scope tenv cenv 586 587-- | See 'Coercion.substCo' 588substCo :: HasCallStack => Subst -> Coercion -> Coercion 589substCo subst co = Coercion.substCo (getTCvSubst subst) co 590 591{- 592************************************************************************ 593* * 594\section{IdInfo substitution} 595* * 596************************************************************************ 597-} 598 599substIdType :: Subst -> Id -> Id 600substIdType subst@(Subst _ _ tv_env cv_env) id 601 | (isEmptyVarEnv tv_env && isEmptyVarEnv cv_env) || noFreeVarsOfType old_ty = id 602 | otherwise = setIdType id (substTy subst old_ty) 603 -- The tyCoVarsOfType is cheaper than it looks 604 -- because we cache the free tyvars of the type 605 -- in a Note in the id's type itself 606 where 607 old_ty = idType id 608 609------------------ 610-- | Substitute into some 'IdInfo' with regard to the supplied new 'Id'. 611substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo 612substIdInfo subst new_id info 613 | nothing_to_do = Nothing 614 | otherwise = Just (info `setRuleInfo` substSpec subst new_id old_rules 615 `setUnfoldingInfo` substUnfolding subst old_unf) 616 where 617 old_rules = ruleInfo info 618 old_unf = unfoldingInfo info 619 nothing_to_do = isEmptyRuleInfo old_rules && not (isFragileUnfolding old_unf) 620 621------------------ 622-- | Substitutes for the 'Id's within an unfolding 623substUnfolding, substUnfoldingSC :: Subst -> Unfolding -> Unfolding 624 -- Seq'ing on the returned Unfolding is enough to cause 625 -- all the substitutions to happen completely 626 627substUnfoldingSC subst unf -- Short-cut version 628 | isEmptySubst subst = unf 629 | otherwise = substUnfolding subst unf 630 631substUnfolding subst df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) 632 = df { df_bndrs = bndrs', df_args = args' } 633 where 634 (subst',bndrs') = substBndrs subst bndrs 635 args' = map (substExpr (text "subst-unf:dfun") subst') args 636 637substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_src = src }) 638 -- Retain an InlineRule! 639 | not (isStableSource src) -- Zap an unstable unfolding, to save substitution work 640 = NoUnfolding 641 | otherwise -- But keep a stable one! 642 = seqExpr new_tmpl `seq` 643 unf { uf_tmpl = new_tmpl } 644 where 645 new_tmpl = substExpr (text "subst-unf") subst tmpl 646 647substUnfolding _ unf = unf -- NoUnfolding, OtherCon 648 649------------------ 650substIdOcc :: Subst -> Id -> Id 651-- These Ids should not be substituted to non-Ids 652substIdOcc subst v = case lookupIdSubst (text "substIdOcc") subst v of 653 Var v' -> v' 654 other -> pprPanic "substIdOcc" (vcat [ppr v <+> ppr other, ppr subst]) 655 656------------------ 657-- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id' 658substSpec :: Subst -> Id -> RuleInfo -> RuleInfo 659substSpec subst new_id (RuleInfo rules rhs_fvs) 660 = seqRuleInfo new_spec `seq` new_spec 661 where 662 subst_ru_fn = const (idName new_id) 663 new_spec = RuleInfo (map (substRule subst subst_ru_fn) rules) 664 (substDVarSet subst rhs_fvs) 665 666------------------ 667substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule] 668substRulesForImportedIds subst rules 669 = map (substRule subst not_needed) rules 670 where 671 not_needed name = pprPanic "substRulesForImportedIds" (ppr name) 672 673------------------ 674substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule 675 676-- The subst_ru_fn argument is applied to substitute the ru_fn field 677-- of the rule: 678-- - Rules for *imported* Ids never change ru_fn 679-- - Rules for *local* Ids are in the IdInfo for that Id, 680-- and the ru_fn field is simply replaced by the new name 681-- of the Id 682substRule _ _ rule@(BuiltinRule {}) = rule 683substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args 684 , ru_fn = fn_name, ru_rhs = rhs 685 , ru_local = is_local }) 686 = rule { ru_bndrs = bndrs' 687 , ru_fn = if is_local 688 then subst_ru_fn fn_name 689 else fn_name 690 , ru_args = map (substExpr doc subst') args 691 , ru_rhs = substExpr (text "foo") subst' rhs } 692 -- Do NOT optimise the RHS (previously we did simplOptExpr here) 693 -- See Note [Substitute lazily] 694 where 695 doc = text "subst-rule" <+> ppr fn_name 696 (subst', bndrs') = substBndrs subst bndrs 697 698------------------ 699substDVarSet :: Subst -> DVarSet -> DVarSet 700substDVarSet subst fvs 701 = mkDVarSet $ fst $ foldr (subst_fv subst) ([], emptyVarSet) $ dVarSetElems fvs 702 where 703 subst_fv subst fv acc 704 | isId fv = expr_fvs (lookupIdSubst (text "substDVarSet") subst fv) isLocalVar emptyVarSet $! acc 705 | otherwise = tyCoFVsOfType (lookupTCvSubst subst fv) (const True) emptyVarSet $! acc 706 707------------------ 708substTickish :: Subst -> Tickish Id -> Tickish Id 709substTickish subst (Breakpoint n ids) 710 = Breakpoint n (map do_one ids) 711 where 712 do_one = getIdFromTrivialExpr . lookupIdSubst (text "subst_tickish") subst 713substTickish _subst other = other 714 715{- Note [Substitute lazily] 716~~~~~~~~~~~~~~~~~~~~~~~~~~~ 717The functions that substitute over IdInfo must be pretty lazy, because 718they are knot-tied by substRecBndrs. 719 720One case in point was #10627 in which a rule for a function 'f' 721referred to 'f' (at a different type) on the RHS. But instead of just 722substituting in the rhs of the rule, we were calling simpleOptExpr, which 723looked at the idInfo for 'f'; result <<loop>>. 724 725In any case we don't need to optimise the RHS of rules, or unfoldings, 726because the simplifier will do that. 727 728 729Note [substTickish] 730~~~~~~~~~~~~~~~~~~~~~~ 731A Breakpoint contains a list of Ids. What happens if we ever want to 732substitute an expression for one of these Ids? 733 734First, we ensure that we only ever substitute trivial expressions for 735these Ids, by marking them as NoOccInfo in the occurrence analyser. 736Then, when substituting for the Id, we unwrap any type applications 737and abstractions to get back to an Id, with getIdFromTrivialExpr. 738 739Second, we have to ensure that we never try to substitute a literal 740for an Id in a breakpoint. We ensure this by never storing an Id with 741an unlifted type in a Breakpoint - see Coverage.mkTickish. 742Breakpoints can't handle free variables with unlifted types anyway. 743-} 744 745{- 746Note [Worker inlining] 747~~~~~~~~~~~~~~~~~~~~~~ 748A worker can get sustituted away entirely. 749 - it might be trivial 750 - it might simply be very small 751We do not treat an InlWrapper as an 'occurrence' in the occurrence 752analyser, so it's possible that the worker is not even in scope any more. 753 754In all all these cases we simply drop the special case, returning to 755InlVanilla. The WARN is just so I can see if it happens a lot. 756-} 757