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