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