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