Implement QuantifiedConstraints
[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, isDataConId_maybe, idDataCon,
70 isConLikeId, isBottomingId, idIsFrom,
71 hasNoBinding,
72
73 -- ** Evidence variables
74 DictId, isDictId, isEvVar,
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, DictId, 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 spack 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 (isCoercionType 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( isCoercionType 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 | isCoercionType 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 | isCoercionType 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 (isCoercionType 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 (isCoercionType 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 (Trac #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 isDFunId :: Id -> Bool
423
424 isClassOpId_maybe :: Id -> Maybe Class
425 isPrimOpId_maybe :: Id -> Maybe PrimOp
426 isFCallId_maybe :: Id -> Maybe ForeignCall
427 isDataConWorkId_maybe :: Id -> Maybe DataCon
428
429 isRecordSelector id = case Var.idDetails id of
430 RecSelId {} -> True
431 _ -> False
432
433 isDataConRecordSelector id = case Var.idDetails id of
434 RecSelId {sel_tycon = RecSelData _} -> True
435 _ -> False
436
437 isPatSynRecordSelector id = case Var.idDetails id of
438 RecSelId {sel_tycon = RecSelPatSyn _} -> True
439 _ -> False
440
441 isNaughtyRecordSelector id = case Var.idDetails id of
442 RecSelId { sel_naughty = n } -> n
443 _ -> False
444
445 isClassOpId_maybe id = case Var.idDetails id of
446 ClassOpId cls -> Just cls
447 _other -> Nothing
448
449 isPrimOpId id = case Var.idDetails id of
450 PrimOpId _ -> True
451 _ -> False
452
453 isDFunId id = case Var.idDetails id of
454 DFunId {} -> True
455 _ -> False
456
457 isPrimOpId_maybe id = case Var.idDetails id of
458 PrimOpId op -> Just op
459 _ -> Nothing
460
461 isFCallId id = case Var.idDetails id of
462 FCallId _ -> True
463 _ -> False
464
465 isFCallId_maybe id = case Var.idDetails id of
466 FCallId call -> Just call
467 _ -> Nothing
468
469 isDataConWorkId id = case Var.idDetails id of
470 DataConWorkId _ -> True
471 _ -> False
472
473 isDataConWorkId_maybe id = case Var.idDetails id of
474 DataConWorkId con -> Just con
475 _ -> Nothing
476
477 isDataConId_maybe :: Id -> Maybe DataCon
478 isDataConId_maybe id = case Var.idDetails id of
479 DataConWorkId con -> Just con
480 DataConWrapId con -> Just con
481 _ -> Nothing
482
483 isJoinId :: Var -> Bool
484 -- It is convenient in SetLevels.lvlMFE to apply isJoinId
485 -- to the free vars of an expression, so it's convenient
486 -- if it returns False for type variables
487 isJoinId id
488 | isId id = case Var.idDetails id of
489 JoinId {} -> True
490 _ -> False
491 | otherwise = False
492
493 isJoinId_maybe :: Var -> Maybe JoinArity
494 isJoinId_maybe id
495 | isId id = ASSERT2( isId id, ppr id )
496 case Var.idDetails id of
497 JoinId arity -> Just arity
498 _ -> Nothing
499 | otherwise = Nothing
500
501 idDataCon :: Id -> DataCon
502 -- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
503 --
504 -- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
505 idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
506
507 hasNoBinding :: Id -> Bool
508 -- ^ Returns @True@ of an 'Id' which may not have a
509 -- binding, even though it is defined in this module.
510
511 -- Data constructor workers used to be things of this kind, but
512 -- they aren't any more. Instead, we inject a binding for
513 -- them at the CorePrep stage.
514 -- EXCEPT: unboxed tuples, which definitely have no binding
515 hasNoBinding id = case Var.idDetails id of
516 PrimOpId _ -> True -- See Note [Primop wrappers]
517 FCallId _ -> True
518 DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc
519 _ -> isCompulsoryUnfolding (idUnfolding id)
520 -- See Note [Levity-polymorphic Ids]
521
522 isImplicitId :: Id -> Bool
523 -- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
524 -- declarations, so we don't need to put its signature in an interface
525 -- file, even if it's mentioned in some other interface unfolding.
526 isImplicitId id
527 = case Var.idDetails id of
528 FCallId {} -> True
529 ClassOpId {} -> True
530 PrimOpId {} -> True
531 DataConWorkId {} -> True
532 DataConWrapId {} -> True
533 -- These are implied by their type or class decl;
534 -- remember that all type and class decls appear in the interface file.
535 -- The dfun id is not an implicit Id; it must *not* be omitted, because
536 -- it carries version info for the instance decl
537 _ -> False
538
539 idIsFrom :: Module -> Id -> Bool
540 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
541
542 {- Note [Levity-polymorphic Ids]
543 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
544 Some levity-polymorphic Ids must be applied and and inlined, not left
545 un-saturated. Example:
546 unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b
547
548 This has a compulsory unfolding because we can't lambda-bind those
549 arguments. But the compulsory unfolding may leave levity-polymorphic
550 lambdas if it is not applied to enough arguments; e.g. (Trac #14561)
551 bad :: forall (a :: TYPE r). a -> a
552 bad = unsafeCoerce#
553
554 The desugar has special magic to detect such cases: DsExpr.badUseOfLevPolyPrimop.
555 And we want that magic to apply to levity-polymorphic compulsory-inline things.
556 The easiest way to do this is for hasNoBinding to return True of all things
557 that have compulsory unfolding. A very Ids with a compulsory unfolding also
558 have a binding, but it does not harm to say they don't here, and its a very
559 simple way to fix Trac #14561.
560
561 Note [Primop wrappers]
562 ~~~~~~~~~~~~~~~~~~~~~~
563 Currently hasNoBinding claims that PrimOpIds don't have a curried
564 function definition. But actually they do, in GHC.PrimopWrappers,
565 which is auto-generated from prelude/primops.txt.pp. So actually, hasNoBinding
566 could return 'False' for PrimOpIds.
567
568 But we'd need to add something in CoreToStg to swizzle any unsaturated
569 applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.
570
571 Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
572 used by GHCi, which does not implement primops direct at all.
573 -}
574
575 isDeadBinder :: Id -> Bool
576 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
577 | otherwise = False -- TyVars count as not dead
578
579 {-
580 ************************************************************************
581 * *
582 Evidence variables
583 * *
584 ************************************************************************
585 -}
586
587 isEvVar :: Var -> Bool
588 isEvVar var = isPredTy (varType var)
589
590 isDictId :: Id -> Bool
591 isDictId id = isDictTy (idType id)
592
593 {-
594 ************************************************************************
595 * *
596 Join variables
597 * *
598 ************************************************************************
599 -}
600
601 idJoinArity :: JoinId -> JoinArity
602 idJoinArity id = isJoinId_maybe id `orElse` pprPanic "idJoinArity" (ppr id)
603
604 asJoinId :: Id -> JoinArity -> JoinId
605 asJoinId id arity = WARN(not (isLocalId id),
606 text "global id being marked as join var:" <+> ppr id)
607 WARN(not (is_vanilla_or_join id),
608 ppr id <+> pprIdDetails (idDetails id))
609 id `setIdDetails` JoinId arity
610 where
611 is_vanilla_or_join id = case Var.idDetails id of
612 VanillaId -> True
613 JoinId {} -> True
614 _ -> False
615
616 zapJoinId :: Id -> Id
617 -- May be a regular id already
618 zapJoinId jid | isJoinId jid = zapIdTailCallInfo (jid `setIdDetails` VanillaId)
619 -- Core Lint may complain if still marked
620 -- as AlwaysTailCalled
621 | otherwise = jid
622
623 asJoinId_maybe :: Id -> Maybe JoinArity -> Id
624 asJoinId_maybe id (Just arity) = asJoinId id arity
625 asJoinId_maybe id Nothing = zapJoinId id
626
627 {-
628 ************************************************************************
629 * *
630 \subsection{IdInfo stuff}
631 * *
632 ************************************************************************
633 -}
634
635 ---------------------------------
636 -- ARITY
637 idArity :: Id -> Arity
638 idArity id = arityInfo (idInfo id)
639
640 setIdArity :: Id -> Arity -> Id
641 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
642
643 idCallArity :: Id -> Arity
644 idCallArity id = callArityInfo (idInfo id)
645
646 setIdCallArity :: Id -> Arity -> Id
647 setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id
648
649 idFunRepArity :: Id -> RepArity
650 idFunRepArity x = countFunRepArgs (idArity x) (idType x)
651
652 -- | Returns true if an application to n args would diverge
653 isBottomingId :: Var -> Bool
654 isBottomingId v
655 | isId v = isBottomingSig (idStrictness v)
656 | otherwise = False
657
658 idStrictness :: Id -> StrictSig
659 idStrictness id = strictnessInfo (idInfo id)
660
661 setIdStrictness :: Id -> StrictSig -> Id
662 setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
663
664 zapIdStrictness :: Id -> Id
665 zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
666
667 -- | This predicate says whether the 'Id' has a strict demand placed on it or
668 -- has a type such that it can always be evaluated strictly (i.e an
669 -- unlifted type, as of GHC 7.6). We need to
670 -- check separately whether the 'Id' has a so-called \"strict type\" because if
671 -- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
672 -- type, we still want @isStrictId id@ to be @True@.
673 isStrictId :: Id -> Bool
674 isStrictId id
675 = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
676 not (isJoinId id) && (
677 (isStrictType (idType id)) ||
678 -- Take the best of both strictnesses - old and new
679 (isStrictDmd (idDemandInfo id))
680 )
681
682 ---------------------------------
683 -- UNFOLDING
684 idUnfolding :: Id -> Unfolding
685 -- Do not expose the unfolding of a loop breaker!
686 idUnfolding id
687 | isStrongLoopBreaker (occInfo info) = NoUnfolding
688 | otherwise = unfoldingInfo info
689 where
690 info = idInfo id
691
692 realIdUnfolding :: Id -> Unfolding
693 -- Expose the unfolding if there is one, including for loop breakers
694 realIdUnfolding id = unfoldingInfo (idInfo id)
695
696 setIdUnfolding :: Id -> Unfolding -> Id
697 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
698
699 idDemandInfo :: Id -> Demand
700 idDemandInfo id = demandInfo (idInfo id)
701
702 setIdDemandInfo :: Id -> Demand -> Id
703 setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id
704
705 setCaseBndrEvald :: StrictnessMark -> Id -> Id
706 -- Used for variables bound by a case expressions, both the case-binder
707 -- itself, and any pattern-bound variables that are argument of a
708 -- strict constructor. It just marks the variable as already-evaluated,
709 -- so that (for example) a subsequent 'seq' can be dropped
710 setCaseBndrEvald str id
711 | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding
712 | otherwise = id
713
714 ---------------------------------
715 -- SPECIALISATION
716
717 -- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs
718
719 idSpecialisation :: Id -> RuleInfo
720 idSpecialisation id = ruleInfo (idInfo id)
721
722 idCoreRules :: Id -> [CoreRule]
723 idCoreRules id = ruleInfoRules (idSpecialisation id)
724
725 idHasRules :: Id -> Bool
726 idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))
727
728 setIdSpecialisation :: Id -> RuleInfo -> Id
729 setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id
730
731 ---------------------------------
732 -- CAF INFO
733 idCafInfo :: Id -> CafInfo
734 idCafInfo id = cafInfo (idInfo id)
735
736 setIdCafInfo :: Id -> CafInfo -> Id
737 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
738
739 ---------------------------------
740 -- Occurrence INFO
741 idOccInfo :: Id -> OccInfo
742 idOccInfo id = occInfo (idInfo id)
743
744 setIdOccInfo :: Id -> OccInfo -> Id
745 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
746
747 zapIdOccInfo :: Id -> Id
748 zapIdOccInfo b = b `setIdOccInfo` noOccInfo
749
750 {-
751 ---------------------------------
752 -- INLINING
753 The inline pragma tells us to be very keen to inline this Id, but it's still
754 OK not to if optimisation is switched off.
755 -}
756
757 idInlinePragma :: Id -> InlinePragma
758 idInlinePragma id = inlinePragInfo (idInfo id)
759
760 setInlinePragma :: Id -> InlinePragma -> Id
761 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
762
763 modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
764 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
765
766 idInlineActivation :: Id -> Activation
767 idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
768
769 setInlineActivation :: Id -> Activation -> Id
770 setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
771
772 idRuleMatchInfo :: Id -> RuleMatchInfo
773 idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
774
775 isConLikeId :: Id -> Bool
776 isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
777
778 {-
779 ---------------------------------
780 -- ONE-SHOT LAMBDAS
781 -}
782
783 idOneShotInfo :: Id -> OneShotInfo
784 idOneShotInfo id = oneShotInfo (idInfo id)
785
786 -- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account
787 -- See Note [The state-transformer hack] in CoreArity
788 idStateHackOneShotInfo :: Id -> OneShotInfo
789 idStateHackOneShotInfo id
790 | isStateHackType (idType id) = stateHackOneShot
791 | otherwise = idOneShotInfo id
792
793 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
794 -- This one is the "business end", called externally.
795 -- It works on type variables as well as Ids, returning True
796 -- Its main purpose is to encapsulate the Horrible State Hack
797 -- See Note [The state-transformer hack] in CoreArity
798 isOneShotBndr :: Var -> Bool
799 isOneShotBndr var
800 | isTyVar var = True
801 | OneShotLam <- idStateHackOneShotInfo var = True
802 | otherwise = False
803
804 -- | Should we apply the state hack to values of this 'Type'?
805 stateHackOneShot :: OneShotInfo
806 stateHackOneShot = OneShotLam
807
808 typeOneShot :: Type -> OneShotInfo
809 typeOneShot ty
810 | isStateHackType ty = stateHackOneShot
811 | otherwise = NoOneShotInfo
812
813 isStateHackType :: Type -> Bool
814 isStateHackType ty
815 | hasNoStateHack unsafeGlobalDynFlags
816 = False
817 | otherwise
818 = case tyConAppTyCon_maybe ty of
819 Just tycon -> tycon == statePrimTyCon
820 _ -> False
821 -- This is a gross hack. It claims that
822 -- every function over realWorldStatePrimTy is a one-shot
823 -- function. This is pretty true in practice, and makes a big
824 -- difference. For example, consider
825 -- a `thenST` \ r -> ...E...
826 -- The early full laziness pass, if it doesn't know that r is one-shot
827 -- will pull out E (let's say it doesn't mention r) to give
828 -- let lvl = E in a `thenST` \ r -> ...lvl...
829 -- When `thenST` gets inlined, we end up with
830 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
831 -- and we don't re-inline E.
832 --
833 -- It would be better to spot that r was one-shot to start with, but
834 -- I don't want to rely on that.
835 --
836 -- Another good example is in fill_in in PrelPack.hs. We should be able to
837 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
838
839 isProbablyOneShotLambda :: Id -> Bool
840 isProbablyOneShotLambda id = case idStateHackOneShotInfo id of
841 OneShotLam -> True
842 NoOneShotInfo -> False
843
844 setOneShotLambda :: Id -> Id
845 setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id
846
847 clearOneShotLambda :: Id -> Id
848 clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id
849
850 setIdOneShotInfo :: Id -> OneShotInfo -> Id
851 setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id
852
853 updOneShotInfo :: Id -> OneShotInfo -> Id
854 -- Combine the info in the Id with new info
855 updOneShotInfo id one_shot
856 | do_upd = setIdOneShotInfo id one_shot
857 | otherwise = id
858 where
859 do_upd = case (idOneShotInfo id, one_shot) of
860 (NoOneShotInfo, _) -> True
861 (OneShotLam, _) -> False
862
863 -- The OneShotLambda functions simply fiddle with the IdInfo flag
864 -- But watch out: this may change the type of something else
865 -- f = \x -> e
866 -- If we change the one-shot-ness of x, f's type changes
867
868 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
869 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
870
871 zapLamIdInfo :: Id -> Id
872 zapLamIdInfo = zapInfo zapLamInfo
873
874 zapFragileIdInfo :: Id -> Id
875 zapFragileIdInfo = zapInfo zapFragileInfo
876
877 zapIdDemandInfo :: Id -> Id
878 zapIdDemandInfo = zapInfo zapDemandInfo
879
880 zapIdUsageInfo :: Id -> Id
881 zapIdUsageInfo = zapInfo zapUsageInfo
882
883 zapIdUsageEnvInfo :: Id -> Id
884 zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo
885
886 zapIdUsedOnceInfo :: Id -> Id
887 zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo
888
889 zapIdTailCallInfo :: Id -> Id
890 zapIdTailCallInfo = zapInfo zapTailCallInfo
891
892 zapStableUnfolding :: Id -> Id
893 zapStableUnfolding id
894 | isStableUnfolding (realIdUnfolding id) = setIdUnfolding id NoUnfolding
895 | otherwise = id
896
897 {-
898 Note [transferPolyIdInfo]
899 ~~~~~~~~~~~~~~~~~~~~~~~~~
900 This transfer is used in two places:
901 FloatOut (long-distance let-floating)
902 SimplUtils.abstractFloats (short-distance let-floating)
903
904 Consider the short-distance let-floating:
905
906 f = /\a. let g = rhs in ...
907
908 Then if we float thus
909
910 g' = /\a. rhs
911 f = /\a. ...[g' a/g]....
912
913 we *do not* want to lose g's
914 * strictness information
915 * arity
916 * inline pragma (though that is bit more debatable)
917 * occurrence info
918
919 Mostly this is just an optimisation, but it's *vital* to
920 transfer the occurrence info. Consider
921
922 NonRec { f = /\a. let Rec { g* = ..g.. } in ... }
923
924 where the '*' means 'LoopBreaker'. Then if we float we must get
925
926 Rec { g'* = /\a. ...(g' a)... }
927 NonRec { f = /\a. ...[g' a/g]....}
928
929 where g' is also marked as LoopBreaker. If not, terrible things
930 can happen if we re-simplify the binding (and the Simplifier does
931 sometimes simplify a term twice); see Trac #4345.
932
933 It's not so simple to retain
934 * worker info
935 * rules
936 so we simply discard those. Sooner or later this may bite us.
937
938 If we abstract wrt one or more *value* binders, we must modify the
939 arity and strictness info before transferring it. E.g.
940 f = \x. e
941 -->
942 g' = \y. \x. e
943 + substitute (g' y) for g
944 Notice that g' has an arity one more than the original g
945 -}
946
947 transferPolyIdInfo :: Id -- Original Id
948 -> [Var] -- Abstract wrt these variables
949 -> Id -- New Id
950 -> Id
951 transferPolyIdInfo old_id abstract_wrt new_id
952 = modifyIdInfo transfer new_id
953 where
954 arity_increase = count isId abstract_wrt -- Arity increases by the
955 -- number of value binders
956
957 old_info = idInfo old_id
958 old_arity = arityInfo old_info
959 old_inline_prag = inlinePragInfo old_info
960 old_occ_info = occInfo old_info
961 new_arity = old_arity + arity_increase
962 new_occ_info = zapOccTailCallInfo old_occ_info
963
964 old_strictness = strictnessInfo old_info
965 new_strictness = increaseStrictSigArity arity_increase old_strictness
966
967 transfer new_info = new_info `setArityInfo` new_arity
968 `setInlinePragInfo` old_inline_prag
969 `setOccInfo` new_occ_info
970 `setStrictnessInfo` new_strictness
971
972 isNeverLevPolyId :: Id -> Bool
973 isNeverLevPolyId = isNeverLevPolyIdInfo . idInfo