compiler/basicTypes/Id.hs

   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
   8 {-# LANGUAGE CPP #-}
   9
  10 -- |
  11 -- #name_types#
  12 -- GHC uses several kinds of name internally:
  13 --
  14 -- * 'OccName.OccName': see "OccName#name_types"
  15 --
  16 -- * 'RdrName.RdrName': see "RdrName#name_types"
  17 --
  18 -- * 'Name.Name': see "Name#name_types"
  19 --
  20 -- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TyCoRep.Type' and some additional
  21 --   details (a 'IdInfo.IdInfo' and one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that
  22 --   are added, modified and inspected by various compiler passes. These 'Var.Var' names may either
  23 --   be global or local, see "Var#globalvslocal"
  24 --
  25 -- * 'Var.Var': see "Var#name_types"
  26
  27 module Id (
  28         -- * The main types
  29         Var, Id, isId,
  30
  31         -- * In and Out variants
  32         InVar,  InId,
  33         OutVar, OutId,
  34
  35         -- ** Simple construction
  36         mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
  37         mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
  38         mkLocalIdOrCoVarWithInfo,
  39         mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
  40         mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
  41         mkUserLocal, mkUserLocalOrCoVar,
  42         mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
  43         mkWorkerId,
  44
  45         -- ** Taking an Id apart
  46         idName, idType, idUnique, idInfo, idDetails,
  47         recordSelectorTyCon,
  48
  49         -- ** Modifying an Id
  50         setIdName, setIdUnique, Id.setIdType,
  51         setIdExported, setIdNotExported,
  52         globaliseId, localiseId,
  53         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
  54         zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
  55         zapIdUsedOnceInfo, zapIdTailCallInfo,
  56         zapFragileIdInfo, zapIdStrictness, zapStableUnfolding,
  57         transferPolyIdInfo,
  58
  59         -- ** Predicates on Ids
  60         isImplicitId, isDeadBinder,
  61         isStrictId,
  62         isExportedId, isLocalId, isGlobalId,
  63         isRecordSelector, isNaughtyRecordSelector,
  64         isPatSynRecordSelector,
  65         isDataConRecordSelector,
  66         isClassOpId_maybe, isDFunId,
  67         isPrimOpId, isPrimOpId_maybe,
  68         isFCallId, isFCallId_maybe,
  69         isDataConWorkId, isDataConWorkId_maybe,
  70         isDataConWrapId, isDataConWrapId_maybe,
  71         isDataConId_maybe,
  72         idDataCon,
  73         isConLikeId, isBottomingId, idIsFrom,
  74         hasNoBinding,
  75
  76         -- ** Join variables
  77         JoinId, isJoinId, isJoinId_maybe, idJoinArity,
  78         asJoinId, asJoinId_maybe, zapJoinId,
  79
  80         -- ** Inline pragma stuff
  81         idInlinePragma, setInlinePragma, modifyInlinePragma,
  82         idInlineActivation, setInlineActivation, idRuleMatchInfo,
  83
  84         -- ** One-shot lambdas
  85         isOneShotBndr, isProbablyOneShotLambda,
  86         setOneShotLambda, clearOneShotLambda,
  87         updOneShotInfo, setIdOneShotInfo,
  88         isStateHackType, stateHackOneShot, typeOneShot,
  89
  90         -- ** Reading 'IdInfo' fields
  91         idArity,
  92         idCallArity, idFunRepArity,
  93         idUnfolding, realIdUnfolding,
  94         idSpecialisation, idCoreRules, idHasRules,
  95         idCafInfo,
  96         idOneShotInfo, idStateHackOneShotInfo,
  97         idOccInfo,
  98         isNeverLevPolyId,
  99
 100         -- ** Writing 'IdInfo' fields
 101         setIdUnfolding, setCaseBndrEvald,
 102         setIdArity,
 103         setIdCallArity,
 104
 105         setIdSpecialisation,
 106         setIdCafInfo,
 107         setIdOccInfo, zapIdOccInfo,
 108
 109         setIdDemandInfo,
 110         setIdStrictness,
 111
 112         idDemandInfo,
 113         idStrictness,
 114
 115     ) where
 116
 117 #include "HsVersions.h"
 118
 119 import GhcPrelude
 120
 121 import DynFlags
 122 import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding,
 123                  isCompulsoryUnfolding, Unfolding( NoUnfolding ) )
 124
 125 import IdInfo
 126 import BasicTypes
 127
 128 -- Imported and re-exported
 129 import Var( Id, CoVar, JoinId,
 130             InId,  InVar,
 131             OutId, OutVar,
 132             idInfo, idDetails, setIdDetails, globaliseId, varType,
 133             isId, isLocalId, isGlobalId, isExportedId )
 134 import qualified Var
 135
 136 import Type
 137 import RepType
 138 import TysPrim
 139 import DataCon
 140 import Demand
 141 import Name
 142 import Module
 143 import Class
 144 import {-# SOURCE #-} PrimOp (PrimOp)
 145 import ForeignCall
 146 import Maybes
 147 import SrcLoc
 148 import Outputable
 149 import Unique
 150 import UniqSupply
 151 import FastString
 152 import Util
 153
 154 -- infixl so you can say (id `set` a `set` b)
 155 infixl  1 `setIdUnfolding`,
 156           `setIdArity`,
 157           `setIdCallArity`,
 158           `setIdOccInfo`,
 159           `setIdOneShotInfo`,
 160
 161           `setIdSpecialisation`,
 162           `setInlinePragma`,
 163           `setInlineActivation`,
 164           `idCafInfo`,
 165
 166           `setIdDemandInfo`,
 167           `setIdStrictness`,
 168
 169           `asJoinId`,
 170           `asJoinId_maybe`
 171
 172 {-
 173 ************************************************************************
 174 *                                                                      *
 175 \subsection{Basic Id manipulation}
 176 *                                                                      *
 177 ************************************************************************
 178 -}
 179
 180 idName   :: Id -> Name
 181 idName    = Var.varName
 182
 183 idUnique :: Id -> Unique
 184 idUnique  = Var.varUnique
 185
 186 idType   :: Id -> Kind
 187 idType    = Var.varType
 188
 189 setIdName :: Id -> Name -> Id
 190 setIdName = Var.setVarName
 191
 192 setIdUnique :: Id -> Unique -> Id
 193 setIdUnique = Var.setVarUnique
 194
 195 -- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
 196 -- reduce space usage
 197 setIdType :: Id -> Type -> Id
 198 setIdType id ty = seqType ty `seq` Var.setVarType id ty
 199
 200 setIdExported :: Id -> Id
 201 setIdExported = Var.setIdExported
 202
 203 setIdNotExported :: Id -> Id
 204 setIdNotExported = Var.setIdNotExported
 205
 206 localiseId :: Id -> Id
 207 -- Make an Id with the same unique and type as the
 208 -- incoming Id, but with an *Internal* Name and *LocalId* flavour
 209 localiseId id
 210   | ASSERT( isId id ) isLocalId id && isInternalName name
 211   = id
 212   | otherwise
 213   = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)
 214   where
 215     name = idName id
 216
 217 lazySetIdInfo :: Id -> IdInfo -> Id
 218 lazySetIdInfo = Var.lazySetIdInfo
 219
 220 setIdInfo :: Id -> IdInfo -> Id
 221 setIdInfo id info = info `seq` (lazySetIdInfo id info)
 222         -- Try to avoid space leaks by seq'ing
 223
 224 modifyIdInfo :: HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id
 225 modifyIdInfo fn id = setIdInfo id (fn (idInfo id))
 226
 227 -- maybeModifyIdInfo tries to avoid unnecessary thrashing
 228 maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
 229 maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
 230 maybeModifyIdInfo Nothing         id = id
 231
 232 {-
 233 ************************************************************************
 234 *                                                                      *
 235 \subsection{Simple Id construction}
 236 *                                                                      *
 237 ************************************************************************
 238
 239 Absolutely all Ids are made by mkId.  It is just like Var.mkId,
 240 but in addition it pins free-tyvar-info onto the Id's type,
 241 where it can easily be found.
 242
 243 Note [Free type variables]
 244 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 245 At one time we cached the free type variables of the type of an Id
 246 at the root of the type in a TyNote.  The idea was to avoid repeating
 247 the free-type-variable calculation.  But it turned out to slow down
 248 the compiler overall. I don't quite know why; perhaps finding free
 249 type variables of an Id isn't all that common whereas applying a
 250 substitution (which changes the free type variables) is more common.
 251 Anyway, we removed it in March 2008.
 252 -}
 253
 254 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 255 mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
 256 mkGlobalId = Var.mkGlobalVar
 257
 258 -- | Make a global 'Id' without any extra information at all
 259 mkVanillaGlobal :: Name -> Type -> Id
 260 mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
 261
 262 -- | Make a global 'Id' with no global information but some generic 'IdInfo'
 263 mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
 264 mkVanillaGlobalWithInfo = mkGlobalId VanillaId
 265
 266
 267 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 268 mkLocalId :: Name -> Type -> Id
 269 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
 270  -- It's tempting to ASSERT( not (isCoVarType ty) ), but don't. Sometimes,
 271  -- the type is a panic. (Search invented_id)
 272
 273 -- | Make a local CoVar
 274 mkLocalCoVar :: Name -> Type -> CoVar
 275 mkLocalCoVar name ty
 276   = ASSERT( isCoVarType ty )
 277     Var.mkLocalVar CoVarId name ty vanillaIdInfo
 278
 279 -- | Like 'mkLocalId', but checks the type to see if it should make a covar
 280 mkLocalIdOrCoVar :: Name -> Type -> Id
 281 mkLocalIdOrCoVar name ty
 282   | isCoVarType ty = mkLocalCoVar name ty
 283   | otherwise      = mkLocalId    name ty
 284
 285 -- | Make a local id, with the IdDetails set to CoVarId if the type indicates
 286 -- so.
 287 mkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id
 288 mkLocalIdOrCoVarWithInfo name ty info
 289   = Var.mkLocalVar details name ty info
 290   where
 291     details | isCoVarType ty = CoVarId
 292             | otherwise      = VanillaId
 293
 294     -- proper ids only; no covars!
 295 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
 296 mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info
 297         -- Note [Free type variables]
 298
 299 -- | Create a local 'Id' that is marked as exported.
 300 -- This prevents things attached to it from being removed as dead code.
 301 -- See Note [Exported LocalIds]
 302 mkExportedLocalId :: IdDetails -> Name -> Type -> Id
 303 mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
 304         -- Note [Free type variables]
 305
 306 mkExportedVanillaId :: Name -> Type -> Id
 307 mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
 308         -- Note [Free type variables]
 309
 310
 311 -- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
 312 -- that are created by the compiler out of thin air
 313 mkSysLocal :: FastString -> Unique -> Type -> Id
 314 mkSysLocal fs uniq ty = ASSERT( not (isCoVarType ty) )
 315                         mkLocalId (mkSystemVarName uniq fs) ty
 316
 317 -- | Like 'mkSysLocal', but checks to see if we have a covar type
 318 mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id
 319 mkSysLocalOrCoVar fs uniq ty
 320   = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty
 321
 322 mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
 323 mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))
 324
 325 mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id
 326 mkSysLocalOrCoVarM fs ty
 327   = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))
 328
 329 -- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
 330 mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
 331 mkUserLocal occ uniq ty loc = ASSERT( not (isCoVarType ty) )
 332                               mkLocalId (mkInternalName uniq occ loc) ty
 333
 334 -- | Like 'mkUserLocal', but checks if we have a coercion type
 335 mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
 336 mkUserLocalOrCoVar occ uniq ty loc
 337   = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty
 338
 339 {-
 340 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 341 @Uniques@, but that's OK because the templates are supposed to be
 342 instantiated before use.
 343 -}
 344
 345 -- | Workers get local names. "CoreTidy" will externalise these if necessary
 346 mkWorkerId :: Unique -> Id -> Type -> Id
 347 mkWorkerId uniq unwrkr ty
 348   = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
 349
 350 -- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
 351 mkTemplateLocal :: Int -> Type -> Id
 352 mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "v") (mkBuiltinUnique i) ty
 353
 354 -- | Create a template local for a series of types
 355 mkTemplateLocals :: [Type] -> [Id]
 356 mkTemplateLocals = mkTemplateLocalsNum 1
 357
 358 -- | Create a template local for a series of type, but start from a specified template local
 359 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 360 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 361
 362 {- Note [Exported LocalIds]
 363 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 364 We use mkExportedLocalId for things like
 365  - Dictionary functions (DFunId)
 366  - Wrapper and matcher Ids for pattern synonyms
 367  - Default methods for classes
 368  - Pattern-synonym matcher and builder Ids
 369  - etc
 370
 371 They marked as "exported" in the sense that they should be kept alive
 372 even if apparently unused in other bindings, and not dropped as dead
 373 code by the occurrence analyser.  (But "exported" here does not mean
 374 "brought into lexical scope by an import declaration". Indeed these
 375 things are always internal Ids that the user never sees.)
 376
 377 It's very important that they are *LocalIds*, not GlobalIds, for lots
 378 of reasons:
 379
 380  * We want to treat them as free variables for the purpose of
 381    dependency analysis (e.g. CoreFVs.exprFreeVars).
 382
 383  * Look them up in the current substitution when we come across
 384    occurrences of them (in Subst.lookupIdSubst). Lacking this we
 385    can get an out-of-date unfolding, which can in turn make the
 386    simplifier go into an infinite loop (#9857)
 387
 388  * Ensure that for dfuns that the specialiser does not float dict uses
 389    above their defns, which would prevent good simplifications happening.
 390
 391  * The strictness analyser treats a occurrence of a GlobalId as
 392    imported and assumes it contains strictness in its IdInfo, which
 393    isn't true if the thing is bound in the same module as the
 394    occurrence.
 395
 396 In CoreTidy we must make all these LocalIds into GlobalIds, so that in
 397 importing modules (in --make mode) we treat them as properly global.
 398 That is what is happening in, say tidy_insts in TidyPgm.
 399
 400 ************************************************************************
 401 *                                                                      *
 402 \subsection{Special Ids}
 403 *                                                                      *
 404 ************************************************************************
 405 -}
 406
 407 -- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.
 408 recordSelectorTyCon :: Id -> RecSelParent
 409 recordSelectorTyCon id
 410   = case Var.idDetails id of
 411         RecSelId { sel_tycon = parent } -> parent
 412         _ -> panic "recordSelectorTyCon"
 413
 414
 415 isRecordSelector        :: Id -> Bool
 416 isNaughtyRecordSelector :: Id -> Bool
 417 isPatSynRecordSelector  :: Id -> Bool
 418 isDataConRecordSelector  :: Id -> Bool
 419 isPrimOpId              :: Id -> Bool
 420 isFCallId               :: Id -> Bool
 421 isDataConWorkId         :: Id -> Bool
 422 isDataConWrapId         :: Id -> Bool
 423 isDFunId                :: Id -> Bool
 424
 425 isClassOpId_maybe       :: Id -> Maybe Class
 426 isPrimOpId_maybe        :: Id -> Maybe PrimOp
 427 isFCallId_maybe         :: Id -> Maybe ForeignCall
 428 isDataConWorkId_maybe   :: Id -> Maybe DataCon
 429 isDataConWrapId_maybe   :: Id -> Maybe DataCon
 430
 431 isRecordSelector id = case Var.idDetails id of
 432                         RecSelId {}     -> True
 433                         _               -> False
 434
 435 isDataConRecordSelector id = case Var.idDetails id of
 436                         RecSelId {sel_tycon = RecSelData _} -> True
 437                         _               -> False
 438
 439 isPatSynRecordSelector id = case Var.idDetails id of
 440                         RecSelId {sel_tycon = RecSelPatSyn _} -> True
 441                         _               -> False
 442
 443 isNaughtyRecordSelector id = case Var.idDetails id of
 444                         RecSelId { sel_naughty = n } -> n
 445                         _                               -> False
 446
 447 isClassOpId_maybe id = case Var.idDetails id of
 448                         ClassOpId cls -> Just cls
 449                         _other        -> Nothing
 450
 451 isPrimOpId id = case Var.idDetails id of
 452                         PrimOpId _ -> True
 453                         _          -> False
 454
 455 isDFunId id = case Var.idDetails id of
 456                         DFunId {} -> True
 457                         _         -> False
 458
 459 isPrimOpId_maybe id = case Var.idDetails id of
 460                         PrimOpId op -> Just op
 461                         _           -> Nothing
 462
 463 isFCallId id = case Var.idDetails id of
 464                         FCallId _ -> True
 465                         _         -> False
 466
 467 isFCallId_maybe id = case Var.idDetails id of
 468                         FCallId call -> Just call
 469                         _            -> Nothing
 470
 471 isDataConWorkId id = case Var.idDetails id of
 472                         DataConWorkId _ -> True
 473                         _               -> False
 474
 475 isDataConWorkId_maybe id = case Var.idDetails id of
 476                         DataConWorkId con -> Just con
 477                         _                 -> Nothing
 478
 479 isDataConWrapId id = case Var.idDetails id of
 480                        DataConWrapId _ -> True
 481                        _               -> False
 482
 483 isDataConWrapId_maybe id = case Var.idDetails id of
 484                         DataConWrapId con -> Just con
 485                         _                 -> Nothing
 486
 487 isDataConId_maybe :: Id -> Maybe DataCon
 488 isDataConId_maybe id = case Var.idDetails id of
 489                          DataConWorkId con -> Just con
 490                          DataConWrapId con -> Just con
 491                          _                 -> Nothing
 492
 493 isJoinId :: Var -> Bool
 494 -- It is convenient in SetLevels.lvlMFE to apply isJoinId
 495 -- to the free vars of an expression, so it's convenient
 496 -- if it returns False for type variables
 497 isJoinId id
 498   | isId id = case Var.idDetails id of
 499                 JoinId {} -> True
 500                 _         -> False
 501   | otherwise = False
 502
 503 isJoinId_maybe :: Var -> Maybe JoinArity
 504 isJoinId_maybe id
 505  | isId id  = ASSERT2( isId id, ppr id )
 506               case Var.idDetails id of
 507                 JoinId arity -> Just arity
 508                 _            -> Nothing
 509  | otherwise = Nothing
 510
 511 idDataCon :: Id -> DataCon
 512 -- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
 513 --
 514 -- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
 515 idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
 516
 517 hasNoBinding :: Id -> Bool
 518 -- ^ Returns @True@ of an 'Id' which may not have a
 519 -- binding, even though it is defined in this module.
 520
 521 -- Data constructor workers used to be things of this kind, but
 522 -- they aren't any more.  Instead, we inject a binding for
 523 -- them at the CorePrep stage.
 524 --
 525 -- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers] in PrimOp.hs.
 526 -- for the history of this.
 527 --
 528 -- Note that CorePrep currently eta expands things no-binding things and this
 529 -- can cause quite subtle bugs. See Note [Eta expansion of hasNoBinding things
 530 -- in CorePrep] in CorePrep for details.
 531 --
 532 -- EXCEPT: unboxed tuples, which definitely have no binding
 533 hasNoBinding id = case Var.idDetails id of
 534                         PrimOpId _       -> False   -- See Note [Primop wrappers] in PrimOp.hs
 535                         FCallId _        -> True
 536                         DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc
 537                         _                -> isCompulsoryUnfolding (idUnfolding id)
 538                                             -- See Note [Levity-polymorphic Ids]
 539
 540 isImplicitId :: Id -> Bool
 541 -- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
 542 -- declarations, so we don't need to put its signature in an interface
 543 -- file, even if it's mentioned in some other interface unfolding.
 544 isImplicitId id
 545   = case Var.idDetails id of
 546         FCallId {}       -> True
 547         ClassOpId {}     -> True
 548         PrimOpId {}      -> True
 549         DataConWorkId {} -> True
 550         DataConWrapId {} -> True
 551                 -- These are implied by their type or class decl;
 552                 -- remember that all type and class decls appear in the interface file.
 553                 -- The dfun id is not an implicit Id; it must *not* be omitted, because
 554                 -- it carries version info for the instance decl
 555         _               -> False
 556
 557 idIsFrom :: Module -> Id -> Bool
 558 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
 559
 560 {- Note [Levity-polymorphic Ids]
 561 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 562 Some levity-polymorphic Ids must be applied and and inlined, not left
 563 un-saturated.  Example:
 564   unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b
 565
 566 This has a compulsory unfolding because we can't lambda-bind those
 567 arguments.  But the compulsory unfolding may leave levity-polymorphic
 568 lambdas if it is not applied to enough arguments; e.g. (#14561)
 569   bad :: forall (a :: TYPE r). a -> a
 570   bad = unsafeCoerce#
 571
 572 The desugar has special magic to detect such cases: DsExpr.badUseOfLevPolyPrimop.
 573 And we want that magic to apply to levity-polymorphic compulsory-inline things.
 574 The easiest way to do this is for hasNoBinding to return True of all things
 575 that have compulsory unfolding.  Some Ids with a compulsory unfolding also
 576 have a binding, but it does not harm to say they don't here, and its a very
 577 simple way to fix #14561.
 578 -}
 579
 580 isDeadBinder :: Id -> Bool
 581 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
 582                   | otherwise = False   -- TyVars count as not dead
 583
 584 {-
 585 ************************************************************************
 586 *                                                                      *
 587               Join variables
 588 *                                                                      *
 589 ************************************************************************
 590 -}
 591
 592 idJoinArity :: JoinId -> JoinArity
 593 idJoinArity id = isJoinId_maybe id `orElse` pprPanic "idJoinArity" (ppr id)
 594
 595 asJoinId :: Id -> JoinArity -> JoinId
 596 asJoinId id arity = WARN(not (isLocalId id),
 597                          text "global id being marked as join var:" <+> ppr id)
 598                     WARN(not (is_vanilla_or_join id),
 599                          ppr id <+> pprIdDetails (idDetails id))
 600                     id `setIdDetails` JoinId arity
 601   where
 602     is_vanilla_or_join id = case Var.idDetails id of
 603                               VanillaId -> True
 604                               JoinId {} -> True
 605                               _         -> False
 606
 607 zapJoinId :: Id -> Id
 608 -- May be a regular id already
 609 zapJoinId jid | isJoinId jid = zapIdTailCallInfo (jid `setIdDetails` VanillaId)
 610                                  -- Core Lint may complain if still marked
 611                                  -- as AlwaysTailCalled
 612               | otherwise    = jid
 613
 614 asJoinId_maybe :: Id -> Maybe JoinArity -> Id
 615 asJoinId_maybe id (Just arity) = asJoinId id arity
 616 asJoinId_maybe id Nothing      = zapJoinId id
 617
 618 {-
 619 ************************************************************************
 620 *                                                                      *
 621 \subsection{IdInfo stuff}
 622 *                                                                      *
 623 ************************************************************************
 624 -}
 625
 626         ---------------------------------
 627         -- ARITY
 628 idArity :: Id -> Arity
 629 idArity id = arityInfo (idInfo id)
 630
 631 setIdArity :: Id -> Arity -> Id
 632 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 633
 634 idCallArity :: Id -> Arity
 635 idCallArity id = callArityInfo (idInfo id)
 636
 637 setIdCallArity :: Id -> Arity -> Id
 638 setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id
 639
 640 idFunRepArity :: Id -> RepArity
 641 idFunRepArity x = countFunRepArgs (idArity x) (idType x)
 642
 643 -- | Returns true if an application to n args would diverge
 644 isBottomingId :: Var -> Bool
 645 isBottomingId v
 646   | isId v    = isBottomingSig (idStrictness v)
 647   | otherwise = False
 648
 649 -- | Accesses the 'Id''s 'strictnessInfo'.
 650 idStrictness :: Id -> StrictSig
 651 idStrictness id = strictnessInfo (idInfo id)
 652
 653 setIdStrictness :: Id -> StrictSig -> Id
 654 setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
 655
 656 zapIdStrictness :: Id -> Id
 657 zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
 658
 659 -- | This predicate says whether the 'Id' has a strict demand placed on it or
 660 -- has a type such that it can always be evaluated strictly (i.e an
 661 -- unlifted type, as of GHC 7.6).  We need to
 662 -- check separately whether the 'Id' has a so-called \"strict type\" because if
 663 -- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
 664 -- type, we still want @isStrictId id@ to be @True@.
 665 isStrictId :: Id -> Bool
 666 isStrictId id
 667   = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
 668          not (isJoinId id) && (
 669            (isStrictType (idType id)) ||
 670            -- Take the best of both strictnesses - old and new
 671            (isStrictDmd (idDemandInfo id))
 672          )
 673
 674         ---------------------------------
 675         -- UNFOLDING
 676 idUnfolding :: Id -> Unfolding
 677 -- Do not expose the unfolding of a loop breaker!
 678 idUnfolding id
 679   | isStrongLoopBreaker (occInfo info) = NoUnfolding
 680   | otherwise                          = unfoldingInfo info
 681   where
 682     info = idInfo id
 683
 684 realIdUnfolding :: Id -> Unfolding
 685 -- Expose the unfolding if there is one, including for loop breakers
 686 realIdUnfolding id = unfoldingInfo (idInfo id)
 687
 688 setIdUnfolding :: Id -> Unfolding -> Id
 689 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 690
 691 idDemandInfo       :: Id -> Demand
 692 idDemandInfo       id = demandInfo (idInfo id)
 693
 694 setIdDemandInfo :: Id -> Demand -> Id
 695 setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id
 696
 697 setCaseBndrEvald :: StrictnessMark -> Id -> Id
 698 -- Used for variables bound by a case expressions, both the case-binder
 699 -- itself, and any pattern-bound variables that are argument of a
 700 -- strict constructor.  It just marks the variable as already-evaluated,
 701 -- so that (for example) a subsequent 'seq' can be dropped
 702 setCaseBndrEvald str id
 703   | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding
 704   | otherwise          = id
 705
 706         ---------------------------------
 707         -- SPECIALISATION
 708
 709 -- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs
 710
 711 idSpecialisation :: Id -> RuleInfo
 712 idSpecialisation id = ruleInfo (idInfo id)
 713
 714 idCoreRules :: Id -> [CoreRule]
 715 idCoreRules id = ruleInfoRules (idSpecialisation id)
 716
 717 idHasRules :: Id -> Bool
 718 idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))
 719
 720 setIdSpecialisation :: Id -> RuleInfo -> Id
 721 setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id
 722
 723         ---------------------------------
 724         -- CAF INFO
 725 idCafInfo :: Id -> CafInfo
 726 idCafInfo id = cafInfo (idInfo id)
 727
 728 setIdCafInfo :: Id -> CafInfo -> Id
 729 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 730
 731         ---------------------------------
 732         -- Occurrence INFO
 733 idOccInfo :: Id -> OccInfo
 734 idOccInfo id = occInfo (idInfo id)
 735
 736 setIdOccInfo :: Id -> OccInfo -> Id
 737 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
 738
 739 zapIdOccInfo :: Id -> Id
 740 zapIdOccInfo b = b `setIdOccInfo` noOccInfo
 741
 742 {-
 743         ---------------------------------
 744         -- INLINING
 745 The inline pragma tells us to be very keen to inline this Id, but it's still
 746 OK not to if optimisation is switched off.
 747 -}
 748
 749 idInlinePragma :: Id -> InlinePragma
 750 idInlinePragma id = inlinePragInfo (idInfo id)
 751
 752 setInlinePragma :: Id -> InlinePragma -> Id
 753 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 754
 755 modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
 756 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
 757
 758 idInlineActivation :: Id -> Activation
 759 idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
 760
 761 setInlineActivation :: Id -> Activation -> Id
 762 setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
 763
 764 idRuleMatchInfo :: Id -> RuleMatchInfo
 765 idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
 766
 767 isConLikeId :: Id -> Bool
 768 isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
 769
 770 {-
 771         ---------------------------------
 772         -- ONE-SHOT LAMBDAS
 773 -}
 774
 775 idOneShotInfo :: Id -> OneShotInfo
 776 idOneShotInfo id = oneShotInfo (idInfo id)
 777
 778 -- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account
 779 -- See Note [The state-transformer hack] in CoreArity
 780 idStateHackOneShotInfo :: Id -> OneShotInfo
 781 idStateHackOneShotInfo id
 782     | isStateHackType (idType id) = stateHackOneShot
 783     | otherwise                   = idOneShotInfo id
 784
 785 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
 786 -- This one is the "business end", called externally.
 787 -- It works on type variables as well as Ids, returning True
 788 -- Its main purpose is to encapsulate the Horrible State Hack
 789 -- See Note [The state-transformer hack] in CoreArity
 790 isOneShotBndr :: Var -> Bool
 791 isOneShotBndr var
 792   | isTyVar var                              = True
 793   | OneShotLam <- idStateHackOneShotInfo var = True
 794   | otherwise                                = False
 795
 796 -- | Should we apply the state hack to values of this 'Type'?
 797 stateHackOneShot :: OneShotInfo
 798 stateHackOneShot = OneShotLam
 799
 800 typeOneShot :: Type -> OneShotInfo
 801 typeOneShot ty
 802    | isStateHackType ty = stateHackOneShot
 803    | otherwise          = NoOneShotInfo
 804
 805 isStateHackType :: Type -> Bool
 806 isStateHackType ty
 807   | hasNoStateHack unsafeGlobalDynFlags
 808   = False
 809   | otherwise
 810   = case tyConAppTyCon_maybe ty of
 811         Just tycon -> tycon == statePrimTyCon
 812         _          -> False
 813         -- This is a gross hack.  It claims that
 814         -- every function over realWorldStatePrimTy is a one-shot
 815         -- function.  This is pretty true in practice, and makes a big
 816         -- difference.  For example, consider
 817         --      a `thenST` \ r -> ...E...
 818         -- The early full laziness pass, if it doesn't know that r is one-shot
 819         -- will pull out E (let's say it doesn't mention r) to give
 820         --      let lvl = E in a `thenST` \ r -> ...lvl...
 821         -- When `thenST` gets inlined, we end up with
 822         --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
 823         -- and we don't re-inline E.
 824         --
 825         -- It would be better to spot that r was one-shot to start with, but
 826         -- I don't want to rely on that.
 827         --
 828         -- Another good example is in fill_in in PrelPack.hs.  We should be able to
 829         -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 830
 831 isProbablyOneShotLambda :: Id -> Bool
 832 isProbablyOneShotLambda id = case idStateHackOneShotInfo id of
 833                                OneShotLam    -> True
 834                                NoOneShotInfo -> False
 835
 836 setOneShotLambda :: Id -> Id
 837 setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id
 838
 839 clearOneShotLambda :: Id -> Id
 840 clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id
 841
 842 setIdOneShotInfo :: Id -> OneShotInfo -> Id
 843 setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id
 844
 845 updOneShotInfo :: Id -> OneShotInfo -> Id
 846 -- Combine the info in the Id with new info
 847 updOneShotInfo id one_shot
 848   | do_upd    = setIdOneShotInfo id one_shot
 849   | otherwise = id
 850   where
 851     do_upd = case (idOneShotInfo id, one_shot) of
 852                 (NoOneShotInfo, _) -> True
 853                 (OneShotLam,    _) -> False
 854
 855 -- The OneShotLambda functions simply fiddle with the IdInfo flag
 856 -- But watch out: this may change the type of something else
 857 --      f = \x -> e
 858 -- If we change the one-shot-ness of x, f's type changes
 859
 860 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
 861 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
 862
 863 zapLamIdInfo :: Id -> Id
 864 zapLamIdInfo = zapInfo zapLamInfo
 865
 866 zapFragileIdInfo :: Id -> Id
 867 zapFragileIdInfo = zapInfo zapFragileInfo
 868
 869 zapIdDemandInfo :: Id -> Id
 870 zapIdDemandInfo = zapInfo zapDemandInfo
 871
 872 zapIdUsageInfo :: Id -> Id
 873 zapIdUsageInfo = zapInfo zapUsageInfo
 874
 875 zapIdUsageEnvInfo :: Id -> Id
 876 zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo
 877
 878 zapIdUsedOnceInfo :: Id -> Id
 879 zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo
 880
 881 zapIdTailCallInfo :: Id -> Id
 882 zapIdTailCallInfo = zapInfo zapTailCallInfo
 883
 884 zapStableUnfolding :: Id -> Id
 885 zapStableUnfolding id
 886  | isStableUnfolding (realIdUnfolding id) = setIdUnfolding id NoUnfolding
 887  | otherwise                              = id
 888
 889 {-
 890 Note [transferPolyIdInfo]
 891 ~~~~~~~~~~~~~~~~~~~~~~~~~
 892 This transfer is used in three places:
 893         FloatOut (long-distance let-floating)
 894         SimplUtils.abstractFloats (short-distance let-floating)
 895         StgLiftLams (selectively lambda-lift local functions to top-level)
 896
 897 Consider the short-distance let-floating:
 898
 899    f = /\a. let g = rhs in ...
 900
 901 Then if we float thus
 902
 903    g' = /\a. rhs
 904    f = /\a. ...[g' a/g]....
 905
 906 we *do not* want to lose g's
 907   * strictness information
 908   * arity
 909   * inline pragma (though that is bit more debatable)
 910   * occurrence info
 911
 912 Mostly this is just an optimisation, but it's *vital* to
 913 transfer the occurrence info.  Consider
 914
 915    NonRec { f = /\a. let Rec { g* = ..g.. } in ... }
 916
 917 where the '*' means 'LoopBreaker'.  Then if we float we must get
 918
 919    Rec { g'* = /\a. ...(g' a)... }
 920    NonRec { f = /\a. ...[g' a/g]....}
 921
 922 where g' is also marked as LoopBreaker.  If not, terrible things
 923 can happen if we re-simplify the binding (and the Simplifier does
 924 sometimes simplify a term twice); see #4345.
 925
 926 It's not so simple to retain
 927   * worker info
 928   * rules
 929 so we simply discard those.  Sooner or later this may bite us.
 930
 931 If we abstract wrt one or more *value* binders, we must modify the
 932 arity and strictness info before transferring it.  E.g.
 933       f = \x. e
 934 -->
 935       g' = \y. \x. e
 936       + substitute (g' y) for g
 937 Notice that g' has an arity one more than the original g
 938 -}
 939
 940 transferPolyIdInfo :: Id        -- Original Id
 941                    -> [Var]     -- Abstract wrt these variables
 942                    -> Id        -- New Id
 943                    -> Id
 944 transferPolyIdInfo old_id abstract_wrt new_id
 945   = modifyIdInfo transfer new_id
 946   where
 947     arity_increase = count isId abstract_wrt    -- Arity increases by the
 948                                                 -- number of value binders
 949
 950     old_info        = idInfo old_id
 951     old_arity       = arityInfo old_info
 952     old_inline_prag = inlinePragInfo old_info
 953     old_occ_info    = occInfo old_info
 954     new_arity       = old_arity + arity_increase
 955     new_occ_info    = zapOccTailCallInfo old_occ_info
 956
 957     old_strictness  = strictnessInfo old_info
 958     new_strictness  = increaseStrictSigArity arity_increase old_strictness
 959
 960     transfer new_info = new_info `setArityInfo` new_arity
 961                                  `setInlinePragInfo` old_inline_prag
 962                                  `setOccInfo` new_occ_info
 963                                  `setStrictnessInfo` new_strictness
 964
 965 isNeverLevPolyId :: Id -> Bool
 966 isNeverLevPolyId = isNeverLevPolyIdInfo . idInfo