Id.hs 34 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

5
\section[Id]{@Ids@: Value and constructor identifiers}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

8
{-# LANGUAGE CPP #-}
9

batterseapower's avatar
batterseapower committed
10 11 12 13 14 15 16 17 18 19
-- |
-- #name_types#
-- GHC uses several kinds of name internally:
--
-- * 'OccName.OccName': see "OccName#name_types"
--
-- * 'RdrName.RdrName': see "RdrName#name_types"
--
-- * 'Name.Name': see "Name#name_types"
--
20
-- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TyCoRep.Type' and some additional
batterseapower's avatar
batterseapower committed
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
batterseapower's avatar
batterseapower committed
23 24 25
--   be global or local, see "Var#globalvslocal"
--
-- * 'Var.Var': see "Var#name_types"
Ian Lynagh's avatar
Ian Lynagh committed
26

27
module Id (
28
        -- * The main types
29 30
        Var, Id, isId,

31 32 33 34
        -- * In and Out variants
        InVar,  InId,
        OutVar, OutId,

35 36
        -- ** Simple construction
        mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
37
        mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
38
        mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
39
        mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
40
        mkUserLocal, mkUserLocalOrCoVar,
41
        mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
42
        mkWorkerId,
43 44

        -- ** Taking an Id apart
45
        idName, idType, idUnique, idInfo, idDetails,
Adam Gundry's avatar
Adam Gundry committed
46
        recordSelectorTyCon,
47 48

        -- ** Modifying an Id
Austin Seipp's avatar
Austin Seipp committed
49 50 51
        setIdName, setIdUnique, Id.setIdType,
        setIdExported, setIdNotExported,
        globaliseId, localiseId,
52
        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
53
        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
lukemaurer's avatar
lukemaurer committed
54
        zapIdUsedOnceInfo, zapIdTailCallInfo,
55
        zapFragileIdInfo, zapIdStrictness, zapStableUnfolding,
56
        transferPolyIdInfo,
57 58

        -- ** Predicates on Ids
Austin Seipp's avatar
Austin Seipp committed
59
        isImplicitId, isDeadBinder,
60
        isStrictId,
61 62
        isExportedId, isLocalId, isGlobalId,
        isRecordSelector, isNaughtyRecordSelector,
Matthew Pickering's avatar
Matthew Pickering committed
63 64
        isPatSynRecordSelector,
        isDataConRecordSelector,
65 66 67
        isClassOpId_maybe, isDFunId,
        isPrimOpId, isPrimOpId_maybe,
        isFCallId, isFCallId_maybe,
68 69 70
        isDataConWorkId, isDataConWorkId_maybe,
        isDataConWrapId, isDataConWrapId_maybe,
        isDataConId_maybe,
71
        idDataCon,
Matthew Pickering's avatar
Matthew Pickering committed
72
        isConLikeId, isBottomingId, idIsFrom,
73
        hasNoBinding,
74

lukemaurer's avatar
lukemaurer committed
75
        -- ** Join variables
76
        JoinId, isJoinId, isJoinId_maybe, idJoinArity,
lukemaurer's avatar
lukemaurer committed
77 78
        asJoinId, asJoinId_maybe, zapJoinId,

79 80
        -- ** Inline pragma stuff
        idInlinePragma, setInlinePragma, modifyInlinePragma,
81
        idInlineActivation, setInlineActivation, idRuleMatchInfo,
82

83
        -- ** One-shot lambdas
84
        isOneShotBndr, isProbablyOneShotLambda,
Austin Seipp's avatar
Austin Seipp committed
85
        setOneShotLambda, clearOneShotLambda,
86 87
        updOneShotInfo, setIdOneShotInfo,
        isStateHackType, stateHackOneShot, typeOneShot,
88 89

        -- ** Reading 'IdInfo' fields
90
        idArity,
Richard Eisenberg's avatar
Richard Eisenberg committed
91
        idCallArity, idFunRepArity,
92 93 94
        idUnfolding, realIdUnfolding,
        idSpecialisation, idCoreRules, idHasRules,
        idCafInfo,
95
        idOneShotInfo, idStateHackOneShotInfo,
96
        idOccInfo,
Richard Eisenberg's avatar
Richard Eisenberg committed
97
        isNeverLevPolyId,
98 99

        -- ** Writing 'IdInfo' fields
100
        setIdUnfolding, setCaseBndrEvald,
101
        setIdArity,
102
        setIdCallArity,
103

104 105 106
        setIdSpecialisation,
        setIdCafInfo,
        setIdOccInfo, zapIdOccInfo,
107

Austin Seipp's avatar
Austin Seipp committed
108 109
        setIdDemandInfo,
        setIdStrictness,
110
        setIdCprInfo,
111

Austin Seipp's avatar
Austin Seipp committed
112
        idDemandInfo,
113
        idStrictness,
114
        idCprInfo,
115

116
    ) where
117

118
#include "HsVersions.h"
sof's avatar
sof committed
119

120 121
import GhcPrelude

Sylvain Henry's avatar
Sylvain Henry committed
122
import DynFlags
123 124
import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding,
                 isCompulsoryUnfolding, Unfolding( NoUnfolding ) )
125 126

import IdInfo
Simon Marlow's avatar
Simon Marlow committed
127
import BasicTypes
128

129
-- Imported and re-exported
130
import Var( Id, CoVar, JoinId,
131 132
            InId,  InVar,
            OutId, OutVar,
lukemaurer's avatar
lukemaurer committed
133
            idInfo, idDetails, setIdDetails, globaliseId, varType,
134
            isId, isLocalId, isGlobalId, isExportedId )
Simon Marlow's avatar
Simon Marlow committed
135
import qualified Var
136

Simon Marlow's avatar
Simon Marlow committed
137
import Type
Sylvain Henry's avatar
Sylvain Henry committed
138
import GHC.Types.RepType
batterseapower's avatar
batterseapower committed
139
import TysPrim
Simon Marlow's avatar
Simon Marlow committed
140
import DataCon
141
import Demand
142
import Cpr
Simon Marlow's avatar
Simon Marlow committed
143 144
import Name
import Module
twanvl's avatar
twanvl committed
145
import Class
146
import {-# SOURCE #-} PrimOp (PrimOp)
twanvl's avatar
twanvl committed
147
import ForeignCall
Simon Marlow's avatar
Simon Marlow committed
148 149
import Maybes
import SrcLoc
150
import Outputable
Simon Marlow's avatar
Simon Marlow committed
151
import Unique
152
import UniqSupply
Simon Marlow's avatar
Simon Marlow committed
153
import FastString
154
import Util
155

156
-- infixl so you can say (id `set` a `set` b)
157
infixl  1 `setIdUnfolding`,
158
          `setIdArity`,
159
          `setIdCallArity`,
160
          `setIdOccInfo`,
161
          `setIdOneShotInfo`,
162

163 164 165
          `setIdSpecialisation`,
          `setInlinePragma`,
          `setInlineActivation`,
166 167 168
          `idCafInfo`,

          `setIdDemandInfo`,
lukemaurer's avatar
lukemaurer committed
169
          `setIdStrictness`,
170
          `setIdCprInfo`,
lukemaurer's avatar
lukemaurer committed
171 172 173

          `asJoinId`,
          `asJoinId_maybe`
batterseapower's avatar
batterseapower committed
174

Austin Seipp's avatar
Austin Seipp committed
175 176 177
{-
************************************************************************
*                                                                      *
178
\subsection{Basic Id manipulation}
Austin Seipp's avatar
Austin Seipp committed
179 180 181
*                                                                      *
************************************************************************
-}
182 183 184 185 186

idName   :: Id -> Name
idName    = Var.varName

idUnique :: Id -> Unique
187
idUnique  = Var.varUnique
188 189

idType   :: Id -> Kind
190
idType    = Var.varType
batterseapower's avatar
batterseapower committed
191

192
setIdName :: Id -> Name -> Id
193
setIdName = Var.setVarName
194

batterseapower's avatar
batterseapower committed
195
setIdUnique :: Id -> Unique -> Id
196
setIdUnique = Var.setVarUnique
batterseapower's avatar
batterseapower committed
197 198 199

-- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
-- reduce space usage
200 201
setIdType :: Id -> Type -> Id
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
Gabor Greif's avatar
Gabor Greif committed
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
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
213
  | ASSERT( isId id ) isLocalId id && isInternalName name
214 215
  = id
  | otherwise
216
  = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)
217 218 219
  where
    name = idName id

220
lazySetIdInfo :: Id -> IdInfo -> Id
221
lazySetIdInfo = Var.lazySetIdInfo
222 223

setIdInfo :: Id -> IdInfo -> Id
224
setIdInfo id info = info `seq` (lazySetIdInfo id info)
Gabor Greif's avatar
Gabor Greif committed
225
        -- Try to avoid space leaks by seq'ing
226

227
modifyIdInfo :: HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id
228 229
modifyIdInfo fn id = setIdInfo id (fn (idInfo id))

Gabor Greif's avatar
Gabor Greif committed
230
-- maybeModifyIdInfo tries to avoid unnecessary thrashing
231 232
maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
233
maybeModifyIdInfo Nothing         id = id
234

Austin Seipp's avatar
Austin Seipp committed
235 236 237
{-
************************************************************************
*                                                                      *
238
\subsection{Simple Id construction}
Austin Seipp's avatar
Austin Seipp committed
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

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
246 247 248 249 250 251
Note [Free type variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~
At one time we cached the free type variables of the type of an Id
at the root of the type in a TyNote.  The idea was to avoid repeating
the free-type-variable calculation.  But it turned out to slow down
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
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
253 254
substitution (which changes the free type variables) is more common.
Anyway, we removed it in March 2008.
Austin Seipp's avatar
Austin Seipp committed
255
-}
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
256

batterseapower's avatar
batterseapower committed
257
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
258 259
mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId = Var.mkGlobalVar
260

batterseapower's avatar
batterseapower committed
261
-- | Make a global 'Id' without any extra information at all
262 263
mkVanillaGlobal :: Name -> Type -> Id
mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
264

batterseapower's avatar
batterseapower committed
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

batterseapower's avatar
batterseapower committed
270
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
271 272 273
mkLocalId :: HasDebugCallStack => Name -> Type -> Id
mkLocalId name ty = ASSERT( not (isCoVarType ty) )
                    mkLocalIdWithInfo name ty vanillaIdInfo
274 275 276 277

-- | Make a local CoVar
mkLocalCoVar :: Name -> Type -> CoVar
mkLocalCoVar name ty
278
  = ASSERT( isCoVarType ty )
279
    Var.mkLocalVar CoVarId name ty vanillaIdInfo
280 281 282 283

-- | Like 'mkLocalId', but checks the type to see if it should make a covar
mkLocalIdOrCoVar :: Name -> Type -> Id
mkLocalIdOrCoVar name ty
284 285
  | isCoVarType ty = mkLocalCoVar name ty
  | otherwise      = mkLocalId    name ty
286 287

    -- proper ids only; no covars!
288 289 290
mkLocalIdWithInfo :: HasDebugCallStack => Name -> Type -> IdInfo -> Id
mkLocalIdWithInfo name ty info = ASSERT( not (isCoVarType ty) )
                                 Var.mkLocalVar VanillaId name ty info
291
        -- Note [Free type variables]
292

293
-- | Create a local 'Id' that is marked as exported.
294
-- This prevents things attached to it from being removed as dead code.
295 296 297
-- See Note [Exported LocalIds]
mkExportedLocalId :: IdDetails -> Name -> Type -> Id
mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
298
        -- Note [Free type variables]
299

300 301 302 303
mkExportedVanillaId :: Name -> Type -> Id
mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
        -- Note [Free type variables]

304

305
-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
306
-- that are created by the compiler out of thin air
307
mkSysLocal :: FastString -> Unique -> Type -> Id
308
mkSysLocal fs uniq ty = ASSERT( not (isCoVarType ty) )
309 310 311 312 313
                        mkLocalId (mkSystemVarName uniq fs) ty

-- | Like 'mkSysLocal', but checks to see if we have a covar type
mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id
mkSysLocalOrCoVar fs uniq ty
314
  = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty
315

316 317 318
mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))

319 320 321
mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id
mkSysLocalOrCoVarM fs ty
  = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))
322

batterseapower's avatar
batterseapower committed
323
-- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
324
mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
325
mkUserLocal occ uniq ty loc = ASSERT( not (isCoVarType ty) )
326 327 328 329 330 331 332
                              mkLocalId (mkInternalName uniq occ loc) ty

-- | Like 'mkUserLocal', but checks if we have a coercion type
mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
mkUserLocalOrCoVar occ uniq ty loc
  = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty

Austin Seipp's avatar
Austin Seipp committed
333
{-
334 335 336
Make some local @Ids@ for a template @CoreExpr@.  These have bogus
@Uniques@, but that's OK because the templates are supposed to be
instantiated before use.
Austin Seipp's avatar
Austin Seipp committed
337
-}
338

batterseapower's avatar
batterseapower committed
339
-- | Workers get local names. "CoreTidy" will externalise these if necessary
340 341
mkWorkerId :: Unique -> Id -> Type -> Id
mkWorkerId uniq unwrkr ty
342
  = mkLocalId (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
343

batterseapower's avatar
batterseapower committed
344
-- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
345
mkTemplateLocal :: Int -> Type -> Id
346
mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "v") (mkBuiltinUnique i) ty
347 348
   -- "OrCoVar" since this is used in a superclass selector,
   -- and "~" and "~~" have coercion "superclasses".
349 350

-- | Create a template local for a series of types
351
mkTemplateLocals :: [Type] -> [Id]
352
mkTemplateLocals = mkTemplateLocalsNum 1
353

354
-- | Create a template local for a series of type, but start from a specified template local
355
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
356
mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
357

Simon Peyton Jones's avatar
Simon Peyton Jones committed
358 359
{- Note [Exported LocalIds]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
360 361 362 363
We use mkExportedLocalId for things like
 - Dictionary functions (DFunId)
 - Wrapper and matcher Ids for pattern synonyms
 - Default methods for classes
364
 - Pattern-synonym matcher and builder Ids
365 366 367 368 369 370 371 372
 - etc

They marked as "exported" in the sense that they should be kept alive
even if apparently unused in other bindings, and not dropped as dead
code by the occurrence analyser.  (But "exported" here does not mean
"brought into lexical scope by an import declaration". Indeed these
things are always internal Ids that the user never sees.)

Simon Peyton Jones's avatar
Simon Peyton Jones committed
373
It's very important that they are *LocalIds*, not GlobalIds, for lots
374 375 376 377 378 379
of reasons:

 * We want to treat them as free variables for the purpose of
   dependency analysis (e.g. CoreFVs.exprFreeVars).

 * Look them up in the current substitution when we come across
380 381
   occurrences of them (in Subst.lookupIdSubst). Lacking this we
   can get an out-of-date unfolding, which can in turn make the
382
   simplifier go into an infinite loop (#9857)
383 384 385 386 387 388 389 390 391 392 393

 * Ensure that for dfuns that the specialiser does not float dict uses
   above their defns, which would prevent good simplifications happening.

 * The strictness analyser treats a occurrence of a GlobalId as
   imported and assumes it contains strictness in its IdInfo, which
   isn't true if the thing is bound in the same module as the
   occurrence.

In CoreTidy we must make all these LocalIds into GlobalIds, so that in
importing modules (in --make mode) we treat them as properly global.
394
That is what is happening in, say tidy_insts in GHC.Iface.Tidy.
395

Austin Seipp's avatar
Austin Seipp committed
396 397
************************************************************************
*                                                                      *
398
\subsection{Special Ids}
Austin Seipp's avatar
Austin Seipp committed
399 400 401
*                                                                      *
************************************************************************
-}
402

Adam Gundry's avatar
Adam Gundry committed
403
-- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.
Matthew Pickering's avatar
Matthew Pickering committed
404
recordSelectorTyCon :: Id -> RecSelParent
Adam Gundry's avatar
Adam Gundry committed
405
recordSelectorTyCon id
406
  = case Var.idDetails id of
Matthew Pickering's avatar
Matthew Pickering committed
407
        RecSelId { sel_tycon = parent } -> parent
Adam Gundry's avatar
Adam Gundry committed
408
        _ -> panic "recordSelectorTyCon"
twanvl's avatar
twanvl committed
409

Matthew Pickering's avatar
Matthew Pickering committed
410

411 412
isRecordSelector        :: Id -> Bool
isNaughtyRecordSelector :: Id -> Bool
Matthew Pickering's avatar
Matthew Pickering committed
413 414
isPatSynRecordSelector  :: Id -> Bool
isDataConRecordSelector  :: Id -> Bool
415 416 417
isPrimOpId              :: Id -> Bool
isFCallId               :: Id -> Bool
isDataConWorkId         :: Id -> Bool
418
isDataConWrapId         :: Id -> Bool
419
isDFunId                :: Id -> Bool
twanvl's avatar
twanvl committed
420

421 422 423 424
isClassOpId_maybe       :: Id -> Maybe Class
isPrimOpId_maybe        :: Id -> Maybe PrimOp
isFCallId_maybe         :: Id -> Maybe ForeignCall
isDataConWorkId_maybe   :: Id -> Maybe DataCon
425
isDataConWrapId_maybe   :: Id -> Maybe DataCon
sof's avatar
sof committed
426

427
isRecordSelector id = case Var.idDetails id of
Matthew Pickering's avatar
Matthew Pickering committed
428 429 430 431 432 433 434 435 436
                        RecSelId {}     -> True
                        _               -> False

isDataConRecordSelector id = case Var.idDetails id of
                        RecSelId {sel_tycon = RecSelData _} -> True
                        _               -> False

isPatSynRecordSelector id = case Var.idDetails id of
                        RecSelId {sel_tycon = RecSelPatSyn _} -> True
twanvl's avatar
twanvl committed
437
                        _               -> False
sof's avatar
sof committed
438

439 440
isNaughtyRecordSelector id = case Var.idDetails id of
                        RecSelId { sel_naughty = n } -> n
twanvl's avatar
twanvl committed
441
                        _                               -> False
442

443
isClassOpId_maybe id = case Var.idDetails id of
444 445
                        ClassOpId cls -> Just cls
                        _other        -> Nothing
446

447
isPrimOpId id = case Var.idDetails id of
twanvl's avatar
twanvl committed
448 449
                        PrimOpId _ -> True
                        _          -> False
450

451
isDFunId id = case Var.idDetails id of
452 453 454
                        DFunId {} -> True
                        _         -> False

455
isPrimOpId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
456 457
                        PrimOpId op -> Just op
                        _           -> Nothing
458

459
isFCallId id = case Var.idDetails id of
twanvl's avatar
twanvl committed
460 461
                        FCallId _ -> True
                        _         -> False
462

463
isFCallId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
464 465
                        FCallId call -> Just call
                        _            -> Nothing
466

467
isDataConWorkId id = case Var.idDetails id of
twanvl's avatar
twanvl committed
468 469
                        DataConWorkId _ -> True
                        _               -> False
sof's avatar
sof committed
470

471
isDataConWorkId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
472 473
                        DataConWorkId con -> Just con
                        _                 -> Nothing
sof's avatar
sof committed
474

475 476 477 478
isDataConWrapId id = case Var.idDetails id of
                       DataConWrapId _ -> True
                       _               -> False

479 480 481 482
isDataConWrapId_maybe id = case Var.idDetails id of
                        DataConWrapId con -> Just con
                        _                 -> Nothing

483
isDataConId_maybe :: Id -> Maybe DataCon
484
isDataConId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
485 486 487
                         DataConWorkId con -> Just con
                         DataConWrapId con -> Just con
                         _                 -> Nothing
488

489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506
isJoinId :: Var -> Bool
-- It is convenient in SetLevels.lvlMFE to apply isJoinId
-- to the free vars of an expression, so it's convenient
-- if it returns False for type variables
isJoinId id
  | isId id = case Var.idDetails id of
                JoinId {} -> True
                _         -> False
  | otherwise = False

isJoinId_maybe :: Var -> Maybe JoinArity
isJoinId_maybe id
 | isId id  = ASSERT2( isId id, ppr id )
              case Var.idDetails id of
                JoinId arity -> Just arity
                _            -> Nothing
 | otherwise = Nothing

507
idDataCon :: Id -> DataCon
batterseapower's avatar
batterseapower committed
508
-- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
509
--
batterseapower's avatar
batterseapower committed
510 511
-- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
512

513
hasNoBinding :: Id -> Bool
batterseapower's avatar
batterseapower committed
514 515 516
-- ^ Returns @True@ of an 'Id' which may not have a
-- binding, even though it is defined in this module.

517
-- Data constructor workers used to be things of this kind, but
518 519
-- they aren't any more.  Instead, we inject a binding for
-- them at the CorePrep stage.
520 521 522 523 524 525 526 527
--
-- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers] in PrimOp.hs.
-- for the history of this.
--
-- Note that CorePrep currently eta expands things no-binding things and this
-- can cause quite subtle bugs. See Note [Eta expansion of hasNoBinding things
-- in CorePrep] in CorePrep for details.
--
528
-- EXCEPT: unboxed tuples, which definitely have no binding
529
hasNoBinding id = case Var.idDetails id of
530
                        PrimOpId _       -> False   -- See Note [Primop wrappers] in PrimOp.hs
531
                        FCallId _        -> True
532
                        DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc
533 534
                        _                -> isCompulsoryUnfolding (idUnfolding id)
                                            -- See Note [Levity-polymorphic Ids]
535

536
isImplicitId :: Id -> Bool
batterseapower's avatar
batterseapower committed
537
-- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
538 539
-- declarations, so we don't need to put its signature in an interface
-- file, even if it's mentioned in some other interface unfolding.
540
isImplicitId id
541
  = case Var.idDetails id of
542
        FCallId {}       -> True
543
        ClassOpId {}     -> True
544 545
        PrimOpId {}      -> True
        DataConWorkId {} -> True
546
        DataConWrapId {} -> True
Gabor Greif's avatar
Gabor Greif committed
547
                -- These are implied by their type or class decl;
548 549 550
                -- remember that all type and class decls appear in the interface file.
                -- The dfun id is not an implicit Id; it must *not* be omitted, because
                -- it carries version info for the instance decl
twanvl's avatar
twanvl committed
551
        _               -> False
552 553 554

idIsFrom :: Module -> Id -> Bool
idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
555

556 557
{- Note [Levity-polymorphic Ids]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Brian Wignall's avatar
Brian Wignall committed
558
Some levity-polymorphic Ids must be applied and inlined, not left
559 560 561 562 563
un-saturated.  Example:
  unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b

This has a compulsory unfolding because we can't lambda-bind those
arguments.  But the compulsory unfolding may leave levity-polymorphic
564
lambdas if it is not applied to enough arguments; e.g. (#14561)
565 566 567 568 569 570
  bad :: forall (a :: TYPE r). a -> a
  bad = unsafeCoerce#

The desugar has special magic to detect such cases: DsExpr.badUseOfLevPolyPrimop.
And we want that magic to apply to levity-polymorphic compulsory-inline things.
The easiest way to do this is for hasNoBinding to return True of all things
571
that have compulsory unfolding.  Some Ids with a compulsory unfolding also
572
have a binding, but it does not harm to say they don't here, and its a very
573
simple way to fix #14561.
Austin Seipp's avatar
Austin Seipp committed
574
-}
575

576
isDeadBinder :: Id -> Bool
577
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
578
                  | otherwise = False   -- TyVars count as not dead
579

lukemaurer's avatar
lukemaurer committed
580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613
{-
************************************************************************
*                                                                      *
              Join variables
*                                                                      *
************************************************************************
-}

idJoinArity :: JoinId -> JoinArity
idJoinArity id = isJoinId_maybe id `orElse` pprPanic "idJoinArity" (ppr id)

asJoinId :: Id -> JoinArity -> JoinId
asJoinId id arity = WARN(not (isLocalId id),
                         text "global id being marked as join var:" <+> ppr id)
                    WARN(not (is_vanilla_or_join id),
                         ppr id <+> pprIdDetails (idDetails id))
                    id `setIdDetails` JoinId arity
  where
    is_vanilla_or_join id = case Var.idDetails id of
                              VanillaId -> True
                              JoinId {} -> True
                              _         -> False

zapJoinId :: Id -> Id
-- May be a regular id already
zapJoinId jid | isJoinId jid = zapIdTailCallInfo (jid `setIdDetails` VanillaId)
                                 -- Core Lint may complain if still marked
                                 -- as AlwaysTailCalled
              | otherwise    = jid

asJoinId_maybe :: Id -> Maybe JoinArity -> Id
asJoinId_maybe id (Just arity) = asJoinId id arity
asJoinId_maybe id Nothing      = zapJoinId id

Austin Seipp's avatar
Austin Seipp committed
614 615 616
{-
************************************************************************
*                                                                      *
617
\subsection{IdInfo stuff}
Austin Seipp's avatar
Austin Seipp committed
618 619 620
*                                                                      *
************************************************************************
-}
621

622 623
        ---------------------------------
        -- ARITY
624
idArity :: Id -> Arity
625
idArity id = arityInfo (idInfo id)
626

627 628
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
629

630 631 632 633 634 635
idCallArity :: Id -> Arity
idCallArity id = callArityInfo (idInfo id)

setIdCallArity :: Id -> Arity -> Id
setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id

Richard Eisenberg's avatar
Richard Eisenberg committed
636 637 638
idFunRepArity :: Id -> RepArity
idFunRepArity x = countFunRepArgs (idArity x) (idType x)

639
-- | Returns true if an application to n args would diverge
Simon Peyton Jones's avatar
Simon Peyton Jones committed
640 641 642 643
isBottomingId :: Var -> Bool
isBottomingId v
  | isId v    = isBottomingSig (idStrictness v)
  | otherwise = False
644

645
-- | Accesses the 'Id''s 'strictnessInfo'.
646
idStrictness :: Id -> StrictSig
647
idStrictness id = strictnessInfo (idInfo id)
648

649
setIdStrictness :: Id -> StrictSig -> Id
650
setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
651

652 653 654 655 656 657
idCprInfo :: Id -> CprSig
idCprInfo id = cprInfo (idInfo id)

setIdCprInfo :: Id -> CprSig -> Id
setIdCprInfo id sig = modifyIdInfo (\info -> setCprInfo info sig) id

658
zapIdStrictness :: Id -> Id
659
zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
660

batterseapower's avatar
batterseapower committed
661
-- | This predicate says whether the 'Id' has a strict demand placed on it or
662 663
-- has a type such that it can always be evaluated strictly (i.e an
-- unlifted type, as of GHC 7.6).  We need to
batterseapower's avatar
batterseapower committed
664 665 666
-- check separately whether the 'Id' has a so-called \"strict type\" because if
-- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
-- type, we still want @isStrictId id@ to be @True@.
667 668 669
isStrictId :: Id -> Bool
isStrictId id
  = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
lukemaurer's avatar
lukemaurer committed
670
         not (isJoinId id) && (
671
           (isStrictType (idType id)) ||
Austin Seipp's avatar
Austin Seipp committed
672
           -- Take the best of both strictnesses - old and new
673
           (isStrictDmd (idDemandInfo id))
lukemaurer's avatar
lukemaurer committed
674
         )
675

676 677
        ---------------------------------
        -- UNFOLDING
678
idUnfolding :: Id -> Unfolding
679
-- Do not expose the unfolding of a loop breaker!
680
idUnfolding id
681 682
  | isStrongLoopBreaker (occInfo info) = NoUnfolding
  | otherwise                          = unfoldingInfo info
683 684 685 686 687 688
  where
    info = idInfo id

realIdUnfolding :: Id -> Unfolding
-- Expose the unfolding if there is one, including for loop breakers
realIdUnfolding id = unfoldingInfo (idInfo id)
689

690
setIdUnfolding :: Id -> Unfolding -> Id
691
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
692

693
idDemandInfo       :: Id -> Demand
694
idDemandInfo       id = demandInfo (idInfo id)
695

696
setIdDemandInfo :: Id -> Demand -> Id
697
setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id
698

699 700 701 702 703 704 705 706 707
setCaseBndrEvald :: StrictnessMark -> Id -> Id
-- Used for variables bound by a case expressions, both the case-binder
-- itself, and any pattern-bound variables that are argument of a
-- strict constructor.  It just marks the variable as already-evaluated,
-- so that (for example) a subsequent 'seq' can be dropped
setCaseBndrEvald str id
  | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding
  | otherwise          = id

708 709
        ---------------------------------
        -- SPECIALISATION
710

711
-- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs
712

713 714
idSpecialisation :: Id -> RuleInfo
idSpecialisation id = ruleInfo (idInfo id)
715

716
idCoreRules :: Id -> [CoreRule]
717
idCoreRules id = ruleInfoRules (idSpecialisation id)
718

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
719
idHasRules :: Id -> Bool
720
idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
721

722 723
setIdSpecialisation :: Id -> RuleInfo -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id
724

725 726
        ---------------------------------
        -- CAF INFO
727
idCafInfo :: Id -> CafInfo
728 729 730 731 732
idCafInfo id = cafInfo (idInfo id)

setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id

733
        ---------------------------------
Gabor Greif's avatar
Gabor Greif committed
734
        -- Occurrence INFO
735 736
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
737 738 739

setIdOccInfo :: Id -> OccInfo -> Id
setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
740 741

zapIdOccInfo :: Id -> Id
lukemaurer's avatar
lukemaurer committed
742
zapIdOccInfo b = b `setIdOccInfo` noOccInfo
sof's avatar
sof committed
743

Austin Seipp's avatar
Austin Seipp committed
744
{-
745 746
        ---------------------------------
        -- INLINING
747 748
The inline pragma tells us to be very keen to inline this Id, but it's still
OK not to if optimisation is switched off.
Austin Seipp's avatar
Austin Seipp committed
749
-}
750

751
idInlinePragma :: Id -> InlinePragma
752
idInlinePragma id = inlinePragInfo (idInfo id)
753

754
setInlinePragma :: Id -> InlinePragma -> Id
755
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
756

757
modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
758
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
759 760 761 762 763

idInlineActivation :: Id -> Activation
idInlineActivation id = inlinePragmaActivation (idInlinePragma id)

setInlineActivation :: Id -> Activation -> Id
764
setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
765 766 767 768 769 770

idRuleMatchInfo :: Id -> RuleMatchInfo
idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)

isConLikeId :: Id -> Bool
isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
771

Austin Seipp's avatar
Austin Seipp committed
772
{-
773 774
        ---------------------------------
        -- ONE-SHOT LAMBDAS
Austin Seipp's avatar
Austin Seipp committed
775 776
-}

777 778
idOneShotInfo :: Id -> OneShotInfo
idOneShotInfo id = oneShotInfo (idInfo id)
779

780 781 782 783 784 785 786
-- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account
-- See Note [The state-transformer hack] in CoreArity
idStateHackOneShotInfo :: Id -> OneShotInfo
idStateHackOneShotInfo id
    | isStateHackType (idType id) = stateHackOneShot
    | otherwise                   = idOneShotInfo id

batterseapower's avatar
batterseapower committed
787
-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
788
-- This one is the "business end", called externally.
789
-- It works on type variables as well as Ids, returning True