Id.hs 30.2 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 9
{-# LANGUAGE CPP #-}

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 31 32
        Var, Id, isId,

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

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

        -- ** Modifying an Id
Austin Seipp's avatar
Austin Seipp committed
47 48 49
        setIdName, setIdUnique, Id.setIdType,
        setIdExported, setIdNotExported,
        globaliseId, localiseId,
50
        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
51
        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapFragileIdInfo,
52
        zapIdStrictness,
53
        transferPolyIdInfo,
54 55

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

69
        -- ** Evidence variables
70
        DictId, isDictId, isEvVar,
71

72 73
        -- ** Inline pragma stuff
        idInlinePragma, setInlinePragma, modifyInlinePragma,
74
        idInlineActivation, setInlineActivation, idRuleMatchInfo,
75

76
        -- ** One-shot lambdas
77
        isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda,
Austin Seipp's avatar
Austin Seipp committed
78
        setOneShotLambda, clearOneShotLambda,
79 80
        updOneShotInfo, setIdOneShotInfo,
        isStateHackType, stateHackOneShot, typeOneShot,
81 82

        -- ** Reading 'IdInfo' fields
83 84
        idArity,
        idCallArity,
85 86 87
        idUnfolding, realIdUnfolding,
        idSpecialisation, idCoreRules, idHasRules,
        idCafInfo,
88
        idOneShotInfo,
89 90 91 92 93 94
        idOccInfo,

        -- ** Writing 'IdInfo' fields
        setIdUnfoldingLazily,
        setIdUnfolding,
        setIdArity,
95
        setIdCallArity,
96

97 98 99
        setIdSpecialisation,
        setIdCafInfo,
        setIdOccInfo, zapIdOccInfo,
100

Austin Seipp's avatar
Austin Seipp committed
101 102
        setIdDemandInfo,
        setIdStrictness,
103

Austin Seipp's avatar
Austin Seipp committed
104
        idDemandInfo,
105 106
        idStrictness,

107
    ) where
108

109
#include "HsVersions.h"
sof's avatar
sof committed
110

111
import CoreSyn ( CoreRule, Unfolding( NoUnfolding ) )
112 113

import IdInfo
Simon Marlow's avatar
Simon Marlow committed
114
import BasicTypes
115

116
-- Imported and re-exported
117
import Var( Id, CoVar, DictId,
118
            idInfo, idDetails, globaliseId, varType,
119
            isId, isLocalId, isGlobalId, isExportedId )
Simon Marlow's avatar
Simon Marlow committed
120
import qualified Var
121

Simon Marlow's avatar
Simon Marlow committed
122
import Type
batterseapower's avatar
batterseapower committed
123
import TysPrim
Simon Marlow's avatar
Simon Marlow committed
124
import DataCon
125
import Demand
Simon Marlow's avatar
Simon Marlow committed
126 127
import Name
import Module
twanvl's avatar
twanvl committed
128
import Class
129
import {-# SOURCE #-} PrimOp (PrimOp)
twanvl's avatar
twanvl committed
130
import ForeignCall
Simon Marlow's avatar
Simon Marlow committed
131 132
import Maybes
import SrcLoc
133
import Outputable
Simon Marlow's avatar
Simon Marlow committed
134
import Unique
135
import UniqSupply
Simon Marlow's avatar
Simon Marlow committed
136
import FastString
137
import Util
Simon Marlow's avatar
Simon Marlow committed
138
import StaticFlags
139

140
-- infixl so you can say (id `set` a `set` b)
141 142 143
infixl  1 `setIdUnfoldingLazily`,
          `setIdUnfolding`,
          `setIdArity`,
144
          `setIdCallArity`,
145
          `setIdOccInfo`,
146
          `setIdOneShotInfo`,
147

148 149 150
          `setIdSpecialisation`,
          `setInlinePragma`,
          `setInlineActivation`,
151 152 153 154
          `idCafInfo`,

          `setIdDemandInfo`,
          `setIdStrictness`
batterseapower's avatar
batterseapower committed
155

Austin Seipp's avatar
Austin Seipp committed
156 157 158
{-
************************************************************************
*                                                                      *
159
\subsection{Basic Id manipulation}
Austin Seipp's avatar
Austin Seipp committed
160 161 162
*                                                                      *
************************************************************************
-}
163 164 165 166 167

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

idUnique :: Id -> Unique
168
idUnique  = Var.varUnique
169 170

idType   :: Id -> Kind
171
idType    = Var.varType
batterseapower's avatar
batterseapower committed
172

173
setIdName :: Id -> Name -> Id
174
setIdName = Var.setVarName
175

batterseapower's avatar
batterseapower committed
176
setIdUnique :: Id -> Unique -> Id
177
setIdUnique = Var.setVarUnique
batterseapower's avatar
batterseapower committed
178 179 180

-- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
-- reduce space usage
181 182
setIdType :: Id -> Type -> Id
setIdType id ty = seqType ty `seq` Var.setVarType id ty
183

184
setIdExported :: Id -> Id
185
setIdExported = Var.setIdExported
186

187
setIdNotExported :: Id -> Id
188
setIdNotExported = Var.setIdNotExported
189

190
localiseId :: Id -> Id
191
-- Make an with the same unique and type as the
192
-- incoming Id, but with an *Internal* Name and *LocalId* flavour
193
localiseId id
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
194
  | ASSERT( isId id ) isLocalId id && isInternalName name
195 196
  = id
  | otherwise
197
  = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)
198 199 200
  where
    name = idName id

201
lazySetIdInfo :: Id -> IdInfo -> Id
202
lazySetIdInfo = Var.lazySetIdInfo
203 204

setIdInfo :: Id -> IdInfo -> Id
205
setIdInfo id info = info `seq` (lazySetIdInfo id info)
206 207 208 209 210
        -- Try to avoid spack leaks by seq'ing

modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo fn id = setIdInfo id (fn (idInfo id))

Gabor Greif's avatar
Gabor Greif committed
211
-- maybeModifyIdInfo tries to avoid unnecessary thrashing
212 213
maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
214
maybeModifyIdInfo Nothing         id = id
215

Austin Seipp's avatar
Austin Seipp committed
216 217 218
{-
************************************************************************
*                                                                      *
219
\subsection{Simple Id construction}
Austin Seipp's avatar
Austin Seipp committed
220 221
*                                                                      *
************************************************************************
222

223
Absolutely all Ids are made by mkId.  It is just like Var.mkId,
224
but in addition it pins free-tyvar-info onto the Id's type,
225
where it can easily be found.
226

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
227 228 229 230 231 232
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
233
type variables of an Id isn't all that common whereas applying a
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
234 235
substitution (which changes the free type variables) is more common.
Anyway, we removed it in March 2008.
Austin Seipp's avatar
Austin Seipp committed
236
-}
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
237

batterseapower's avatar
batterseapower committed
238
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
239 240
mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId = Var.mkGlobalVar
241

batterseapower's avatar
batterseapower committed
242
-- | Make a global 'Id' without any extra information at all
243 244
mkVanillaGlobal :: Name -> Type -> Id
mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
245

batterseapower's avatar
batterseapower committed
246
-- | Make a global 'Id' with no global information but some generic 'IdInfo'
247
mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
248
mkVanillaGlobalWithInfo = mkGlobalId VanillaId
249

250

batterseapower's avatar
batterseapower committed
251
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
252
mkLocalId :: Name -> Type -> Id
253 254
mkLocalId name ty = mkLocalIdWithInfo name ty
                         (vanillaIdInfo `setOneShotInfo` typeOneShot ty)
255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277
 -- It's tempting to ASSERT( not (isCoercionType ty) ), but don't. Sometimes,
 -- the type is a panic. (Search invented_id)

-- | Make a local CoVar
mkLocalCoVar :: Name -> Type -> CoVar
mkLocalCoVar name ty
  = ASSERT( isCoercionType ty )
    Var.mkLocalVar CoVarId name ty (vanillaIdInfo `setOneShotInfo` typeOneShot ty)

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

-- | Make a local id, with the IdDetails set to CoVarId if the type indicates
-- so.
mkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id
mkLocalIdOrCoVarWithInfo name ty info
  = Var.mkLocalVar details name ty info
  where
    details | isCoercionType ty = CoVarId
            | otherwise         = VanillaId
278

279
    -- proper ids only; no covars!
280
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
281
mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info
282
        -- Note [Free type variables]
283

284
-- | Create a local 'Id' that is marked as exported.
285
-- This prevents things attached to it from being removed as dead code.
286 287 288
-- See Note [Exported LocalIds]
mkExportedLocalId :: IdDetails -> Name -> Type -> Id
mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
289
        -- Note [Free type variables]
290 291


292
-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
293
-- that are created by the compiler out of thin air
294
mkSysLocal :: FastString -> Unique -> Type -> Id
295 296 297 298 299 300 301 302 303 304
mkSysLocal fs uniq ty = ASSERT( not (isCoercionType ty) )
                        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
  | isCoercionType ty = mkLocalCoVar name ty
  | otherwise         = mkLocalId    name ty
  where
    name = mkSystemVarName uniq fs
305

306 307 308
mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))

309 310 311
mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id
mkSysLocalOrCoVarM fs ty
  = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))
312

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

-- | Like 'mkUserLocal' for covars
mkUserLocalCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
mkUserLocalCoVar occ uniq ty loc
  = mkLocalCoVar (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

mkDerivedLocalCoVarM :: MonadUnique m => (OccName -> OccName) -> Id -> Type -> m Id
mkDerivedLocalCoVarM deriv_name id ty
    = ASSERT( isCoercionType ty )
      do { uniq <- getUniqueM
         ; let name = mkDerivedInternalName deriv_name uniq (getName id)
         ; return (mkLocalCoVar name ty) }
334

Austin Seipp's avatar
Austin Seipp committed
335
{-
336 337 338
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
339
-}
340

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

batterseapower's avatar
batterseapower committed
346
-- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
347
mkTemplateLocal :: Int -> Type -> Id
348
mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "tpl") (mkBuiltinUnique i) ty
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 382
   occurrences of them (in Subst.lookupIdSubst). Lacking this we
   can get an out-of-date unfolding, which can in turn make the
   simplifier go into an infinite loop (Trac #9857)
383 384 385 386 387 388 389 390 391 392 393 394

 * 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.
That is what is happening in, say tidy_insts in TidyPgm.
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
isDFunId                :: Id -> Bool
twanvl's avatar
twanvl committed
419

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

425
isRecordSelector id = case Var.idDetails id of
Matthew Pickering's avatar
Matthew Pickering committed
426 427 428 429 430 431 432 433 434
                        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
435
                        _               -> False
sof's avatar
sof committed
436

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

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

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

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

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

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

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

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

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

473
isDataConId_maybe :: Id -> Maybe DataCon
474
isDataConId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
475 476 477
                         DataConWorkId con -> Just con
                         DataConWrapId con -> Just con
                         _                 -> Nothing
478

479
idDataCon :: Id -> DataCon
batterseapower's avatar
batterseapower committed
480
-- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
481
--
batterseapower's avatar
batterseapower committed
482 483
-- 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)
484

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

489
-- Data constructor workers used to be things of this kind, but
490 491
-- they aren't any more.  Instead, we inject a binding for
-- them at the CorePrep stage.
492
-- EXCEPT: unboxed tuples, which definitely have no binding
493
hasNoBinding id = case Var.idDetails id of
494 495 496 497
                        PrimOpId _       -> True        -- See Note [Primop wrappers]
                        FCallId _        -> True
                        DataConWorkId dc -> isUnboxedTupleCon dc
                        _                -> False
498

499
isImplicitId :: Id -> Bool
batterseapower's avatar
batterseapower committed
500
-- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
501 502
-- declarations, so we don't need to put its signature in an interface
-- file, even if it's mentioned in some other interface unfolding.
503
isImplicitId id
504
  = case Var.idDetails id of
505
        FCallId {}       -> True
506
        ClassOpId {}     -> True
507 508
        PrimOpId {}      -> True
        DataConWorkId {} -> True
509
        DataConWrapId {} -> True
Gabor Greif's avatar
Gabor Greif committed
510
                -- These are implied by their type or class decl;
511 512 513
                -- 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
514
        _               -> False
515 516 517

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

Austin Seipp's avatar
Austin Seipp committed
519
{-
520 521 522 523 524 525 526 527 528 529 530 531
Note [Primop wrappers]
~~~~~~~~~~~~~~~~~~~~~~
Currently hasNoBinding claims that PrimOpIds don't have a curried
function definition.  But actually they do, in GHC.PrimopWrappers,
which is auto-generated from prelude/primops.txt.pp.  So actually, hasNoBinding
could return 'False' for PrimOpIds.

But we'd need to add something in CoreToStg to swizzle any unsaturated
applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.

Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
used by GHCi, which does not implement primops direct at all.
Austin Seipp's avatar
Austin Seipp committed
532
-}
533

534
isDeadBinder :: Id -> Bool
535
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
536
                  | otherwise = False   -- TyVars count as not dead
537

Austin Seipp's avatar
Austin Seipp committed
538 539 540
{-
************************************************************************
*                                                                      *
541
              Evidence variables
Austin Seipp's avatar
Austin Seipp committed
542 543 544
*                                                                      *
************************************************************************
-}
545

546 547
isEvVar :: Var -> Bool
isEvVar var = isPredTy (varType var)
548 549 550 551

isDictId :: Id -> Bool
isDictId id = isDictTy (idType id)

Austin Seipp's avatar
Austin Seipp committed
552 553 554
{-
************************************************************************
*                                                                      *
555
\subsection{IdInfo stuff}
Austin Seipp's avatar
Austin Seipp committed
556 557 558
*                                                                      *
************************************************************************
-}
559

560 561
        ---------------------------------
        -- ARITY
562
idArity :: Id -> Arity
563
idArity id = arityInfo (idInfo id)
564

565 566
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
567

568 569 570 571 572 573
idCallArity :: Id -> Arity
idCallArity id = callArityInfo (idInfo id)

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

574 575 576
idRepArity :: Id -> RepArity
idRepArity x = typeRepArity (idArity x) (idType x)

577
-- | Returns true if an application to n args would diverge
578
isBottomingId :: Id -> Bool
579
isBottomingId id = isBottomingSig (idStrictness id)
580

581
idStrictness :: Id -> StrictSig
582
idStrictness id = strictnessInfo (idInfo id)
583

584
setIdStrictness :: Id -> StrictSig -> Id
585
setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
586

587
zapIdStrictness :: Id -> Id
588
zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
589

batterseapower's avatar
batterseapower committed
590
-- | This predicate says whether the 'Id' has a strict demand placed on it or
591 592
-- 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
593 594 595
-- 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@.
596 597 598
isStrictId :: Id -> Bool
isStrictId id
  = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
599
           (isStrictType (idType id)) ||
Austin Seipp's avatar
Austin Seipp committed
600
           -- Take the best of both strictnesses - old and new
601
           (isStrictDmd (idDemandInfo id))
602

603 604
        ---------------------------------
        -- UNFOLDING
605
idUnfolding :: Id -> Unfolding
606
-- Do not expose the unfolding of a loop breaker!
607
idUnfolding id
608 609
  | isStrongLoopBreaker (occInfo info) = NoUnfolding
  | otherwise                          = unfoldingInfo info
610 611 612 613 614 615
  where
    info = idInfo id

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

617 618 619
setIdUnfoldingLazily :: Id -> Unfolding -> Id
setIdUnfoldingLazily id unfolding = modifyIdInfo (`setUnfoldingInfoLazily` unfolding) id

620
setIdUnfolding :: Id -> Unfolding -> Id
621
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
622

623
idDemandInfo       :: Id -> Demand
624
idDemandInfo       id = demandInfo (idInfo id)
625

626
setIdDemandInfo :: Id -> Demand -> Id
627
setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id
628

629 630
        ---------------------------------
        -- SPECIALISATION
631

632
-- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs
633

634 635
idSpecialisation :: Id -> RuleInfo
idSpecialisation id = ruleInfo (idInfo id)
636

637
idCoreRules :: Id -> [CoreRule]
638
idCoreRules id = ruleInfoRules (idSpecialisation id)
639

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
640
idHasRules :: Id -> Bool
641
idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
642

643 644
setIdSpecialisation :: Id -> RuleInfo -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id
645

646 647
        ---------------------------------
        -- CAF INFO
648
idCafInfo :: Id -> CafInfo
649 650 651 652 653
idCafInfo id = cafInfo (idInfo id)

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

654 655
        ---------------------------------
        -- Occcurrence INFO
656 657
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
658 659 660

setIdOccInfo :: Id -> OccInfo -> Id
setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
661 662 663

zapIdOccInfo :: Id -> Id
zapIdOccInfo b = b `setIdOccInfo` NoOccInfo
sof's avatar
sof committed
664

Austin Seipp's avatar
Austin Seipp committed
665
{-
666 667
        ---------------------------------
        -- INLINING
668 669
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
670
-}
671

672
idInlinePragma :: Id -> InlinePragma
673
idInlinePragma id = inlinePragInfo (idInfo id)
674

675
setInlinePragma :: Id -> InlinePragma -> Id
676
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
677

678
modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
679
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
680 681 682 683 684

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

setInlineActivation :: Id -> Activation -> Id
685
setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
686 687 688 689 690 691

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

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

Austin Seipp's avatar
Austin Seipp committed
693
{-
694 695
        ---------------------------------
        -- ONE-SHOT LAMBDAS
Austin Seipp's avatar
Austin Seipp committed
696 697
-}

698 699
idOneShotInfo :: Id -> OneShotInfo
idOneShotInfo id = oneShotInfo (idInfo id)
700

batterseapower's avatar
batterseapower committed
701
-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
702
-- This one is the "business end", called externally.
703
-- It works on type variables as well as Ids, returning True
704
-- Its main purpose is to encapsulate the Horrible State Hack
705 706 707 708
isOneShotBndr :: Var -> Bool
isOneShotBndr var
  | isTyVar var = True
  | otherwise   = isOneShotLambda var
709

batterseapower's avatar
batterseapower committed
710
-- | Should we apply the state hack to values of this 'Type'?
711 712 713 714 715 716 717 718
stateHackOneShot :: OneShotInfo
stateHackOneShot = OneShotLam         -- Or maybe ProbOneShot?

typeOneShot :: Type -> OneShotInfo
typeOneShot ty
   | isStateHackType ty = stateHackOneShot
   | otherwise          = NoOneShotInfo

719 720
isStateHackType :: Type -> Bool
isStateHackType ty
721
  | opt_NoStateHack
722 723
  = False
  | otherwise
724
  = case tyConAppTyCon_maybe ty of
725
        Just tycon -> tycon == statePrimTyCon
726
        _          -> False
727 728 729 730 731 732 733 734 735 736 737 738 739 740 741
        -- This is a gross hack.  It claims that
        -- every function over realWorldStatePrimTy is a one-shot
        -- function.  This is pretty true in practice, and makes a big
        -- difference.  For example, consider
        --      a `thenST` \ r -> ...E...
        -- The early full laziness pass, if it doesn't know that r is one-shot
        -- will pull out E (let's say it doesn't mention r) to give
        --      let lvl = E in a `thenST` \ r -> ...lvl...
        -- When `thenST` gets inlined, we end up with
        --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
        -- and we don't re-inline E.
        --
        -- It would be better to spot that r was one-shot to start with, but
        -- I don't want to rely on that.
        --
742
        -- Another good example is in fill_in in PrelPack.hs.  We should be able to
743
        -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
744 745


batterseapower's avatar
batterseapower committed
746 747
-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once.
-- You probably want to use 'isOneShotBndr' instead
748
isOneShotLambda :: Id -> Bool
749 750 751 752 753 754 755 756 757
isOneShotLambda id = case idOneShotInfo id of
                       OneShotLam -> True
                       _          -> False

isProbablyOneShotLambda :: Id -> Bool
isProbablyOneShotLambda id = case idOneShotInfo id of
                               OneShotLam    -> True
                               ProbOneShot   -> True
                               NoOneShotInfo -> False
758 759

setOneShotLambda :: Id -> Id
760
setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id
761 762

clearOneShotLambda :: Id -> Id
763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778
clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id

setIdOneShotInfo :: Id -> OneShotInfo -> Id
setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id

updOneShotInfo :: Id -> OneShotInfo -> Id
-- Combine the info in the Id with new info
updOneShotInfo id one_shot
  | do_upd    = setIdOneShotInfo id one_shot
  | otherwise = id
  where
    do_upd = case (idOneShotInfo id, one_shot) of
                (NoOneShotInfo, _) -> True
                (OneShotLam,    _) -> False
                (_, NoOneShotInfo) -> False
                _                  -> True
779

batterseapower's avatar
batterseapower committed
780
-- The OneShotLambda functions simply fiddle with the IdInfo flag
781
-- But watch out: this may change the type of something else
782
--      f = \x -> e
783
-- If we change the one-shot-ness of x, f's type changes
784

785 786 787
zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id

788
zapLamIdInfo :: Id -> Id
789 790
zapLamIdInfo = zapInfo zapLamInfo

791
zapFragileIdInfo :: Id -> Id
Austin Seipp's avatar
Austin Seipp committed
792
zapFragileIdInfo = zapInfo zapFragileInfo
793

794 795 796 797 798
zapIdDemandInfo :: Id -> Id
zapIdDemandInfo = zapInfo zapDemandInfo

zapIdUsageInfo :: Id ->