--------------------------------
-- Creating new mutable type variables
- newTyVar,
+ newTyVar, newSigTyVar,
newTyVarTy, -- Kind -> TcM TcType
newTyVarTys, -- Int -> Kind -> TcM [TcType]
- newKindVar, newKindVars, newBoxityVar,
+ newKindVar, newKindVars, newOpenTypeKind,
putTcTyVar, getTcTyVar,
newMutTyVar, readMutTyVar, writeMutTyVar,
- newHoleTyVarTy, readHoleResult, zapToType,
-
--------------------------------
-- Instantiation
tcInstTyVar, tcInstTyVars, tcInstType,
-- friends:
import TypeRep ( Type(..), SourceType(..), TyNote(..), -- Friend; can see representation
- Kind, ThetaType
+ Kind, ThetaType, typeCon
)
import TcType ( TcType, TcThetaType, TcTauType, TcPredType,
TcTyVarSet, TcKind, TcTyVar, TyVarDetails(..),
tcEqType, tcCmpPred, isClassPred,
tcSplitPhiTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe,
tcSplitTyConApp_maybe, tcSplitForAllTys,
- tcIsTyVarTy, tcSplitSigmaTy,
- isUnLiftedType, isIPPred, isHoleTyVar, isTyVarTy,
+ tcIsTyVarTy, tcSplitSigmaTy, mkTyConApp,
+ isUnLiftedType, isIPPred, isTyVarTy,
mkAppTy, mkTyVarTy, mkTyVarTys,
tyVarsOfPred, getClassPredTys_maybe,
import Name ( Name, setNameUnique, mkSystemTvNameEncoded )
import VarSet
import CmdLineOpts ( dopt, DynFlag(..) )
-import Util ( nOfThem, isSingleton, equalLength, notNull )
+import Util ( nOfThem, isSingleton, equalLength, notNull, lengthExceeds )
import ListSetOps ( equivClasses, removeDups )
import Outputable
\end{code}
= newUnique `thenM` \ uniq ->
newMutTyVar (mkSystemTvNameEncoded uniq FSLIT("t")) kind VanillaTv
+newSigTyVar :: Kind -> TcM TcTyVar
+newSigTyVar kind
+ = newUnique `thenM` \ uniq ->
+ newMutTyVar (mkSystemTvNameEncoded uniq FSLIT("s")) kind SigTv
+
newTyVarTy :: Kind -> TcM TcType
newTyVarTy kind
= newTyVar kind `thenM` \ tc_tyvar ->
newKindVars :: Int -> TcM [TcKind]
newKindVars n = mappM (\ _ -> newKindVar) (nOfThem n ())
-newBoxityVar :: TcM TcKind
-newBoxityVar
+newOpenTypeKind :: TcM TcKind -- Returns the kind (Type bx), where bx is fresh
+newOpenTypeKind
= newUnique `thenM` \ uniq ->
newMutTyVar (mkSystemTvNameEncoded uniq FSLIT("bx")) superBoxity VanillaTv `thenM` \ kv ->
- returnM (TyVarTy kv)
+ returnM (mkTyConApp typeCon [TyVarTy kv])
\end{code}
%************************************************************************
%* *
-\subsection{'hole' type variables}
-%* *
-%************************************************************************
-
-\begin{code}
-newHoleTyVarTy :: TcM TcType
- = newUnique `thenM` \ uniq ->
- newMutTyVar (mkSystemTvNameEncoded uniq FSLIT("h")) openTypeKind HoleTv `thenM` \ tv ->
- returnM (TyVarTy tv)
-
-readHoleResult :: TcType -> TcM TcType
--- Read the answer out of a hole, constructed by newHoleTyVarTy
-readHoleResult (TyVarTy tv)
- = ASSERT( isHoleTyVar tv )
- getTcTyVar tv `thenM` \ maybe_res ->
- case maybe_res of
- Just ty -> returnM ty
- Nothing -> pprPanic "readHoleResult: empty" (ppr tv)
-readHoleResult ty = pprPanic "readHoleResult: not hole" (ppr ty)
-
-zapToType :: TcType -> TcM TcType
-zapToType (TyVarTy tv)
- | isHoleTyVar tv
- = getTcTyVar tv `thenM` \ maybe_res ->
- case maybe_res of
- Nothing -> newTyVarTy openTypeKind `thenM` \ ty ->
- putTcTyVar tv ty `thenM_`
- returnM ty
- Just ty -> returnM ty -- No need to loop; we never
- -- have chains of holes
-
-zapToType other_ty = returnM other_ty
-\end{code}
-
-%************************************************************************
-%* *
\subsection{Type instantiation}
%* *
%************************************************************************
%************************************************************************
\begin{code}
+-- Enumerate the contexts in which a "source type", <S>, can occur
+-- Eq a
+-- or ?x::Int
+-- or r <: {x::Int}
+-- or (N a) where N is a newtype
+
data SourceTyCtxt
= ClassSCCtxt Name -- Superclasses of clas
- | SigmaCtxt -- Context of a normal for-all type
- | DataTyCtxt Name -- Context of a data decl
+ -- class <S> => C a where ...
+ | SigmaCtxt -- Theta part of a normal for-all type
+ -- f :: <S> => a -> a
+ | DataTyCtxt Name -- Theta part of a data decl
+ -- data <S> => T a = MkT a
| TypeCtxt -- Source type in an ordinary type
+ -- f :: N a -> N a
| InstThetaCtxt -- Context of an instance decl
+ -- instance <S> => C [a] where ...
| InstHeadCtxt -- Head of an instance decl
+ -- instance ... => Eq a where ...
pprSourceTyCtxt (ClassSCCtxt c) = ptext SLIT("the super-classes of class") <+> quotes (ppr c)
pprSourceTyCtxt SigmaCtxt = ptext SLIT("the context of a polymorphic type")
-- This checks the argument types and
-- ambiguity of the existential context (if any)
addErrCtxt (existentialCtxt con)
- (checkFreeness ex_tvs ex_theta)
+ (checkFreeness ex_tvs ex_theta)
where
ctxt = ConArgCtxt (dataConName con)
(_, _, ex_tvs, ex_theta, _, _) = dataConSig con