X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FbasicTypes%2FVar.lhs;h=566d502ae1a4a269ccc5b044fb0a5fb1f119a3fe;hb=b526760519fa077794cc68478fa6d786200f9e70;hp=351082859297d5bba8a6629182eb476c15464e15;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index 3510828..566d502 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -40,6 +40,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 @@ -84,7 +88,7 @@ data Var varName :: !Name, -- Always an External or WiredIn Name realUnique :: FastInt, idType :: Type, - idInfo :: IdInfo, + idInfo_ :: IdInfo, gblDetails :: GlobalIdDetails } | LocalId { -- Used for locally-defined Ids @@ -92,7 +96,7 @@ data Var varName :: !Name, realUnique :: FastInt, idType :: Type, - idInfo :: IdInfo, + idInfo_ :: IdInfo, lclDetails :: LocalIdDetails } data LocalIdDetails @@ -187,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 @@ -195,22 +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 --- 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 +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} %************************************************************************ @@ -277,25 +284,30 @@ globaliseId :: GlobalIdDetails -> Id -> Id globaliseId details id = GlobalId { varName = varName id, realUnique = realUnique id, idType = idType id, - idInfo = idInfo 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} @@ -312,7 +324,7 @@ mkGlobalId details name ty info realUnique = getKey# (nameUnique name), -- Cache the unique idType = ty, gblDetails = details, - idInfo = info } + idInfo_ = info } mk_local_id :: Name -> Type -> LocalIdDetails -> IdInfo -> Id mk_local_id name ty details info @@ -320,7 +332,7 @@ mk_local_id name ty details info realUnique = getKey# (nameUnique name), -- Cache the unique idType = ty, lclDetails = details, - idInfo = info } + idInfo_ = info } mkLocalId :: Name -> Type -> IdInfo -> Id mkLocalId name ty info = mk_local_id name ty NotExported info