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