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