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