module Var (
Var, CoVar, Id, DictId, DFunId, EvVar, EqVar, EvId, IpId,
TyVar, TypeVar, KindVar, TKVar,
varName, varUnique, varType,
setVarName, setVarUnique, setVarType,
mkGlobalVar, mkLocalVar, mkExportedLocalVar, mkCoVar,
idInfo, idDetails,
lazySetIdInfo, setIdDetails, globaliseId,
setIdExported, setIdNotExported,
isId, isTKVar, isTyVar, isTcTyVar,
isLocalVar, isLocalId,
isGlobalId, isExportedId,
mustHaveLocalBinding,
mkTyVar, mkTcTyVar, mkKindVar,
tyVarName, tyVarKind, tcTyVarDetails, setTcTyVarDetails,
setTyVarName, setTyVarUnique, setTyVarKind, updateTyVarKind,
updateTyVarKindM
) where
#include "HsVersions.h"
import TypeRep( Type, Kind, SuperKind )
import TcType( TcTyVarDetails, pprTcTyVarDetails )
import IdInfo( IdDetails, IdInfo, coVarDetails, vanillaIdInfo, pprIdDetails )
import Name hiding (varName)
import Unique
import Util
import FastTypes
import FastString
import Outputable
import Data.Data
type Id = Var
type TyVar = Var
type TKVar = Var
type TypeVar = Var
type KindVar = Var
type EvId = Id
type EvVar = EvId
type DFunId = Id
type DictId = EvId
type IpId = EvId
type EqVar = EvId
type CoVar = Id
data Var
= TyVar {
varName :: !Name,
realUnique :: FastInt,
varType :: Kind
}
| TcTyVar {
varName :: !Name,
realUnique :: FastInt,
varType :: Kind,
tc_tv_details :: TcTyVarDetails }
| Id {
varName :: !Name,
realUnique :: FastInt,
varType :: Type,
idScope :: IdScope,
id_details :: IdDetails,
id_info :: IdInfo }
deriving Typeable
data IdScope
= GlobalId
| LocalId ExportFlag
data ExportFlag
= NotExported
| Exported
instance Outputable Var where
ppr var = ppr (varName var) <> getPprStyle (ppr_debug var)
ppr_debug :: Var -> PprStyle -> SDoc
ppr_debug (TyVar {}) sty
| debugStyle sty = brackets (ptext (sLit "tv"))
ppr_debug (TcTyVar {tc_tv_details = d}) sty
| dumpStyle sty || debugStyle sty = brackets (pprTcTyVarDetails d)
ppr_debug (Id { idScope = s, id_details = d }) sty
| debugStyle sty = brackets (ppr_id_scope s <> pprIdDetails d)
ppr_debug _ _ = empty
ppr_id_scope :: IdScope -> SDoc
ppr_id_scope GlobalId = ptext (sLit "gid")
ppr_id_scope (LocalId Exported) = ptext (sLit "lidx")
ppr_id_scope (LocalId NotExported) = ptext (sLit "lid")
instance NamedThing Var where
getName = varName
instance Uniquable Var where
getUnique = varUnique
instance Eq Var where
a == b = realUnique a ==# realUnique b
instance Ord Var where
a <= b = realUnique a <=# realUnique b
a < b = realUnique a <# realUnique b
a >= b = realUnique a >=# realUnique b
a > b = realUnique a ># realUnique b
a `compare` b = varUnique a `compare` varUnique b
instance Data Var where
toConstr _ = abstractConstr "Var"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "Var"
varUnique :: Var -> Unique
varUnique var = mkUniqueGrimily (iBox (realUnique var))
setVarUnique :: Var -> Unique -> Var
setVarUnique var uniq
= var { realUnique = getKeyFastInt uniq,
varName = setNameUnique (varName var) uniq }
setVarName :: Var -> Name -> Var
setVarName var new_name
= var { realUnique = getKeyFastInt (getUnique new_name),
varName = new_name }
setVarType :: Id -> Type -> Id
setVarType id ty = id { varType = ty }
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 {varType = k}
updateTyVarKind :: (Kind -> Kind) -> TyVar -> TyVar
updateTyVarKind update tv = tv {varType = update (tyVarKind tv)}
updateTyVarKindM :: (Monad m) => (Kind -> m Kind) -> TyVar -> m TyVar
updateTyVarKindM update tv
= do { k' <- update (tyVarKind tv)
; return $ tv {varType = k'} }
mkTyVar :: Name -> Kind -> TyVar
mkTyVar name kind = TyVar { varName = name
, realUnique = getKeyFastInt (nameUnique name)
, varType = kind
}
mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
mkTcTyVar name kind details
=
TcTyVar { varName = name,
realUnique = getKeyFastInt (nameUnique name),
varType = kind,
tc_tv_details = details
}
tcTyVarDetails :: TyVar -> TcTyVarDetails
tcTyVarDetails (TcTyVar { tc_tv_details = details }) = details
tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var)
setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar
setTcTyVarDetails tv details = tv { tc_tv_details = details }
mkKindVar :: Name -> SuperKind -> KindVar
mkKindVar name kind = TyVar
{ varName = name
, realUnique = getKeyFastInt (nameUnique name)
, varType = kind }
idInfo :: Id -> IdInfo
idInfo (Id { id_info = info }) = info
idInfo other = pprPanic "idInfo" (ppr other)
idDetails :: Id -> IdDetails
idDetails (Id { id_details = details }) = details
idDetails other = pprPanic "idDetails" (ppr other)
mkGlobalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalVar details name ty info
= mk_id name ty GlobalId details info
mkLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
mkLocalVar details name ty info
= mk_id name ty (LocalId NotExported) details info
mkCoVar :: Name -> Type -> CoVar
mkCoVar name ty = mk_id name ty (LocalId NotExported) coVarDetails vanillaIdInfo
mkExportedLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
mkExportedLocalVar details name ty info
= mk_id name ty (LocalId Exported) details info
mk_id :: Name -> Type -> IdScope -> IdDetails -> IdInfo -> Id
mk_id name ty scope details info
= Id { varName = name,
realUnique = getKeyFastInt (nameUnique name),
varType = ty,
idScope = scope,
id_details = details,
id_info = info }
lazySetIdInfo :: Id -> IdInfo -> Var
lazySetIdInfo id info = id { id_info = info }
setIdDetails :: Id -> IdDetails -> Id
setIdDetails id details = id { id_details = details }
globaliseId :: Id -> Id
globaliseId id = id { idScope = GlobalId }
setIdExported :: Id -> Id
setIdExported id@(Id { idScope = LocalId {} }) = id { idScope = LocalId Exported }
setIdExported id@(Id { idScope = GlobalId }) = id
setIdExported tv = pprPanic "setIdExported" (ppr tv)
setIdNotExported :: Id -> Id
setIdNotExported id = ASSERT( isLocalId id )
id { idScope = LocalId NotExported }
isTyVar :: Var -> Bool
isTyVar = isTKVar
isTKVar :: Var -> Bool
isTKVar (TyVar {}) = True
isTKVar (TcTyVar {}) = True
isTKVar _ = False
isTcTyVar :: Var -> Bool
isTcTyVar (TcTyVar {}) = True
isTcTyVar _ = False
isId :: Var -> Bool
isId (Id {}) = True
isId _ = False
isLocalId :: Var -> Bool
isLocalId (Id { idScope = LocalId _ }) = True
isLocalId _ = False
isLocalVar :: Var -> Bool
isLocalVar v = not (isGlobalId v)
isGlobalId :: Var -> Bool
isGlobalId (Id { idScope = GlobalId }) = True
isGlobalId _ = False
mustHaveLocalBinding :: Var -> Bool
mustHaveLocalBinding var = isLocalVar var
isExportedId :: Var -> Bool
isExportedId (Id { idScope = GlobalId }) = True
isExportedId (Id { idScope = LocalId Exported}) = True
isExportedId _ = False