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