\begin{code}
module Var (
- Var, 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,
- newMutTyVar, readMutTyVar, writeMutTyVar, makeTyVarImmutable,
+ tcTyVarDetails,
-- Ids
Id, DictId,
idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
- setIdName, setIdUnique, setIdInfo, lazySetIdInfo,
- setIdLocalExported, zapSpecPragmaId,
+ setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo,
+ setIdExported, setIdNotExported,
- globalIdDetails, setGlobalIdDetails,
+ globalIdDetails, globaliseId,
- mkLocalId, mkGlobalId, mkSpecPragmaId,
+ mkLocalId, mkExportedLocalId, mkGlobalId,
- isTyVar, isMutTyVar, mutTyVarDetails,
- isId, isLocalVar, isLocalId,
- isGlobalId, isExportedId, isSpecPragmaId,
+ isTyVar, isTcTyVar, isId, isLocalVar, isLocalId,
+ isGlobalId, isExportedId,
mustHaveLocalBinding
) where
#include "HsVersions.h"
-import {-# SOURCE #-} TypeRep( Type, Kind )
-import {-# SOURCE #-} TcType( TyVarDetails )
-import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId,
- IdInfo, seqIdInfo )
+import {-# SOURCE #-} TypeRep( Type )
+import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails )
+import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, IdInfo, seqIdInfo )
-import Name ( Name, OccName, NamedThing(..),
- setNameUnique, setNameOcc, nameUnique,
- mkSystemName
+import Name ( Name, NamedThing(..),
+ setNameUnique, nameUnique
)
-import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
+import Kind ( Kind )
+import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey# )
import FastTypes
import Outputable
-
-import IOExts ( IORef, newIORef, readIORef, writeIORef )
\end{code}
\begin{code}
data Var
- = Var {
+ = 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
- = LocalId -- Used for locally-defined Ids (see NOTE below)
- LocalIdDetails
+ tyVarKind :: Kind }
- | GlobalId -- Used for imported Ids, dict selectors etc
- GlobalIdDetails
+ | TcTyVar { -- Used only during type inference
+ varName :: !Name,
+ realUnique :: FastInt,
+ tyVarKind :: Kind,
+ tcTyVarDetails :: TcTyVarDetails }
- | TyVar
- | MutTyVar (IORef (Maybe Type)) -- Used during unification;
- TyVarDetails
+ | GlobalId { -- Used for imported Ids, dict selectors etc
+ varName :: !Name,
+ realUnique :: FastInt,
+ idType :: Type,
+ idInfo :: IdInfo,
+ gblDetails :: GlobalIdDetails }
- -- 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.
+ | 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
+ -- Exported Ids are kept alive;
+ -- NotExported things may be discarded as dead code.
\end{code}
LocalId and GlobalId
\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)
\begin{code}
varUnique :: Var -> Unique
-varUnique (Var {realUnique = uniq}) = mkUniqueGrimily uniq
+varUnique var = mkUniqueGrimily (iBox (realUnique var))
setVarUnique :: Var -> Unique -> Var
-setVarUnique var@(Var {varName = name}) uniq
- = var {realUnique = getKey uniq,
- varName = setNameUnique name 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}
\begin{code}
type TyVar = Var
-\end{code}
-\begin{code}
tyVarName = varName
-tyVarKind = varType
setTyVarUnique = setVarUnique
setTyVarName = setVarName
\begin{code}
mkTyVar :: Name -> Kind -> TyVar
-mkTyVar name kind = Var { varName = name
- , realUnique = getKey (nameUnique name)
- , varType = kind
- , varDetails = TyVar
- , varInfo = pprPanic "mkTyVar" (ppr name)
+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
- , varInfo = pprPanic "mkSysTyVar" (ppr name)
- }
- where
- name = mkSystemName uniq FSLIT("t")
-
-newMutTyVar :: Name -> Kind -> TyVarDetails -> IO TyVar
-newMutTyVar name kind details
- = do loc <- newIORef Nothing
- return (Var { varName = name
- , realUnique = getKey (nameUnique name)
- , varType = kind
- , varDetails = MutTyVar loc details
- , varInfo = pprPanic "newMutTyVar" (ppr name)
- })
-
-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}
-
-mutTyVarDetails :: TyVar -> TyVarDetails
-mutTyVarDetails (Var {varDetails = MutTyVar _ details}) = details
+mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
+mkTcTyVar name kind details
+ = TcTyVar { varName = name,
+ realUnique = getKey# (nameUnique name),
+ tyVarKind = kind,
+ tcTyVarDetails = details
+ }
\end{code}
\begin{code}
idName = varName
-idType = varType
idUnique = varUnique
-idInfo = varInfo
setIdUnique :: Id -> Unique -> Id
setIdUnique = setVarUnique
setIdName :: Id -> Name -> Id
setIdName = setVarName
-setIdLocalExported :: Id -> Id
-setIdLocalExported id = id { varDetails = LocalId Exported }
+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
-zapSpecPragmaId :: Id -> Id
-zapSpecPragmaId id
- = case varDetails id of
- LocalId SpecPragma -> id { varDetails = LocalId NotExported }
- 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 var info = var {varInfo = info}
+lazySetIdInfo id info = id {idInfo = info}
setIdInfo :: Id -> IdInfo -> Id
-setIdInfo var info = seqIdInfo info `seq` 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})
- = seqIdInfo new_info `seq` var {varInfo = new_info}
+modifyIdInfo fn id
+ = seqIdInfo new_info `seq` id {idInfo = new_info}
where
- new_info = fn info
+ 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}
%************************************************************************
%************************************************************************
\begin{code}
-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 }
+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 = mkId name ty (LocalId NotExported) info
+mkLocalId name ty info = mk_local_id name ty 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
+mkExportedLocalId :: Name -> Type -> IdInfo -> Id
+mkExportedLocalId name ty info = mk_local_id name ty Exported info
\end{code}
\begin{code}
-isTyVar, isMutTyVar :: Var -> Bool
-isId, isLocalVar, isLocalId :: Var -> Bool
-isGlobalId, isExportedId, isSpecPragmaId :: Var -> Bool
-mustHaveLocalBinding :: Var -> Bool
-
-isTyVar var = case varDetails var of
- TyVar -> True
- MutTyVar _ _ -> True
- other -> False
+isTyVar, isTcTyVar :: Var -> Bool
+isId, isLocalVar, isLocalId :: Var -> Bool
+isGlobalId, isExportedId :: Var -> Bool
+mustHaveLocalBinding :: Var -> Bool
-isMutTyVar (Var {varDetails = MutTyVar _ _}) = True
-isMutTyVar other = False
+isTyVar (TyVar {}) = True
+isTyVar (TcTyVar {}) = True
+isTyVar other = False
+isTcTyVar (TcTyVar {}) = True
+isTcTyVar other = False
-isId var = case varDetails var of
- LocalId _ -> True
- GlobalId _ -> True
- other -> False
+isId (LocalId {}) = True
+isId (GlobalId {}) = True
+isId other = False
-isLocalId var = case varDetails var of
- LocalId _ -> True
- 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 var = case varDetails var of
- LocalId _ -> True
- TyVar -> True
- MutTyVar _ _ -> True
- other -> False
+isLocalVar (GlobalId {}) = False
+isLocalVar other = True
-- mustHaveLocalBinding returns True of Ids and TyVars
-- that must have a binding in this module. The converse
-- because it's only used for assertions
mustHaveLocalBinding var = isLocalVar var
-isGlobalId var = case varDetails var of
- GlobalId _ -> True
- other -> False
+isGlobalId (GlobalId {}) = True
+isGlobalId 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
+isExportedId (GlobalId {}) = True
+isExportedId (LocalId {lclDetails = details})
+ = case details of
+ Exported -> True
+ other -> False
+isExportedId other = False
\end{code}
\begin{code}
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 }
+globalIdDetails (GlobalId {gblDetails = details}) = details
+globalIdDetails other = notGlobalId
\end{code}
projects / ghc-hetmet.git / blobdiff