X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FVar.lhs;h=2f4edd300f7494ed420c044e3e3e8067ec716f27;hp=351082859297d5bba8a6629182eb476c15464e15;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hpb=49c98d143c382a1341e1046f5ca00819a25691ba diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index 3510828..2f4edd3 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -5,9 +5,16 @@ \section{@Vars@: Variables} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module Var ( Var, - varName, varUnique, + varName, varUnique, varType, setVarName, setVarUnique, -- TyVars @@ -40,6 +47,10 @@ 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 import FastTypes @@ -67,7 +78,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 } @@ -76,23 +87,23 @@ 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, - idInfo :: IdInfo, + varType :: Type, + idInfo_ :: IdInfo, gblDetails :: GlobalIdDetails } | LocalId { -- Used for locally-defined Ids -- See Note [GlobalId/LocalId] below varName :: !Name, realUnique :: FastInt, - idType :: Type, - idInfo :: IdInfo, + varType :: Type, + idInfo_ :: IdInfo, lclDetails :: LocalIdDetails } data LocalIdDetails @@ -177,40 +188,33 @@ setVarName var new_name type TyVar = Var tyVarName = varName +tyVarKind = varType setTyVarUnique = setVarUnique 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 = TyVar { varName = name +mkTyVar name kind = ASSERT( not (isCoercionKind kind ) ) + TyVar { varName = name , realUnique = getKey# (nameUnique name) - , tyVarKind = kind + , varType = kind , isCoercionVar = False } mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar mkTcTyVar name kind details - = TcTyVar { varName = name, + = -- TOM: no longer valid assertion? + -- ASSERT( not (isCoercionKind kind) ) + TcTyVar { varName = name, realUnique = getKey# (nameUnique name), - tyVarKind = kind, + varType = kind, tcTyVarDetails = details } - -mkWildCoVar :: Kind -> TyVar --- A type variable that is never referred to, --- so its unique doesn't matter -mkWildCoVar kind - = TyVar { varName = mkSysTvName wild_uniq FSLIT("co_wild"), - realUnique = _ILIT(1), - tyVarKind = kind, - isCoercionVar = True } - where - wild_uniq = mkBuiltinUnique 1 \end{code} %************************************************************************ @@ -228,12 +232,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 + , varType = 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), + varType = kind, + isCoercionVar = True } + where + wild_uniq = mkBuiltinUnique 1 \end{code} %************************************************************************ @@ -252,6 +268,7 @@ type DictId = Id \begin{code} idName = varName idUnique = varUnique +idType = varType setIdUnique :: Id -> Unique -> Id setIdUnique = setVarUnique @@ -260,7 +277,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, @@ -276,26 +293,31 @@ 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, + varType = varType id, + idInfo_ = idInfo id, gblDetails = details } +idInfo :: Id -> IdInfo +idInfo (GlobalId {idInfo_ = info}) = info +idInfo (LocalId {idInfo_ = info}) = info +idInfo other_var = pprPanic "idInfo" (ppr other_var) + lazySetIdInfo :: Id -> IdInfo -> Id -lazySetIdInfo id info = id {idInfo = info} +lazySetIdInfo id info = id {idInfo_ = info} setIdInfo :: Id -> IdInfo -> Id -setIdInfo id info = seqIdInfo info `seq` id {idInfo = 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 id - = seqIdInfo new_info `seq` id {idInfo = new_info} + = seqIdInfo new_info `seq` id {idInfo_ = new_info} where new_info = fn (idInfo id) -- maybeModifyIdInfo tries to avoid unnecesary thrashing maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id -maybeModifyIdInfo (Just new_info) id = id {idInfo = new_info} +maybeModifyIdInfo (Just new_info) id = id {idInfo_ = new_info} maybeModifyIdInfo Nothing id = id \end{code} @@ -310,17 +332,17 @@ mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id mkGlobalId details name ty info = GlobalId { varName = name, realUnique = getKey# (nameUnique name), -- Cache the unique - idType = ty, + varType = ty, gblDetails = details, - idInfo = info } + 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, + varType = ty, lclDetails = details, - idInfo = info } + idInfo_ = info } mkLocalId :: Name -> Type -> IdInfo -> Id mkLocalId name ty info = mk_local_id name ty NotExported info