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