X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FVar.lhs;h=60fdf3831c3c5de74a15612b80089db9189cf292;hb=ac10f8408520a30e8437496d320b8b86afda2e8f;hp=4d5be70d52ceeb961dc60b179aeebb06d4b6b22f;hpb=506fa77d392191e46c12b2c19387ff5b0888f6a2;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs index 4d5be70..60fdf38 100644 --- a/ghc/compiler/basicTypes/Var.lhs +++ b/ghc/compiler/basicTypes/Var.lhs @@ -5,49 +5,47 @@ \begin{code} module Var ( - Var, IdOrTyVar, VarDetails, -- Abstract - varName, varUnique, varInfo, varType, - setVarName, setVarUnique, setVarType, setVarOcc, - + Var, + varName, varUnique, + setVarName, setVarUnique, -- TyVars - TyVar, + TyVar, mkTyVar, mkTcTyVar, tyVarName, tyVarKind, setTyVarName, setTyVarUnique, - mkTyVar, mkSysTyVar, isTyVar, isSigTyVar, - newMutTyVar, newSigTyVar, - readMutTyVar, writeMutTyVar, isMutTyVar, makeTyVarImmutable, - - -- UVars - UVar, - isUVar, - mkUVar, + tcTyVarDetails, -- Ids Id, DictId, idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo, - setIdName, setIdUnique, setIdInfo, - mkIdVar, isId, externallyVisibleId + setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, + setIdExported, setIdNotExported, + + globalIdDetails, globaliseId, + + mkLocalId, mkExportedLocalId, mkGlobalId, + + isTyVar, isTcTyVar, isId, isLocalVar, isLocalId, + isGlobalId, isExportedId, + mustHaveLocalBinding ) where #include "HsVersions.h" -import {-# SOURCE #-} Type( Type, Kind ) -import {-# SOURCE #-} IdInfo( IdInfo ) +import {-# SOURCE #-} TypeRep( Type ) +import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails ) +import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, IdInfo, seqIdInfo ) -import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey ) -import Name ( Name, OccName, NamedThing(..), - setNameUnique, setNameOcc, nameUnique, - mkSysLocalName, isExternallyVisibleName +import Name ( Name, NamedThing(..), + setNameUnique, nameUnique ) -import BasicTypes ( Unused ) +import Kind ( Kind ) +import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey# ) +import FastTypes import Outputable - -import IOExts ( IORef, newIORef, readIORef, writeIORef ) \end{code} - %************************************************************************ %* * \subsection{The main data type declarations} @@ -61,36 +59,65 @@ 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 + = TyVar { + varName :: !Name, + realUnique :: FastInt, -- Key for fast comparison -- Identical to the Unique in the name, -- cached here for speed - varType :: Type, - varDetails :: VarDetails, - varInfo :: IdInfo -- Only used for Ids at the moment - } - -data VarDetails - = AnId - | 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. + tyVarKind :: Kind } + + | TcTyVar { -- Used only during type inference + varName :: !Name, + realUnique :: FastInt, + tyVarKind :: Kind, + tcTyVarDetails :: TcTyVarDetails } + + | GlobalId { -- Used for imported Ids, dict selectors etc + varName :: !Name, + realUnique :: FastInt, + idType :: Type, + idInfo :: IdInfo, + gblDetails :: GlobalIdDetails } + + | LocalId { -- Used for locally-defined Ids (see NOTE below) + varName :: !Name, + realUnique :: FastInt, + idType :: 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. \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) + 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 instance Show Var where showsPrec p var = showsPrecSDoc p (ppr var) @@ -115,22 +142,17 @@ instance Ord Var where \begin{code} varUnique :: Var -> Unique -varUnique (Var {realUnique = uniq}) = mkUniqueGrimily uniq +varUnique var = mkUniqueGrimily (iBox (realUnique var)) setVarUnique :: Var -> Unique -> Var -setVarUnique var uniq = var {realUnique = getKey uniq, - varName = setNameUnique (varName var) uniq} +setVarUnique var uniq + = var { realUnique = getKey# uniq, + varName = setNameUnique (varName var) uniq } setVarName :: Var -> Name -> Var setVarName var new_name - = var { realUnique = getKey (getUnique new_name), varName = new_name } - -setVarOcc :: Var -> OccName -> Var -setVarOcc var new_occ - = var { varName = setNameOcc (varName var) new_occ } - -setVarType :: Var -> Type -> Var -setVarType var ty = var {varType = ty} + = var { realUnique = getKey# (getUnique new_name), + varName = new_name } \end{code} @@ -142,11 +164,8 @@ setVarType var ty = var {varType = ty} \begin{code} type TyVar = Var -\end{code} -\begin{code} tyVarName = varName -tyVarKind = varType setTyVarUnique = setVarUnique setTyVarName = setVarName @@ -154,90 +173,18 @@ setTyVarName = setVarName \begin{code} mkTyVar :: Name -> Kind -> TyVar -mkTyVar name kind = Var { varName = name - , realUnique = getKey (nameUnique name) - , varType = kind - , varDetails = TyVar -#ifdef DEBUG - , varInfo = pprPanic "looking at IdInfo of a tyvar" (ppr name) -#endif +mkTyVar name kind = TyVar { varName = name + , realUnique = getKey# (nameUnique name) + , tyVarKind = kind } -mkSysTyVar :: Unique -> Kind -> TyVar -mkSysTyVar uniq kind = Var { varName = name - , realUnique = getKey uniq - , varType = kind - , varDetails = TyVar -#ifdef DEBUG - , varInfo = pprPanic "mkSysTyVar" (ppr name) -#endif - } - 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 - -isSigTyVar :: Var -> Bool -isSigTyVar (Var {varDetails = MutTyVar _ is_sig}) = is_sig -isSigTyVar other = False -\end{code} - - -%************************************************************************ -%* * -\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 } -\end{code} - -\begin{code} -isUVar :: Var -> Bool -isUVar (Var {varDetails = details}) = case details of - UVar -> True - other -> False +mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar +mkTcTyVar name kind details + = TcTyVar { varName = name, + realUnique = getKey# (nameUnique name), + tyVarKind = kind, + tcTyVarDetails = details + } \end{code} @@ -256,9 +203,7 @@ type DictId = Id \begin{code} idName = varName -idType = varType idUnique = varUnique -idInfo = varInfo setIdUnique :: Id -> Unique -> Id setIdUnique = setVarUnique @@ -266,44 +211,127 @@ setIdUnique = setVarUnique setIdName :: Id -> Name -> Id setIdName = setVarName +setIdType :: Id -> Type -> Id +setIdType id ty = id {idType = ty} + +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 + +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, + idType = idType id, + idInfo = idInfo id, + gblDetails = details } + +lazySetIdInfo :: Id -> IdInfo -> Id +lazySetIdInfo id info = id {idInfo = info} + setIdInfo :: Id -> IdInfo -> Id -setIdInfo var info = var {varInfo = info} +setIdInfo id info = seqIdInfo info `seq` id {idInfo = info} + -- Try to avoid spack leaks by seq'ing modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id -modifyIdInfo fn var@(Var {varInfo = info}) = var {varInfo = fn info} +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 var@(Var {varInfo = info}) = case fn info of - Nothing -> var - Just new_info -> var {varInfo = new_info} +maybeModifyIdInfo fn id + = case fn (idInfo id) of + Nothing -> id + Just new_info -> id {idInfo = 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} +mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id +mkGlobalId details name ty info + = GlobalId { varName = name, + realUnique = getKey# (nameUnique name), -- Cache the unique + idType = 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 + idType = 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} -isId :: Var -> Bool -isId (Var {varDetails = AnId}) = True -isId other = False +isTyVar, isTcTyVar :: Var -> Bool +isId, isLocalVar, isLocalId :: Var -> Bool +isGlobalId, isExportedId :: Var -> Bool +mustHaveLocalBinding :: Var -> Bool + +isTyVar (TyVar {}) = True +isTyVar (TcTyVar {}) = True +isTyVar other = False + +isTcTyVar (TcTyVar {}) = True +isTcTyVar other = False + +isId (LocalId {}) = True +isId (GlobalId {}) = True +isId other = False + +isLocalId (LocalId {}) = True +isLocalId 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 (GlobalId {}) = False +isLocalVar other = True + +-- 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 (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 \end{code} -@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. - -In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's -local-ness precisely so that the test here would be easy - -This defn appears here (rather than, say, in Id.lhs) because -CostCentre.lhs uses it (CostCentre feeds PprType feeds Id.lhs) - -\end{code} \begin{code} -externallyVisibleId :: Id -> Bool -externallyVisibleId var = isExternallyVisibleName (varName var) +globalIdDetails :: Var -> GlobalIdDetails +-- Works OK on local Ids too, returning notGlobalId +globalIdDetails (GlobalId {gblDetails = details}) = details +globalIdDetails other = notGlobalId \end{code} +