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