X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FVar.lhs;h=d2c22f3b414461ab72213fc2d5a30b92df234072;hb=1f5e55804b97d2b9a77207d568d602ba88d8855d;hp=489e42ab16c46d4c75d8a71be16a46f56ed2edf4;hpb=30b5ebe424ebae69b162ac3fc547eb14d898535f;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs index 489e42a..d2c22f3 100644 --- a/ghc/compiler/basicTypes/Var.lhs +++ b/ghc/compiler/basicTypes/Var.lhs @@ -1,53 +1,56 @@ -s% +% % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section{@Vars@: Variables} \begin{code} module Var ( - Var, IdOrTyVar, VarDetails, -- Abstract + Var, VarDetails, -- Abstract varName, varUnique, varInfo, varType, setVarName, setVarUnique, setVarType, setVarOcc, - -- TyVars TyVar, tyVarName, tyVarKind, setTyVarName, setTyVarUnique, - mkTyVar, mkSysTyVar, isTyVar, isSigTyVar, - newMutTyVar, newSigTyVar, - readMutTyVar, writeMutTyVar, isMutTyVar, makeTyVarImmutable, - - -- UVars - UVar, - isUVar, - mkUVar, mkNamedUVar, + mkTyVar, mkSysTyVar, + mkMutTyVar, mutTyVarRef, makeTyVarImmutable, -- Ids Id, DictId, idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo, - setIdName, setIdUnique, setIdInfo, lazySetIdInfo, zapIdInfo, - mkIdVar, isId, externallyVisibleId + setIdName, setIdUnique, setIdInfo, lazySetIdInfo, + setIdLocalExported, zapSpecPragmaId, + + globalIdDetails, setGlobalIdDetails, + + mkLocalId, mkGlobalId, mkSpecPragmaId, + + isTyVar, isMutTyVar, mutTyVarDetails, + isId, isLocalVar, isLocalId, + isGlobalId, isExportedId, isSpecPragmaId, + mustHaveLocalBinding ) where #include "HsVersions.h" import {-# SOURCE #-} TypeRep( Type, Kind ) -import {-# SOURCE #-} IdInfo( IdInfo, seqIdInfo, vanillaIdInfo ) +import {-# SOURCE #-} TcType( TyVarDetails ) +import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, + IdInfo, seqIdInfo ) -import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey ) import Name ( Name, OccName, NamedThing(..), setNameUnique, setNameOcc, nameUnique, - mkSysLocalName, isExternallyVisibleName + mkSystemTvNameEncoded, ) -import BasicTypes ( Unused ) +import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey# ) +import FastTypes import Outputable -import IOExts ( IORef, newIORef, readIORef, writeIORef ) +import DATA_IOREF ( IORef ) \end{code} - %************************************************************************ %* * \subsection{The main data type declarations} @@ -61,12 +64,10 @@ strictness). The essential info about different kinds of @Vars@ is in its @VarDetails@. \begin{code} -type IdOrTyVar = Var - data Var = Var { - varName :: Name, - realUnique :: Int#, -- Key for fast comparison + varName :: !Name, + realUnique :: FastInt, -- Key for fast comparison -- Identical to the Unique in the name, -- cached here for speed varType :: Type, @@ -75,19 +76,46 @@ data Var } data VarDetails - = AnId + = LocalId -- Used for locally-defined Ids (see NOTE below) + LocalIdDetails + + | GlobalId -- Used for imported Ids, dict selectors etc + GlobalIdDetails + | TyVar | MutTyVar (IORef (Maybe Type)) -- Used during unification; - Bool -- True <=> this is a type signature variable, which - -- should not be unified with a non-tyvar type - | UVar -- Usage variable - --- For a long time I tried to keep mutable Vars statically type-distinct --- from immutable Vars, but I've finally given up. It's just too painful. --- After type checking there are no MutTyVars left, but there's no static check --- of that fact. + TyVarDetails + -- TODO: the IORef should be unboxed here, but we don't want to unbox + -- the Name above. + + -- For a long time I tried to keep mutable Vars statically + -- type-distinct from immutable Vars, but I've finally given + -- up. It's just too painful. After type checking there are + -- no MutTyVars left, but there's no static check of that + -- fact. + +data LocalIdDetails + = NotExported -- Not exported + | Exported -- Exported + | SpecPragma -- Not exported, but not to be discarded either + -- It's unclean that this is so deeply built in \end{code} +LocalId and GlobalId +~~~~~~~~~~~~~~~~~~~~ +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) + +A LocalId is + * bound within an expression (lambda, case, local let(rec)) + * or defined at top level in the module being compiled + +After CoreTidy, top-level LocalIds are turned into GlobalIds + + \begin{code} instance Outputable Var where ppr var = ppr (varName var) @@ -115,16 +143,16 @@ instance Ord Var where \begin{code} varUnique :: Var -> Unique -varUnique (Var {realUnique = uniq}) = mkUniqueGrimily uniq +varUnique (Var {realUnique = uniq}) = mkUniqueGrimily (iBox uniq) setVarUnique :: Var -> Unique -> Var setVarUnique var@(Var {varName = name}) uniq - = var {realUnique = getKey uniq, + = var {realUnique = getKey# uniq, varName = setNameUnique name uniq} setVarName :: Var -> Name -> Var setVarName var new_name - = var { realUnique = getKey (getUnique new_name), varName = new_name } + = var { realUnique = getKey# (getUnique new_name), varName = new_name } setVarOcc :: Var -> OccName -> Var setVarOcc var new_occ @@ -156,99 +184,39 @@ setTyVarName = setVarName \begin{code} mkTyVar :: Name -> Kind -> TyVar mkTyVar name kind = Var { varName = name - , realUnique = getKey (nameUnique name) + , realUnique = getKey# (nameUnique name) , varType = kind , varDetails = TyVar -#ifdef DEBUG - , varInfo = pprPanic "looking at IdInfo of a tyvar" (ppr name) -#endif + , varInfo = pprPanic "mkTyVar" (ppr name) } mkSysTyVar :: Unique -> Kind -> TyVar mkSysTyVar uniq kind = Var { varName = name - , realUnique = getKey uniq + , realUnique = getKey# uniq , varType = kind , varDetails = TyVar -#ifdef DEBUG - , varInfo = pprPanic "mkSysTyVar" (ppr name) -#endif + , varInfo = pprPanic "mkSysTyVar" (ppr name) } where - name = mkSysLocalName uniq SLIT("t") - -newMutTyVar :: Name -> Kind -> IO TyVar -newMutTyVar name kind = - do loc <- newIORef Nothing - return (Var { varName = name, - realUnique = getKey (nameUnique name), - varType = kind, - varDetails = MutTyVar loc False}) - -newSigTyVar :: Name -> Kind -> IO TyVar -newSigTyVar name kind = - do loc <- newIORef Nothing - return (Var { varName = name, - realUnique = getKey (nameUnique name), - varType = kind, - varDetails = MutTyVar loc True}) - -readMutTyVar :: TyVar -> IO (Maybe Type) -readMutTyVar (Var {varDetails = MutTyVar loc _}) = readIORef loc - -writeMutTyVar :: TyVar -> Maybe Type -> IO () -writeMutTyVar (Var {varDetails = MutTyVar loc _}) val = writeIORef loc val - -makeTyVarImmutable :: TyVar -> TyVar -makeTyVarImmutable tyvar = tyvar { varDetails = TyVar} - -isTyVar :: Var -> Bool -isTyVar (Var {varDetails = details}) = case details of - TyVar -> True - MutTyVar _ _ -> True - other -> False - -isMutTyVar :: Var -> Bool -isMutTyVar (Var {varDetails = MutTyVar _ _}) = True -isMutTyVar other = False + name = mkSystemTvNameEncoded uniq FSLIT("t") -isSigTyVar :: Var -> Bool -isSigTyVar (Var {varDetails = MutTyVar _ is_sig}) = is_sig -isSigTyVar other = False -\end{code} +mkMutTyVar :: Name -> Kind -> TyVarDetails -> IORef (Maybe Type) -> TyVar +mkMutTyVar name kind details ref + = Var { varName = name + , realUnique = getKey# (nameUnique name) + , varType = kind + , varDetails = MutTyVar ref details + , varInfo = pprPanic "newMutTyVar" (ppr name) + } +mutTyVarRef :: TyVar -> IORef (Maybe Type) +mutTyVarRef (Var {varDetails = MutTyVar loc _}) = loc -%************************************************************************ -%* * -\subsection{Usage variables} -%* * -%************************************************************************ - -\begin{code} -type UVar = Var -\end{code} - -\begin{code} -mkUVar :: Unique -> UVar -mkUVar unique = Var { varName = mkSysLocalName unique SLIT("u"), - realUnique = getKey unique, - varDetails = UVar } - -mkNamedUVar :: Name -> UVar -mkNamedUVar name = Var { varName = name - , realUnique = getKey (nameUnique name) - , varDetails = UVar -#ifdef DEBUG - , varType = pprPanic "looking at Type of a uvar" (ppr name) - , varInfo = pprPanic "looking at IdInfo of a uvar" (ppr name) -#endif - } -\end{code} +makeTyVarImmutable :: TyVar -> TyVar +makeTyVarImmutable tyvar = tyvar { varDetails = TyVar} -\begin{code} -isUVar :: Var -> Bool -isUVar (Var {varDetails = details}) = case details of - UVar -> True - other -> False +mutTyVarDetails :: TyVar -> TyVarDetails +mutTyVarDetails (Var {varDetails = MutTyVar _ details}) = details \end{code} @@ -277,6 +245,15 @@ setIdUnique = setVarUnique setIdName :: Id -> Name -> Id setIdName = setVarName +setIdLocalExported :: Id -> Id +setIdLocalExported id = id { varDetails = LocalId Exported } + +zapSpecPragmaId :: Id -> Id +zapSpecPragmaId id + = case varDetails id of + LocalId SpecPragma -> id { varDetails = LocalId NotExported } + other -> id + lazySetIdInfo :: Id -> IdInfo -> Id lazySetIdInfo var info = var {varInfo = info} @@ -284,9 +261,6 @@ setIdInfo :: Id -> IdInfo -> Id setIdInfo var info = seqIdInfo info `seq` var {varInfo = info} -- Try to avoid spack leaks by seq'ing -zapIdInfo :: Id -> Id -zapIdInfo var = var {varInfo = vanillaIdInfo} - modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id modifyIdInfo fn var@(Var {varInfo = info}) = seqIdInfo new_info `seq` var {varInfo = new_info} @@ -296,35 +270,98 @@ modifyIdInfo fn var@(Var {varInfo = info}) -- maybeModifyIdInfo tries to avoid unnecesary thrashing maybeModifyIdInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id maybeModifyIdInfo fn var@(Var {varInfo = info}) = case fn info of - Nothing -> var - Just new_info -> var {varInfo = new_info} + Nothing -> var + Just new_info -> var {varInfo = new_info} \end{code} +%************************************************************************ +%* * +\subsection{Predicates over variables +%* * +%************************************************************************ + \begin{code} -mkIdVar :: Name -> Type -> IdInfo -> Id -mkIdVar name ty info - = Var {varName = name, realUnique = getKey (nameUnique name), varType = ty, - varDetails = AnId, varInfo = info} +mkId :: Name -> Type -> VarDetails -> IdInfo -> Id +mkId name ty details info + = Var { varName = name, + realUnique = getKey# (nameUnique name), -- Cache the unique + varType = ty, + varDetails = details, + varInfo = info } + +mkLocalId :: Name -> Type -> IdInfo -> Id +mkLocalId name ty info = mkId name ty (LocalId NotExported) info + +mkSpecPragmaId :: Name -> Type -> IdInfo -> Id +mkSpecPragmaId name ty info = mkId name ty (LocalId SpecPragma) info + +mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id +mkGlobalId details name ty info = mkId name ty (GlobalId details) info \end{code} \begin{code} -isId :: Var -> Bool -isId (Var {varDetails = AnId}) = True -isId other = False -\end{code} +isTyVar, isMutTyVar :: Var -> Bool +isId, isLocalVar, isLocalId :: Var -> Bool +isGlobalId, isExportedId, isSpecPragmaId :: Var -> Bool +mustHaveLocalBinding :: Var -> Bool -@externallyVisibleId@: is it true that another module might be -able to ``see'' this Id in a code generation sense. That -is, another .o file might refer to this Id. +isTyVar var = case varDetails var of + TyVar -> True + MutTyVar _ _ -> True + other -> False -In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's -local-ness precisely so that the test here would be easy +isMutTyVar (Var {varDetails = MutTyVar _ _}) = True +isMutTyVar other = False -This defn appears here (rather than, say, in Id.lhs) because -CostCentre.lhs uses it (CostCentre feeds PprType feeds Id.lhs) +isId var = case varDetails var of + LocalId _ -> True + GlobalId _ -> True + other -> False + +isLocalId var = case varDetails var of + LocalId _ -> True + other -> False + +-- isLocalVar returns True for type variables as well as local Ids +-- These are the variables that we need to pay attention to when finding free +-- variables, or doing dependency analysis. +isLocalVar var = case varDetails var of + LocalId _ -> True + TyVar -> True + MutTyVar _ _ -> True + other -> False + +-- mustHaveLocalBinding returns True of Ids and TyVars +-- that must have a binding in this module. The converse +-- is not quite right: there are some GlobalIds that must have +-- bindings, such as record selectors. But that doesn't matter, +-- because it's only used for assertions +mustHaveLocalBinding var = isLocalVar var + +isGlobalId var = case varDetails var of + GlobalId _ -> True + other -> False + +-- isExportedId means "don't throw this away" +isExportedId var = case varDetails var of + LocalId Exported -> True + LocalId SpecPragma -> True + GlobalId _ -> True + other -> False + +isSpecPragmaId var = case varDetails var of + LocalId SpecPragma -> True + other -> False \end{code} + \begin{code} -externallyVisibleId :: Id -> Bool -externallyVisibleId var = isExternallyVisibleName (varName var) +globalIdDetails :: Var -> GlobalIdDetails +-- Works OK on local Ids too, returning notGlobalId +globalIdDetails var = case varDetails var of + GlobalId details -> details + other -> notGlobalId +setGlobalIdDetails :: Id -> GlobalIdDetails -> Id +setGlobalIdDetails id details = id { varDetails = GlobalId details } \end{code} +