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,
  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         idWorkerInfo,
  72         idUnfolding,
  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         setIdWorkerInfo,
  90         setIdSpecialisation,
  91         setIdCafInfo,
  92         setIdOccInfo, zapIdOccInfo,
  93
  94 #ifdef OLD_STRICTNESS
  95         setIdStrictness,
  96         setIdDemandInfo,
  97         setIdCprInfo,
  98 #endif
  99     ) where
 100
 101 #include "HsVersions.h"
 102
 103 import CoreSyn ( CoreRule, Unfolding )
 104
 105 import IdInfo
 106 import BasicTypes
 107
 108 -- Imported and re-exported
 109 import Var( Var, Id, DictId,
 110             idInfo, idDetails, globaliseId,
 111             isId, isLocalId, isGlobalId, isExportedId )
 112 import qualified Var
 113
 114 import TyCon
 115 import Type
 116 import TcType
 117 import TysPrim
 118 #ifdef OLD_STRICTNESS
 119 import qualified Demand
 120 #endif
 121 import DataCon
 122 import NewDemand
 123 import Name
 124 import Module
 125 import Class
 126 import PrimOp
 127 import ForeignCall
 128 import OccName
 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
 330 isClassOpId_maybe       :: Id -> Maybe Class
 331 isPrimOpId_maybe        :: Id -> Maybe PrimOp
 332 isFCallId_maybe         :: Id -> Maybe ForeignCall
 333 isDataConWorkId_maybe   :: Id -> Maybe DataCon
 334
 335 isRecordSelector id = case Var.idDetails id of
 336                         RecSelId {}  -> True
 337                         _               -> False
 338
 339 isNaughtyRecordSelector id = case Var.idDetails id of
 340                         RecSelId { sel_naughty = n } -> n
 341                         _                               -> False
 342
 343 isClassOpId_maybe id = case Var.idDetails id of
 344                         ClassOpId cls -> Just cls
 345                         _other        -> Nothing
 346
 347 isPrimOpId id = case Var.idDetails id of
 348                         PrimOpId _ -> 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         -- WORKER ID
 512 idWorkerInfo :: Id -> WorkerInfo
 513 idWorkerInfo id = workerInfo (idInfo id)
 514
 515 setIdWorkerInfo :: Id -> WorkerInfo -> Id
 516 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
 517
 518         ---------------------------------
 519         -- UNFOLDING
 520 idUnfolding :: Id -> Unfolding
 521 idUnfolding id = unfoldingInfo (idInfo id)
 522
 523 setIdUnfolding :: Id -> Unfolding -> Id
 524 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 525
 526 #ifdef OLD_STRICTNESS
 527         ---------------------------------
 528         -- (OLD) DEMAND
 529 idDemandInfo :: Id -> Demand.Demand
 530 idDemandInfo id = demandInfo (idInfo id)
 531
 532 setIdDemandInfo :: Id -> Demand.Demand -> Id
 533 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
 534 #endif
 535
 536 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
 537 idNewDemandInfo       :: Id -> NewDemand.Demand
 538
 539 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
 540 idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
 541
 542 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
 543 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
 544
 545         ---------------------------------
 546         -- SPECIALISATION
 547 idSpecialisation :: Id -> SpecInfo
 548 idSpecialisation id = specInfo (idInfo id)
 549
 550 idCoreRules :: Id -> [CoreRule]
 551 idCoreRules id = specInfoRules (idSpecialisation id)
 552
 553 idHasRules :: Id -> Bool
 554 idHasRules id = not (isEmptySpecInfo (idSpecialisation id))
 555
 556 setIdSpecialisation :: Id -> SpecInfo -> Id
 557 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 558
 559         ---------------------------------
 560         -- CAF INFO
 561 idCafInfo :: Id -> CafInfo
 562 #ifdef OLD_STRICTNESS
 563 idCafInfo id = case cgInfo (idInfo id) of
 564                   NoCgInfo -> pprPanic "idCafInfo" (ppr id)
 565                   info     -> cgCafInfo info
 566 #else
 567 idCafInfo id = cafInfo (idInfo id)
 568 #endif
 569
 570 setIdCafInfo :: Id -> CafInfo -> Id
 571 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 572
 573         ---------------------------------
 574         -- CPR INFO
 575 #ifdef OLD_STRICTNESS
 576 idCprInfo :: Id -> CprInfo
 577 idCprInfo id = cprInfo (idInfo id)
 578
 579 setIdCprInfo :: Id -> CprInfo -> Id
 580 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
 581 #endif
 582
 583         ---------------------------------
 584         -- Occcurrence INFO
 585 idOccInfo :: Id -> OccInfo
 586 idOccInfo id = occInfo (idInfo id)
 587
 588 setIdOccInfo :: Id -> OccInfo -> Id
 589 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
 590
 591 zapIdOccInfo :: Id -> Id
 592 zapIdOccInfo b = b `setIdOccInfo` NoOccInfo
 593 \end{code}
 594
 595
 596         ---------------------------------
 597         -- INLINING
 598 The inline pragma tells us to be very keen to inline this Id, but it's still
 599 OK not to if optimisation is switched off.
 600
 601 \begin{code}
 602 idInlinePragma :: Id -> InlinePragInfo
 603 idInlinePragma id = inlinePragInfo (idInfo id)
 604
 605 setInlinePragma :: Id -> InlinePragInfo -> Id
 606 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 607
 608 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
 609 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
 610 \end{code}
 611
 612
 613         ---------------------------------
 614         -- ONE-SHOT LAMBDAS
 615 \begin{code}
 616 idLBVarInfo :: Id -> LBVarInfo
 617 idLBVarInfo id = lbvarInfo (idInfo id)
 618
 619 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
 620 -- OR we are applying the \"state hack\" which makes it appear as if theis is the case for
 621 -- lambdas used in @IO@. You should prefer using this over 'isOneShotLambda'
 622 isOneShotBndr :: Id -> Bool
 623 -- This one is the "business end", called externally.
 624 -- Its main purpose is to encapsulate the Horrible State Hack
 625 isOneShotBndr id = isOneShotLambda id || isStateHackType (idType id)
 626
 627 -- | Should we apply the state hack to values of this 'Type'?
 628 isStateHackType :: Type -> Bool
 629 isStateHackType ty
 630   | opt_NoStateHack
 631   = False
 632   | otherwise
 633   = case splitTyConApp_maybe ty of
 634         Just (tycon,_) -> tycon == statePrimTyCon
 635         _              -> False
 636         -- This is a gross hack.  It claims that
 637         -- every function over realWorldStatePrimTy is a one-shot
 638         -- function.  This is pretty true in practice, and makes a big
 639         -- difference.  For example, consider
 640         --      a `thenST` \ r -> ...E...
 641         -- The early full laziness pass, if it doesn't know that r is one-shot
 642         -- will pull out E (let's say it doesn't mention r) to give
 643         --      let lvl = E in a `thenST` \ r -> ...lvl...
 644         -- When `thenST` gets inlined, we end up with
 645         --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
 646         -- and we don't re-inline E.
 647         --
 648         -- It would be better to spot that r was one-shot to start with, but
 649         -- I don't want to rely on that.
 650         --
 651         -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
 652         -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 653
 654
 655 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once.
 656 -- You probably want to use 'isOneShotBndr' instead
 657 isOneShotLambda :: Id -> Bool
 658 isOneShotLambda id = case idLBVarInfo id of
 659                        IsOneShotLambda  -> True
 660                        NoLBVarInfo      -> False
 661
 662 setOneShotLambda :: Id -> Id
 663 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
 664
 665 clearOneShotLambda :: Id -> Id
 666 clearOneShotLambda id
 667   | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
 668   | otherwise          = id
 669
 670 -- The OneShotLambda functions simply fiddle with the IdInfo flag
 671 -- But watch out: this may change the type of something else
 672 --      f = \x -> e
 673 -- If we change the one-shot-ness of x, f's type changes
 674 \end{code}
 675
 676 \begin{code}
 677 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
 678 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
 679
 680 zapLamIdInfo :: Id -> Id
 681 zapLamIdInfo = zapInfo zapLamInfo
 682
 683 zapDemandIdInfo :: Id -> Id
 684 zapDemandIdInfo = zapInfo zapDemandInfo
 685
 686 zapFragileIdInfo :: Id -> Id
 687 zapFragileIdInfo = zapInfo zapFragileInfo
 688 \end{code}
 689
 690 Note [transferPolyIdInfo]
 691 ~~~~~~~~~~~~~~~~~~~~~~~~~
 692 Suppose we have
 693
 694    f = /\a. let g = rhs in ...
 695
 696 where g has interesting strictness information.  Then if we float thus
 697
 698    g' = /\a. rhs
 699    f = /\a. ...[g' a/g]
 700
 701 we *do not* want to lose g's
 702   * strictness information
 703   * arity
 704   * inline pragma (though that is bit more debatable)
 705
 706 It's simple to retain strictness and arity, but not so simple to retain
 707   * worker info
 708   * rules
 709 so we simply discard those.  Sooner or later this may bite us.
 710
 711 This transfer is used in two places:
 712         FloatOut (long-distance let-floating)
 713         SimplUtils.abstractFloats (short-distance let-floating)
 714
 715 If we abstract wrt one or more *value* binders, we must modify the
 716 arity and strictness info before transferring it.  E.g.
 717       f = \x. e
 718 -->
 719       g' = \y. \x. e
 720       + substitute (g' y) for g
 721 Notice that g' has an arity one more than the original g
 722
 723 \begin{code}
 724 transferPolyIdInfo :: Id        -- Original Id
 725                    -> [Var]     -- Abstract wrt these variables
 726                    -> Id        -- New Id
 727                    -> Id
 728 transferPolyIdInfo old_id abstract_wrt new_id
 729   = modifyIdInfo transfer new_id
 730   where
 731     arity_increase = count isId abstract_wrt    -- Arity increases by the
 732                                                 -- number of value binders
 733
 734     old_info        = idInfo old_id
 735     old_arity       = arityInfo old_info
 736     old_inline_prag = inlinePragInfo old_info
 737     new_arity       = old_arity + arity_increase
 738     old_strictness  = newStrictnessInfo old_info
 739     new_strictness  = fmap (increaseStrictSigArity arity_increase) old_strictness
 740
 741     transfer new_info = new_info `setNewStrictnessInfo` new_strictness
 742                                  `setArityInfo` new_arity
 743                                  `setInlinePragInfo` old_inline_prag
 744 \end{code}