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