X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FVar.lhs;h=3c3ff7f44055e84f020fac1ca3d93404760f3152;hp=4b58a328c94003e52f08adad3e6ca27568b14a52;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=f8c52d7fde2d7408b4f734251c373f8d3e2c558e diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index 4b58a32..3c3ff7f 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -5,60 +5,109 @@ \section{@Vars@: Variables} \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details +-- | +-- #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, varType, - setVarName, setVarUnique, - - -- TyVars - TyVar, mkTyVar, mkTcTyVar, mkWildCoVar, - tyVarName, tyVarKind, - setTyVarName, setTyVarUnique, setTyVarKind, - tcTyVarDetails, - - -- CoVars - CoVar, coVarName, setCoVarUnique, setCoVarName, mkCoVar, isCoVar, - - -- Ids - Id, DictId, - idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo, - setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, + -- * The main data type and synonyms + Var, TyVar, CoVar, TyCoVar, Id, DictId, DFunId, EvVar, EvId, IpId, + + -- ** Taking 'Var's apart + varName, varUnique, varType, + + -- ** Modifying 'Var's + setVarName, setVarUnique, setVarType, + + -- ** Constructing, taking apart, modifying 'Id's + mkGlobalVar, mkLocalVar, mkExportedLocalVar, mkCoVar, + idInfo, idDetails, + lazySetIdInfo, setIdDetails, globaliseId, setIdExported, setIdNotExported, - globalIdDetails, globaliseId, + -- ** Predicates + isId, isTyVar, isTcTyVar, + isLocalVar, isLocalId, + isGlobalId, isExportedId, + mustHaveLocalBinding, + + -- ** Constructing 'TyVar's + mkTyVar, mkTcTyVar, - mkLocalId, mkExportedLocalId, mkGlobalId, + -- ** Taking 'TyVar's apart + tyVarName, tyVarKind, tcTyVarDetails, setTcTyVarDetails, + + -- ** Modifying 'TyVar's + setTyVarName, setTyVarUnique, setTyVarKind - isTyVar, isTcTyVar, isId, isLocalVar, isLocalId, - isGlobalId, isExportedId, - mustHaveLocalBinding ) where #include "HsVersions.h" +#include "Typeable.h" import {-# SOURCE #-} TypeRep( Type, Kind ) import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails ) -import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, - IdInfo, seqIdInfo ) -import {-# SOURCE #-} TypeRep( isCoercionKind ) +import {-# SOURCE #-} IdInfo( IdDetails, IdInfo, coVarDetails, vanillaIdInfo, pprIdDetails ) import Name hiding (varName) import Unique +import Util import FastTypes import FastString -import Outputable +import Outputable + +import Data.Data \end{code} %************************************************************************ %* * + Synonyms +%* * +%************************************************************************ +-- These synonyms are here and not in Id because otherwise we need a very +-- large number of SOURCE imports of Id.hs :-( + +\begin{code} +type EvVar = Var -- An evidence variable: dictionary or equality constraint + -- Could be an DictId or a CoVar + +type Id = Var -- A term-level identifier +type DFunId = Id -- A dictionary function +type EvId = Id -- Term-level evidence: DictId or IpId +type DictId = EvId -- A dictionary variable +type IpId = EvId -- A term-level implicit parameter + +type TyVar = Var +type CoVar = Id -- A coercion variable is simply an Id + -- variable of kind @ty1 ~ ty2@. Hence its + -- 'varType' is always @PredTy (EqPred t1 t2)@ +type TyCoVar = TyVar -- Something that is a type OR coercion variable. +\end{code} + +%************************************************************************ +%* * \subsection{The main data type declarations} %* * %************************************************************************ @@ -70,14 +119,15 @@ 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 - varType :: Kind, - isCoercionVar :: Bool + varType :: Kind -- ^ The type or kind of the 'Var' in question } | TcTyVar { -- Used only during type inference @@ -86,29 +136,24 @@ data Var varName :: !Name, realUnique :: FastInt, varType :: Kind, - tcTyVarDetails :: TcTyVarDetails } - - | GlobalId { -- Used for imported Ids, dict selectors etc - -- See Note [GlobalId/LocalId] below - varName :: !Name, -- Always an External or WiredIn Name - realUnique :: FastInt, - varType :: Type, - idInfo_ :: IdInfo, - gblDetails :: GlobalIdDetails } + tc_tv_details :: TcTyVarDetails } - | LocalId { -- Used for locally-defined Ids - -- See Note [GlobalId/LocalId] below + | Id { varName :: !Name, realUnique :: FastInt, 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. + idScope :: IdScope, + id_details :: IdDetails, -- Stable, doesn't change + id_info :: IdInfo } -- Unstable, updated by simplifier + deriving Typeable + +data IdScope -- See Note [GlobalId/LocalId] + = GlobalId + | LocalId ExportFlag + +data ExportFlag + = NotExported -- ^ Not exported: may be discarded as dead code. + | Exported -- ^ Exported: kept alive \end{code} Note [GlobalId/LocalId] @@ -127,17 +172,20 @@ A LocalId is * 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") - TcTyVar {tcTyVarDetails = details} -> pprTcTyVarDetails details + ppr var = ppr (varName var) <+> ifPprDebug (brackets (ppr_debug var)) + +ppr_debug :: Var -> SDoc +ppr_debug (TyVar {}) = ptext (sLit "tv") +ppr_debug (TcTyVar {tc_tv_details = d}) = pprTcTyVarDetails d +ppr_debug (Id { idScope = s, id_details = d }) = ppr_id_scope s <> pprIdDetails d + +ppr_id_scope :: IdScope -> SDoc +ppr_id_scope GlobalId = ptext (sLit "gid") +ppr_id_scope (LocalId Exported) = ptext (sLit "lidx") +ppr_id_scope (LocalId NotExported) = ptext (sLit "lid") instance Show Var where showsPrec p var = showsPrecSDoc p (ppr var) @@ -157,6 +205,12 @@ instance Ord Var where a >= b = realUnique a >=# realUnique b a > b = realUnique a ># realUnique b a `compare` b = varUnique a `compare` varUnique b + +instance Data Var where + -- don't traverse? + toConstr _ = abstractConstr "Var" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNoRepType "Var" \end{code} @@ -166,13 +220,16 @@ 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 } \end{code} @@ -183,12 +240,16 @@ 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 @@ -197,210 +258,140 @@ setTyVarKind tv k = tv {varType = k} \begin{code} mkTyVar :: Name -> Kind -> TyVar -mkTyVar name kind = ASSERT( not (isCoercionKind kind ) ) - TyVar { varName = name - , realUnique = getKey# (nameUnique name) +mkTyVar name kind = TyVar { varName = name + , realUnique = getKeyFastInt (nameUnique name) , varType = kind - , isCoercionVar = False } mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar mkTcTyVar name kind details - = -- TOM: no longer valid assertion? - -- ASSERT( not (isCoercionKind kind) ) + = -- NB: 'kind' may be a coercion kind; cf, 'TcMType.newMetaCoVar' TcTyVar { varName = name, - realUnique = getKey# (nameUnique name), + realUnique = getKeyFastInt (nameUnique name), varType = kind, - tcTyVarDetails = details + tc_tv_details = details } -\end{code} -%************************************************************************ -%* * -\subsection{Coercion variables} -%* * -%************************************************************************ - -\begin{code} -type CoVar = Var -- A coercion variable is simply a type - -- variable of kind (ty1 :=: ty2) -coVarName = varName - -setCoVarUnique = setVarUnique -setCoVarName = setVarName +tcTyVarDetails :: TyVar -> TcTyVarDetails +tcTyVarDetails (TcTyVar { tc_tv_details = details }) = details +tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var) -mkCoVar :: Name -> Kind -> CoVar -mkCoVar name kind = ASSERT( isCoercionKind kind ) - TyVar { varName = name - , realUnique = getKey# (nameUnique name) - , varType = kind - , isCoercionVar = True - } - -mkWildCoVar :: Kind -> TyVar --- 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 +setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar +setTcTyVarDetails tv details = tv { tc_tv_details = details } \end{code} %************************************************************************ %* * -\subsection{Id Construction} +\subsection{Ids} %* * %************************************************************************ -Most Id-related functions are in Id.lhs and MkId.lhs - \begin{code} -type Id = Var -type DictId = Id -\end{code} - -\begin{code} -idName = varName -idUnique = varUnique -idType = varType - -setIdUnique :: Id -> Unique -> Id -setIdUnique = setVarUnique - -setIdName :: Id -> Name -> Id -setIdName = setVarName - -setIdType :: Id -> Type -> Id -setIdType id ty = id {varType = ty} +idInfo :: Id -> IdInfo +idInfo (Id { id_info = info }) = info +idInfo other = pprPanic "idInfo" (ppr other) + +idDetails :: Id -> IdDetails +idDetails (Id { id_details = details }) = details +idDetails other = pprPanic "idDetails" (ppr other) + +-- The next three have a 'Var' suffix even though they always build +-- Ids, becuase Id.lhs uses 'mkGlobalId' etc with different types +mkGlobalVar :: IdDetails -> Name -> Type -> IdInfo -> Id +mkGlobalVar details name ty info + = mk_id name ty GlobalId details info + +mkLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id +mkLocalVar details name ty info + = mk_id name ty (LocalId NotExported) details info + +mkCoVar :: Name -> Type -> CoVar +-- Coercion variables have no IdInfo +mkCoVar name ty = mk_id name ty (LocalId NotExported) coVarDetails vanillaIdInfo + +-- | Exported 'Var's will not be removed as dead code +mkExportedLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id +mkExportedLocalVar details name ty info + = mk_id name ty (LocalId Exported) details info + +mk_id :: Name -> Type -> IdScope -> IdDetails -> IdInfo -> Id +mk_id name ty scope details info + = Id { varName = name, + realUnique = getKeyFastInt (nameUnique name), + varType = ty, + idScope = scope, + id_details = details, + id_info = info } + +------------------- +lazySetIdInfo :: Id -> IdInfo -> Var +lazySetIdInfo id info = id { id_info = info } + +setIdDetails :: Id -> IdDetails -> Id +setIdDetails id details = id { id_details = details } + +globaliseId :: Id -> Id +-- ^ If it's a local, make it global +globaliseId id = id { idScope = GlobalId } 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 +-- ^ 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 +setIdExported id@(Id { idScope = LocalId {} }) = id { idScope = LocalId Exported } +setIdExported id@(Id { idScope = GlobalId }) = id +setIdExported tv = pprPanic "setIdExported" (ppr tv) setIdNotExported :: Id -> Id --- We can only do this to LocalIds -setIdNotExported id = ASSERT( isLocalId id ) id { lclDetails = NotExported } - -globaliseId :: GlobalIdDetails -> Id -> Id --- If it's a local, make it global -globaliseId details id = GlobalId { varName = varName id, - realUnique = realUnique id, - varType = varType id, - idInfo_ = idInfo id, - gblDetails = details } - -idInfo :: Id -> IdInfo -idInfo (GlobalId {idInfo_ = info}) = info -idInfo (LocalId {idInfo_ = info}) = info -idInfo other_var = pprPanic "idInfo" (ppr other_var) - -lazySetIdInfo :: Id -> IdInfo -> Id -lazySetIdInfo id info = id {idInfo_ = info} - -setIdInfo :: Id -> IdInfo -> Id -setIdInfo id info = seqIdInfo info `seq` id {idInfo_ = info} - -- Try to avoid spack leaks by seq'ing - -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 :: Maybe IdInfo -> Id -> Id -maybeModifyIdInfo (Just new_info) id = id {idInfo_ = new_info} -maybeModifyIdInfo Nothing id = id +-- ^ We can only do this to LocalIds +setIdNotExported id = ASSERT( isLocalId id ) + id { idScope = LocalId NotExported } \end{code} %************************************************************************ %* * -\subsection{Predicates over variables +\subsection{Predicates over variables} %* * %************************************************************************ \begin{code} -mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id -mkGlobalId details name ty info - = GlobalId { varName = name, - realUnique = getKey# (nameUnique name), -- Cache the unique - varType = ty, - gblDetails = details, - idInfo_ = info } - -mk_local_id :: Name -> Type -> LocalIdDetails -> IdInfo -> Id -mk_local_id name ty details info - = LocalId { varName = name, - realUnique = getKey# (nameUnique name), -- Cache the unique - varType = ty, - lclDetails = details, - idInfo_ = info } - -mkLocalId :: Name -> Type -> IdInfo -> Id -mkLocalId name ty info = mk_local_id name ty NotExported info - -mkExportedLocalId :: Name -> Type -> IdInfo -> Id -mkExportedLocalId name ty info = mk_local_id 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 -- True of both type variables only isTyVar (TyVar {}) = True isTyVar (TcTyVar {}) = True -isTyVar other = False +isTyVar _ = False +isTcTyVar :: Var -> Bool isTcTyVar (TcTyVar {}) = True -isTcTyVar other = False - -isId (LocalId {}) = True -isId (GlobalId {}) = True -isId other = False +isTcTyVar _ = False -isLocalId (LocalId {}) = True -isLocalId other = False +isId :: Var -> Bool +isId (Id {}) = True +isId _ = False -isCoVar (v@(TyVar {})) = isCoercionVar v -isCoVar other = False +isLocalId :: Var -> Bool +isLocalId (Id { idScope = LocalId _ }) = True +isLocalId _ = 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 (GlobalId {}) = False -isLocalVar other = True +isLocalVar :: Var -> Bool +isLocalVar v = not (isGlobalId v) --- mustHaveLocalBinding returns True of Ids and TyVars +isGlobalId :: Var -> Bool +isGlobalId (Id { idScope = GlobalId }) = True +isGlobalId _ = False + +-- | '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 - --- isExportedId means "don't throw this away" -isExportedId (GlobalId {}) = True -isExportedId (LocalId {lclDetails = details}) - = case details of - Exported -> True - other -> False -isExportedId other = False +-- | 'isExportedIdVar' means \"don't throw this away\" +isExportedId :: Var -> Bool +isExportedId (Id { idScope = GlobalId }) = True +isExportedId (Id { idScope = LocalId Exported}) = True +isExportedId _ = False \end{code} - -\begin{code} -globalIdDetails :: Var -> GlobalIdDetails --- Works OK on local Ids too, returning notGlobalId -globalIdDetails (GlobalId {gblDetails = details}) = details -globalIdDetails other = notGlobalId -\end{code} -