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