\begin{code}
module Id (
- Id, DictId, GenId,
+ Id, DictId,
-- Simple construction
- mkVanillaId, mkImportedId, mkSysLocal, mkUserLocal,
- mkTemplateLocals, mkWildId, mkUserId,
+ mkId, mkVanillaId, mkSysLocal, mkUserLocal,
+ mkTemplateLocals, mkWildId, mkTemplateLocal,
-- Taking an Id apart
idName, idType, idUnique, idInfo,
recordSelectorFieldLabel,
-- Modifying an Id
- setIdName, setIdUnique, setIdType, setIdInfo,
- setIdVisibility, mkIdVisible,
+ setIdName, setIdUnique, setIdType, setIdNoDiscard,
+ setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
+ zapFragileIdInfo, zapLamIdInfo,
-- Predicates
omitIfaceSigForId,
+ exportWithOrigOccName,
externallyVisibleId,
idFreeTyVars,
-- Inline pragma stuff
getInlinePragma, setInlinePragma, modifyInlinePragma,
- idWantsToBeINLINEd, idMustBeINLINEd, idMustNotBeINLINEd,
- isSpecPragmaId,
-
- isRecordSelector,
+ isSpecPragmaId, isRecordSelector,
isPrimitiveId_maybe, isDataConId_maybe,
- isConstantId,
- isBottomingId,
+ isConstantId, isBottomingId, idAppIsBottom,
+ isExportedId, isUserExportedId,
+ mayHaveNoBinding,
+
+ -- One shot lambda stuff
+ isOneShotLambda, setOneShotLambda, clearOneShotLambda,
-- IdInfo stuff
setIdUnfolding,
setIdArity,
setIdDemandInfo,
setIdStrictness,
+ setIdWorkerInfo,
setIdSpecialisation,
setIdUpdateInfo,
setIdCafInfo,
+ setIdCprInfo,
+ setIdOccInfo,
getIdArity,
getIdDemandInfo,
getIdStrictness,
+ getIdWorkerInfo,
getIdUnfolding,
getIdSpecialisation,
getIdUpdateInfo,
- getIdCafInfo
+ getIdCafInfo,
+ getIdCprInfo,
+ getIdOccInfo
) where
#include "HsVersions.h"
import {-# SOURCE #-} CoreUnfold ( Unfolding )
+import {-# SOURCE #-} CoreSyn ( CoreRules )
-import Var ( Id, GenId, DictId, VarDetails(..),
- isId, mkId,
- idName, idType, idUnique, idInfo, varDetails,
- setIdName, setVarType, setIdUnique, setIdInfo, modifyIdInfo,
+import Var ( Id, DictId,
+ isId, mkIdVar,
+ idName, idType, idUnique, idInfo,
+ setIdName, setVarType, setIdUnique,
+ setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
externallyVisibleId
)
import VarSet
-import Type ( GenType, Type, tyVarsOfType, typePrimRep, addFreeTyVars )
-import IdInfo
-import Demand ( Demand )
-import Name ( Name, OccName,
+import Type ( Type, tyVarsOfType, typePrimRep, addFreeTyVars, seqType, splitTyConApp_maybe )
+
+import IdInfo
+
+import Demand ( Demand, isStrict, wwLazy )
+import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
- isWiredInName, setNameVisibility, mkNameVisible
+ isWiredInName, isUserExportedName
)
+import OccName ( UserFS )
import Const ( Con(..) )
import PrimRep ( PrimRep )
import PrimOp ( PrimOp )
+import TysPrim ( statePrimTyCon )
import FieldLabel ( FieldLabel(..) )
-import BasicTypes ( Module )
+import SrcLoc ( SrcLoc )
import Unique ( Unique, mkBuiltinUnique, getBuiltinUniques )
import Outputable
`setIdArity`,
`setIdDemandInfo`,
`setIdStrictness`,
+ `setIdWorkerInfo`,
`setIdSpecialisation`,
`setIdUpdateInfo`,
- `setInlinePragma`
+ `setInlinePragma`,
+ `getIdCafInfo`,
+ `getIdCprInfo`
+
-- infixl so you can say (id `set` a `set` b)
\end{code}
%* *
%************************************************************************
-\begin{code}
-mkVanillaId :: Name -> (GenType flexi) -> GenId flexi
-mkVanillaId name ty = mkId name ty VanillaId noIdInfo
+Absolutely all Ids are made by mkId. It
+ a) Pins free-tyvar-info onto the Id's type,
+ where it can easily be found.
+ b) Ensures that exported Ids are
-mkImportedId :: Name -> Type -> IdInfo -> Id
-mkImportedId name ty info = mkId name ty VanillaId info
+\begin{code}
+mkId :: Name -> Type -> IdInfo -> Id
+mkId name ty info = mkIdVar name (addFreeTyVars ty) info'
+ where
+ info' | isUserExportedName name = setNoDiscardInfo info
+ | otherwise = info
+\end{code}
-mkUserId :: Name -> GenType flexi -> GenId flexi
-mkUserId name ty = mkVanillaId name ty
+\begin{code}
+mkVanillaId :: Name -> Type -> Id
+mkVanillaId name ty = mkId name ty vanillaIdInfo
-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
-mkUserLocal :: OccName -> Unique -> GenType flexi -> GenId flexi
-mkSysLocal :: Unique -> GenType flexi -> GenId flexi
+mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
+mkSysLocal :: UserFS -> Unique -> Type -> Id
-mkSysLocal uniq ty = mkVanillaId (mkSysLocalName uniq) ty
-mkUserLocal occ uniq ty = mkVanillaId (mkLocalName uniq occ) ty
+mkSysLocal fs uniq ty = mkVanillaId (mkSysLocalName uniq fs) ty
+mkUserLocal occ uniq ty loc = mkVanillaId (mkLocalName uniq occ loc) ty
\end{code}
Make some local @Ids@ for a template @CoreExpr@. These have bogus
\begin{code}
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
-mkWildId ty = mkSysLocal (mkBuiltinUnique 1) ty
+mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
-- "Template locals" typically used in unfoldings
mkTemplateLocals :: [Type] -> [Id]
-mkTemplateLocals tys = zipWith mkSysLocal
+mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
(getBuiltinUniques (length tys))
tys
+
+mkTemplateLocal :: Int -> Type -> Id
+mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
\end{code}
%************************************************************************
\begin{code}
-idFreeTyVars :: (GenId flexi) -> (GenTyVarSet flexi)
+idFreeTyVars :: Id -> TyVarSet
idFreeTyVars id = tyVarsOfType (idType id)
-setIdType :: GenId flexi1 -> GenType flexi2 -> GenId flexi2
+setIdType :: Id -> Type -> Id
-- Add free tyvar info to the type
-setIdType id ty = setVarType id (addFreeTyVars ty)
+setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
\end{code}
-omitIfaceSigForId tells whether an Id's info is implied by other declarations,
-so we don't need to put its signature in an interface file, even if it's mentioned
-in some other interface unfolding.
-
-\begin{code}
-omitIfaceSigForId :: Id -> Bool
-omitIfaceSigForId id
- | isWiredInName (idName id)
- = True
-
- | otherwise
- = case varDetails id of
- RecordSelId _ -> True -- Includes dictionary selectors
- ConstantId _ -> True
- -- ConstantIds are implied by their type or class decl;
- -- remember that all type and class decls appear in the interface file.
- -- The dfun id must *not* be omitted, because it carries version info for
- -- the instance decl
-
- other -> False -- Don't omit!
-\end{code}
-
-See notes with setNameVisibility (Name.lhs)
-
-\begin{code}
-setIdVisibility :: Maybe Module -> Unique -> Id -> Id
-setIdVisibility maybe_mod u id
- = setIdName id (setNameVisibility maybe_mod u (idName id))
-
-mkIdVisible :: Module -> Unique -> Id -> Id
-mkIdVisible mod u id
- = setIdName id (mkNameVisible mod u (idName id))
-\end{code}
%************************************************************************
%* *
%************************************************************************
\begin{code}
+idFlavour :: Id -> IdFlavour
+idFlavour id = flavourInfo (idInfo id)
+
+setIdNoDiscard :: Id -> Id
+setIdNoDiscard id -- Make an Id into a NoDiscardId, unless it is already
+ = modifyIdInfo setNoDiscardInfo id
+
recordSelectorFieldLabel :: Id -> FieldLabel
-recordSelectorFieldLabel id = case varDetails id of
+recordSelectorFieldLabel id = case idFlavour id of
RecordSelId lbl -> lbl
-isRecordSelector id = case varDetails id of
+isRecordSelector id = case idFlavour id of
RecordSelId lbl -> True
other -> False
-isPrimitiveId_maybe id = case varDetails id of
+isPrimitiveId_maybe id = case idFlavour id of
ConstantId (PrimOp op) -> Just op
other -> Nothing
-isDataConId_maybe id = case varDetails id of
+isDataConId_maybe id = case idFlavour id of
ConstantId (DataCon con) -> Just con
other -> Nothing
-isConstantId id = case varDetails id of
+isConstantId id = case idFlavour id of
ConstantId _ -> True
other -> False
+
+isSpecPragmaId id = case idFlavour id of
+ SpecPragmaId -> True
+ other -> False
+
+mayHaveNoBinding id = isConstantId id
+ -- mayHaveNoBinding returns True of an Id which may not have a
+ -- binding, even though it is defined in this module. Notably,
+ -- the constructors of a dictionary are in this situation.
+ --
+ -- mayHaveNoBinding returns True of some things that *do* have a local binding,
+ -- so it's only an approximation. That's ok... it's only use for assertions.
+
+-- Don't drop a binding for an exported Id,
+-- if it otherwise looks dead.
+isExportedId :: Id -> Bool
+isExportedId id = case idFlavour id of
+ VanillaId -> False
+ other -> True -- All the others are no-discard
+
+-- Say if an Id was exported by the user
+-- Implies isExportedId (see mkId above)
+isUserExportedId :: Id -> Bool
+isUserExportedId id = isUserExportedName (idName id)
\end{code}
+omitIfaceSigForId tells whether an Id's info is implied by other declarations,
+so we don't need to put its signature in an interface file, even if it's mentioned
+in some other interface unfolding.
+
+\begin{code}
+omitIfaceSigForId :: Id -> Bool
+omitIfaceSigForId id
+ | isWiredInName (idName id)
+ = True
+
+ | otherwise
+ = case idFlavour id of
+ RecordSelId _ -> True -- Includes dictionary selectors
+ ConstantId _ -> True
+ -- ConstantIds are implied by their type or class decl;
+ -- remember that all type and class decls appear in the interface file.
+ -- The dfun id must *not* be omitted, because it carries version info for
+ -- the instance decl
+
+ other -> False -- Don't omit!
+
+-- Certain names must be exported with their original occ names, because
+-- these names are bound by either a class declaration or a data declaration
+-- or an explicit user export.
+exportWithOrigOccName :: Id -> Bool
+exportWithOrigOccName id = omitIfaceSigForId id || isUserExportedId id
+\end{code}
+
+
+
%************************************************************************
%* *
\subsection{IdInfo stuff}
\begin{code}
---------------------------------
-- ARITY
-getIdArity :: GenId flexi -> ArityInfo
+getIdArity :: Id -> ArityInfo
getIdArity id = arityInfo (idInfo id)
-setIdArity :: GenId flexi -> ArityInfo -> GenId flexi
-setIdArity id arity = modifyIdInfo id (arity `setArityInfo`)
+setIdArity :: Id -> ArityInfo -> Id
+setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
---------------------------------
-- STRICTNESS
-getIdStrictness :: GenId flexi -> StrictnessInfo
+getIdStrictness :: Id -> StrictnessInfo
getIdStrictness id = strictnessInfo (idInfo id)
-setIdStrictness :: GenId flexi -> StrictnessInfo -> GenId flexi
-setIdStrictness id strict_info = modifyIdInfo id (strict_info `setStrictnessInfo`)
+setIdStrictness :: Id -> StrictnessInfo -> Id
+setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
+
+-- isBottomingId returns true if an application to n args would diverge
+isBottomingId :: Id -> Bool
+isBottomingId id = isBottomingStrictness (strictnessInfo (idInfo id))
+
+idAppIsBottom :: Id -> Int -> Bool
+idAppIsBottom id n = appIsBottom (strictnessInfo (idInfo id)) n
-isBottomingId :: GenId flexi -> Bool
-isBottomingId id = bottomIsGuaranteed (strictnessInfo (idInfo id))
+ ---------------------------------
+ -- WORKER ID
+getIdWorkerInfo :: Id -> WorkerInfo
+getIdWorkerInfo id = workerInfo (idInfo id)
+
+setIdWorkerInfo :: Id -> WorkerInfo -> Id
+setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
---------------------------------
-- UNFOLDING
-getIdUnfolding :: GenId flexi -> Unfolding
+getIdUnfolding :: Id -> Unfolding
getIdUnfolding id = unfoldingInfo (idInfo id)
-setIdUnfolding :: GenId flexi -> Unfolding -> GenId flexi
-setIdUnfolding id unfolding = modifyIdInfo id (unfolding `setUnfoldingInfo`)
+setIdUnfolding :: Id -> Unfolding -> Id
+setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
---------------------------------
-- DEMAND
-getIdDemandInfo :: GenId flexi -> Demand
+getIdDemandInfo :: Id -> Demand
getIdDemandInfo id = demandInfo (idInfo id)
-setIdDemandInfo :: GenId flexi -> Demand -> GenId flexi
-setIdDemandInfo id demand_info = modifyIdInfo id (demand_info `setDemandInfo`)
+setIdDemandInfo :: Id -> Demand -> Id
+setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
---------------------------------
-- UPDATE INFO
-getIdUpdateInfo :: GenId flexi -> UpdateInfo
+getIdUpdateInfo :: Id -> UpdateInfo
getIdUpdateInfo id = updateInfo (idInfo id)
-setIdUpdateInfo :: GenId flexi -> UpdateInfo -> GenId flexi
-setIdUpdateInfo id upd_info = modifyIdInfo id (upd_info `setUpdateInfo`)
+setIdUpdateInfo :: Id -> UpdateInfo -> Id
+setIdUpdateInfo id upd_info = modifyIdInfo (`setUpdateInfo` upd_info) id
---------------------------------
-- SPECIALISATION
-getIdSpecialisation :: GenId flexi -> IdSpecEnv
+getIdSpecialisation :: Id -> CoreRules
getIdSpecialisation id = specInfo (idInfo id)
-setIdSpecialisation :: GenId flexi -> IdSpecEnv -> GenId flexi
-setIdSpecialisation id spec_info = modifyIdInfo id (spec_info `setSpecInfo`)
+setIdSpecialisation :: Id -> CoreRules -> Id
+setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
---------------------------------
-- CAF INFO
-getIdCafInfo :: GenId flexi -> CafInfo
+getIdCafInfo :: Id -> CafInfo
getIdCafInfo id = cafInfo (idInfo id)
-setIdCafInfo :: GenId flexi -> CafInfo -> GenId flexi
-setIdCafInfo id caf_info = modifyIdInfo id (caf_info `setCafInfo`)
+setIdCafInfo :: Id -> CafInfo -> Id
+setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
+
+ ---------------------------------
+ -- CPR INFO
+getIdCprInfo :: Id -> CprInfo
+getIdCprInfo id = cprInfo (idInfo id)
+
+setIdCprInfo :: Id -> CprInfo -> Id
+setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
+
+ ---------------------------------
+ -- Occcurrence INFO
+getIdOccInfo :: Id -> OccInfo
+getIdOccInfo id = occInfo (idInfo id)
+
+setIdOccInfo :: Id -> OccInfo -> Id
+setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
\end{code}
OK not to if optimisation is switched off.
\begin{code}
-getInlinePragma :: GenId flexi -> InlinePragInfo
+getInlinePragma :: Id -> InlinePragInfo
getInlinePragma id = inlinePragInfo (idInfo id)
-setInlinePragma :: GenId flexi -> InlinePragInfo -> GenId flexi
-setInlinePragma id prag = modifyIdInfo id (setInlinePragInfo prag)
+setInlinePragma :: Id -> InlinePragInfo -> Id
+setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
-modifyInlinePragma :: GenId flexi -> (InlinePragInfo -> InlinePragInfo) -> GenId flexi
-modifyInlinePragma id fn = modifyIdInfo id (\info -> setInlinePragInfo (fn (inlinePragInfo info)) info)
+modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
+modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
+\end{code}
-idWantsToBeINLINEd :: GenId flexi -> Bool
-idWantsToBeINLINEd id = case getInlinePragma id of
- IWantToBeINLINEd -> True
- IMustBeINLINEd -> True
- other -> False
-idMustNotBeINLINEd id = case getInlinePragma id of
- IMustNotBeINLINEd -> True
- IAmASpecPragmaId -> True
- IAmALoopBreaker -> True
- other -> False
+ ---------------------------------
+ -- ONE-SHOT LAMBDAS
+\begin{code}
+isOneShotLambda :: Id -> Bool
+isOneShotLambda id = case lbvarInfo (idInfo id) of
+ IsOneShotLambda -> True
+ NoLBVarInfo -> case splitTyConApp_maybe (idType id) of
+ Just (tycon,_) -> tycon == statePrimTyCon
+ other -> False
+ -- The last clause is a gross hack. It claims that
+ -- every function over realWorldStatePrimTy is a one-shot
+ -- function. This is pretty true in practice, and makes a big
+ -- difference. For example, consider
+ -- a `thenST` \ r -> ...E...
+ -- The early full laziness pass, if it doesn't know that r is one-shot
+ -- will pull out E (let's say it doesn't mention r) to give
+ -- let lvl = E in a `thenST` \ r -> ...lvl...
+ -- When `thenST` gets inlined, we end up with
+ -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
+ -- and we don't re-inline E.
+ --
+ -- It would be better to spot that r was one-shot to start with, but
+ -- I don't want to rely on that.
+ --
+ -- Another good example is in fill_in in PrelPack.lhs. We should be able to
+ -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
+
+setOneShotLambda :: Id -> Id
+setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
+
+clearOneShotLambda :: Id -> Id
+clearOneShotLambda id
+ | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
+ | otherwise = id
+
+-- But watch out: this may change the type of something else
+-- f = \x -> e
+-- If we change the one-shot-ness of x, f's type changes
+\end{code}
-idMustBeINLINEd id = case getInlinePragma id of
- IMustBeINLINEd -> True
- other -> False
+\begin{code}
+zapFragileIdInfo :: Id -> Id
+zapFragileIdInfo id = maybeModifyIdInfo zapFragileInfo id
-isSpecPragmaId id = case getInlinePragma id of
- IAmASpecPragmaId -> True
- other -> False
+zapLamIdInfo :: Id -> Id
+zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
\end{code}
+
projects / ghc-hetmet.git / blobdiff