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         -- In-scope set
   9         InScopeSet, emptyInScopeSet, mkInScopeSet,
  10         extendInScopeSet, extendInScopeSetList,
  11         lookupInScope, elemInScopeSet, uniqAway,
  12
  13
  14         -- Substitution stuff
  15         Subst, TyVarSubst, IdSubst,
  16         emptySubst, mkSubst, substEnv, substInScope,
  17         lookupSubst, lookupIdSubst, isEmptySubst, extendSubst, extendSubstList,
  18         zapSubstEnv, setSubstEnv,
  19         setInScope,
  20         extendInScope, extendInScopeList, extendNewInScope, extendNewInScopeList,
  21         isInScope, modifyInScope,
  22
  23         bindSubst, unBindSubst, bindSubstList, unBindSubstList,
  24
  25         -- Binders
  26         substBndr, substBndrs, substTyVar, substId, substIds,
  27         substAndCloneId, substAndCloneIds,
  28
  29         -- Type stuff
  30         mkTyVarSubst, mkTopTyVarSubst,
  31         substTy, substClasses, substTheta,
  32
  33         -- Expression stuff
  34         substExpr, substIdInfo
  35     ) where
  36
  37 #include "HsVersions.h"
  38
  39 import CmdLineOpts      ( opt_PprStyle_Debug )
  40 import CoreSyn          ( Expr(..), Bind(..), Note(..), CoreExpr,
  41                           CoreRules(..), CoreRule(..),
  42                           isEmptyCoreRules, seqRules
  43                         )
  44 import CoreFVs          ( exprFreeVars, mustHaveLocalBinding )
  45 import TypeRep          ( Type(..), TyNote(..),
  46                         )  -- friend
  47 import Type             ( ThetaType, PredType(..), ClassContext,
  48                           tyVarsOfType, tyVarsOfTypes, mkAppTy
  49                         )
  50 import VarSet
  51 import VarEnv
  52 import Var              ( setVarUnique, isId )
  53 import Id               ( idType, setIdType, idOccInfo, zapFragileIdInfo )
  54 import IdInfo           ( IdInfo, isFragileOcc,
  55                           specInfo, setSpecInfo,
  56                           WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo
  57                         )
  58 import Unique           ( Uniquable(..), deriveUnique )
  59 import UniqSet          ( elemUniqSet_Directly )
  60 import UniqSupply       ( UniqSupply, uniqFromSupply, splitUniqSupply )
  61 import Var              ( Var, Id, TyVar, isTyVar )
  62 import Outputable
  63 import PprCore          ()              -- Instances
  64 import UniqFM           ( ufmToList )   -- Yuk (add a new op to VarEnv)
  65 import Util             ( mapAccumL, foldl2, seqList, ($!) )
  66 import FastTypes
  67 \end{code}
  68
  69
  70 %************************************************************************
  71 %*                                                                      *
  72 \subsection{The in-scope set}
  73 %*                                                                      *
  74 %************************************************************************
  75
  76 \begin{code}
  77 data InScopeSet = InScope (VarEnv Var) FastInt
  78         -- The Int# is a kind of hash-value used by uniqAway
  79         -- For example, it might be the size of the set
  80         -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
  81
  82 emptyInScopeSet :: InScopeSet
  83 emptyInScopeSet = InScope emptyVarSet 1#
  84
  85 mkInScopeSet :: VarEnv Var -> InScopeSet
  86 mkInScopeSet in_scope = InScope in_scope 1#
  87
  88 extendInScopeSet :: InScopeSet -> Var -> InScopeSet
  89 extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#)
  90
  91 extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
  92 extendInScopeSetList (InScope in_scope n) vs
  93    = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
  94                     (n +# iUnbox (length vs))
  95
  96 modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet
  97 -- Exploit the fact that the in-scope "set" is really a map
  98 --      Make old_v map to new_v
  99 modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#)
 100
 101 delInScopeSet :: InScopeSet -> Var -> InScopeSet
 102 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
 103
 104 elemInScopeSet :: Var -> InScopeSet -> Bool
 105 elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope
 106
 107 lookupInScope :: InScopeSet -> Var -> Var
 108 -- It's important to look for a fixed point
 109 -- When we see (case x of y { I# v -> ... })
 110 -- we add  [x -> y] to the in-scope set (Simplify.simplCaseBinder).
 111 -- When we lookup up an occurrence of x, we map to y, but then
 112 -- we want to look up y in case it has acquired more evaluation information by now.
 113 lookupInScope (InScope in_scope n) v
 114   = go v
 115   where
 116     go v = case lookupVarEnv in_scope v of
 117                 Just v' | v == v'   -> v'       -- Reached a fixed point
 118                         | otherwise -> go v'
 119                 Nothing             -> WARN( mustHaveLocalBinding v, ppr v )
 120                                        v
 121 \end{code}
 122
 123 \begin{code}
 124 uniqAway :: InScopeSet -> Var -> Var
 125 -- (uniqAway in_scope v) finds a unique that is not used in the
 126 -- in-scope set, and gives that to v.  It starts with v's current unique, of course,
 127 -- in the hope that it won't have to change it, nad thereafter uses a combination
 128 -- of that and the hash-code found in the in-scope set
 129 uniqAway (InScope set n) var
 130   | not (var `elemVarSet` set) = var                            -- Nothing to do
 131   | otherwise                  = try 1#
 132   where
 133     orig_unique = getUnique var
 134     try k
 135 #ifdef DEBUG
 136           | k ># 1000#
 137           = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
 138 #endif
 139           | uniq `elemUniqSet_Directly` set = try (k +# 1#)
 140 #ifdef DEBUG
 141           | opt_PprStyle_Debug && k ># 3#
 142           = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
 143             setVarUnique var uniq
 144 #endif
 145           | otherwise = setVarUnique var uniq
 146           where
 147             uniq = deriveUnique orig_unique (iBox (n *# k))
 148 \end{code}
 149
 150
 151 %************************************************************************
 152 %*                                                                      *
 153 \subsection{Substitutions}
 154 %*                                                                      *
 155 %************************************************************************
 156
 157 \begin{code}
 158 data Subst = Subst InScopeSet           -- In scope
 159                    SubstEnv             -- Substitution itself
 160         -- INVARIANT 1: The (domain of the) in-scope set is a superset
 161         --              of the free vars of the range of the substitution
 162         --              that might possibly clash with locally-bound variables
 163         --              in the thing being substituted in.
 164         -- This is what lets us deal with name capture properly
 165         -- It's a hard invariant to check...
 166         -- There are various ways of causing it to happen:
 167         --      - arrange that the in-scope set really is all the things in scope
 168         --      - arrange that it's the free vars of the range of the substitution
 169         --      - make it empty because all the free vars of the subst are fresh,
 170         --              and hence can't possibly clash.a
 171         --
 172         -- INVARIANT 2: No variable is both in scope and in the domain of the substitution
 173         --              Equivalently, the substitution is idempotent
 174         --      [Sep 2000: Lies, all lies.  The substitution now does contain
 175         --                 mappings x77 -> DoneId x77 occ
 176         --                 to record x's occurrence information.]
 177         --      [Also watch out: the substitution can contain x77 -> DoneEx (Var x77)
 178         --       Consider let x = case k of I# x77 -> ... in
 179         --                let y = case k of I# x77 -> ... in ...
 180         --       and suppose the body is strict in both x and y.  Then the simplifier
 181         --       will pull the first (case k) to the top; so the second (case k) will
 182         --       cancel out, mapping x77 to, well, x77!  But one is an in-Id and the
 183         --       other is an out-Id. So the substitution is idempotent in the sense
 184         --       that we *must not* repeatedly apply it.]
 185
 186 type IdSubst    = Subst
 187 \end{code}
 188
 189 The general plan about the substitution and in-scope set for Ids is as follows
 190
 191 * substId always adds new_id to the in-scope set.
 192   new_id has a correctly-substituted type, but all its fragile IdInfo has been zapped.
 193   That is added back in later.  So new_id is the minimal thing it's
 194   correct to substitute.
 195
 196 * substId adds a binding (DoneId new_id occ) to the substitution if
 197         EITHER the Id's unique has changed
 198         OR     the Id has interesting occurrence information
 199   So in effect you can only get to interesting occurrence information
 200   by looking up the *old* Id; it's not really attached to the new id
 201   at all.
 202
 203   Note, though that the substitution isn't necessarily extended
 204   if the type changes.  Why not?  Because of the next point:
 205
 206 * We *always, always* finish by looking up in the in-scope set
 207   any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
 208   Reason: so that we never finish up with a "old" Id in the result.
 209   An old Id might point to an old unfolding and so on... which gives a space leak.
 210
 211   [The DoneEx and DoneVar hits map to "new" stuff.]
 212
 213 * It follows that substExpr must not do a no-op if the substitution is empty.
 214   substType is free to do so, however.
 215
 216 * When we come to a let-binding (say) we generate new IdInfo, including an
 217   unfolding, attach it to the binder, and add this newly adorned binder to
 218   the in-scope set.  So all subsequent occurrences of the binder will get mapped
 219   to the full-adorned binder, which is also the one put in the binding site.
 220
 221 * The in-scope "set" usually maps x->x; we use it simply for its domain.
 222   But sometimes we have two in-scope Ids that are synomyms, and should
 223   map to the same target:  x->x, y->x.  Notably:
 224         case y of x { ... }
 225   That's why the "set" is actually a VarEnv Var
 226
 227
 228 \begin{code}
 229 isEmptySubst :: Subst -> Bool
 230 isEmptySubst (Subst _ env) = isEmptySubstEnv env
 231
 232 emptySubst :: Subst
 233 emptySubst = Subst emptyInScopeSet emptySubstEnv
 234
 235 mkSubst :: InScopeSet -> SubstEnv -> Subst
 236 mkSubst in_scope env = Subst in_scope env
 237
 238 substEnv :: Subst -> SubstEnv
 239 substEnv (Subst _ env) = env
 240
 241 substInScope :: Subst -> InScopeSet
 242 substInScope (Subst in_scope _) = in_scope
 243
 244 zapSubstEnv :: Subst -> Subst
 245 zapSubstEnv (Subst in_scope env) = Subst in_scope emptySubstEnv
 246
 247 extendSubst :: Subst -> Var -> SubstResult -> Subst
 248 extendSubst (Subst in_scope env) v r = Subst in_scope (extendSubstEnv env v r)
 249
 250 extendSubstList :: Subst -> [Var] -> [SubstResult] -> Subst
 251 extendSubstList (Subst in_scope env) v r = Subst in_scope (extendSubstEnvList env v r)
 252
 253 lookupSubst :: Subst -> Var -> Maybe SubstResult
 254 lookupSubst (Subst _ env) v = lookupSubstEnv env v
 255
 256 lookupIdSubst :: Subst -> Id -> SubstResult
 257 -- Does the lookup in the in-scope set too
 258 lookupIdSubst (Subst in_scope env) v
 259   = case lookupSubstEnv env v of
 260         Just (DoneId v' occ) -> DoneId (lookupInScope in_scope v') occ
 261         Just res             -> res
 262         Nothing              -> DoneId v' (idOccInfo v')
 263                                 -- We don't use DoneId for LoopBreakers, so the idOccInfo is
 264                                 -- very important!  If isFragileOcc returned True for
 265                                 -- loop breakers we could avoid this call, but at the expense
 266                                 -- of adding more to the substitution, and building new Ids
 267                                 -- in substId a bit more often than really necessary
 268                              where
 269                                     v' = lookupInScope in_scope v
 270
 271 isInScope :: Var -> Subst -> Bool
 272 isInScope v (Subst in_scope _) = v `elemInScopeSet` in_scope
 273
 274 modifyInScope :: Subst -> Var -> Var -> Subst
 275 modifyInScope (Subst in_scope env) old_v new_v = Subst (modifyInScopeSet in_scope old_v new_v) env
 276         -- make old_v map to new_v
 277
 278 extendInScope :: Subst -> Var -> Subst
 279         -- Add a new variable as in-scope
 280         -- Remember to delete any existing binding in the substitution!
 281 extendInScope (Subst in_scope env) v = Subst (in_scope `extendInScopeSet` v)
 282                                              (env `delSubstEnv` v)
 283
 284 extendInScopeList :: Subst -> [Var] -> Subst
 285 extendInScopeList (Subst in_scope env) vs = Subst (extendInScopeSetList in_scope vs)
 286                                                   (delSubstEnvList env vs)
 287
 288 -- The "New" variants are guaranteed to be adding freshly-allocated variables
 289 -- It's not clear that the gain (not needing to delete it from the substitution)
 290 -- is worth the extra proof obligation
 291 extendNewInScope :: Subst -> Var -> Subst
 292 extendNewInScope (Subst in_scope env) v = Subst (in_scope `extendInScopeSet` v) env
 293
 294 extendNewInScopeList :: Subst -> [Var] -> Subst
 295 extendNewInScopeList (Subst in_scope env) vs = Subst (in_scope `extendInScopeSetList` vs) env
 296
 297 -------------------------------
 298 bindSubst :: Subst -> Var -> Var -> Subst
 299 -- Extend with a substitution, v1 -> Var v2
 300 -- and extend the in-scopes with v2
 301 bindSubst (Subst in_scope env) old_bndr new_bndr
 302   = Subst (in_scope `extendInScopeSet` new_bndr)
 303           (extendSubstEnv env old_bndr subst_result)
 304   where
 305     subst_result | isId old_bndr = DoneEx (Var new_bndr)
 306                  | otherwise     = DoneTy (TyVarTy new_bndr)
 307
 308 unBindSubst :: Subst -> Var -> Var -> Subst
 309 -- Reverse the effect of bindSubst
 310 -- If old_bndr was already in the substitution, this doesn't quite work
 311 unBindSubst (Subst in_scope env) old_bndr new_bndr
 312   = Subst (in_scope `delInScopeSet` new_bndr) (delSubstEnv env old_bndr)
 313
 314 -- And the "List" forms
 315 bindSubstList :: Subst -> [Var] -> [Var] -> Subst
 316 bindSubstList subst old_bndrs new_bndrs
 317   = foldl2 bindSubst subst old_bndrs new_bndrs
 318
 319 unBindSubstList :: Subst -> [Var] -> [Var] -> Subst
 320 unBindSubstList subst old_bndrs new_bndrs
 321   = foldl2 unBindSubst subst old_bndrs new_bndrs
 322
 323
 324 -------------------------------
 325 setInScope :: Subst     -- Take env part from here
 326            -> InScopeSet
 327            -> Subst
 328 setInScope (Subst in_scope1 env1) in_scope2
 329   = Subst in_scope2 env1
 330
 331 setSubstEnv :: Subst            -- Take in-scope part from here
 332             -> SubstEnv         -- ... and env part from here
 333             -> Subst
 334 setSubstEnv (Subst in_scope1 _) env2 = Subst in_scope1 env2
 335 \end{code}
 336
 337 Pretty printing, for debugging only
 338
 339 \begin{code}
 340 instance Outputable SubstResult where
 341   ppr (DoneEx e)   = ptext SLIT("DoneEx") <+> ppr e
 342   ppr (DoneId v _) = ptext SLIT("DoneId") <+> ppr v
 343   ppr (ContEx _ e) = ptext SLIT("ContEx") <+> ppr e
 344   ppr (DoneTy t)   = ptext SLIT("DoneTy") <+> ppr t
 345
 346 instance Outputable SubstEnv where
 347   ppr se = brackets (fsep (punctuate comma (map ppr_elt (ufmToList (substEnvEnv se)))))
 348         where
 349            ppr_elt (uniq,sr) = ppr uniq <+> ptext SLIT("->") <+> ppr sr
 350
 351 instance Outputable Subst where
 352   ppr (Subst (InScope in_scope _) se)
 353         =  ptext SLIT("<InScope =") <+> braces   (fsep (map ppr (rngVarEnv in_scope)))
 354         $$ ptext SLIT(" Subst   =") <+> ppr se <> char '>'
 355 \end{code}
 356
 357 %************************************************************************
 358 %*                                                                      *
 359 \subsection{Type substitution}
 360 %*                                                                      *
 361 %************************************************************************
 362
 363 \begin{code}
 364 type TyVarSubst = Subst -- TyVarSubst are expected to have range elements
 365         -- (We could have a variant of Subst, but it doesn't seem worth it.)
 366
 367 -- mkTyVarSubst generates the in-scope set from
 368 -- the types given; but it's just a thunk so with a bit of luck
 369 -- it'll never be evaluated
 370 mkTyVarSubst :: [TyVar] -> [Type] -> Subst
 371 mkTyVarSubst tyvars tys = Subst (mkInScopeSet (tyVarsOfTypes tys)) (zip_ty_env tyvars tys emptySubstEnv)
 372
 373 -- mkTopTyVarSubst is called when doing top-level substitutions.
 374 -- Here we expect that the free vars of the range of the
 375 -- substitution will be empty.
 376 mkTopTyVarSubst :: [TyVar] -> [Type] -> Subst
 377 mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zip_ty_env tyvars tys emptySubstEnv)
 378
 379 zip_ty_env []       []       env = env
 380 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendSubstEnv env tv (DoneTy ty))
 381 \end{code}
 382
 383 substTy works with general Substs, so that it can be called from substExpr too.
 384
 385 \begin{code}
 386 substTy :: Subst -> Type  -> Type
 387 substTy subst ty | isEmptySubst subst = ty
 388                  | otherwise          = subst_ty subst ty
 389
 390 substClasses :: TyVarSubst -> ClassContext -> ClassContext
 391 substClasses subst theta
 392   | isEmptySubst subst = theta
 393   | otherwise          = [(clas, map (subst_ty subst) tys) | (clas, tys) <- theta]
 394
 395 substTheta :: TyVarSubst -> ThetaType -> ThetaType
 396 substTheta subst theta
 397   | isEmptySubst subst = theta
 398   | otherwise          = map (substPred subst) theta
 399
 400 substPred :: TyVarSubst -> PredType -> PredType
 401 substPred subst (Class clas tys) = Class clas (map (subst_ty subst) tys)
 402 substPred subst (IParam n ty)    = IParam n (subst_ty subst ty)
 403
 404 subst_ty subst ty
 405    = go ty
 406   where
 407     go (TyConApp tc tys)           = let args = map go tys
 408                                      in  args `seqList` TyConApp tc args
 409
 410     go (PredTy p)                  = PredTy $! (substPred subst p)
 411
 412     go (NoteTy (SynNote ty1) ty2)  = NoteTy (SynNote $! (go ty1)) $! (go ty2)
 413     go (NoteTy (FTVNote _) ty2)    = go ty2             -- Discard the free tyvar note
 414     go (NoteTy (UsgNote usg)  ty2) = (NoteTy $! UsgNote usg) $! go ty2                  -- Keep usage annot
 415     go (NoteTy (UsgForAll uv) ty2) = (NoteTy $! UsgForAll uv) $! go ty2                 -- Keep uvar bdr
 416
 417     go (FunTy arg res)             = (FunTy $! (go arg)) $! (go res)
 418     go (AppTy fun arg)             = mkAppTy (go fun) $! (go arg)
 419     go ty@(TyVarTy tv)             = case (lookupSubst subst tv) of
 420                                         Nothing            -> ty
 421                                         Just (DoneTy ty')  -> ty'
 422
 423     go (ForAllTy tv ty)            = case substTyVar subst tv of
 424                                         (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
 425 \end{code}
 426
 427 Here is where we invent a new binder if necessary.
 428
 429 \begin{code}
 430 substTyVar :: Subst -> TyVar -> (Subst, TyVar)
 431 substTyVar subst@(Subst in_scope env) old_var
 432   | old_var == new_var  -- No need to clone
 433                         -- But we *must* zap any current substitution for the variable.
 434                         --  For example:
 435                         --      (\x.e) with id_subst = [x |-> e']
 436                         -- Here we must simply zap the substitution for x
 437                         --
 438                         -- The new_id isn't cloned, but it may have a different type
 439                         -- etc, so we must return it, not the old id
 440   = (Subst (in_scope `extendInScopeSet` new_var)
 441            (delSubstEnv env old_var),
 442      new_var)
 443
 444   | otherwise   -- The new binder is in scope so
 445                 -- we'd better rename it away from the in-scope variables
 446                 -- Extending the substitution to do this renaming also
 447                 -- has the (correct) effect of discarding any existing
 448                 -- substitution for that variable
 449   = (Subst (in_scope `extendInScopeSet` new_var)
 450            (extendSubstEnv env old_var (DoneTy (TyVarTy new_var))),
 451      new_var)
 452   where
 453     new_var = uniqAway in_scope old_var
 454         -- The uniqAway part makes sure the new variable is not already in scope
 455 \end{code}
 456
 457
 458 %************************************************************************
 459 %*                                                                      *
 460 \section{Expression substitution}
 461 %*                                                                      *
 462 %************************************************************************
 463
 464 This expression substituter deals correctly with name capture.
 465
 466 BUT NOTE that substExpr silently discards the
 467         unfolding, and
 468         spec env
 469 IdInfo attached to any binders in the expression.  It's quite
 470 tricky to do them 'right' in the case of mutually recursive bindings,
 471 and so far has proved unnecessary.
 472
 473 \begin{code}
 474 substExpr :: Subst -> CoreExpr -> CoreExpr
 475 substExpr subst expr
 476         -- NB: we do not do a no-op when the substitution is empty,
 477         -- because we always want to substitute the variables in the
 478         -- in-scope set for their occurrences.  Why?
 479         --      (a) because they may contain more information
 480         --      (b) because leaving an un-substituted Id might cause
 481         --          a space leak (its unfolding might point to an old version
 482         --          of its right hand side).
 483
 484   = go expr
 485   where
 486     go (Var v) = -- See the notes at the top, with the Subst data type declaration
 487                  case lookupIdSubst subst v of
 488
 489                     ContEx env' e' -> substExpr (setSubstEnv subst env') e'
 490                     DoneId v _     -> Var v
 491                     DoneEx e'      -> e'
 492
 493     go (Type ty)      = Type (go_ty ty)
 494     go (Lit lit)      = Lit lit
 495     go (App fun arg)  = App (go fun) (go arg)
 496     go (Note note e)  = Note (go_note note) (go e)
 497
 498     go (Lam bndr body) = Lam bndr' (substExpr subst' body)
 499                        where
 500                          (subst', bndr') = substBndr subst bndr
 501
 502     go (Let (NonRec bndr rhs) body) = Let (NonRec bndr' (go rhs)) (substExpr subst' body)
 503                                     where
 504                                       (subst', bndr') = substBndr subst bndr
 505
 506     go (Let (Rec pairs) body) = Let (Rec pairs') (substExpr subst' body)
 507                               where
 508                                 (subst', bndrs') = substBndrs subst (map fst pairs)
 509                                 pairs'  = bndrs' `zip` rhss'
 510                                 rhss'   = map (substExpr subst' . snd) pairs
 511
 512     go (Case scrut bndr alts) = Case (go scrut) bndr' (map (go_alt subst') alts)
 513                               where
 514                                 (subst', bndr') = substBndr subst bndr
 515
 516     go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
 517                                  where
 518                                    (subst', bndrs') = substBndrs subst bndrs
 519
 520     go_note (Coerce ty1 ty2) = Coerce (go_ty ty1) (go_ty ty2)
 521     go_note note             = note
 522
 523     go_ty ty = substTy subst ty
 524
 525 \end{code}
 526
 527 Substituting in binders is a rather tricky part of the whole compiler.
 528
 529 When we hit a binder we may need to
 530   (a) apply the the type envt (if non-empty) to its type
 531   (c) give it a new unique to avoid name clashes
 532
 533 \begin{code}
 534 substBndr :: Subst -> Var -> (Subst, Var)
 535 substBndr subst bndr
 536   | isTyVar bndr  = substTyVar subst bndr
 537   | otherwise     = substId    subst bndr
 538
 539 substBndrs :: Subst -> [Var] -> (Subst, [Var])
 540 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
 541
 542
 543 substIds :: Subst -> [Id] -> (Subst, [Id])
 544 substIds subst bndrs = mapAccumL substId subst bndrs
 545
 546 substId :: Subst -> Id -> (Subst, Id)
 547         -- Returns an Id with empty IdInfo
 548         -- See the notes with the Subst data type decl at the
 549         -- top of this module
 550
 551 substId subst@(Subst in_scope env) old_id
 552   = (Subst (in_scope `extendInScopeSet` new_id) new_env, new_id)
 553   where
 554     id_ty    = idType old_id
 555     occ_info = idOccInfo old_id
 556
 557        -- id1 has its type zapped
 558     id1 |  noTypeSubst env
 559         || isEmptyVarSet (tyVarsOfType id_ty) = old_id
 560                         -- The tyVarsOfType is cheaper than it looks
 561                         -- because we cache the free tyvars of the type
 562                         -- in a Note in the id's type itself
 563         | otherwise  = setIdType old_id (substTy subst id_ty)
 564
 565         -- id2 has its IdInfo zapped
 566     id2 = zapFragileIdInfo id1
 567
 568         -- new_id is cloned if necessary
 569     new_id = uniqAway in_scope id2
 570
 571         -- Extend the substitution if the unique has changed,
 572         -- or there's some useful occurrence information
 573         -- See the notes with substTyVar for the delSubstEnv
 574     new_env | new_id /= old_id || isFragileOcc occ_info
 575             = extendSubstEnv env old_id (DoneId new_id occ_info)
 576             | otherwise
 577             = delSubstEnv env old_id
 578 \end{code}
 579
 580 Now a variant that unconditionally allocates a new unique.
 581
 582 \begin{code}
 583 substAndCloneIds :: Subst -> UniqSupply -> [Id] -> (Subst, UniqSupply, [Id])
 584 substAndCloneIds subst us [] = (subst, us, [])
 585 substAndCloneIds subst us (b:bs) = case substAndCloneId  subst  us  b  of { (subst1, us1, b') ->
 586                                    case substAndCloneIds subst1 us1 bs of { (subst2, us2, bs') ->
 587                                    (subst2, us2, (b':bs')) }}
 588
 589 substAndCloneId :: Subst -> UniqSupply -> Id -> (Subst, UniqSupply, Id)
 590 substAndCloneId subst@(Subst in_scope env) us old_id
 591   = (Subst (in_scope `extendInScopeSet` new_id)
 592            (extendSubstEnv env old_id (DoneEx (Var new_id))),
 593      new_us,
 594      new_id)
 595   where
 596     id_ty    = idType old_id
 597     id1 | noTypeSubst env || isEmptyVarSet (tyVarsOfType id_ty) = old_id
 598         | otherwise                                             = setIdType old_id (substTy subst id_ty)
 599
 600     id2          = zapFragileIdInfo id1
 601     new_id       = setVarUnique id2 (uniqFromSupply us1)
 602     (us1,new_us) = splitUniqSupply us
 603 \end{code}
 604
 605
 606 %************************************************************************
 607 %*                                                                      *
 608 \section{IdInfo substitution}
 609 %*                                                                      *
 610 %************************************************************************
 611
 612 \begin{code}
 613 substIdInfo :: Subst
 614             -> IdInfo           -- Get un-substituted ones from here
 615             -> IdInfo           -- Substitute it and add it to here
 616             -> IdInfo           -- To give this
 617         -- Seq'ing on the returned IdInfo is enough to cause all the
 618         -- substitutions to happen completely
 619
 620 substIdInfo subst old_info new_info
 621   = info2
 622   where
 623     info1 | isEmptyCoreRules old_rules = new_info
 624           | otherwise                  = new_info `setSpecInfo` new_rules
 625                         -- setSpecInfo does a seq
 626           where
 627             new_rules = substRules subst old_rules
 628
 629     info2 | not (workerExists old_wrkr) = info1
 630           | otherwise                   = info1 `setWorkerInfo` new_wrkr
 631                         -- setWorkerInfo does a seq
 632           where
 633             new_wrkr = substWorker subst old_wrkr
 634
 635     old_rules = specInfo   old_info
 636     old_wrkr  = workerInfo old_info
 637
 638 substWorker :: Subst -> WorkerInfo -> WorkerInfo
 639         -- Seq'ing on the returned WorkerInfo is enough to cause all the
 640         -- substitutions to happen completely
 641
 642 substWorker subst NoWorker
 643   = NoWorker
 644 substWorker subst (HasWorker w a)
 645   = case lookupIdSubst subst w of
 646         (DoneId w1 _)     -> HasWorker w1 a
 647         (DoneEx (Var w1)) -> HasWorker w1 a
 648         (DoneEx other)    -> WARN( True, text "substWorker: DoneEx" <+> ppr w )
 649                                   NoWorker      -- Worker has got substituted away altogether
 650         (ContEx se1 e)    -> WARN( True, text "substWorker: ContEx" <+> ppr w <+> ppr e)
 651                                   NoWorker      -- Ditto
 652
 653 substRules :: Subst -> CoreRules -> CoreRules
 654         -- Seq'ing on the returned CoreRules is enough to cause all the
 655         -- substitutions to happen completely
 656
 657 substRules subst rules
 658  | isEmptySubst subst = rules
 659
 660 substRules subst (Rules rules rhs_fvs)
 661   = seqRules new_rules `seq` new_rules
 662   where
 663     new_rules = Rules (map do_subst rules) (substVarSet subst rhs_fvs)
 664
 665     do_subst rule@(BuiltinRule _) = rule
 666     do_subst (Rule name tpl_vars lhs_args rhs)
 667         = Rule name tpl_vars'
 668                (map (substExpr subst') lhs_args)
 669                (substExpr subst' rhs)
 670         where
 671           (subst', tpl_vars') = substBndrs subst tpl_vars
 672
 673 substVarSet subst fvs
 674   = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
 675   where
 676     subst_fv subst fv = case lookupIdSubst subst fv of
 677                             DoneId fv' _    -> unitVarSet fv'
 678                             DoneEx expr     -> exprFreeVars expr
 679                             DoneTy ty       -> tyVarsOfType ty
 680                             ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr)
 681 \end{code}