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