X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FVar.lhs;h=d9cedf0b07fd4c1c0a345751747d65de0fb44cd4;hb=de400dba4adc3ea9323289594d932410fa8e6419;hp=566d502ae1a4a269ccc5b044fb0a5fb1f119a3fe;hpb=b526760519fa077794cc68478fa6d786200f9e70;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index 566d502..d9cedf0 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -7,7 +7,7 @@ \begin{code} module Var ( Var, - varName, varUnique, + varName, varUnique, varType, setVarName, setVarUnique, -- TyVars @@ -40,9 +40,7 @@ import {-# SOURCE #-} TypeRep( Type, Kind ) import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails ) import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, IdInfo, seqIdInfo ) -#ifdef DEBUG import {-# SOURCE #-} TypeRep( isCoercionKind ) -#endif import Name hiding (varName) import Unique @@ -71,7 +69,7 @@ data Var realUnique :: FastInt, -- Key for fast comparison -- Identical to the Unique in the name, -- cached here for speed - tyVarKind :: Kind, + varType :: Kind, isCoercionVar :: Bool } @@ -80,14 +78,14 @@ data Var -- inference, as well varName :: !Name, realUnique :: FastInt, - tyVarKind :: Kind, + varType :: Kind, tcTyVarDetails :: TcTyVarDetails } | GlobalId { -- Used for imported Ids, dict selectors etc -- See Note [GlobalId/LocalId] below varName :: !Name, -- Always an External or WiredIn Name realUnique :: FastInt, - idType :: Type, + varType :: Type, idInfo_ :: IdInfo, gblDetails :: GlobalIdDetails } @@ -95,7 +93,7 @@ data Var -- See Note [GlobalId/LocalId] below varName :: !Name, realUnique :: FastInt, - idType :: Type, + varType :: Type, idInfo_ :: IdInfo, lclDetails :: LocalIdDetails } @@ -129,9 +127,9 @@ instance Outputable Var where 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") + GlobalId {} -> ptext (sLit "gid") + LocalId {} -> ptext (sLit "lid") + TyVar {} -> ptext (sLit "tv") TcTyVar {tcTyVarDetails = details} -> pprTcTyVarDetails details instance Show Var where @@ -161,12 +159,12 @@ varUnique var = mkUniqueGrimily (iBox (realUnique var)) setVarUnique :: Var -> Unique -> Var setVarUnique var uniq - = var { realUnique = getKey# uniq, + = var { realUnique = getKeyFastInt uniq, varName = setNameUnique (varName var) uniq } setVarName :: Var -> Name -> Var setVarName var new_name - = var { realUnique = getKey# (getUnique new_name), + = var { realUnique = getKeyFastInt (getUnique new_name), varName = new_name } \end{code} @@ -180,30 +178,38 @@ setVarName var new_name \begin{code} type TyVar = Var +tyVarName :: TyVar -> Name tyVarName = varName +tyVarKind :: TyVar -> Kind +tyVarKind = varType + +setTyVarUnique :: TyVar -> Unique -> TyVar setTyVarUnique = setVarUnique + +setTyVarName :: TyVar -> Name -> TyVar setTyVarName = setVarName setTyVarKind :: TyVar -> Kind -> TyVar -setTyVarKind tv k = tv {tyVarKind = k} +setTyVarKind tv k = tv {varType = k} \end{code} \begin{code} mkTyVar :: Name -> Kind -> TyVar mkTyVar name kind = ASSERT( not (isCoercionKind kind ) ) TyVar { varName = name - , realUnique = getKey# (nameUnique name) - , tyVarKind = kind + , realUnique = getKeyFastInt (nameUnique name) + , varType = kind , isCoercionVar = False } mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar mkTcTyVar name kind details - = ASSERT( not (isCoercionKind kind) ) + = -- TOM: no longer valid assertion? + -- ASSERT( not (isCoercionKind kind) ) TcTyVar { varName = name, - realUnique = getKey# (nameUnique name), - tyVarKind = kind, + realUnique = getKeyFastInt (nameUnique name), + varType = kind, tcTyVarDetails = details } \end{code} @@ -217,17 +223,23 @@ mkTcTyVar name kind details \begin{code} type CoVar = Var -- A coercion variable is simply a type -- variable of kind (ty1 :=: ty2) + +coVarName :: CoVar -> Name coVarName = varName +setCoVarUnique :: CoVar -> Unique -> CoVar setCoVarUnique = setVarUnique + +setCoVarName :: CoVar -> Name -> CoVar setCoVarName = setVarName mkCoVar :: Name -> Kind -> CoVar mkCoVar name kind = ASSERT( isCoercionKind kind ) - TyVar { varName = name - , realUnique = getKey# (nameUnique name) - , tyVarKind = kind - , isCoercionVar = True + TyVar { varName = name + , realUnique = getKeyFastInt (nameUnique name) + , varType = kind + -- varType is always PredTy (EqPred t1 t2) + , isCoercionVar = True } mkWildCoVar :: Kind -> TyVar @@ -235,9 +247,9 @@ mkWildCoVar :: Kind -> TyVar -- so its unique doesn't matter mkWildCoVar kind = ASSERT( isCoercionKind kind ) - TyVar { varName = mkSysTvName wild_uniq FSLIT("co_wild"), + TyVar { varName = mkSysTvName wild_uniq (fsLit "co_wild"), realUnique = _ILIT(1), - tyVarKind = kind, + varType = kind, isCoercionVar = True } where wild_uniq = mkBuiltinUnique 1 @@ -257,8 +269,13 @@ type DictId = Id \end{code} \begin{code} +idName :: Id -> Name +idUnique :: Id -> Unique +idType :: Id -> Kind + idName = varName idUnique = varUnique +idType = varType setIdUnique :: Id -> Unique -> Id setIdUnique = setVarUnique @@ -267,7 +284,7 @@ setIdName :: Id -> Name -> Id setIdName = setVarName setIdType :: Id -> Type -> Id -setIdType id ty = id {idType = ty} +setIdType id ty = id {varType = ty} setIdExported :: Id -> Id -- Can be called on GlobalIds, such as data cons and class ops, @@ -283,7 +300,7 @@ 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, + varType = varType id, idInfo_ = idInfo id, gblDetails = details } @@ -321,16 +338,16 @@ maybeModifyIdInfo Nothing id = id mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id mkGlobalId details name ty info = GlobalId { varName = name, - realUnique = getKey# (nameUnique name), -- Cache the unique - idType = ty, + realUnique = getKeyFastInt (nameUnique name), -- Cache the unique + varType = 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, + realUnique = getKeyFastInt (nameUnique name), -- Cache the unique + varType = ty, lclDetails = details, idInfo_ = info } @@ -346,29 +363,30 @@ isTyVar, isTcTyVar :: Var -> Bool isId, isLocalVar, isLocalId :: Var -> Bool isGlobalId, isExportedId :: Var -> Bool mustHaveLocalBinding :: Var -> Bool +isCoVar :: Var -> Bool isTyVar (TyVar {}) = True isTyVar (TcTyVar {}) = True -isTyVar other = False +isTyVar _ = False isTcTyVar (TcTyVar {}) = True -isTcTyVar other = False +isTcTyVar _ = False isId (LocalId {}) = True isId (GlobalId {}) = True -isId other = False +isId _ = False isLocalId (LocalId {}) = True -isLocalId other = False +isLocalId _ = False isCoVar (v@(TyVar {})) = isCoercionVar v -isCoVar other = False +isCoVar _ = 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 +isLocalVar _ = True -- mustHaveLocalBinding returns True of Ids and TyVars -- that must have a binding in this module. The converse @@ -378,21 +396,21 @@ isLocalVar other = True mustHaveLocalBinding var = isLocalVar var isGlobalId (GlobalId {}) = True -isGlobalId other = False +isGlobalId _ = 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 + _ -> False +isExportedId _ = False \end{code} \begin{code} globalIdDetails :: Var -> GlobalIdDetails -- Works OK on local Ids too, returning notGlobalId globalIdDetails (GlobalId {gblDetails = details}) = details -globalIdDetails other = notGlobalId +globalIdDetails _ = notGlobalId \end{code}