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