compiler/basicTypes/Id.lhs

   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 \begin{code}
   8 -- |
   9 -- #name_types#
  10 -- GHC uses several kinds of name internally:
  11 --
  12 -- * 'OccName.OccName': see "OccName#name_types"
  13 --
  14 -- * 'RdrName.RdrName': see "RdrName#name_types"
  15 --
  16 -- * 'Name.Name': see "Name#name_types"
  17 --
  18 -- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TypeRep.Type' and some additional
  19 --   details (a 'IdInfo.IdInfo' and one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that
  20 --   are added, modified and inspected by various compiler passes. These 'Var.Var' names may either
  21 --   be global or local, see "Var#globalvslocal"
  22 --
  23 -- * 'Var.Var': see "Var#name_types"
  24 module Id (
  25         -- * The main types
  26         Id, DictId,
  27
  28         -- ** Simple construction
  29         mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
  30         mkLocalId, mkLocalIdWithInfo,
  31         mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM,
  32         mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
  33         mkWorkerId, mkExportedLocalId,
  34
  35         -- ** Taking an Id apart
  36         idName, idType, idUnique, idInfo,
  37         isId, globalIdDetails, idPrimRep,
  38         recordSelectorFieldLabel,
  39
  40         -- ** Modifying an Id
  41         setIdName, setIdUnique, Id.setIdType,
  42         setIdExported, setIdNotExported,
  43         globaliseId, localiseId,
  44         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
  45         zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo,
  46
  47
  48         -- ** Predicates on Ids
  49         isImplicitId, isDeadBinder, isDictId, isStrictId,
  50         isExportedId, isLocalId, isGlobalId,
  51         isRecordSelector, isNaughtyRecordSelector,
  52         isClassOpId_maybe,
  53         isPrimOpId, isPrimOpId_maybe,
  54         isFCallId, isFCallId_maybe,
  55         isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
  56         isBottomingId, idIsFrom,
  57         isTickBoxOp, isTickBoxOp_maybe,
  58         hasNoBinding,
  59
  60         -- ** Inline pragma stuff
  61         idInlinePragma, setInlinePragma, modifyInlinePragma,
  62
  63         -- ** One-shot lambdas
  64         isOneShotBndr, isOneShotLambda, isStateHackType,
  65         setOneShotLambda, clearOneShotLambda,
  66
  67         -- ** Reading 'IdInfo' fields
  68         idArity,
  69         idNewDemandInfo, idNewDemandInfo_maybe,
  70         idNewStrictness, idNewStrictness_maybe,
  71         idUnfolding,
  72         idSpecialisation, idCoreRules, idHasRules,
  73         idCafInfo,
  74         idLBVarInfo,
  75         idOccInfo,
  76
  77 #ifdef OLD_STRICTNESS
  78         idDemandInfo,
  79         idStrictness,
  80         idCprInfo,
  81 #endif
  82
  83         -- ** Writing 'IdInfo' fields
  84         setIdUnfolding,
  85         setIdArity,
  86         setIdNewDemandInfo,
  87         setIdNewStrictness, zapIdNewStrictness,
  88         setIdSpecialisation,
  89         setIdCafInfo,
  90         setIdOccInfo, zapIdOccInfo,
  91
  92 #ifdef OLD_STRICTNESS
  93         setIdStrictness,
  94         setIdDemandInfo,
  95         setIdCprInfo,
  96 #endif
  97     ) where
  98
  99 #include "HsVersions.h"
 100
 101 import CoreSyn ( CoreRule, Unfolding )
 102
 103 import IdInfo
 104 import BasicTypes
 105 import qualified Var
 106 import Var
 107 import TyCon
 108 import Type
 109 import TcType
 110 import TysPrim
 111 #ifdef OLD_STRICTNESS
 112 import qualified Demand
 113 #endif
 114 import DataCon
 115 import NewDemand
 116 import Name
 117 import Module
 118 import Class
 119 import PrimOp
 120 import ForeignCall
 121 import OccName
 122 import Maybes
 123 import SrcLoc
 124 import Outputable
 125 import Unique
 126 import UniqSupply
 127 import FastString
 128 import StaticFlags
 129
 130 -- infixl so you can say (id `set` a `set` b)
 131 infixl  1 `setIdUnfolding`,
 132           `setIdArity`,
 133           `setIdNewDemandInfo`,
 134           `setIdNewStrictness`,
 135           `setIdSpecialisation`,
 136           `setInlinePragma`,
 137           `idCafInfo`
 138 #ifdef OLD_STRICTNESS
 139           ,`idCprInfo`
 140           ,`setIdStrictness`
 141           ,`setIdDemandInfo`
 142 #endif
 143 \end{code}
 144
 145 %************************************************************************
 146 %*                                                                      *
 147 \subsection{Basic Id manipulation}
 148 %*                                                                      *
 149 %************************************************************************
 150
 151 \begin{code}
 152 idName   :: Id -> Name
 153 idName    = Var.varName
 154
 155 idUnique :: Id -> Unique
 156 idUnique  = varUnique
 157
 158 idType   :: Id -> Kind
 159 idType    = varType
 160
 161 idInfo :: Id -> IdInfo
 162 idInfo = varIdInfo
 163
 164 idPrimRep :: Id -> PrimRep
 165 idPrimRep id = typePrimRep (idType id)
 166
 167 globalIdDetails :: Id -> GlobalIdDetails
 168 globalIdDetails = globalIdVarDetails
 169
 170
 171 setIdName :: Id -> Name -> Id
 172 setIdName = setVarName
 173
 174 setIdUnique :: Id -> Unique -> Id
 175 setIdUnique = setVarUnique
 176
 177 -- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
 178 -- reduce space usage
 179 setIdType :: Id -> Type -> Id
 180 setIdType id ty = seqType ty `seq` Var.setVarType id ty
 181
 182 setIdExported :: Id -> Id
 183 setIdExported = setIdVarExported
 184
 185 setIdNotExported :: Id -> Id
 186 setIdNotExported = setIdVarNotExported
 187
 188 localiseId :: Id -> Id
 189 -- Make an with the same unique and type as the
 190 -- incoming Id, but with an *Internal* Name and *LocalId* flavour
 191 localiseId id
 192   | isLocalId id && isInternalName name
 193   = id
 194   | otherwise
 195   = mkLocalIdWithInfo (localiseName name) (idType id) (idInfo id)
 196   where
 197     name = idName id
 198
 199 globaliseId :: GlobalIdDetails -> Id -> Id
 200 globaliseId = globaliseIdVar
 201
 202 lazySetIdInfo :: Id -> IdInfo -> Id
 203 lazySetIdInfo = lazySetVarIdInfo
 204
 205 setIdInfo :: Id -> IdInfo -> Id
 206 setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info)
 207         -- Try to avoid spack leaks by seq'ing
 208
 209 modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
 210 modifyIdInfo fn id = setIdInfo id (fn (idInfo id))
 211
 212 -- maybeModifyIdInfo tries to avoid unnecesary thrashing
 213 maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
 214 maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
 215 maybeModifyIdInfo Nothing         id = id
 216 \end{code}
 217
 218 %************************************************************************
 219 %*                                                                      *
 220 \subsection{Simple Id construction}
 221 %*                                                                      *
 222 %************************************************************************
 223
 224 Absolutely all Ids are made by mkId.  It is just like Var.mkId,
 225 but in addition it pins free-tyvar-info onto the Id's type,
 226 where it can easily be found.
 227
 228 Note [Free type variables]
 229 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 230 At one time we cached the free type variables of the type of an Id
 231 at the root of the type in a TyNote.  The idea was to avoid repeating
 232 the free-type-variable calculation.  But it turned out to slow down
 233 the compiler overall. I don't quite know why; perhaps finding free
 234 type variables of an Id isn't all that common whereas applying a
 235 substitution (which changes the free type variables) is more common.
 236 Anyway, we removed it in March 2008.
 237
 238 \begin{code}
 239 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 240 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
 241 mkGlobalId = mkGlobalIdVar
 242
 243 -- | Make a global 'Id' without any extra information at all
 244 mkVanillaGlobal :: Name -> Type -> Id
 245 mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
 246
 247 -- | Make a global 'Id' with no global information but some generic 'IdInfo'
 248 mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
 249 mkVanillaGlobalWithInfo = mkGlobalId VanillaGlobal
 250
 251
 252 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 253 mkLocalId :: Name -> Type -> Id
 254 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
 255
 256 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
 257 mkLocalIdWithInfo = mkLocalIdVar
 258         -- Note [Free type variables]
 259
 260 -- | Create a local 'Id' that is marked as exported. This prevents things attached to it from being removed as dead code.
 261 mkExportedLocalId :: Name -> Type -> Id
 262 mkExportedLocalId name ty = mkExportedLocalIdVar name ty vanillaIdInfo
 263         -- Note [Free type variables]
 264
 265
 266 -- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal") that are created by the compiler out of thin air
 267 mkSysLocal :: FastString -> Unique -> Type -> Id
 268 mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
 269
 270 mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
 271 mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))
 272
 273
 274 -- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
 275 mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
 276 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
 277
 278 mkUserLocalM :: MonadUnique m => OccName -> Type -> SrcSpan -> m Id
 279 mkUserLocalM occ ty loc = getUniqueM >>= (\uniq -> return (mkUserLocal occ uniq ty loc))
 280
 281 \end{code}
 282
 283 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 284 @Uniques@, but that's OK because the templates are supposed to be
 285 instantiated before use.
 286
 287 \begin{code}
 288 -- | Workers get local names. "CoreTidy" will externalise these if necessary
 289 mkWorkerId :: Unique -> Id -> Type -> Id
 290 mkWorkerId uniq unwrkr ty
 291   = mkLocalId wkr_name ty
 292   where
 293     wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcSpan unwrkr)
 294
 295 -- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
 296 mkTemplateLocal :: Int -> Type -> Id
 297 mkTemplateLocal i ty = mkSysLocal (fsLit "tpl") (mkBuiltinUnique i) ty
 298
 299 -- | Create a template local for a series of types
 300 mkTemplateLocals :: [Type] -> [Id]
 301 mkTemplateLocals = mkTemplateLocalsNum 1
 302
 303 -- | Create a template local for a series of type, but start from a specified template local
 304 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 305 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 306 \end{code}
 307
 308
 309 %************************************************************************
 310 %*                                                                      *
 311 \subsection{Basic predicates on @Id@s}
 312 %*                                                                      *
 313 %************************************************************************
 314
 315 \begin{code}
 316 isId :: Id -> Bool
 317 isId = isIdVar
 318
 319 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 320 isLocalId :: Id -> Bool
 321 isLocalId = isLocalIdVar
 322
 323 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 324 isGlobalId :: Id -> Bool
 325 isGlobalId = isGlobalIdVar
 326
 327 -- | Determines whether an 'Id' is marked as exported and hence will not be considered dead code
 328 isExportedId :: Id -> Bool
 329 isExportedId = isExportedIdVar
 330 \end{code}
 331
 332 %************************************************************************
 333 %*                                                                      *
 334 \subsection{Special Ids}
 335 %*                                                                      *
 336 %************************************************************************
 337
 338 \begin{code}
 339 -- | If the 'Id' is that for a record selector, extract the 'sel_tycon' and label. Panic otherwise
 340 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
 341 recordSelectorFieldLabel id
 342   = case globalIdDetails id of
 343         RecordSelId { sel_tycon = tycon, sel_label = lbl } -> (tycon,lbl)
 344         _ -> panic "recordSelectorFieldLabel"
 345
 346 isRecordSelector        :: Id -> Bool
 347 isNaughtyRecordSelector :: Id -> Bool
 348 isPrimOpId              :: Id -> Bool
 349 isFCallId               :: Id -> Bool
 350 isDataConWorkId         :: Id -> Bool
 351
 352 isClassOpId_maybe       :: Id -> Maybe Class
 353 isPrimOpId_maybe        :: Id -> Maybe PrimOp
 354 isFCallId_maybe         :: Id -> Maybe ForeignCall
 355 isDataConWorkId_maybe   :: Id -> Maybe DataCon
 356
 357 isRecordSelector id = case globalIdDetails id of
 358                         RecordSelId {}  -> True
 359                         _               -> False
 360
 361 isNaughtyRecordSelector id = case globalIdDetails id of
 362                         RecordSelId { sel_naughty = n } -> n
 363                         _                               -> False
 364
 365 isClassOpId_maybe id = case globalIdDetails id of
 366                         ClassOpId cls -> Just cls
 367                         _other        -> Nothing
 368
 369 isPrimOpId id = case globalIdDetails id of
 370                         PrimOpId _ -> True
 371                         _          -> False
 372
 373 isPrimOpId_maybe id = case globalIdDetails id of
 374                         PrimOpId op -> Just op
 375                         _           -> Nothing
 376
 377 isFCallId id = case globalIdDetails id of
 378                         FCallId _ -> True
 379                         _         -> False
 380
 381 isFCallId_maybe id = case globalIdDetails id of
 382                         FCallId call -> Just call
 383                         _            -> Nothing
 384
 385 isDataConWorkId id = case globalIdDetails id of
 386                         DataConWorkId _ -> True
 387                         _               -> False
 388
 389 isDataConWorkId_maybe id = case globalIdDetails id of
 390                         DataConWorkId con -> Just con
 391                         _                 -> Nothing
 392
 393 isDataConId_maybe :: Id -> Maybe DataCon
 394 isDataConId_maybe id = case globalIdDetails id of
 395                          DataConWorkId con -> Just con
 396                          DataConWrapId con -> Just con
 397                          _                 -> Nothing
 398
 399 idDataCon :: Id -> DataCon
 400 -- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
 401 --
 402 -- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
 403 idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
 404
 405
 406 isDictId :: Id -> Bool
 407 isDictId id = isDictTy (idType id)
 408
 409 hasNoBinding :: Id -> Bool
 410 -- ^ Returns @True@ of an 'Id' which may not have a
 411 -- binding, even though it is defined in this module.
 412
 413 -- Data constructor workers used to be things of this kind, but
 414 -- they aren't any more.  Instead, we inject a binding for
 415 -- them at the CorePrep stage.
 416 -- EXCEPT: unboxed tuples, which definitely have no binding
 417 hasNoBinding id = case globalIdDetails id of
 418                         PrimOpId _       -> True        -- See Note [Primop wrappers]
 419                         FCallId _        -> True
 420                         DataConWorkId dc -> isUnboxedTupleCon dc
 421                         _                -> False
 422
 423 isImplicitId :: Id -> Bool
 424 -- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
 425 -- declarations, so we don't need to put its signature in an interface
 426 -- file, even if it's mentioned in some other interface unfolding.
 427 isImplicitId id
 428   = case globalIdDetails id of
 429         RecordSelId {}  -> True
 430         FCallId _       -> True
 431         PrimOpId _      -> True
 432         ClassOpId _     -> True
 433         DataConWorkId _ -> True
 434         DataConWrapId _ -> True
 435                 -- These are are implied by their type or class decl;
 436                 -- remember that all type and class decls appear in the interface file.
 437                 -- The dfun id is not an implicit Id; it must *not* be omitted, because
 438                 -- it carries version info for the instance decl
 439         _               -> False
 440
 441 idIsFrom :: Module -> Id -> Bool
 442 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
 443 \end{code}
 444
 445 Note [Primop wrappers]
 446 ~~~~~~~~~~~~~~~~~~~~~~
 447 Currently hasNoBinding claims that PrimOpIds don't have a curried
 448 function definition.  But actually they do, in GHC.PrimopWrappers,
 449 which is auto-generated from prelude/primops.txt.pp.  So actually, hasNoBinding
 450 could return 'False' for PrimOpIds.
 451
 452 But we'd need to add something in CoreToStg to swizzle any unsaturated
 453 applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.
 454
 455 Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
 456 used by GHCi, which does not implement primops direct at all.
 457
 458
 459
 460 \begin{code}
 461 isDeadBinder :: Id -> Bool
 462 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
 463                   | otherwise = False   -- TyVars count as not dead
 464 \end{code}
 465
 466 \begin{code}
 467 isTickBoxOp :: Id -> Bool
 468 isTickBoxOp id =
 469   case globalIdDetails id of
 470     TickBoxOpId _    -> True
 471     _                -> False
 472
 473 isTickBoxOp_maybe :: Id -> Maybe TickBoxOp
 474 isTickBoxOp_maybe id =
 475   case globalIdDetails id of
 476     TickBoxOpId tick -> Just tick
 477     _                -> Nothing
 478 \end{code}
 479
 480 %************************************************************************
 481 %*                                                                      *
 482 \subsection{IdInfo stuff}
 483 %*                                                                      *
 484 %************************************************************************
 485
 486 \begin{code}
 487         ---------------------------------
 488         -- ARITY
 489 idArity :: Id -> Arity
 490 idArity id = arityInfo (idInfo id)
 491
 492 setIdArity :: Id -> Arity -> Id
 493 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 494
 495 #ifdef OLD_STRICTNESS
 496         ---------------------------------
 497         -- (OLD) STRICTNESS
 498 idStrictness :: Id -> StrictnessInfo
 499 idStrictness id = strictnessInfo (idInfo id)
 500
 501 setIdStrictness :: Id -> StrictnessInfo -> Id
 502 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
 503 #endif
 504
 505 -- | Returns true if an application to n args would diverge
 506 isBottomingId :: Id -> Bool
 507 isBottomingId id = isBottomingSig (idNewStrictness id)
 508
 509 idNewStrictness_maybe :: Id -> Maybe StrictSig
 510 idNewStrictness :: Id -> StrictSig
 511
 512 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
 513 idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
 514
 515 setIdNewStrictness :: Id -> StrictSig -> Id
 516 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
 517
 518 zapIdNewStrictness :: Id -> Id
 519 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
 520
 521 -- | This predicate says whether the 'Id' has a strict demand placed on it or
 522 -- has a type such that it can always be evaluated strictly (e.g., an
 523 -- unlifted type, but see the comment for 'isStrictType').  We need to
 524 -- check separately whether the 'Id' has a so-called \"strict type\" because if
 525 -- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
 526 -- type, we still want @isStrictId id@ to be @True@.
 527 isStrictId :: Id -> Bool
 528 isStrictId id
 529   = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
 530            (isStrictDmd (idNewDemandInfo id)) ||
 531            (isStrictType (idType id))
 532
 533         ---------------------------------
 534         -- UNFOLDING
 535 idUnfolding :: Id -> Unfolding
 536 idUnfolding id = unfoldingInfo (idInfo id)
 537
 538 setIdUnfolding :: Id -> Unfolding -> Id
 539 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 540
 541 #ifdef OLD_STRICTNESS
 542         ---------------------------------
 543         -- (OLD) DEMAND
 544 idDemandInfo :: Id -> Demand.Demand
 545 idDemandInfo id = demandInfo (idInfo id)
 546
 547 setIdDemandInfo :: Id -> Demand.Demand -> Id
 548 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
 549 #endif
 550
 551 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
 552 idNewDemandInfo       :: Id -> NewDemand.Demand
 553
 554 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
 555 idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
 556
 557 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
 558 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
 559
 560         ---------------------------------
 561         -- SPECIALISATION
 562 idSpecialisation :: Id -> SpecInfo
 563 idSpecialisation id = specInfo (idInfo id)
 564
 565 idCoreRules :: Id -> [CoreRule]
 566 idCoreRules id = specInfoRules (idSpecialisation id)
 567
 568 idHasRules :: Id -> Bool
 569 idHasRules id = not (isEmptySpecInfo (idSpecialisation id))
 570
 571 setIdSpecialisation :: Id -> SpecInfo -> Id
 572 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 573
 574         ---------------------------------
 575         -- CAF INFO
 576 idCafInfo :: Id -> CafInfo
 577 #ifdef OLD_STRICTNESS
 578 idCafInfo id = case cgInfo (idInfo id) of
 579                   NoCgInfo -> pprPanic "idCafInfo" (ppr id)
 580                   info     -> cgCafInfo info
 581 #else
 582 idCafInfo id = cafInfo (idInfo id)
 583 #endif
 584
 585 setIdCafInfo :: Id -> CafInfo -> Id
 586 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 587
 588         ---------------------------------
 589         -- CPR INFO
 590 #ifdef OLD_STRICTNESS
 591 idCprInfo :: Id -> CprInfo
 592 idCprInfo id = cprInfo (idInfo id)
 593
 594 setIdCprInfo :: Id -> CprInfo -> Id
 595 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
 596 #endif
 597
 598         ---------------------------------
 599         -- Occcurrence INFO
 600 idOccInfo :: Id -> OccInfo
 601 idOccInfo id = occInfo (idInfo id)
 602
 603 setIdOccInfo :: Id -> OccInfo -> Id
 604 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
 605
 606 zapIdOccInfo :: Id -> Id
 607 zapIdOccInfo b = b `setIdOccInfo` NoOccInfo
 608 \end{code}
 609
 610
 611         ---------------------------------
 612         -- INLINING
 613 The inline pragma tells us to be very keen to inline this Id, but it's still
 614 OK not to if optimisation is switched off.
 615
 616 \begin{code}
 617 idInlinePragma :: Id -> InlinePragInfo
 618 idInlinePragma id = inlinePragInfo (idInfo id)
 619
 620 setInlinePragma :: Id -> InlinePragInfo -> Id
 621 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 622
 623 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
 624 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
 625 \end{code}
 626
 627
 628         ---------------------------------
 629         -- ONE-SHOT LAMBDAS
 630 \begin{code}
 631 idLBVarInfo :: Id -> LBVarInfo
 632 idLBVarInfo id = lbvarInfo (idInfo id)
 633
 634 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
 635 -- OR we are applying the \"state hack\" which makes it appear as if theis is the case for
 636 -- lambdas used in @IO@. You should prefer using this over 'isOneShotLambda'
 637 isOneShotBndr :: Id -> Bool
 638 -- This one is the "business end", called externally.
 639 -- Its main purpose is to encapsulate the Horrible State Hack
 640 isOneShotBndr id = isOneShotLambda id || isStateHackType (idType id)
 641
 642 -- | Should we apply the state hack to values of this 'Type'?
 643 isStateHackType :: Type -> Bool
 644 isStateHackType ty
 645   | opt_NoStateHack
 646   = False
 647   | otherwise
 648   = case splitTyConApp_maybe ty of
 649         Just (tycon,_) -> tycon == statePrimTyCon
 650         _              -> False
 651         -- This is a gross hack.  It claims that
 652         -- every function over realWorldStatePrimTy is a one-shot
 653         -- function.  This is pretty true in practice, and makes a big
 654         -- difference.  For example, consider
 655         --      a `thenST` \ r -> ...E...
 656         -- The early full laziness pass, if it doesn't know that r is one-shot
 657         -- will pull out E (let's say it doesn't mention r) to give
 658         --      let lvl = E in a `thenST` \ r -> ...lvl...
 659         -- When `thenST` gets inlined, we end up with
 660         --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
 661         -- and we don't re-inline E.
 662         --
 663         -- It would be better to spot that r was one-shot to start with, but
 664         -- I don't want to rely on that.
 665         --
 666         -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
 667         -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 668
 669
 670 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once.
 671 -- You probably want to use 'isOneShotBndr' instead
 672 isOneShotLambda :: Id -> Bool
 673 isOneShotLambda id = case idLBVarInfo id of
 674                        IsOneShotLambda  -> True
 675                        NoLBVarInfo      -> False
 676
 677 setOneShotLambda :: Id -> Id
 678 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
 679
 680 clearOneShotLambda :: Id -> Id
 681 clearOneShotLambda id
 682   | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
 683   | otherwise          = id
 684
 685 -- The OneShotLambda functions simply fiddle with the IdInfo flag
 686 -- But watch out: this may change the type of something else
 687 --      f = \x -> e
 688 -- If we change the one-shot-ness of x, f's type changes
 689 \end{code}
 690
 691 \begin{code}
 692 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
 693 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
 694
 695 zapLamIdInfo :: Id -> Id
 696 zapLamIdInfo = zapInfo zapLamInfo
 697
 698 zapDemandIdInfo :: Id -> Id
 699 zapDemandIdInfo = zapInfo zapDemandInfo
 700
 701 zapFragileIdInfo :: Id -> Id
 702 zapFragileIdInfo = zapInfo zapFragileInfo
 703 \end{code}
 704
 705 Note [transferPolyIdInfo]
 706 ~~~~~~~~~~~~~~~~~~~~~~~~~
 707 Suppose we have
 708
 709    f = /\a. let g = rhs in ...
 710
 711 where g has interesting strictness information.  Then if we float thus
 712
 713    g' = /\a. rhs
 714    f = /\a. ...[g' a/g]
 715
 716 we *do not* want to lose the strictness information on g.  Nor arity.
 717
 718 It's simple to retain strictness and arity, but not so simple to retain
 719         worker info
 720         rules
 721 so we simply discard those.  Sooner or later this may bite us.
 722
 723 This transfer is used in two places:
 724         FloatOut (long-distance let-floating)
 725         SimplUtils.abstractFloats (short-distance let-floating)
 726
 727 \begin{code}
 728 transferPolyIdInfo :: Id -> Id -> Id
 729 transferPolyIdInfo old_id new_id
 730   = modifyIdInfo transfer new_id
 731   where
 732     old_info = idInfo old_id
 733     transfer new_info = new_info `setNewStrictnessInfo` (newStrictnessInfo old_info)
 734                                  `setArityInfo` (arityInfo old_info)
 735 \end{code}