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