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