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