X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FVar.lhs;h=eec6c803b461be484597a7b8ead612570893820c;hb=a187566d4ce21b657fd5268373d0e3743d29d886;hp=60fdf3831c3c5de74a15612b80089db9189cf292;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index 60fdf38..eec6c80 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -1,47 +1,90 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section{@Vars@: Variables} \begin{code} +-- | +-- #name_types# +-- GHC uses several kinds of name internally: +-- +-- * 'OccName.OccName': see "OccName#name_types" +-- +-- * 'RdrName.RdrName': see "RdrName#name_types" +-- +-- * 'Name.Name': see "Name#name_types" +-- +-- * 'Id.Id': see "Id#name_types" +-- +-- * 'Var.Var' is a synonym for the 'Id.Id' type but it may additionally potentially contain type variables, +-- which have a 'TypeRep.Kind' rather than a 'TypeRep.Type' and only contain some extra details during typechecking. +-- These 'Var.Var' names may either be global or local, see "Var#globalvslocal" +-- +-- #globalvslocal# +-- Global 'Id's and 'Var's are those that are imported or correspond to a data constructor, primitive operation, or record selectors. +-- Local 'Id's and 'Var's are those bound within an expression (e.g. by a lambda) or at the top level of the module being compiled. module Var ( - Var, - varName, varUnique, - setVarName, setVarUnique, + -- * The main data type + Var, - -- TyVars - TyVar, mkTyVar, mkTcTyVar, - tyVarName, tyVarKind, - setTyVarName, setTyVarUnique, - tcTyVarDetails, + -- ** Constructing 'Var's + mkLocalIdVar, mkExportedLocalIdVar, mkGlobalIdVar, - -- Ids - Id, DictId, - idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo, - setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, - setIdExported, setIdNotExported, + -- ** Taking 'Var's apart + varName, varUnique, varType, varIdInfo, globalIdVarDetails, - globalIdDetails, globaliseId, + -- ** Modifying 'Var's + setVarName, setVarUnique, setVarType, + setIdVarExported, setIdVarNotExported, + globaliseIdVar, lazySetVarIdInfo, - mkLocalId, mkExportedLocalId, mkGlobalId, + -- ** Predicates + isCoVar, isIdVar, isTyVar, isTcTyVar, + isLocalVar, isLocalIdVar, + isGlobalIdVar, isExportedIdVar, + mustHaveLocalBinding, - isTyVar, isTcTyVar, isId, isLocalVar, isLocalId, - isGlobalId, isExportedId, - mustHaveLocalBinding + -- * Type variable data type + TyVar, + + -- ** Constructing 'TyVar's + mkTyVar, mkTcTyVar, mkWildCoVar, + + -- ** Taking 'TyVar's apart + tyVarName, tyVarKind, tcTyVarDetails, + + -- ** Modifying 'TyVar's + setTyVarName, setTyVarUnique, setTyVarKind, + + -- * Coercion variable data type + CoVar, + + -- ** Constructing 'CoVar's + mkCoVar, + + -- ** Taking 'CoVar's apart + coVarName, + + -- ** Modifying 'CoVar's + setCoVarUnique, setCoVarName, + + -- * 'Var' type synonyms + Id, DictId ) where #include "HsVersions.h" -import {-# SOURCE #-} TypeRep( Type ) +import {-# SOURCE #-} TypeRep( Type, Kind ) import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails ) -import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, IdInfo, seqIdInfo ) +import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, + IdInfo ) +import {-# SOURCE #-} TypeRep( isCoercionKind ) -import Name ( Name, NamedThing(..), - setNameUnique, nameUnique - ) -import Kind ( Kind ) -import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey# ) +import Name hiding (varName) +import Unique import FastTypes +import FastString import Outputable \end{code} @@ -59,64 +102,72 @@ strictness). The essential info about different kinds of @Vars@ is in its @VarDetails@. \begin{code} +-- | Essentially a typed 'Name', that may also contain some additional information +-- about the 'Var' and it's use sites. data Var = TyVar { varName :: !Name, realUnique :: FastInt, -- Key for fast comparison -- Identical to the Unique in the name, -- cached here for speed - tyVarKind :: Kind } + varType :: Kind, -- ^ The type or kind of the 'Var' in question + isCoercionVar :: Bool + } | TcTyVar { -- Used only during type inference + -- Used for kind variables during + -- inference, as well varName :: !Name, realUnique :: FastInt, - tyVarKind :: Kind, + varType :: Kind, tcTyVarDetails :: TcTyVarDetails } | GlobalId { -- Used for imported Ids, dict selectors etc - varName :: !Name, + -- See Note [GlobalId/LocalId] below + varName :: !Name, -- Always an External or WiredIn Name realUnique :: FastInt, - idType :: Type, - idInfo :: IdInfo, + varType :: Type, + idInfo_ :: IdInfo, gblDetails :: GlobalIdDetails } - | LocalId { -- Used for locally-defined Ids (see NOTE below) + | LocalId { -- Used for locally-defined Ids + -- See Note [GlobalId/LocalId] below varName :: !Name, realUnique :: FastInt, - idType :: Type, - idInfo :: IdInfo, + varType :: Type, + idInfo_ :: IdInfo, lclDetails :: LocalIdDetails } data LocalIdDetails - = NotExported -- Not exported - | Exported -- Exported - -- Exported Ids are kept alive; - -- NotExported things may be discarded as dead code. + = NotExported -- ^ Not exported: may be discarded as dead code. + | Exported -- ^ Exported: kept alive \end{code} -LocalId and GlobalId -~~~~~~~~~~~~~~~~~~~~ +Note [GlobalId/LocalId] +~~~~~~~~~~~~~~~~~~~~~~~ A GlobalId is * always a constant (top-level) * imported, or data constructor, or primop, or record selector * has a Unique that is globally unique across the whole GHC invocation (a single invocation may compile multiple modules) + * never treated as a candidate by the free-variable finder; + it's a constant! A LocalId is * bound within an expression (lambda, case, local let(rec)) * or defined at top level in the module being compiled + * always treated as a candidate by the free-variable finder After CoreTidy, top-level LocalIds are turned into GlobalIds - \begin{code} instance Outputable Var where ppr var = ppr (varName var) <+> ifPprDebug (brackets extra) where extra = case var of - GlobalId {} -> ptext SLIT("gid") - LocalId {} -> ptext SLIT("lid") - TyVar {} -> ptext SLIT("tv") + GlobalId {} -> ptext (sLit "gid") + LocalId {} -> ptext (sLit "lid") + TyVar {} -> ptext (sLit "tv") TcTyVar {tcTyVarDetails = details} -> pprTcTyVarDetails details instance Show Var where @@ -146,13 +197,43 @@ varUnique var = mkUniqueGrimily (iBox (realUnique var)) setVarUnique :: Var -> Unique -> Var setVarUnique var uniq - = var { realUnique = getKey# uniq, + = var { realUnique = getKeyFastInt uniq, varName = setNameUnique (varName var) uniq } setVarName :: Var -> Name -> Var setVarName var new_name - = var { realUnique = getKey# (getUnique new_name), + = var { realUnique = getKeyFastInt (getUnique new_name), varName = new_name } + +setVarType :: Id -> Type -> Id +setVarType id ty = id { varType = ty } + +setIdVarExported :: Var -> Var +-- ^ Exports the given local 'Id'. Can also be called on global 'Id's, such as data constructors +-- and class operations, which are born as global 'Id's and automatically exported +setIdVarExported id@(LocalId {}) = id { lclDetails = Exported } +setIdVarExported other_id = ASSERT( isIdVar other_id ) other_id + +setIdVarNotExported :: Id -> Id +-- ^ We can only do this to LocalIds +setIdVarNotExported id = ASSERT( isLocalIdVar id ) id { lclDetails = NotExported } + +globaliseIdVar :: GlobalIdDetails -> Var -> Var +-- ^ If it's a local, make it global +globaliseIdVar details id = GlobalId { varName = varName id, + realUnique = realUnique id, + varType = varType id, + idInfo_ = varIdInfo id, + gblDetails = details } + +-- | Extract 'Id' information from the 'Var' if it represents a global or local 'Id', otherwise panic +varIdInfo :: Var -> IdInfo +varIdInfo (GlobalId {idInfo_ = info}) = info +varIdInfo (LocalId {idInfo_ = info}) = info +varIdInfo other_var = pprPanic "idInfo" (ppr other_var) + +lazySetVarIdInfo :: Var -> IdInfo -> Var +lazySetVarIdInfo id info = id { idInfo_ = info } \end{code} @@ -165,173 +246,186 @@ setVarName var new_name \begin{code} type TyVar = Var +tyVarName :: TyVar -> Name tyVarName = varName +tyVarKind :: TyVar -> Kind +tyVarKind = varType + +setTyVarUnique :: TyVar -> Unique -> TyVar setTyVarUnique = setVarUnique + +setTyVarName :: TyVar -> Name -> TyVar setTyVarName = setVarName + +setTyVarKind :: TyVar -> Kind -> TyVar +setTyVarKind tv k = tv {varType = k} \end{code} \begin{code} mkTyVar :: Name -> Kind -> TyVar -mkTyVar name kind = TyVar { varName = name - , realUnique = getKey# (nameUnique name) - , tyVarKind = kind +mkTyVar name kind = ASSERT( not (isCoercionKind kind ) ) + TyVar { varName = name + , realUnique = getKeyFastInt (nameUnique name) + , varType = kind + , isCoercionVar = False } mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar mkTcTyVar name kind details - = TcTyVar { varName = name, - realUnique = getKey# (nameUnique name), - tyVarKind = kind, + = -- NB: 'kind' may be a coercion kind; cf, 'TcMType.newMetaCoVar' + TcTyVar { varName = name, + realUnique = getKeyFastInt (nameUnique name), + varType = kind, tcTyVarDetails = details } \end{code} - %************************************************************************ %* * -\subsection{Id Construction} +\subsection{Coercion variables} %* * %************************************************************************ -Most Id-related functions are in Id.lhs and MkId.lhs - \begin{code} -type Id = Var -type DictId = Id -\end{code} +type CoVar = Var -- A coercion variable is simply a type + -- variable of kind @ty1 :=: ty2@. Hence its + -- 'varType' is always @PredTy (EqPred t1 t2)@ -\begin{code} -idName = varName -idUnique = varUnique +coVarName :: CoVar -> Name +coVarName = varName -setIdUnique :: Id -> Unique -> Id -setIdUnique = setVarUnique +setCoVarUnique :: CoVar -> Unique -> CoVar +setCoVarUnique = setVarUnique -setIdName :: Id -> Name -> Id -setIdName = setVarName +setCoVarName :: CoVar -> Name -> CoVar +setCoVarName = setVarName -setIdType :: Id -> Type -> Id -setIdType id ty = id {idType = ty} +mkCoVar :: Name -> Kind -> CoVar +mkCoVar name kind = ASSERT( isCoercionKind kind ) + TyVar { varName = name + , realUnique = getKeyFastInt (nameUnique name) + , varType = kind + , isCoercionVar = True + } -setIdExported :: Id -> Id --- Can be called on GlobalIds, such as data cons and class ops, --- which are "born" as GlobalIds and automatically exported -setIdExported id@(LocalId {}) = id { lclDetails = Exported } -setIdExported other_id = ASSERT( isId other_id ) other_id +mkWildCoVar :: Kind -> TyVar +-- ^ Create a type variable that is never referred to, so its unique doesn't matter +mkWildCoVar kind + = ASSERT( isCoercionKind kind ) + TyVar { varName = mkSysTvName wild_uniq (fsLit "co_wild"), + realUnique = _ILIT(1), + varType = kind, + isCoercionVar = True } + where + wild_uniq = mkBuiltinUnique 1 -setIdNotExported :: Id -> Id --- We can only do this to LocalIds -setIdNotExported id = ASSERT( isLocalId id ) id { lclDetails = NotExported } +\end{code} -globaliseId :: GlobalIdDetails -> Id -> Id --- If it's a local, make it global -globaliseId details id = GlobalId { varName = varName id, - realUnique = realUnique id, - idType = idType id, - idInfo = idInfo id, - gblDetails = details } +%************************************************************************ +%* * +\subsection{Ids} +%* * +%************************************************************************ -lazySetIdInfo :: Id -> IdInfo -> Id -lazySetIdInfo id info = id {idInfo = info} +\begin{code} -setIdInfo :: Id -> IdInfo -> Id -setIdInfo id info = seqIdInfo info `seq` id {idInfo = info} - -- Try to avoid spack leaks by seq'ing +-- These synonyms are here and not in Id because otherwise we need a very +-- large number of SOURCE imports of Id.hs :-( +type Id = Var +type DictId = Var -modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id -modifyIdInfo fn id - = seqIdInfo new_info `seq` id {idInfo = new_info} - where - new_info = fn (idInfo id) - --- maybeModifyIdInfo tries to avoid unnecesary thrashing -maybeModifyIdInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id -maybeModifyIdInfo fn id - = case fn (idInfo id) of - Nothing -> id - Just new_info -> id {idInfo = new_info} \end{code} %************************************************************************ %* * -\subsection{Predicates over variables +\subsection{Predicates over variables} %* * %************************************************************************ \begin{code} -mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id -mkGlobalId details name ty info +-- | For an explanation of global vs. local 'Var's, see "Var#globalvslocal" +mkGlobalIdVar :: GlobalIdDetails -> Name -> Type -> IdInfo -> Var +mkGlobalIdVar details name ty info = GlobalId { varName = name, - realUnique = getKey# (nameUnique name), -- Cache the unique - idType = ty, + realUnique = getKeyFastInt (nameUnique name), -- Cache the unique + varType = ty, gblDetails = details, - idInfo = info } + idInfo_ = info } -mk_local_id :: Name -> Type -> LocalIdDetails -> IdInfo -> Id -mk_local_id name ty details info +mkLocalIdVar' :: Name -> Type -> LocalIdDetails -> IdInfo -> Var +mkLocalIdVar' name ty details info = LocalId { varName = name, - realUnique = getKey# (nameUnique name), -- Cache the unique - idType = ty, + realUnique = getKeyFastInt (nameUnique name), -- Cache the unique + varType = ty, lclDetails = details, - idInfo = info } + idInfo_ = info } -mkLocalId :: Name -> Type -> IdInfo -> Id -mkLocalId name ty info = mk_local_id name ty NotExported info +-- | For an explanation of global vs. local 'Var's, see "Var#globalvslocal" +mkLocalIdVar :: Name -> Type -> IdInfo -> Var +mkLocalIdVar name ty info = mkLocalIdVar' name ty NotExported info -mkExportedLocalId :: Name -> Type -> IdInfo -> Id -mkExportedLocalId name ty info = mk_local_id name ty Exported info +-- | Exported 'Var's will not be removed as dead code +mkExportedLocalIdVar :: Name -> Type -> IdInfo -> Var +mkExportedLocalIdVar name ty info = mkLocalIdVar' name ty Exported info \end{code} \begin{code} -isTyVar, isTcTyVar :: Var -> Bool -isId, isLocalVar, isLocalId :: Var -> Bool -isGlobalId, isExportedId :: Var -> Bool -mustHaveLocalBinding :: Var -> Bool - +isTyVar :: Var -> Bool isTyVar (TyVar {}) = True isTyVar (TcTyVar {}) = True -isTyVar other = False +isTyVar _ = False +isTcTyVar :: Var -> Bool isTcTyVar (TcTyVar {}) = True -isTcTyVar other = False +isTcTyVar _ = False + +isIdVar :: Var -> Bool +isIdVar (LocalId {}) = True +isIdVar (GlobalId {}) = True +isIdVar _ = False -isId (LocalId {}) = True -isId (GlobalId {}) = True -isId other = False +isLocalIdVar :: Var -> Bool +isLocalIdVar (LocalId {}) = True +isLocalIdVar _ = False -isLocalId (LocalId {}) = True -isLocalId other = False +isCoVar :: Var -> Bool +isCoVar (v@(TyVar {})) = isCoercionVar v +isCoVar (TcTyVar {varType = kind}) = isCoercionKind kind -- used during solving +isCoVar _ = False --- isLocalVar returns True for type variables as well as local Ids +-- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's -- These are the variables that we need to pay attention to when finding free -- variables, or doing dependency analysis. +isLocalVar :: Var -> Bool isLocalVar (GlobalId {}) = False -isLocalVar other = True +isLocalVar _ = True --- mustHaveLocalBinding returns True of Ids and TyVars +-- | 'mustHaveLocalBinding' returns @True@ of 'Id's and 'TyVar's -- that must have a binding in this module. The converse --- is not quite right: there are some GlobalIds that must have +-- is not quite right: there are some global 'Id's that must have -- bindings, such as record selectors. But that doesn't matter, -- because it's only used for assertions +mustHaveLocalBinding :: Var -> Bool mustHaveLocalBinding var = isLocalVar var -isGlobalId (GlobalId {}) = True -isGlobalId other = False +isGlobalIdVar :: Var -> Bool +isGlobalIdVar (GlobalId {}) = True +isGlobalIdVar _ = False --- isExportedId means "don't throw this away" -isExportedId (GlobalId {}) = True -isExportedId (LocalId {lclDetails = details}) +-- | 'isExportedIdVar' means \"don't throw this away\" +isExportedIdVar :: Var -> Bool +isExportedIdVar (GlobalId {}) = True +isExportedIdVar (LocalId {lclDetails = details}) = case details of Exported -> True - other -> False -isExportedId other = False + _ -> False +isExportedIdVar _ = False \end{code} \begin{code} -globalIdDetails :: Var -> GlobalIdDetails --- Works OK on local Ids too, returning notGlobalId -globalIdDetails (GlobalId {gblDetails = details}) = details -globalIdDetails other = notGlobalId +globalIdVarDetails :: Var -> GlobalIdDetails +-- ^ Find the global 'Id' information if the 'Var' is a global 'Id', otherwise returns 'notGlobalId' +globalIdVarDetails (GlobalId {gblDetails = details}) = details +globalIdVarDetails _ = notGlobalId \end{code} -