-
+%
% (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, VarDetails, -- Abstract
+ varName, varUnique, varInfo, varType,
+ setVarName, setVarUnique, setVarType, setVarOcc,
-- TyVars
- TyVar, GenTyVar,
+ TyVar,
tyVarName, tyVarKind,
- tyVarFlexi, setTyVarFlexi, removeTyVarFlexi, setTyVarName, setTyVarUnique,
- mkFlexiTyVar, mkTyVar, mkSysTyVar, isTyVar, isFlexiTyVar,
+ setTyVarName, setTyVarUnique,
+ mkTyVar, mkSysTyVar, isTyVar, isSigTyVar,
+ newMutTyVar, newSigTyVar,
+ readMutTyVar, writeMutTyVar, isMutTyVar, makeTyVarImmutable,
+
+ -- UVars
+ UVar,
+ isUVar,
+ mkUVar, mkNamedUVar,
-- 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, setIdInfo, lazySetIdInfo, zapIdInfo,
+ mkIdVar, isId, externallyVisibleId
) where
#include "HsVersions.h"
-import {-# SOURCE #-} Type( GenType, Kind )
-import {-# SOURCE #-} IdInfo( IdInfo )
-import {-# SOURCE #-} Const( Con )
+import {-# SOURCE #-} TypeRep( Type, Kind )
+import {-# SOURCE #-} IdInfo( IdInfo, seqIdInfo, vanillaIdInfo )
-import FieldLabel ( FieldLabel )
import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
-import Name ( Name, NamedThing(..),
- changeUnique, nameUnique,
+import Name ( Name, OccName, NamedThing(..),
+ setNameUnique, setNameOcc, nameUnique,
mkSysLocalName, isExternallyVisibleName
)
-import BasicTypes ( Unused )
+import FastTypes
import Outputable
-\end{code}
+import IOExts ( IORef, newIORef, readIORef, writeIORef )
+\end{code}
%************************************************************************
in its @VarDetails@.
\begin{code}
-type IdOrTyVar = Var Unused Unused
-
-data Var flex_self flex_ty
+data Var
= Var {
varName :: Name,
- realUnique :: Int#, -- Key for fast comparison
+ 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,
+ varType :: Type,
+ varDetails :: VarDetails,
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
+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.
\end{code}
\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 {realUnique = uniq}) = mkUniqueGrimily uniq
-setVarName :: Var fs ft -> Name -> Var fs ft
+setVarUnique :: Var -> Unique -> Var
+setVarUnique var@(Var {varName = name}) 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 }
-setVarType :: Var flex_self flex_ty1 -> GenType flex_ty2 -> Var flex_self flex_ty2
+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}
\end{code}
%************************************************************************
\begin{code}
-type GenTyVar flex_self = Var flex_self Unused -- Perhaps a mutable tyvar, but
- -- with a fixed Kind
-
-type TyVar = GenTyVar Unused -- NOt even mutable
+type TyVar = Var
\end{code}
\begin{code}
setTyVarUnique = setVarUnique
setTyVarName = setVarName
+\end{code}
-tyVarFlexi :: GenTyVar flexi -> flexi
-tyVarFlexi (Var {varDetails = FlexiTyVar flex}) = flex
-tyVarFlexi other_var = pprPanic "tyVarFlexi" (ppr other_var)
+\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)
+ }
+
+mkSysTyVar :: Unique -> Kind -> TyVar
+mkSysTyVar uniq kind = Var { varName = name
+ , realUnique = getKey uniq
+ , varType = kind
+ , varDetails = TyVar
+ , varInfo = pprPanic "mkSysTyVar" (ppr name)
+ }
+ where
+ name = mkSysLocalName uniq SLIT("t")
-setTyVarFlexi :: GenTyVar flexi1 -> flexi2 -> GenTyVar flexi2
-setTyVarFlexi var flex = var {varDetails = FlexiTyVar flex}
+newMutTyVar :: Name -> Kind -> IO TyVar
+newMutTyVar name kind = newTyVar name kind False
-removeTyVarFlexi :: GenTyVar flexi1 -> GenTyVar flexi2
-removeTyVarFlexi var = var {varDetails = TyVar}
-\end{code}
+newSigTyVar :: Name -> Kind -> IO TyVar
+-- Type variables from type signatures are still mutable, because
+-- they may get unified with type variables from other signatures
+-- But they do contain a flag to distinguish them, so we can tell if
+-- we unify them with a non-type-variable.
+newSigTyVar name kind = newTyVar name kind True
-\begin{code}
-mkTyVar :: Name -> Kind -> GenTyVar flexi
-mkTyVar name kind = Var { varName = name, realUnique = getKey (nameUnique name),
- varType = kind, varDetails = TyVar }
+newTyVar name kind is_sig
+ = do loc <- newIORef Nothing
+ return (Var { varName = name
+ , realUnique = getKey (nameUnique name)
+ , varType = kind
+ , varDetails = MutTyVar loc is_sig
+ , varInfo = pprPanic "newMutTyVar" (ppr name)
+ })
-mkSysTyVar :: Unique -> Kind -> GenTyVar flexi
-mkSysTyVar uniq kind = Var { varName = name, realUnique = getKey uniq,
- varType = kind, varDetails = TyVar }
- where
- name = mkSysLocalName uniq
+readMutTyVar :: TyVar -> IO (Maybe Type)
+readMutTyVar (Var {varDetails = MutTyVar loc _}) = readIORef loc
-mkFlexiTyVar :: Name -> Kind -> flexi -> GenTyVar flexi
-mkFlexiTyVar name kind flex = Var { varName = name,
- realUnique = getKey (nameUnique name),
- varType = kind,
- varDetails = FlexiTyVar flex }
-\end{code}
+writeMutTyVar :: TyVar -> Maybe Type -> IO ()
+writeMutTyVar (Var {varDetails = MutTyVar loc _}) val = writeIORef loc val
-\begin{code}
-isTyVar :: Var fs ft -> Bool
+makeTyVarImmutable :: TyVar -> TyVar
+makeTyVarImmutable tyvar = tyvar { varDetails = TyVar}
+
+isTyVar :: Var -> Bool
isTyVar (Var {varDetails = details}) = case details of
TyVar -> True
- FlexiTyVar _ -> True
+ MutTyVar _ _ -> True
other -> False
-isFlexiTyVar :: Var fs ft -> Bool
-isFlexiTyVar (Var {varDetails = FlexiTyVar _}) = True
-isFlexiTyVar 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 = name
+ , realUnique = getKey unique
+ , varDetails = UVar
+ , varType = pprPanic "mkUVar (varType)" (ppr name)
+ , varInfo = pprPanic "mkUVar (varInfo)" (ppr name)
+ }
+ where name = mkSysLocalName unique SLIT("u")
+
+mkNamedUVar :: Name -> UVar
+mkNamedUVar name = Var { varName = name
+ , realUnique = getKey (nameUnique name)
+ , varDetails = UVar
+ , varType = pprPanic "mkNamedUVar (varType)" (ppr name)
+ , varInfo = pprPanic "mkNamedUVar (varInfo)" (ppr name)
+ }
+\end{code}
+
+\begin{code}
+isUVar :: Var -> Bool
+isUVar (Var {varDetails = details}) = case details of
+ UVar -> True
+ other -> False
\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}
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}
+lazySetIdInfo :: Id -> IdInfo -> Id
+lazySetIdInfo var info = var {varInfo = info}
+
+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}
+ where
+ new_info = fn info
-modifyIdInfo :: GenId flexi -> (IdInfo -> IdInfo) -> GenId flexi
-modifyIdInfo var@(Var {varInfo = info}) fn = var {varInfo = fn 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}
\end{code}
\begin{code}
-mkId :: Name -> GenType flex_ty -> VarDetails Unused -> IdInfo -> GenId flex_ty
-mkId name ty details info
+mkIdVar :: Name -> Type -> IdInfo -> Id
+mkIdVar name ty info
= Var {varName = name, realUnique = getKey (nameUnique name), varType = ty,
- varDetails = details, varInfo = info}
+ varDetails = AnId, varInfo = 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
+isId :: Var -> Bool
+isId (Var {varDetails = AnId}) = True
+isId other = False
\end{code}
@externallyVisibleId@: is it true that another module might be
projects / ghc-hetmet.git / blobdiff