ghc/compiler/coreSyn/Subst.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[CoreUtils]{Utility functions on @Core@ syntax}
   5
   6 \begin{code}
   7 module Subst (
   8         -- Substitution stuff
   9         IdSubstEnv, SubstResult(..),
  10
  11         Subst, emptySubst, mkSubst, substInScope, substTy,
  12         lookupIdSubst, lookupTvSubst, isEmptySubst,
  13         extendIdSubst, extendIdSubstList, extendTvSubst, extendTvSubstList,
  14         zapSubstEnv, setSubstEnv,
  15         getTvSubst, getTvSubstEnv, setTvSubstEnv,
  16
  17         bindSubst, unBindSubst, bindSubstList, unBindSubstList,
  18
  19         -- Binders
  20         simplBndr, simplBndrs, simplLetId, simplLamBndr, simplIdInfo,
  21         substAndCloneId, substAndCloneIds, substAndCloneRecIds,
  22
  23         setInScope, setInScopeSet,
  24         extendInScope, extendInScopeIds,
  25         isInScope, modifyInScope,
  26
  27         -- Expression stuff
  28         substExpr, substRules, substId
  29     ) where
  30
  31 #include "HsVersions.h"
  32
  33 import CoreSyn          ( Expr(..), Bind(..), Note(..), CoreExpr,
  34                           CoreRules(..), CoreRule(..),
  35                           isEmptyCoreRules, seqRules, hasUnfolding, noUnfolding, hasSomeUnfolding,
  36                           Unfolding(..)
  37                         )
  38 import CoreFVs          ( exprFreeVars )
  39 import CoreUtils        ( exprIsTrivial )
  40
  41 import qualified Type   ( substTy )
  42 import Type             ( Type, tyVarsOfType, mkTyVarTy,
  43                           TvSubstEnv, TvSubst(..), substTyVarBndr )
  44 import VarSet
  45 import VarEnv
  46 import Var              ( setVarUnique, isId, mustHaveLocalBinding )
  47 import Id               ( idType, idInfo, setIdInfo, setIdType,
  48                           idUnfolding, setIdUnfolding,
  49                           idOccInfo, maybeModifyIdInfo )
  50 import IdInfo           ( IdInfo, vanillaIdInfo,
  51                           occInfo, isFragileOcc, setOccInfo,
  52                           specInfo, setSpecInfo,
  53                           setArityInfo, unknownArity, arityInfo,
  54                           unfoldingInfo, setUnfoldingInfo,
  55                           WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo
  56                         )
  57 import BasicTypes       ( OccInfo(..) )
  58 import Unique           ( Unique )
  59 import UniqSupply       ( UniqSupply, uniqFromSupply, uniqsFromSupply )
  60 import Var              ( Var, Id, TyVar, isTyVar )
  61 import Outputable
  62 import PprCore          ()              -- Instances
  63 import Util             ( mapAccumL, foldl2 )
  64 import FastTypes
  65 \end{code}
  66
  67
  68 %************************************************************************
  69 %*                                                                      *
  70 \subsection{Substitutions}
  71 %*                                                                      *
  72 %************************************************************************
  73
  74 \begin{code}
  75 data Subst
  76   = Subst InScopeSet    -- Variables in in scope (both Ids and TyVars)
  77           IdSubstEnv    -- Substitution for Ids
  78           TvSubstEnv    -- Substitution for TyVars
  79
  80         -- INVARIANT 1: The (domain of the) in-scope set is a superset
  81         --              of the free vars of the range of the substitution
  82         --              that might possibly clash with locally-bound variables
  83         --              in the thing being substituted in.
  84         -- This is what lets us deal with name capture properly
  85         -- It's a hard invariant to check...
  86         -- There are various ways of causing it to happen:
  87         --      - arrange that the in-scope set really is all the things in scope
  88         --      - arrange that it's the free vars of the range of the substitution
  89         --      - make it empty because all the free vars of the subst are fresh,
  90         --              and hence can't possibly clash.a
  91         --
  92         -- INVARIANT 2: No variable is both in scope and in the domain of the substitution
  93         --              Equivalently, the substitution is idempotent
  94         --      [Sep 2000: Lies, all lies.  The substitution now does contain
  95         --                 mappings x77 -> DoneId x77 occ
  96         --                 to record x's occurrence information.]
  97         --      [Also watch out: the substitution can contain x77 -> DoneEx (Var x77)
  98         --       Consider let x = case k of I# x77 -> ... in
  99         --                let y = case k of I# x77 -> ... in ...
 100         --       and suppose the body is strict in both x and y.  Then the simplifier
 101         --       will pull the first (case k) to the top; so the second (case k) will
 102         --       cancel out, mapping x77 to, well, x77!  But one is an in-Id and the
 103         --       other is an out-Id. So the substitution is idempotent in the sense
 104         --       that we *must not* repeatedly apply it.]
 105
 106
 107 type IdSubstEnv = IdEnv SubstResult
 108
 109 data SubstResult
 110   = DoneEx CoreExpr             -- Completed term
 111   | DoneId Id OccInfo           -- Completed term variable, with occurrence info;
 112                                 -- only used by the simplifier
 113   | ContEx Subst CoreExpr       -- A suspended substitution
 114 \end{code}
 115
 116 The general plan about the substitution and in-scope set for Ids is as follows
 117
 118 * substId always adds new_id to the in-scope set.
 119   new_id has a correctly-substituted type, occ info
 120
 121 * substId adds a binding (DoneId new_id occ) to the substitution if
 122         EITHER the Id's unique has changed
 123         OR     the Id has interesting occurrence information
 124   So in effect you can only get to interesting occurrence information
 125   by looking up the *old* Id; it's not really attached to the new id
 126   at all.
 127
 128   Note, though that the substitution isn't necessarily extended
 129   if the type changes.  Why not?  Because of the next point:
 130
 131 * We *always, always* finish by looking up in the in-scope set
 132   any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
 133   Reason: so that we never finish up with a "old" Id in the result.
 134   An old Id might point to an old unfolding and so on... which gives a space leak.
 135
 136   [The DoneEx and DoneVar hits map to "new" stuff.]
 137
 138 * It follows that substExpr must not do a no-op if the substitution is empty.
 139   substType is free to do so, however.
 140
 141 * When we come to a let-binding (say) we generate new IdInfo, including an
 142   unfolding, attach it to the binder, and add this newly adorned binder to
 143   the in-scope set.  So all subsequent occurrences of the binder will get mapped
 144   to the full-adorned binder, which is also the one put in the binding site.
 145
 146 * The in-scope "set" usually maps x->x; we use it simply for its domain.
 147   But sometimes we have two in-scope Ids that are synomyms, and should
 148   map to the same target:  x->x, y->x.  Notably:
 149         case y of x { ... }
 150   That's why the "set" is actually a VarEnv Var
 151
 152
 153 \begin{code}
 154 isEmptySubst :: Subst -> Bool
 155 isEmptySubst (Subst _ id_env tv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env
 156
 157 emptySubst :: Subst
 158 emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv
 159
 160 mkSubst :: InScopeSet -> Subst
 161 mkSubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv
 162
 163 getTvSubst :: Subst -> TvSubst
 164 getTvSubst (Subst in_scope _ tv_env) = TvSubst in_scope tv_env
 165
 166 getTvSubstEnv :: Subst -> TvSubstEnv
 167 getTvSubstEnv (Subst _ _ tv_env) = tv_env
 168
 169 setTvSubstEnv :: Subst -> TvSubstEnv -> Subst
 170 setTvSubstEnv (Subst in_scope ids _) tvs = Subst in_scope ids tvs
 171
 172
 173
 174 substInScope :: Subst -> InScopeSet
 175 substInScope (Subst in_scope _ _) = in_scope
 176
 177 zapSubstEnv :: Subst -> Subst
 178 zapSubstEnv (Subst in_scope _ _) = Subst in_scope emptyVarEnv emptyVarEnv
 179
 180 -- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set
 181 extendIdSubst :: Subst -> Id -> SubstResult -> Subst
 182 extendIdSubst (Subst in_scope ids tvs) v r = Subst in_scope (extendVarEnv ids v r) tvs
 183
 184 extendIdSubstList :: Subst -> [(Id, SubstResult)] -> Subst
 185 extendIdSubstList (Subst in_scope ids tvs) prs = Subst in_scope (extendVarEnvList ids prs) tvs
 186
 187 extendTvSubst :: Subst -> TyVar -> Type -> Subst
 188 extendTvSubst (Subst in_scope ids tvs) v r = Subst in_scope ids (extendVarEnv tvs v r)
 189
 190 extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
 191 extendTvSubstList (Subst in_scope ids tvs) prs = Subst in_scope ids (extendVarEnvList tvs prs)
 192
 193 lookupIdSubst :: Subst -> Id -> Maybe SubstResult
 194 lookupIdSubst (Subst in_scope ids tvs) v = lookupVarEnv ids v
 195
 196 lookupTvSubst :: Subst -> TyVar -> Maybe Type
 197 lookupTvSubst (Subst _ ids tvs) v = lookupVarEnv tvs v
 198
 199 ------------------------------
 200 isInScope :: Var -> Subst -> Bool
 201 isInScope v (Subst in_scope _ _) = v `elemInScopeSet` in_scope
 202
 203 modifyInScope :: Subst -> Var -> Var -> Subst
 204 modifyInScope (Subst in_scope ids tvs) old_v new_v
 205   = Subst (modifyInScopeSet in_scope old_v new_v) ids tvs
 206         -- make old_v map to new_v
 207
 208 extendInScope :: Subst -> Var -> Subst
 209 extendInScope (Subst in_scope ids tvs) v
 210   = Subst (in_scope `extendInScopeSet` v)
 211           (ids `delVarEnv` v) (tvs `delVarEnv` v)
 212
 213 extendInScopeIds :: Subst -> [Id] -> Subst
 214 extendInScopeIds (Subst in_scope ids tvs) vs
 215   = Subst (in_scope `extendInScopeSetList` vs)
 216           (ids `delVarEnvList` vs) tvs
 217
 218 -------------------------------
 219 bindSubst :: Subst -> Var -> Var -> Subst
 220 -- Extend with a substitution, v1 -> Var v2
 221 -- and extend the in-scopes with v2
 222 bindSubst (Subst in_scope ids tvs) old_bndr new_bndr
 223   | isId old_bndr
 224   = Subst (in_scope `extendInScopeSet` new_bndr)
 225           (extendVarEnv ids old_bndr (DoneEx (Var new_bndr)))
 226           tvs
 227   | otherwise
 228   = Subst (in_scope `extendInScopeSet` new_bndr)
 229           ids
 230           (extendVarEnv tvs old_bndr (mkTyVarTy new_bndr))
 231
 232 unBindSubst :: Subst -> Var -> Var -> Subst
 233 -- Reverse the effect of bindSubst
 234 -- If old_bndr was already in the substitution, this doesn't quite work
 235 unBindSubst (Subst in_scope ids tvs) old_bndr new_bndr
 236   = Subst (in_scope `delInScopeSet` new_bndr)
 237           (delVarEnv ids old_bndr)
 238           (delVarEnv tvs old_bndr)
 239
 240 -- And the "List" forms
 241 bindSubstList :: Subst -> [Var] -> [Var] -> Subst
 242 bindSubstList subst old_bndrs new_bndrs
 243   = foldl2 bindSubst subst old_bndrs new_bndrs
 244
 245 unBindSubstList :: Subst -> [Var] -> [Var] -> Subst
 246 unBindSubstList subst old_bndrs new_bndrs
 247   = foldl2 unBindSubst subst old_bndrs new_bndrs
 248
 249
 250 -------------------------------
 251 setInScopeSet :: Subst -> InScopeSet -> Subst
 252 setInScopeSet (Subst _ ids tvs) in_scope
 253   = Subst in_scope ids tvs
 254
 255 setInScope :: Subst     -- Take env part from here
 256            -> Subst     -- Take in-scope part from here
 257            -> Subst
 258 setInScope (Subst _ ids tvs) (Subst in_scope _ _)
 259   = Subst in_scope ids tvs
 260
 261 setSubstEnv :: Subst    -- Take in-scope part from here
 262             -> Subst    -- ... and env part from here
 263             -> Subst
 264 setSubstEnv s1 s2 = setInScope s2 s1
 265 \end{code}
 266
 267 Pretty printing, for debugging only
 268
 269 \begin{code}
 270 instance Outputable SubstResult where
 271   ppr (DoneEx e)   = ptext SLIT("DoneEx") <+> ppr e
 272   ppr (DoneId v _) = ptext SLIT("DoneId") <+> ppr v
 273   ppr (ContEx _ e) = ptext SLIT("ContEx") <+> ppr e
 274
 275 instance Outputable Subst where
 276   ppr (Subst in_scope ids tvs)
 277         =  ptext SLIT("<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
 278         $$ ptext SLIT(" IdSubst   =") <+> ppr ids
 279         $$ ptext SLIT(" TvSubst   =") <+> ppr tvs
 280          <> char '>'
 281 \end{code}
 282
 283
 284 %************************************************************************
 285 %*                                                                      *
 286 \section{Expression substitution}
 287 %*                                                                      *
 288 %************************************************************************
 289
 290 This expression substituter deals correctly with name capture.
 291
 292 BUT NOTE that substExpr silently discards the
 293         unfolding, and
 294         spec env
 295 IdInfo attached to any binders in the expression.  It's quite
 296 tricky to do them 'right' in the case of mutually recursive bindings,
 297 and so far has proved unnecessary.
 298
 299 \begin{code}
 300 substExpr :: Subst -> CoreExpr -> CoreExpr
 301 substExpr subst expr
 302         -- NB: we do not do a no-op when the substitution is empty,
 303         -- because we always want to substitute the variables in the
 304         -- in-scope set for their occurrences.  Why?
 305         --      (a) because they may contain more information
 306         --      (b) because leaving an un-substituted Id might cause
 307         --          a space leak (its unfolding might point to an old version
 308         --          of its right hand side).
 309
 310   = go expr
 311   where
 312     go (Var v) = case substId subst v of
 313                     ContEx env' e' -> substExpr (setSubstEnv subst env') e'
 314                     DoneId v _     -> Var v
 315                     DoneEx e'      -> e'
 316
 317     go (Type ty)      = Type (go_ty ty)
 318     go (Lit lit)      = Lit lit
 319     go (App fun arg)  = App (go fun) (go arg)
 320     go (Note note e)  = Note (go_note note) (go e)
 321
 322     go (Lam bndr body) = Lam bndr' (substExpr subst' body)
 323                        where
 324                          (subst', bndr') = substBndr subst bndr
 325
 326     go (Let (NonRec bndr rhs) body) = Let (NonRec bndr' (go rhs)) (substExpr subst' body)
 327                                     where
 328                                       (subst', bndr') = substBndr subst bndr
 329
 330     go (Let (Rec pairs) body) = Let (Rec pairs') (substExpr subst' body)
 331                               where
 332                                 (subst', bndrs') = substRecBndrs subst (map fst pairs)
 333                                 pairs'  = bndrs' `zip` rhss'
 334                                 rhss'   = map (substExpr subst' . snd) pairs
 335     go (Case scrut bndr ty alts) = Case (go scrut) bndr' (go_ty ty) (map (go_alt subst') alts)
 336                                  where
 337                                  (subst', bndr') = substBndr subst bndr
 338
 339     go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
 340                                  where
 341                                    (subst', bndrs') = substBndrs subst bndrs
 342
 343     go_note (Coerce ty1 ty2) = Coerce (go_ty ty1) (go_ty ty2)
 344     go_note note             = note
 345
 346     go_ty ty = substTy subst ty
 347
 348 substId :: Subst -> Id -> SubstResult
 349 substId (Subst in_scope ids tvs) v
 350   = case lookupVarEnv ids v of
 351         Just (DoneId v occ) -> DoneId (lookup v) occ
 352         Just res            -> res
 353         Nothing             -> let v' = lookup v
 354                                in DoneId v' (idOccInfo v')
 355                 -- Note [idOccInfo]
 356                 -- We don't use DoneId for LoopBreakers, so the idOccInfo is
 357                 -- very important!  If isFragileOcc returned True for
 358                 -- loop breakers we could avoid this call, but at the expense
 359                 -- of adding more to the substitution, and building new Ids
 360                 -- in substId a bit more often than really necessary
 361   where
 362         -- Get the most up-to-date thing from the in-scope set
 363         -- Even though it isn't in the substitution, it may be in
 364         -- the in-scope set with a different type (we only use the
 365         -- substitution if the unique changes).
 366     lookup v = case lookupInScope in_scope v of
 367                  Just v' -> v'
 368                  Nothing -> WARN( mustHaveLocalBinding v, ppr v ) v
 369
 370
 371 substTy :: Subst -> Type -> Type
 372 substTy subst ty = Type.substTy (getTvSubst subst) ty
 373 \end{code}
 374
 375
 376 %************************************************************************
 377 %*                                                                      *
 378 \section{Substituting an Id binder}
 379 %*                                                                      *
 380 %************************************************************************
 381
 382 \begin{code}
 383 -- simplBndr and simplLetId are used by the simplifier
 384
 385 simplBndr :: Subst -> Var -> (Subst, Var)
 386 -- Used for lambda and case-bound variables
 387 -- Clone Id if necessary, substitute type
 388 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
 389 -- The substitution is extended only if the variable is cloned, because
 390 -- we *don't* need to use it to track occurrence info.
 391 simplBndr subst bndr
 392   | isTyVar bndr  = subst_tv subst bndr
 393   | otherwise     = subst_id False subst subst bndr
 394
 395 simplBndrs :: Subst -> [Var] -> (Subst, [Var])
 396 simplBndrs subst bndrs = mapAccumL simplBndr subst bndrs
 397
 398 simplLamBndr :: Subst -> Var -> (Subst, Var)
 399 -- Used for lambda binders.  These sometimes have unfoldings added by
 400 -- the worker/wrapper pass that must be preserved, becuase they can't
 401 -- be reconstructed from context.  For example:
 402 --      f x = case x of (a,b) -> fw a b x
 403 --      fw a b x{=(a,b)} = ...
 404 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
 405 simplLamBndr subst bndr
 406   | not (isId bndr && hasSomeUnfolding old_unf)
 407   = simplBndr subst bndr        -- Normal case
 408   | otherwise
 409   = (subst', bndr' `setIdUnfolding` substUnfolding subst old_unf)
 410   where
 411     old_unf = idUnfolding bndr
 412     (subst', bndr') = subst_id False subst subst bndr
 413
 414
 415 simplLetId :: Subst -> Id -> (Subst, Id)
 416 -- Clone Id if necessary
 417 -- Substitute its type
 418 -- Return an Id with completely zapped IdInfo
 419 --      [A subsequent substIdInfo will restore its IdInfo]
 420 -- Augment the subtitution
 421 --      if the unique changed, *or*
 422 --      if there's interesting occurrence info
 423
 424 simplLetId subst@(Subst in_scope env tvs) old_id
 425   = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
 426   where
 427     old_info = idInfo old_id
 428     id1     = uniqAway in_scope old_id
 429     id2     = substIdType subst id1
 430     new_id  = setIdInfo id2 vanillaIdInfo
 431
 432         -- Extend the substitution if the unique has changed,
 433         -- or there's some useful occurrence information
 434         -- See the notes with substTyVarBndr for the delSubstEnv
 435     occ_info = occInfo old_info
 436     new_env | new_id /= old_id || isFragileOcc occ_info
 437             = extendVarEnv env old_id (DoneId new_id occ_info)
 438             | otherwise
 439             = delVarEnv env old_id
 440
 441 simplIdInfo :: Subst -> IdInfo -> IdInfo
 442   -- Used by the simplifier to compute new IdInfo for a let(rec) binder,
 443   -- subsequent to simplLetId having zapped its IdInfo
 444 simplIdInfo subst old_info
 445   = case substIdInfo False subst old_info of
 446         Just new_info -> new_info
 447         Nothing       -> old_info
 448 \end{code}
 449
 450 \begin{code}
 451 -- substBndr and friends are used when doing expression substitution only
 452 -- In this case we can *preserve* occurrence information, and indeed we *want*
 453 -- to do so else lose useful occ info in rules.
 454
 455 substBndr :: Subst -> Var -> (Subst, Var)
 456 substBndr subst bndr
 457   | isTyVar bndr  = subst_tv subst bndr
 458   | otherwise     = subst_id True {- keep fragile info -} subst subst bndr
 459
 460 substBndrs :: Subst -> [Var] -> (Subst, [Var])
 461 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
 462
 463 substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
 464 -- Substitute a mutually recursive group
 465 substRecBndrs subst bndrs
 466   = (new_subst, new_bndrs)
 467   where
 468         -- Here's the reason we need to pass rec_subst to subst_id
 469     (new_subst, new_bndrs) = mapAccumL (subst_id True {- keep fragile info -} new_subst)
 470                                        subst bndrs
 471 \end{code}
 472
 473
 474 \begin{code}
 475 subst_tv :: Subst -> TyVar -> (Subst, TyVar)
 476 -- Unpackage and re-package for substTyVarBndr
 477 subst_tv (Subst in_scope id_env tv_env) tv
 478   = case substTyVarBndr (TvSubst in_scope tv_env) tv of
 479         (TvSubst in_scope' tv_env', tv')
 480            -> (Subst in_scope' id_env tv_env', tv')
 481
 482 subst_id :: Bool                -- True <=> keep fragile info
 483          -> Subst               -- Substitution to use for the IdInfo
 484          -> Subst -> Id         -- Substitition and Id to transform
 485          -> (Subst, Id)         -- Transformed pair
 486
 487 -- Returns with:
 488 --      * Unique changed if necessary
 489 --      * Type substituted
 490 --      * Unfolding zapped
 491 --      * Rules, worker, lbvar info all substituted
 492 --      * Occurrence info zapped if is_fragile_occ returns True
 493 --      * The in-scope set extended with the returned Id
 494 --      * The substitution extended with a DoneId if unique changed
 495 --        In this case, the var in the DoneId is the same as the
 496 --        var returned
 497
 498 subst_id keep_fragile rec_subst subst@(Subst in_scope env tvs) old_id
 499   = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
 500   where
 501         -- id1 is cloned if necessary
 502     id1 = uniqAway in_scope old_id
 503
 504         -- id2 has its type zapped
 505     id2 = substIdType subst id1
 506
 507         -- new_id has the right IdInfo
 508         -- The lazy-set is because we're in a loop here, with
 509         -- rec_subst, when dealing with a mutually-recursive group
 510     new_id = maybeModifyIdInfo (substIdInfo keep_fragile rec_subst) id2
 511
 512         -- Extend the substitution if the unique has changed
 513         -- See the notes with substTyVarBndr for the delSubstEnv
 514     new_env | new_id /= old_id
 515             = extendVarEnv env old_id (DoneId new_id (idOccInfo old_id))
 516             | otherwise
 517             = delVarEnv env old_id
 518 \end{code}
 519
 520 Now a variant that unconditionally allocates a new unique.
 521 It also unconditionally zaps the OccInfo.
 522
 523 \begin{code}
 524 subst_clone_id :: Subst                 -- Substitution to use (lazily) for the rules and worker
 525                -> Subst -> (Id, Unique) -- Substitition and Id to transform
 526                -> (Subst, Id)           -- Transformed pair
 527
 528 subst_clone_id rec_subst subst@(Subst in_scope env tvs) (old_id, uniq)
 529   = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
 530   where
 531     id1  = setVarUnique old_id uniq
 532     id2  = substIdType subst id1
 533
 534     new_id  = maybeModifyIdInfo (substIdInfo False rec_subst) id2
 535     new_env = extendVarEnv env old_id (DoneId new_id NoOccInfo)
 536
 537 substAndCloneIds :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
 538 substAndCloneIds subst us ids
 539   = mapAccumL (subst_clone_id subst) subst (ids `zip` uniqsFromSupply us)
 540
 541 substAndCloneRecIds :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
 542 substAndCloneRecIds subst us ids
 543   = (subst', ids')
 544   where
 545     (subst', ids') = mapAccumL (subst_clone_id subst') subst
 546                                (ids `zip` uniqsFromSupply us)
 547
 548 substAndCloneId :: Subst -> UniqSupply -> Id -> (Subst, Id)
 549 substAndCloneId subst us old_id
 550   = subst_clone_id subst subst (old_id, uniqFromSupply us)
 551 \end{code}
 552
 553
 554 %************************************************************************
 555 %*                                                                      *
 556 \section{IdInfo substitution}
 557 %*                                                                      *
 558 %************************************************************************
 559
 560 \begin{code}
 561 substIdInfo :: Bool     -- True <=> keep even fragile info
 562             -> Subst
 563             -> IdInfo
 564             -> Maybe IdInfo
 565 -- The keep_fragile flag is True when we are running a simple expression
 566 -- substitution that preserves all structure, so that arity and occurrence
 567 -- info are unaffected.  The False state is used more often.
 568 --
 569 -- Substitute the
 570 --      rules
 571 --      worker info
 572 -- Zap the unfolding
 573 -- If keep_fragile then
 574 --      keep OccInfo
 575 --      keep Arity
 576 -- else
 577 --      keep only 'robust' OccInfo
 578 --      zap Arity
 579 --
 580 -- Seq'ing on the returned IdInfo is enough to cause all the
 581 -- substitutions to happen completely
 582
 583 substIdInfo keep_fragile subst info
 584   | nothing_to_do = Nothing
 585   | otherwise     = Just (info `setOccInfo`       (if keep_occ then old_occ else NoOccInfo)
 586                                `setArityInfo`     (if keep_arity then old_arity else unknownArity)
 587                                `setSpecInfo`      substRules  subst old_rules
 588                                `setWorkerInfo`    substWorker subst old_wrkr
 589                                `setUnfoldingInfo` noUnfolding)
 590                         -- setSpecInfo does a seq
 591                         -- setWorkerInfo does a seq
 592   where
 593     nothing_to_do = keep_occ && keep_arity &&
 594                     isEmptyCoreRules old_rules &&
 595                     not (workerExists old_wrkr) &&
 596                     not (hasUnfolding (unfoldingInfo info))
 597
 598     keep_occ   = keep_fragile || not (isFragileOcc old_occ)
 599     keep_arity = keep_fragile || old_arity == unknownArity
 600     old_arity = arityInfo info
 601     old_occ   = occInfo info
 602     old_rules = specInfo info
 603     old_wrkr  = workerInfo info
 604
 605 ------------------
 606 substIdType :: Subst -> Id -> Id
 607 substIdType subst@(Subst in_scope id_env tv_env) id
 608   | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
 609   | otherwise   = setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
 610                 -- The tyVarsOfType is cheaper than it looks
 611                 -- because we cache the free tyvars of the type
 612                 -- in a Note in the id's type itself
 613   where
 614     old_ty = idType id
 615
 616 ------------------
 617 substWorker :: Subst -> WorkerInfo -> WorkerInfo
 618         -- Seq'ing on the returned WorkerInfo is enough to cause all the
 619         -- substitutions to happen completely
 620
 621 substWorker subst NoWorker
 622   = NoWorker
 623 substWorker subst (HasWorker w a)
 624   = case substId subst w of
 625         DoneId w1 _     -> HasWorker w1 a
 626         DoneEx (Var w1) -> HasWorker w1 a
 627         DoneEx other    -> WARN( not (exprIsTrivial other), text "substWorker: DoneEx" <+> ppr w )
 628                            NoWorker     -- Worker has got substituted away altogether
 629                                                 -- This can happen if it's trivial,
 630                                                 -- via postInlineUnconditionally
 631         ContEx se1 e    -> WARN( True, text "substWorker: ContEx" <+> ppr w <+> ppr e)
 632                            NoWorker     -- Ditto
 633
 634 ------------------
 635 substUnfolding subst NoUnfolding                 = NoUnfolding
 636 substUnfolding subst (OtherCon cons)             = OtherCon cons
 637 substUnfolding subst (CompulsoryUnfolding rhs)   = CompulsoryUnfolding (substExpr subst rhs)
 638 substUnfolding subst (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr subst rhs) t v w g
 639
 640 ------------------
 641 substRules :: Subst -> CoreRules -> CoreRules
 642         -- Seq'ing on the returned CoreRules is enough to cause all the
 643         -- substitutions to happen completely
 644
 645 substRules subst rules
 646  | isEmptySubst subst = rules
 647
 648 substRules subst (Rules rules rhs_fvs)
 649   = seqRules new_rules `seq` new_rules
 650   where
 651     new_rules = Rules (map do_subst rules) (substVarSet subst rhs_fvs)
 652
 653     do_subst rule@(BuiltinRule _ _) = rule
 654     do_subst (Rule name act tpl_vars lhs_args rhs)
 655         = Rule name act tpl_vars'
 656                (map (substExpr subst') lhs_args)
 657                (substExpr subst' rhs)
 658         where
 659           (subst', tpl_vars') = substBndrs subst tpl_vars
 660
 661 ------------------
 662 substVarSet subst fvs
 663   = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
 664   where
 665     subst_fv subst fv
 666         | isId fv = case substId subst fv of
 667                         DoneId fv' _    -> unitVarSet fv'
 668                         DoneEx expr     -> exprFreeVars expr
 669                         ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr)
 670         | otherwise = case lookupTvSubst subst fv of
 671                             Nothing -> unitVarSet fv
 672                             Just ty -> substVarSet subst (tyVarsOfType ty)
 673 \end{code}