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