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