Add a final demand analyzer run right before TidyCore
[ghc.git] / compiler / basicTypes / Id.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section[Id]{@Ids@: Value and constructor identifiers}
6 -}
7
8 {-# LANGUAGE CPP #-}
9
10 -- |
11 -- #name_types#
12 -- GHC uses several kinds of name internally:
13 --
14 -- * 'OccName.OccName': see "OccName#name_types"
15 --
16 -- * 'RdrName.RdrName': see "RdrName#name_types"
17 --
18 -- * 'Name.Name': see "Name#name_types"
19 --
20 -- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TyCoRep.Type' and some additional
21 -- details (a 'IdInfo.IdInfo' and one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that
22 -- are added, modified and inspected by various compiler passes. These 'Var.Var' names may either
23 -- be global or local, see "Var#globalvslocal"
24 --
25 -- * 'Var.Var': see "Var#name_types"
26
27 module Id (
28 -- * The main types
29 Var, Id, isId,
30
31 -- ** Simple construction
32 mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
33 mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
34 mkLocalIdOrCoVarWithInfo,
35 mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
36 mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
37 mkUserLocal, mkUserLocalOrCoVar,
38 mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
39 mkWorkerId,
40
41 -- ** Taking an Id apart
42 idName, idType, idUnique, idInfo, idDetails, idRepArity,
43 recordSelectorTyCon,
44
45 -- ** Modifying an Id
46 setIdName, setIdUnique, Id.setIdType,
47 setIdExported, setIdNotExported,
48 globaliseId, localiseId,
49 setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
50 zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
51 zapIdUsedOnceInfo,
52 zapFragileIdInfo, zapIdStrictness,
53 transferPolyIdInfo,
54
55 -- ** Predicates on Ids
56 isImplicitId, isDeadBinder,
57 isStrictId,
58 isExportedId, isLocalId, isGlobalId,
59 isRecordSelector, isNaughtyRecordSelector,
60 isPatSynRecordSelector,
61 isDataConRecordSelector,
62 isClassOpId_maybe, isDFunId,
63 isPrimOpId, isPrimOpId_maybe,
64 isFCallId, isFCallId_maybe,
65 isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
66 isConLikeId, isBottomingId, idIsFrom,
67 hasNoBinding,
68
69 -- ** Evidence variables
70 DictId, isDictId, isEvVar,
71
72 -- ** Inline pragma stuff
73 idInlinePragma, setInlinePragma, modifyInlinePragma,
74 idInlineActivation, setInlineActivation, idRuleMatchInfo,
75
76 -- ** One-shot lambdas
77 isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda,
78 setOneShotLambda, clearOneShotLambda,
79 updOneShotInfo, setIdOneShotInfo,
80 isStateHackType, stateHackOneShot, typeOneShot,
81
82 -- ** Reading 'IdInfo' fields
83 idArity,
84 idCallArity,
85 idUnfolding, realIdUnfolding,
86 idSpecialisation, idCoreRules, idHasRules,
87 idCafInfo,
88 idOneShotInfo,
89 idOccInfo,
90
91 -- ** Writing 'IdInfo' fields
92 setIdUnfoldingLazily,
93 setIdUnfolding,
94 setIdArity,
95 setIdCallArity,
96
97 setIdSpecialisation,
98 setIdCafInfo,
99 setIdOccInfo, zapIdOccInfo,
100
101 setIdDemandInfo,
102 setIdStrictness,
103
104 idDemandInfo,
105 idStrictness,
106
107 ) where
108
109 #include "HsVersions.h"
110
111 import CoreSyn ( CoreRule, Unfolding( NoUnfolding ) )
112
113 import IdInfo
114 import BasicTypes
115
116 -- Imported and re-exported
117 import Var( Id, CoVar, DictId,
118 idInfo, idDetails, globaliseId, varType,
119 isId, isLocalId, isGlobalId, isExportedId )
120 import qualified Var
121
122 import Type
123 import TysPrim
124 import DataCon
125 import Demand
126 import Name
127 import Module
128 import Class
129 import {-# SOURCE #-} PrimOp (PrimOp)
130 import ForeignCall
131 import Maybes
132 import SrcLoc
133 import Outputable
134 import Unique
135 import UniqSupply
136 import FastString
137 import Util
138 import StaticFlags
139
140 -- infixl so you can say (id `set` a `set` b)
141 infixl 1 `setIdUnfoldingLazily`,
142 `setIdUnfolding`,
143 `setIdArity`,
144 `setIdCallArity`,
145 `setIdOccInfo`,
146 `setIdOneShotInfo`,
147
148 `setIdSpecialisation`,
149 `setInlinePragma`,
150 `setInlineActivation`,
151 `idCafInfo`,
152
153 `setIdDemandInfo`,
154 `setIdStrictness`
155
156 {-
157 ************************************************************************
158 * *
159 \subsection{Basic Id manipulation}
160 * *
161 ************************************************************************
162 -}
163
164 idName :: Id -> Name
165 idName = Var.varName
166
167 idUnique :: Id -> Unique
168 idUnique = Var.varUnique
169
170 idType :: Id -> Kind
171 idType = Var.varType
172
173 setIdName :: Id -> Name -> Id
174 setIdName = Var.setVarName
175
176 setIdUnique :: Id -> Unique -> Id
177 setIdUnique = Var.setVarUnique
178
179 -- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
180 -- reduce space usage
181 setIdType :: Id -> Type -> Id
182 setIdType id ty = seqType ty `seq` Var.setVarType id ty
183
184 setIdExported :: Id -> Id
185 setIdExported = Var.setIdExported
186
187 setIdNotExported :: Id -> Id
188 setIdNotExported = Var.setIdNotExported
189
190 localiseId :: Id -> Id
191 -- Make an with the same unique and type as the
192 -- incoming Id, but with an *Internal* Name and *LocalId* flavour
193 localiseId id
194 | ASSERT( isId id ) isLocalId id && isInternalName name
195 = id
196 | otherwise
197 = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)
198 where
199 name = idName id
200
201 lazySetIdInfo :: Id -> IdInfo -> Id
202 lazySetIdInfo = Var.lazySetIdInfo
203
204 setIdInfo :: Id -> IdInfo -> Id
205 setIdInfo id info = info `seq` (lazySetIdInfo id info)
206 -- Try to avoid spack leaks by seq'ing
207
208 modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
209 modifyIdInfo fn id = setIdInfo id (fn (idInfo id))
210
211 -- maybeModifyIdInfo tries to avoid unnecessary thrashing
212 maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
213 maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
214 maybeModifyIdInfo Nothing id = id
215
216 {-
217 ************************************************************************
218 * *
219 \subsection{Simple Id construction}
220 * *
221 ************************************************************************
222
223 Absolutely all Ids are made by mkId. It is just like Var.mkId,
224 but in addition it pins free-tyvar-info onto the Id's type,
225 where it can easily be found.
226
227 Note [Free type variables]
228 ~~~~~~~~~~~~~~~~~~~~~~~~~~
229 At one time we cached the free type variables of the type of an Id
230 at the root of the type in a TyNote. The idea was to avoid repeating
231 the free-type-variable calculation. But it turned out to slow down
232 the compiler overall. I don't quite know why; perhaps finding free
233 type variables of an Id isn't all that common whereas applying a
234 substitution (which changes the free type variables) is more common.
235 Anyway, we removed it in March 2008.
236 -}
237
238 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
239 mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
240 mkGlobalId = Var.mkGlobalVar
241
242 -- | Make a global 'Id' without any extra information at all
243 mkVanillaGlobal :: Name -> Type -> Id
244 mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
245
246 -- | Make a global 'Id' with no global information but some generic 'IdInfo'
247 mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
248 mkVanillaGlobalWithInfo = mkGlobalId VanillaId
249
250
251 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
252 mkLocalId :: Name -> Type -> Id
253 mkLocalId name ty = mkLocalIdWithInfo name ty
254 (vanillaIdInfo `setOneShotInfo` typeOneShot ty)
255 -- It's tempting to ASSERT( not (isCoercionType ty) ), but don't. Sometimes,
256 -- the type is a panic. (Search invented_id)
257
258 -- | Make a local CoVar
259 mkLocalCoVar :: Name -> Type -> CoVar
260 mkLocalCoVar name ty
261 = ASSERT( isCoercionType ty )
262 Var.mkLocalVar CoVarId name ty (vanillaIdInfo `setOneShotInfo` typeOneShot ty)
263
264 -- | Like 'mkLocalId', but checks the type to see if it should make a covar
265 mkLocalIdOrCoVar :: Name -> Type -> Id
266 mkLocalIdOrCoVar name ty
267 | isCoercionType ty = mkLocalCoVar name ty
268 | otherwise = mkLocalId name ty
269
270 -- | Make a local id, with the IdDetails set to CoVarId if the type indicates
271 -- so.
272 mkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id
273 mkLocalIdOrCoVarWithInfo name ty info
274 = Var.mkLocalVar details name ty info
275 where
276 details | isCoercionType ty = CoVarId
277 | otherwise = VanillaId
278
279 -- proper ids only; no covars!
280 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
281 mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info
282 -- Note [Free type variables]
283
284 -- | Create a local 'Id' that is marked as exported.
285 -- This prevents things attached to it from being removed as dead code.
286 -- See Note [Exported LocalIds]
287 mkExportedLocalId :: IdDetails -> Name -> Type -> Id
288 mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
289 -- Note [Free type variables]
290
291 mkExportedVanillaId :: Name -> Type -> Id
292 mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
293 -- Note [Free type variables]
294
295
296 -- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
297 -- that are created by the compiler out of thin air
298 mkSysLocal :: FastString -> Unique -> Type -> Id
299 mkSysLocal fs uniq ty = ASSERT( not (isCoercionType ty) )
300 mkLocalId (mkSystemVarName uniq fs) ty
301
302 -- | Like 'mkSysLocal', but checks to see if we have a covar type
303 mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id
304 mkSysLocalOrCoVar fs uniq ty
305 = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty
306
307 mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
308 mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))
309
310 mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id
311 mkSysLocalOrCoVarM fs ty
312 = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))
313
314 -- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
315 mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
316 mkUserLocal occ uniq ty loc = ASSERT( not (isCoercionType ty) )
317 mkLocalId (mkInternalName uniq occ loc) ty
318
319 -- | Like 'mkUserLocal', but checks if we have a coercion type
320 mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
321 mkUserLocalOrCoVar occ uniq ty loc
322 = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty
323
324 {-
325 Make some local @Ids@ for a template @CoreExpr@. These have bogus
326 @Uniques@, but that's OK because the templates are supposed to be
327 instantiated before use.
328 -}
329
330 -- | Workers get local names. "CoreTidy" will externalise these if necessary
331 mkWorkerId :: Unique -> Id -> Type -> Id
332 mkWorkerId uniq unwrkr ty
333 = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
334
335 -- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
336 mkTemplateLocal :: Int -> Type -> Id
337 mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "tpl") (mkBuiltinUnique i) ty
338
339 -- | Create a template local for a series of types
340 mkTemplateLocals :: [Type] -> [Id]
341 mkTemplateLocals = mkTemplateLocalsNum 1
342
343 -- | Create a template local for a series of type, but start from a specified template local
344 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
345 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
346
347 {- Note [Exported LocalIds]
348 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
349 We use mkExportedLocalId for things like
350 - Dictionary functions (DFunId)
351 - Wrapper and matcher Ids for pattern synonyms
352 - Default methods for classes
353 - Pattern-synonym matcher and builder Ids
354 - etc
355
356 They marked as "exported" in the sense that they should be kept alive
357 even if apparently unused in other bindings, and not dropped as dead
358 code by the occurrence analyser. (But "exported" here does not mean
359 "brought into lexical scope by an import declaration". Indeed these
360 things are always internal Ids that the user never sees.)
361
362 It's very important that they are *LocalIds*, not GlobalIds, for lots
363 of reasons:
364
365 * We want to treat them as free variables for the purpose of
366 dependency analysis (e.g. CoreFVs.exprFreeVars).
367
368 * Look them up in the current substitution when we come across
369 occurrences of them (in Subst.lookupIdSubst). Lacking this we
370 can get an out-of-date unfolding, which can in turn make the
371 simplifier go into an infinite loop (Trac #9857)
372
373 * Ensure that for dfuns that the specialiser does not float dict uses
374 above their defns, which would prevent good simplifications happening.
375
376 * The strictness analyser treats a occurrence of a GlobalId as
377 imported and assumes it contains strictness in its IdInfo, which
378 isn't true if the thing is bound in the same module as the
379 occurrence.
380
381 In CoreTidy we must make all these LocalIds into GlobalIds, so that in
382 importing modules (in --make mode) we treat them as properly global.
383 That is what is happening in, say tidy_insts in TidyPgm.
384
385 ************************************************************************
386 * *
387 \subsection{Special Ids}
388 * *
389 ************************************************************************
390 -}
391
392 -- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.
393 recordSelectorTyCon :: Id -> RecSelParent
394 recordSelectorTyCon id
395 = case Var.idDetails id of
396 RecSelId { sel_tycon = parent } -> parent
397 _ -> panic "recordSelectorTyCon"
398
399
400 isRecordSelector :: Id -> Bool
401 isNaughtyRecordSelector :: Id -> Bool
402 isPatSynRecordSelector :: Id -> Bool
403 isDataConRecordSelector :: Id -> Bool
404 isPrimOpId :: Id -> Bool
405 isFCallId :: Id -> Bool
406 isDataConWorkId :: Id -> Bool
407 isDFunId :: Id -> Bool
408
409 isClassOpId_maybe :: Id -> Maybe Class
410 isPrimOpId_maybe :: Id -> Maybe PrimOp
411 isFCallId_maybe :: Id -> Maybe ForeignCall
412 isDataConWorkId_maybe :: Id -> Maybe DataCon
413
414 isRecordSelector id = case Var.idDetails id of
415 RecSelId {} -> True
416 _ -> False
417
418 isDataConRecordSelector id = case Var.idDetails id of
419 RecSelId {sel_tycon = RecSelData _} -> True
420 _ -> False
421
422 isPatSynRecordSelector id = case Var.idDetails id of
423 RecSelId {sel_tycon = RecSelPatSyn _} -> True
424 _ -> False
425
426 isNaughtyRecordSelector id = case Var.idDetails id of
427 RecSelId { sel_naughty = n } -> n
428 _ -> False
429
430 isClassOpId_maybe id = case Var.idDetails id of
431 ClassOpId cls -> Just cls
432 _other -> Nothing
433
434 isPrimOpId id = case Var.idDetails id of
435 PrimOpId _ -> True
436 _ -> False
437
438 isDFunId id = case Var.idDetails id of
439 DFunId {} -> True
440 _ -> False
441
442 isPrimOpId_maybe id = case Var.idDetails id of
443 PrimOpId op -> Just op
444 _ -> Nothing
445
446 isFCallId id = case Var.idDetails id of
447 FCallId _ -> True
448 _ -> False
449
450 isFCallId_maybe id = case Var.idDetails id of
451 FCallId call -> Just call
452 _ -> Nothing
453
454 isDataConWorkId id = case Var.idDetails id of
455 DataConWorkId _ -> True
456 _ -> False
457
458 isDataConWorkId_maybe id = case Var.idDetails id of
459 DataConWorkId con -> Just con
460 _ -> Nothing
461
462 isDataConId_maybe :: Id -> Maybe DataCon
463 isDataConId_maybe id = case Var.idDetails id of
464 DataConWorkId con -> Just con
465 DataConWrapId con -> Just con
466 _ -> Nothing
467
468 idDataCon :: Id -> DataCon
469 -- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
470 --
471 -- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
472 idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
473
474 hasNoBinding :: Id -> Bool
475 -- ^ Returns @True@ of an 'Id' which may not have a
476 -- binding, even though it is defined in this module.
477
478 -- Data constructor workers used to be things of this kind, but
479 -- they aren't any more. Instead, we inject a binding for
480 -- them at the CorePrep stage.
481 -- EXCEPT: unboxed tuples, which definitely have no binding
482 hasNoBinding id = case Var.idDetails id of
483 PrimOpId _ -> True -- See Note [Primop wrappers]
484 FCallId _ -> True
485 DataConWorkId dc -> isUnboxedTupleCon dc
486 _ -> False
487
488 isImplicitId :: Id -> Bool
489 -- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
490 -- declarations, so we don't need to put its signature in an interface
491 -- file, even if it's mentioned in some other interface unfolding.
492 isImplicitId id
493 = case Var.idDetails id of
494 FCallId {} -> True
495 ClassOpId {} -> True
496 PrimOpId {} -> True
497 DataConWorkId {} -> True
498 DataConWrapId {} -> True
499 -- These are implied by their type or class decl;
500 -- remember that all type and class decls appear in the interface file.
501 -- The dfun id is not an implicit Id; it must *not* be omitted, because
502 -- it carries version info for the instance decl
503 _ -> False
504
505 idIsFrom :: Module -> Id -> Bool
506 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
507
508 {-
509 Note [Primop wrappers]
510 ~~~~~~~~~~~~~~~~~~~~~~
511 Currently hasNoBinding claims that PrimOpIds don't have a curried
512 function definition. But actually they do, in GHC.PrimopWrappers,
513 which is auto-generated from prelude/primops.txt.pp. So actually, hasNoBinding
514 could return 'False' for PrimOpIds.
515
516 But we'd need to add something in CoreToStg to swizzle any unsaturated
517 applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.
518
519 Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
520 used by GHCi, which does not implement primops direct at all.
521 -}
522
523 isDeadBinder :: Id -> Bool
524 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
525 | otherwise = False -- TyVars count as not dead
526
527 {-
528 ************************************************************************
529 * *
530 Evidence variables
531 * *
532 ************************************************************************
533 -}
534
535 isEvVar :: Var -> Bool
536 isEvVar var = isPredTy (varType var)
537
538 isDictId :: Id -> Bool
539 isDictId id = isDictTy (idType id)
540
541 {-
542 ************************************************************************
543 * *
544 \subsection{IdInfo stuff}
545 * *
546 ************************************************************************
547 -}
548
549 ---------------------------------
550 -- ARITY
551 idArity :: Id -> Arity
552 idArity id = arityInfo (idInfo id)
553
554 setIdArity :: Id -> Arity -> Id
555 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
556
557 idCallArity :: Id -> Arity
558 idCallArity id = callArityInfo (idInfo id)
559
560 setIdCallArity :: Id -> Arity -> Id
561 setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id
562
563 idRepArity :: Id -> RepArity
564 idRepArity x = typeRepArity (idArity x) (idType x)
565
566 -- | Returns true if an application to n args would diverge
567 isBottomingId :: Id -> Bool
568 isBottomingId id = isBottomingSig (idStrictness id)
569
570 idStrictness :: Id -> StrictSig
571 idStrictness id = strictnessInfo (idInfo id)
572
573 setIdStrictness :: Id -> StrictSig -> Id
574 setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
575
576 zapIdStrictness :: Id -> Id
577 zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
578
579 -- | This predicate says whether the 'Id' has a strict demand placed on it or
580 -- has a type such that it can always be evaluated strictly (i.e an
581 -- unlifted type, as of GHC 7.6). We need to
582 -- check separately whether the 'Id' has a so-called \"strict type\" because if
583 -- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
584 -- type, we still want @isStrictId id@ to be @True@.
585 isStrictId :: Id -> Bool
586 isStrictId id
587 = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
588 (isStrictType (idType id)) ||
589 -- Take the best of both strictnesses - old and new
590 (isStrictDmd (idDemandInfo id))
591
592 ---------------------------------
593 -- UNFOLDING
594 idUnfolding :: Id -> Unfolding
595 -- Do not expose the unfolding of a loop breaker!
596 idUnfolding id
597 | isStrongLoopBreaker (occInfo info) = NoUnfolding
598 | otherwise = unfoldingInfo info
599 where
600 info = idInfo id
601
602 realIdUnfolding :: Id -> Unfolding
603 -- Expose the unfolding if there is one, including for loop breakers
604 realIdUnfolding id = unfoldingInfo (idInfo id)
605
606 setIdUnfoldingLazily :: Id -> Unfolding -> Id
607 setIdUnfoldingLazily id unfolding = modifyIdInfo (`setUnfoldingInfoLazily` unfolding) id
608
609 setIdUnfolding :: Id -> Unfolding -> Id
610 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
611
612 idDemandInfo :: Id -> Demand
613 idDemandInfo id = demandInfo (idInfo id)
614
615 setIdDemandInfo :: Id -> Demand -> Id
616 setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id
617
618 ---------------------------------
619 -- SPECIALISATION
620
621 -- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs
622
623 idSpecialisation :: Id -> RuleInfo
624 idSpecialisation id = ruleInfo (idInfo id)
625
626 idCoreRules :: Id -> [CoreRule]
627 idCoreRules id = ruleInfoRules (idSpecialisation id)
628
629 idHasRules :: Id -> Bool
630 idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))
631
632 setIdSpecialisation :: Id -> RuleInfo -> Id
633 setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id
634
635 ---------------------------------
636 -- CAF INFO
637 idCafInfo :: Id -> CafInfo
638 idCafInfo id = cafInfo (idInfo id)
639
640 setIdCafInfo :: Id -> CafInfo -> Id
641 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
642
643 ---------------------------------
644 -- Occcurrence INFO
645 idOccInfo :: Id -> OccInfo
646 idOccInfo id = occInfo (idInfo id)
647
648 setIdOccInfo :: Id -> OccInfo -> Id
649 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
650
651 zapIdOccInfo :: Id -> Id
652 zapIdOccInfo b = b `setIdOccInfo` NoOccInfo
653
654 {-
655 ---------------------------------
656 -- INLINING
657 The inline pragma tells us to be very keen to inline this Id, but it's still
658 OK not to if optimisation is switched off.
659 -}
660
661 idInlinePragma :: Id -> InlinePragma
662 idInlinePragma id = inlinePragInfo (idInfo id)
663
664 setInlinePragma :: Id -> InlinePragma -> Id
665 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
666
667 modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
668 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
669
670 idInlineActivation :: Id -> Activation
671 idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
672
673 setInlineActivation :: Id -> Activation -> Id
674 setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
675
676 idRuleMatchInfo :: Id -> RuleMatchInfo
677 idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
678
679 isConLikeId :: Id -> Bool
680 isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
681
682 {-
683 ---------------------------------
684 -- ONE-SHOT LAMBDAS
685 -}
686
687 idOneShotInfo :: Id -> OneShotInfo
688 idOneShotInfo id = oneShotInfo (idInfo id)
689
690 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
691 -- This one is the "business end", called externally.
692 -- It works on type variables as well as Ids, returning True
693 -- Its main purpose is to encapsulate the Horrible State Hack
694 isOneShotBndr :: Var -> Bool
695 isOneShotBndr var
696 | isTyVar var = True
697 | otherwise = isOneShotLambda var
698
699 -- | Should we apply the state hack to values of this 'Type'?
700 stateHackOneShot :: OneShotInfo
701 stateHackOneShot = OneShotLam -- Or maybe ProbOneShot?
702
703 typeOneShot :: Type -> OneShotInfo
704 typeOneShot ty
705 | isStateHackType ty = stateHackOneShot
706 | otherwise = NoOneShotInfo
707
708 isStateHackType :: Type -> Bool
709 isStateHackType ty
710 | opt_NoStateHack
711 = False
712 | otherwise
713 = case tyConAppTyCon_maybe ty of
714 Just tycon -> tycon == statePrimTyCon
715 _ -> False
716 -- This is a gross hack. It claims that
717 -- every function over realWorldStatePrimTy is a one-shot
718 -- function. This is pretty true in practice, and makes a big
719 -- difference. For example, consider
720 -- a `thenST` \ r -> ...E...
721 -- The early full laziness pass, if it doesn't know that r is one-shot
722 -- will pull out E (let's say it doesn't mention r) to give
723 -- let lvl = E in a `thenST` \ r -> ...lvl...
724 -- When `thenST` gets inlined, we end up with
725 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
726 -- and we don't re-inline E.
727 --
728 -- It would be better to spot that r was one-shot to start with, but
729 -- I don't want to rely on that.
730 --
731 -- Another good example is in fill_in in PrelPack.hs. We should be able to
732 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
733
734
735 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once.
736 -- You probably want to use 'isOneShotBndr' instead
737 isOneShotLambda :: Id -> Bool
738 isOneShotLambda id = case idOneShotInfo id of
739 OneShotLam -> True
740 _ -> False
741
742 isProbablyOneShotLambda :: Id -> Bool
743 isProbablyOneShotLambda id = case idOneShotInfo id of
744 OneShotLam -> True
745 ProbOneShot -> True
746 NoOneShotInfo -> False
747
748 setOneShotLambda :: Id -> Id
749 setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id
750
751 clearOneShotLambda :: Id -> Id
752 clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id
753
754 setIdOneShotInfo :: Id -> OneShotInfo -> Id
755 setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id
756
757 updOneShotInfo :: Id -> OneShotInfo -> Id
758 -- Combine the info in the Id with new info
759 updOneShotInfo id one_shot
760 | do_upd = setIdOneShotInfo id one_shot
761 | otherwise = id
762 where
763 do_upd = case (idOneShotInfo id, one_shot) of
764 (NoOneShotInfo, _) -> True
765 (OneShotLam, _) -> False
766 (_, NoOneShotInfo) -> False
767 _ -> True
768
769 -- The OneShotLambda functions simply fiddle with the IdInfo flag
770 -- But watch out: this may change the type of something else
771 -- f = \x -> e
772 -- If we change the one-shot-ness of x, f's type changes
773
774 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
775 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
776
777 zapLamIdInfo :: Id -> Id
778 zapLamIdInfo = zapInfo zapLamInfo
779
780 zapFragileIdInfo :: Id -> Id
781 zapFragileIdInfo = zapInfo zapFragileInfo
782
783 zapIdDemandInfo :: Id -> Id
784 zapIdDemandInfo = zapInfo zapDemandInfo
785
786 zapIdUsageInfo :: Id -> Id
787 zapIdUsageInfo = zapInfo zapUsageInfo
788
789 zapIdUsageEnvInfo :: Id -> Id
790 zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo
791
792 zapIdUsedOnceInfo :: Id -> Id
793 zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo
794
795 {-
796 Note [transferPolyIdInfo]
797 ~~~~~~~~~~~~~~~~~~~~~~~~~
798 This transfer is used in two places:
799 FloatOut (long-distance let-floating)
800 SimplUtils.abstractFloats (short-distance let-floating)
801
802 Consider the short-distance let-floating:
803
804 f = /\a. let g = rhs in ...
805
806 Then if we float thus
807
808 g' = /\a. rhs
809 f = /\a. ...[g' a/g]....
810
811 we *do not* want to lose g's
812 * strictness information
813 * arity
814 * inline pragma (though that is bit more debatable)
815 * occurrence info
816
817 Mostly this is just an optimisation, but it's *vital* to
818 transfer the occurrence info. Consider
819
820 NonRec { f = /\a. let Rec { g* = ..g.. } in ... }
821
822 where the '*' means 'LoopBreaker'. Then if we float we must get
823
824 Rec { g'* = /\a. ...(g' a)... }
825 NonRec { f = /\a. ...[g' a/g]....}
826
827 where g' is also marked as LoopBreaker. If not, terrible things
828 can happen if we re-simplify the binding (and the Simplifier does
829 sometimes simplify a term twice); see Trac #4345.
830
831 It's not so simple to retain
832 * worker info
833 * rules
834 so we simply discard those. Sooner or later this may bite us.
835
836 If we abstract wrt one or more *value* binders, we must modify the
837 arity and strictness info before transferring it. E.g.
838 f = \x. e
839 -->
840 g' = \y. \x. e
841 + substitute (g' y) for g
842 Notice that g' has an arity one more than the original g
843 -}
844
845 transferPolyIdInfo :: Id -- Original Id
846 -> [Var] -- Abstract wrt these variables
847 -> Id -- New Id
848 -> Id
849 transferPolyIdInfo old_id abstract_wrt new_id
850 = modifyIdInfo transfer new_id
851 where
852 arity_increase = count isId abstract_wrt -- Arity increases by the
853 -- number of value binders
854
855 old_info = idInfo old_id
856 old_arity = arityInfo old_info
857 old_inline_prag = inlinePragInfo old_info
858 old_occ_info = occInfo old_info
859 new_arity = old_arity + arity_increase
860
861 old_strictness = strictnessInfo old_info
862 new_strictness = increaseStrictSigArity arity_increase old_strictness
863
864 transfer new_info = new_info `setArityInfo` new_arity
865 `setInlinePragInfo` old_inline_prag
866 `setOccInfo` old_occ_info
867 `setStrictnessInfo` new_strictness