X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FVar.lhs;h=5b3097da7da056b1f561367184fcc463893eee4d;hb=6c4e3c1ce1ee67c6355a811a6d4698efb343e361;hp=dae237db0eea8ac2453d976d1785490eb3889793;hpb=ac704fcac946590eef0ec91ae19f3b47d779a75f;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index dae237d..5b3097d 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,9 +47,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 +76,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,23 +85,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 @@ -161,12 +166,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} @@ -181,29 +186,31 @@ 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 = 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} @@ -224,10 +231,11 @@ 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 @@ -237,7 +245,7 @@ mkWildCoVar kind = ASSERT( isCoercionKind kind ) TyVar { varName = mkSysTvName wild_uniq FSLIT("co_wild"), realUnique = _ILIT(1), - tyVarKind = kind, + varType = kind, isCoercionVar = True } where wild_uniq = mkBuiltinUnique 1 @@ -259,6 +267,7 @@ type DictId = Id \begin{code} idName = varName idUnique = varUnique +idType = varType setIdUnique :: Id -> Unique -> Id setIdUnique = setVarUnique @@ -267,7 +276,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,26 +292,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} @@ -316,18 +330,18 @@ 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 } + 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 } + idInfo_ = info } mkLocalId :: Name -> Type -> IdInfo -> Id mkLocalId name ty info = mk_local_id name ty NotExported info