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