X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FVar.lhs;h=dae237db0eea8ac2453d976d1785490eb3889793;hb=ac704fcac946590eef0ec91ae19f3b47d779a75f;hp=d4bf400ef6cced13d2dc15d7d94f7bc52e26ed16;hpb=0b86bc9b022a5965d2b35f143ff4b919f784e676;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index d4bf400..dae237d 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -1,4 +1,5 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section{@Vars@: Variables} @@ -22,7 +23,7 @@ module Var ( Id, DictId, idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo, setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, - setIdExported, setIdNotExported, + setIdExported, setIdNotExported, globalIdDetails, globaliseId, @@ -35,17 +36,19 @@ module Var ( #include "HsVersions.h" -import {-# SOURCE #-} TypeRep( Type, Kind, isCoSuperKind ) +import {-# SOURCE #-} TypeRep( Type, Kind ) import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails ) -import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, IdInfo, seqIdInfo ) - -import Name ( Name, NamedThing(..), - setNameUnique, nameUnique, mkSysTvName - ) -import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey#, - mkBuiltinUnique ) +import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, + IdInfo, seqIdInfo ) +#ifdef DEBUG +import {-# SOURCE #-} TypeRep( isCoercionKind ) +#endif + +import Name hiding (varName) +import Unique import FastTypes -import Outputable +import FastString +import Outputable \end{code} @@ -188,7 +191,8 @@ setTyVarKind tv k = tv {tyVarKind = k} \begin{code} mkTyVar :: Name -> Kind -> TyVar -mkTyVar name kind = TyVar { varName = name +mkTyVar name kind = ASSERT( not (isCoercionKind kind ) ) + TyVar { varName = name , realUnique = getKey# (nameUnique name) , tyVarKind = kind , isCoercionVar = False @@ -196,20 +200,12 @@ mkTyVar name kind = TyVar { varName = name mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar mkTcTyVar name kind details - = TcTyVar { varName = name, + = ASSERT( not (isCoercionKind kind) ) + TcTyVar { varName = name, realUnique = getKey# (nameUnique name), tyVarKind = kind, tcTyVarDetails = details } - -mkWildCoVar :: Kind -> TyVar -mkWildCoVar kind - = TyVar { varName = mkSysTvName wild_uniq FSLIT("co_wild"), - realUnique = _ILIT(1), - tyVarKind = kind, - isCoercionVar = True } - where - wild_uniq = (mkBuiltinUnique 1) \end{code} %************************************************************************ @@ -227,12 +223,24 @@ setCoVarUnique = setVarUnique setCoVarName = setVarName mkCoVar :: Name -> Kind -> CoVar -mkCoVar name kind = TyVar { varName = name +mkCoVar name kind = ASSERT( isCoercionKind kind ) + TyVar { varName = name , realUnique = getKey# (nameUnique name) , tyVarKind = kind , isCoercionVar = True } +mkWildCoVar :: Kind -> TyVar +-- A type variable that is never referred to, +-- so its unique doesn't matter +mkWildCoVar kind + = ASSERT( isCoercionKind kind ) + TyVar { varName = mkSysTvName wild_uniq FSLIT("co_wild"), + realUnique = _ILIT(1), + tyVarKind = kind, + isCoercionVar = True } + where + wild_uniq = mkBuiltinUnique 1 \end{code} %************************************************************************