\begin{code}
module Id (
- Id, DictId, GenId,
+ Id, DictId,
-- Simple construction
mkVanillaId, mkImportedId, mkSysLocal, mkUserLocal,
- mkTemplateLocals, mkWildId, mkUserId,
+ mkTemplateLocals, mkTemplateLocal, mkWildId, mkUserId,
-- Taking an Id apart
- idName, idType, idUnique, idInfo,
+ idName, idType, idUnique, idInfo, idDetails,
idPrimRep, isId,
recordSelectorFieldLabel,
-- Modifying an Id
setIdName, setIdUnique, setIdType, setIdInfo,
- setIdVisibility, mkIdVisible,
-- Predicates
omitIfaceSigForId,
isRecordSelector,
isPrimitiveId_maybe, isDataConId_maybe,
isConstantId,
- isBottomingId,
+ isBottomingId, idAppIsBottom,
-- IdInfo stuff
setIdUnfolding,
import {-# SOURCE #-} CoreUnfold ( Unfolding )
-import Var ( Id, GenId, DictId, VarDetails(..),
+import Var ( Id, DictId, VarDetails(..),
isId, mkId,
- idName, idType, idUnique, idInfo, varDetails,
+ idName, idType, idUnique, idInfo, idDetails,
setIdName, setVarType, setIdUnique, setIdInfo, modifyIdInfo,
externallyVisibleId
)
import VarSet
-import Type ( GenType, Type, tyVarsOfType, typePrimRep, addFreeTyVars )
+import Type ( Type, tyVarsOfType, typePrimRep, addFreeTyVars )
import IdInfo
import Demand ( Demand )
-import Name ( Name, OccName,
+import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
- isWiredInName, setNameVisibility, mkNameVisible
+ isWiredInName
)
import Const ( Con(..) )
import PrimRep ( PrimRep )
import PrimOp ( PrimOp )
import FieldLabel ( FieldLabel(..) )
-import BasicTypes ( Module )
+import SrcLoc ( SrcLoc )
import Unique ( Unique, mkBuiltinUnique, getBuiltinUniques )
import Outputable
%************************************************************************
\begin{code}
-mkVanillaId :: Name -> (GenType flexi) -> GenId flexi
-mkVanillaId name ty = mkId name ty VanillaId noIdInfo
+mkVanillaId :: Name -> Type -> Id
+mkVanillaId name ty = mkId name (addFreeTyVars ty) VanillaId noIdInfo
mkImportedId :: Name -> Type -> IdInfo -> Id
-mkImportedId name ty info = mkId name ty VanillaId info
+mkImportedId name ty info = mkId name (addFreeTyVars ty) VanillaId info
-mkUserId :: Name -> GenType flexi -> GenId flexi
+mkUserId :: Name -> Type -> Id
mkUserId name ty = mkVanillaId name ty
-- 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 :: FAST_STRING -> 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)
= True
| otherwise
- = case varDetails id of
+ = case idDetails id of
RecordSelId _ -> True -- Includes dictionary selectors
ConstantId _ -> True
-- ConstantIds are implied by their type or class 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}
-
%************************************************************************
%* *
\subsection{Special Ids}
\begin{code}
recordSelectorFieldLabel :: Id -> FieldLabel
-recordSelectorFieldLabel id = case varDetails id of
+recordSelectorFieldLabel id = case idDetails id of
RecordSelId lbl -> lbl
-isRecordSelector id = case varDetails id of
+isRecordSelector id = case idDetails id of
RecordSelId lbl -> True
other -> False
-isPrimitiveId_maybe id = case varDetails id of
+isPrimitiveId_maybe id = case idDetails id of
ConstantId (PrimOp op) -> Just op
other -> Nothing
-isDataConId_maybe id = case varDetails id of
+isDataConId_maybe id = case idDetails id of
ConstantId (DataCon con) -> Just con
other -> Nothing
-isConstantId id = case varDetails id of
+isConstantId id = case idDetails id of
ConstantId _ -> True
other -> False
\end{code}
\begin{code}
---------------------------------
-- ARITY
-getIdArity :: GenId flexi -> ArityInfo
+getIdArity :: Id -> ArityInfo
getIdArity id = arityInfo (idInfo id)
-setIdArity :: GenId flexi -> ArityInfo -> GenId flexi
+setIdArity :: Id -> ArityInfo -> Id
setIdArity id arity = modifyIdInfo id (arity `setArityInfo`)
---------------------------------
-- STRICTNESS
-getIdStrictness :: GenId flexi -> StrictnessInfo
+getIdStrictness :: Id -> StrictnessInfo
getIdStrictness id = strictnessInfo (idInfo id)
-setIdStrictness :: GenId flexi -> StrictnessInfo -> GenId flexi
+setIdStrictness :: Id -> StrictnessInfo -> Id
setIdStrictness id strict_info = modifyIdInfo id (strict_info `setStrictnessInfo`)
-isBottomingId :: GenId flexi -> Bool
-isBottomingId id = bottomIsGuaranteed (strictnessInfo (idInfo 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
---------------------------------
-- UNFOLDING
-getIdUnfolding :: GenId flexi -> Unfolding
+getIdUnfolding :: Id -> Unfolding
getIdUnfolding id = unfoldingInfo (idInfo id)
-setIdUnfolding :: GenId flexi -> Unfolding -> GenId flexi
+setIdUnfolding :: Id -> Unfolding -> Id
setIdUnfolding id unfolding = modifyIdInfo id (unfolding `setUnfoldingInfo`)
---------------------------------
-- DEMAND
-getIdDemandInfo :: GenId flexi -> Demand
+getIdDemandInfo :: Id -> Demand
getIdDemandInfo id = demandInfo (idInfo id)
-setIdDemandInfo :: GenId flexi -> Demand -> GenId flexi
+setIdDemandInfo :: Id -> Demand -> Id
setIdDemandInfo id demand_info = modifyIdInfo id (demand_info `setDemandInfo`)
---------------------------------
-- UPDATE INFO
-getIdUpdateInfo :: GenId flexi -> UpdateInfo
+getIdUpdateInfo :: Id -> UpdateInfo
getIdUpdateInfo id = updateInfo (idInfo id)
-setIdUpdateInfo :: GenId flexi -> UpdateInfo -> GenId flexi
+setIdUpdateInfo :: Id -> UpdateInfo -> Id
setIdUpdateInfo id upd_info = modifyIdInfo id (upd_info `setUpdateInfo`)
---------------------------------
-- SPECIALISATION
-getIdSpecialisation :: GenId flexi -> IdSpecEnv
+getIdSpecialisation :: Id -> IdSpecEnv
getIdSpecialisation id = specInfo (idInfo id)
-setIdSpecialisation :: GenId flexi -> IdSpecEnv -> GenId flexi
+setIdSpecialisation :: Id -> IdSpecEnv -> Id
setIdSpecialisation id spec_info = modifyIdInfo id (spec_info `setSpecInfo`)
---------------------------------
-- CAF INFO
-getIdCafInfo :: GenId flexi -> CafInfo
+getIdCafInfo :: Id -> CafInfo
getIdCafInfo id = cafInfo (idInfo id)
-setIdCafInfo :: GenId flexi -> CafInfo -> GenId flexi
+setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo id caf_info = modifyIdInfo id (caf_info `setCafInfo`)
\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 -> InlinePragInfo -> Id
setInlinePragma id prag = modifyIdInfo id (setInlinePragInfo prag)
-modifyInlinePragma :: GenId flexi -> (InlinePragInfo -> InlinePragInfo) -> GenId flexi
+modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
modifyInlinePragma id fn = modifyIdInfo id (\info -> setInlinePragInfo (fn (inlinePragInfo info)) info)
-idWantsToBeINLINEd :: GenId flexi -> Bool
+idWantsToBeINLINEd :: Id -> Bool
idWantsToBeINLINEd id = case getInlinePragma id of
IWantToBeINLINEd -> True
IMustBeINLINEd -> True
projects / ghc-hetmet.git / blobdiff