-
+%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section{@Vars@: Variables}
\begin{code}
module Var (
- Var, IdOrTyVar, -- Abstract
- VarDetails(..), -- Concrete
- varName, varUnique, varDetails, varInfo, varType,
- setVarName, setVarUnique, setVarType,
-
+ Var,
+ varName, varUnique,
+ setVarName, setVarUnique, setVarOcc,
-- TyVars
- TyVar, GenTyVar,
+ TyVar, mkTyVar, mkTcTyVar,
tyVarName, tyVarKind,
- tyVarFlexi, setTyVarFlexi, removeTyVarFlexi, setTyVarName, setTyVarUnique,
- mkFlexiTyVar, mkTyVar, mkSysTyVar, isTyVar, isFlexiTyVar,
+ setTyVarName, setTyVarUnique,
+ tcTyVarRef, tcTyVarDetails,
-- Ids
- Id, DictId, GenId,
- idName, idType, idUnique, idInfo, modifyIdInfo,
- setIdName, setIdUnique, setIdInfo,
- mkId, isId, externallyVisibleId
+ Id, DictId,
+ idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
+ setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo,
+ setIdLocalExported, zapSpecPragmaId,
+
+ globalIdDetails, setGlobalIdDetails,
+
+ mkLocalId, mkExportedLocalId, mkSpecPragmaId,
+ mkGlobalId,
+
+ isTyVar, isTcTyVar, isId, isLocalVar, isLocalId,
+ isGlobalId, isExportedId, isSpecPragmaId,
+ mustHaveLocalBinding
) where
#include "HsVersions.h"
-import {-# SOURCE #-} Type( GenType, Kind )
-import {-# SOURCE #-} IdInfo( IdInfo )
-import {-# SOURCE #-} Const( Con )
+import {-# SOURCE #-} TypeRep( Type )
+import {-# SOURCE #-} TcType( TyVarDetails )
+import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId,
+ IdInfo, seqIdInfo )
-import FieldLabel ( FieldLabel )
-import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
-import Name ( Name, NamedThing(..),
- changeUnique, nameUnique,
- mkSysLocalName, isExternallyVisibleName
+import Name ( Name, OccName, NamedThing(..),
+ setNameUnique, setNameOcc, nameUnique
)
-import BasicTypes ( Unused )
+import Kind ( Kind )
+import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey# )
+import FastTypes
import Outputable
+import DATA_IOREF
\end{code}
-
%************************************************************************
%* *
\subsection{The main data type declarations}
in its @VarDetails@.
\begin{code}
-type IdOrTyVar = Var Unused Unused
-
-data Var flex_self flex_ty
- = Var {
- varName :: Name,
- realUnique :: Int#, -- Key for fast comparison
+data Var
+ = TyVar {
+ varName :: !Name,
+ realUnique :: FastInt, -- Key for fast comparison
-- Identical to the Unique in the name,
-- cached here for speed
- varType :: GenType flex_ty,
- varDetails :: VarDetails flex_self,
- varInfo :: IdInfo -- Only used for Ids at the moment
- }
-
-varUnique Var{realUnique = uniq} = mkUniqueGrimily uniq
-
-data VarDetails flex_self
- = TyVar
- | FlexiTyVar flex_self -- Used during unification
- | VanillaId -- Most Ids are like this
- | ConstantId Con -- The Id for a constant (data constructor or primop)
- | RecordSelId FieldLabel -- The Id for a record selector
+ tyVarKind :: Kind }
+
+ | TcTyVar { -- Used only during type inference
+ varName :: !Name, -- Could we get away without a Name?
+ realUnique :: FastInt,
+ tyVarKind :: Kind,
+ tcTyVarRef :: IORef (Maybe Type),
+ tcTyVarDetails :: TyVarDetails }
+
+ | 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
+ | 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 fs ft) where
+instance Outputable Var where
ppr var = ppr (varName var)
-instance Show (Var fs ft) where
+instance Show Var where
showsPrec p var = showsPrecSDoc p (ppr var)
-instance NamedThing (Var fs ft) where
+instance NamedThing Var where
getName = varName
-instance Uniquable (Var fs ft) where
+instance Uniquable Var where
getUnique = varUnique
-instance Eq (Var fs ft) where
+instance Eq Var where
a == b = realUnique a ==# realUnique b
-instance Ord (Var fs ft) where
+instance Ord Var where
a <= b = realUnique a <=# realUnique b
a < b = realUnique a <# realUnique b
a >= b = realUnique a >=# realUnique b
\begin{code}
-setVarUnique :: Var fs ft -> Unique -> Var fs ft
-setVarUnique var uniq = var {realUnique = getKey uniq,
- varName = changeUnique (varName var) uniq}
+varUnique :: Var -> Unique
+varUnique var = mkUniqueGrimily (iBox (realUnique var))
+
+setVarUnique :: Var -> Unique -> Var
+setVarUnique var uniq
+ = var { realUnique = getKey# uniq,
+ varName = setNameUnique (varName var) uniq }
-setVarName :: Var fs ft -> Name -> Var fs ft
+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 }
-setVarType :: Var flex_self flex_ty1 -> GenType flex_ty2 -> Var flex_self flex_ty2
-setVarType var ty = var {varType = ty}
+setVarOcc :: Var -> OccName -> Var
+setVarOcc var new_occ
+ = var { varName = setNameOcc (varName var) new_occ }
\end{code}
%************************************************************************
\begin{code}
-type GenTyVar flex_self = Var flex_self Unused -- Perhaps a mutable tyvar, but
- -- with a fixed Kind
+type TyVar = Var
-type TyVar = GenTyVar Unused -- NOt even mutable
-\end{code}
-
-\begin{code}
tyVarName = varName
-tyVarKind = varType
setTyVarUnique = setVarUnique
setTyVarName = setVarName
-
-tyVarFlexi :: GenTyVar flexi -> flexi
-tyVarFlexi (Var {varDetails = FlexiTyVar flex}) = flex
-tyVarFlexi other_var = pprPanic "tyVarFlexi" (ppr other_var)
-
-setTyVarFlexi :: GenTyVar flexi1 -> flexi2 -> GenTyVar flexi2
-setTyVarFlexi var flex = var {varDetails = FlexiTyVar flex}
-
-removeTyVarFlexi :: GenTyVar flexi1 -> GenTyVar flexi2
-removeTyVarFlexi var = var {varDetails = TyVar}
-\end{code}
-
-\begin{code}
-mkTyVar :: Name -> Kind -> GenTyVar flexi
-mkTyVar name kind = Var { varName = name, realUnique = getKey (nameUnique name),
- varType = kind, varDetails = TyVar }
-
-mkSysTyVar :: Unique -> Kind -> GenTyVar flexi
-mkSysTyVar uniq kind = Var { varName = name, realUnique = getKey uniq,
- varType = kind, varDetails = TyVar }
- where
- name = mkSysLocalName uniq
-
-mkFlexiTyVar :: Name -> Kind -> flexi -> GenTyVar flexi
-mkFlexiTyVar name kind flex = Var { varName = name,
- realUnique = getKey (nameUnique name),
- varType = kind,
- varDetails = FlexiTyVar flex }
\end{code}
\begin{code}
-isTyVar :: Var fs ft -> Bool
-isTyVar (Var {varDetails = details}) = case details of
- TyVar -> True
- FlexiTyVar _ -> True
- other -> False
-
-isFlexiTyVar :: Var fs ft -> Bool
-isFlexiTyVar (Var {varDetails = FlexiTyVar _}) = True
-isFlexiTyVar other = False
+mkTyVar :: Name -> Kind -> TyVar
+mkTyVar name kind = TyVar { varName = name
+ , realUnique = getKey# (nameUnique name)
+ , tyVarKind = kind
+ }
+
+mkTcTyVar :: Name -> Kind -> TyVarDetails -> IORef (Maybe Type) -> TyVar
+mkTcTyVar name kind details ref
+ = TcTyVar { varName = name,
+ realUnique = getKey# (nameUnique name),
+ tyVarKind = kind,
+ tcTyVarRef = ref,
+ tcTyVarDetails = details
+ }
\end{code}
%* *
%************************************************************************
- Most Id-related functions are in Id.lhs and MkId.lhs
+Most Id-related functions are in Id.lhs and MkId.lhs
\begin{code}
-type GenId flex_ty = Var Unused flex_ty
-type Id = GenId Unused
-type DictId = Id
+type Id = Var
+type DictId = Id
\end{code}
\begin{code}
idName = varName
-idType = varType
idUnique = varUnique
-idInfo = varInfo
-idDetails = varDetails
setIdUnique :: Id -> Unique -> Id
setIdUnique = setVarUnique
setIdName :: Id -> Name -> Id
setIdName = setVarName
-setIdInfo :: GenId flexi -> IdInfo -> GenId flexi
-setIdInfo var info = var {varInfo = info}
-
-modifyIdInfo :: GenId flexi -> (IdInfo -> IdInfo) -> GenId flexi
-modifyIdInfo var@(Var {varInfo = info}) fn = var {varInfo = fn info}
+setIdType :: Id -> Type -> Id
+setIdType id ty = id {idType = ty}
+
+setIdLocalExported :: Id -> Id
+-- It had better be a LocalId already
+setIdLocalExported id = id { lclDetails = Exported }
+
+setGlobalIdDetails :: Id -> GlobalIdDetails -> Id
+-- It had better be a GlobalId already
+setGlobalIdDetails id details = id { gblDetails = details }
+
+zapSpecPragmaId :: Id -> Id
+zapSpecPragmaId id
+ | isSpecPragmaId id = id {lclDetails = NotExported}
+ | otherwise = id
+
+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 :: (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
+%* *
+%************************************************************************
+
\begin{code}
-mkId :: Name -> GenType flex_ty -> VarDetails Unused -> IdInfo -> GenId flex_ty
-mkId name ty details info
- = Var {varName = name, realUnique = getKey (nameUnique name), varType = ty,
- varDetails = details, 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
+
+mkSpecPragmaId :: Name -> Type -> IdInfo -> Id
+mkSpecPragmaId name ty info = mk_local_id name ty SpecPragma info
\end{code}
\begin{code}
-isId :: Var fs ft -> Bool
-isId (Var {varDetails = details}) = case details of
- VanillaId -> True
- ConstantId _ -> True
- RecordSelId _ -> True
- other -> False
+isTyVar, isTcTyVar :: Var -> Bool
+isId, isLocalVar, isLocalId :: Var -> Bool
+isGlobalId, isExportedId, isSpecPragmaId :: 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
+ SpecPragma -> True
+ other -> False
+isExportedId other = False
+
+isSpecPragmaId (LocalId {lclDetails = SpecPragma}) = True
+isSpecPragmaId 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}
+
projects / ghc-hetmet.git / blobdiff