\begin{code}
module TcUnify ( unifyTauTy, unifyTauTyList, unifyTauTyLists,
- unifyFunTy, unifyListTy, unifyTupleTy, unifyUnboxedTupleTy,
- unifyKind, unifyKinds
+ unifyFunTy, unifyListTy, unifyTupleTy,
+ unifyKind, unifyKinds, unifyOpenTypeKind
) where
#include "HsVersions.h"
-- friends:
import TcMonad
-import TcEnv ( tidyType, tidyTypes, tidyTyVar )
-import Type ( GenType(..), Type, tyVarsOfType, funTyCon,
- typeKind, mkFunTy, splitFunTy_maybe, splitTyConApp_maybe,
- Kind, hasMoreBoxityInfo, openTypeKind, boxedTypeKind, superKind,
- splitAppTy_maybe
+import TypeRep ( Type(..), PredType(..) ) -- friend
+import Type ( unboxedTypeKind, boxedTypeKind, openTypeKind,
+ typeCon, openKindCon, hasMoreBoxityInfo,
+ tyVarsOfType, typeKind,
+ mkFunTy, splitFunTy_maybe, splitTyConApp_maybe,
+ isNotUsgTy, splitAppTy_maybe, mkTyConApp,
+ tidyOpenType, tidyOpenTypes, tidyTyVar
)
-import TyCon ( TyCon, isTupleTyCon, isUnboxedTupleTyCon,
- tyConArity, matchesTyCon )
-import Name ( isSysLocalName )
-import Var ( TyVar, tyVarKind, varName )
-import VarEnv
+import TyCon ( TyCon, isTupleTyCon, tupleTyConBoxity, tyConArity )
+import Var ( tyVarKind, varName, isSigTyVar )
import VarSet ( varSetElems )
-import TcType ( TcType, TcMaybe(..), TcTauType, TcTyVar,
- TcKind,
- newTyVarTy, tcReadTyVar, tcWriteTyVar, zonkTcType
+import TcType ( TcType, TcTauType, TcTyVar, TcKind, newBoxityVar,
+ newTyVarTy, newTyVarTys, tcGetTyVar, tcPutTyVar, zonkTcType
)
+import Name ( isSystemName )
+
-- others:
-import BasicTypes ( Arity )
-import TysWiredIn ( listTyCon, mkListTy, mkTupleTy, mkUnboxedTupleTy )
-import PprType () -- Instances
-import Util
+import BasicTypes ( Arity, Boxity, isBoxed )
+import TysWiredIn ( listTyCon, mkListTy, mkTupleTy )
import Outputable
\end{code}
%************************************************************************
\begin{code}
-unifyKind :: TcKind s -- Expected
- -> TcKind s -- Actual
- -> TcM s ()
+unifyKind :: TcKind -- Expected
+ -> TcKind -- Actual
+ -> TcM ()
unifyKind k1 k2
= tcAddErrCtxtM (unifyCtxt "kind" k1 k2) $
uTys k1 k1 k2 k2
-unifyKinds :: [TcKind s] -> [TcKind s] -> TcM s ()
+unifyKinds :: [TcKind] -> [TcKind] -> TcM ()
unifyKinds [] [] = returnTc ()
unifyKinds (k1:ks1) (k2:ks2) = unifyKind k1 k2 `thenTc_`
unifyKinds ks1 ks2
unifyKinds _ _ = panic "unifyKinds: length mis-match"
\end{code}
+\begin{code}
+unifyOpenTypeKind :: TcKind -> TcM ()
+-- Ensures that the argument kind is of the form (Type bx)
+-- for some boxity bx
+
+unifyOpenTypeKind ty@(TyVarTy tyvar)
+ = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+ case maybe_ty of
+ Just ty' -> unifyOpenTypeKind ty'
+ other -> unify_open_kind_help ty
+
+unifyOpenTypeKind ty
+ = case splitTyConApp_maybe ty of
+ Just (tycon, [_]) | tycon == typeCon -> returnTc ()
+ other -> unify_open_kind_help ty
+
+unify_open_kind_help ty -- Revert to ordinary unification
+ = newBoxityVar `thenNF_Tc` \ boxity ->
+ unifyKind ty (mkTyConApp typeCon [boxity])
+\end{code}
+
%************************************************************************
%* *
Unify two @TauType@s. Dead straightforward.
\begin{code}
-unifyTauTy :: TcTauType s -> TcTauType s -> TcM s ()
+unifyTauTy :: TcTauType -> TcTauType -> TcM ()
unifyTauTy ty1 ty2 -- ty1 expected, ty2 inferred
= tcAddErrCtxtM (unifyCtxt "type" ty1 ty2) $
uTys ty1 ty1 ty2 ty2
complain if their lengths differ.
\begin{code}
-unifyTauTyLists :: [TcTauType s] -> [TcTauType s] -> TcM s ()
+unifyTauTyLists :: [TcTauType] -> [TcTauType] -> TcM ()
unifyTauTyLists [] [] = returnTc ()
unifyTauTyLists (ty1:tys1) (ty2:tys2) = uTys ty1 ty1 ty2 ty2 `thenTc_`
unifyTauTyLists tys1 tys2
lists, when all the elts should be of the same type.
\begin{code}
-unifyTauTyList :: [TcTauType s] -> TcM s ()
+unifyTauTyList :: [TcTauType] -> TcM ()
unifyTauTyList [] = returnTc ()
unifyTauTyList [ty] = returnTc ()
unifyTauTyList (ty1:tys@(ty2:_)) = unifyTauTy ty1 ty2 `thenTc_`
We call the first one \tr{ps_ty1}, \tr{ps_ty2} for ``possible synomym''.
\begin{code}
-uTys :: TcTauType s -> TcTauType s -- Error reporting ty1 and real ty1
- -> TcTauType s -> TcTauType s -- Error reporting ty2 and real ty2
- -> TcM s ()
+uTys :: TcTauType -> TcTauType -- Error reporting ty1 and real ty1
+ -- ty1 is the *expected* type
+
+ -> TcTauType -> TcTauType -- Error reporting ty2 and real ty2
+ -- ty2 is the *actual* type
+ -> TcM ()
-- Always expand synonyms (see notes at end)
+ -- (this also throws away FTVs and usage annots)
uTys ps_ty1 (NoteTy _ ty1) ps_ty2 ty2 = uTys ps_ty1 ty1 ps_ty2 ty2
uTys ps_ty1 ty1 ps_ty2 (NoteTy _ ty2) = uTys ps_ty1 ty1 ps_ty2 ty2
uTys ps_ty1 ty1 ps_ty2 (TyVarTy tyvar2) = uVar True tyvar2 ps_ty1 ty1
-- "True" means args swapped
+ -- Predicates
+uTys _ (PredTy (IParam n1 t1)) _ (PredTy (IParam n2 t2))
+ | n1 == n2 = uTys t1 t1 t2 t2
+uTys _ (PredTy (Class c1 tys1)) _ (PredTy (Class c2 tys2))
+ | c1 == c2 = unifyTauTyLists tys1 tys2
+
-- Functions; just check the two parts
uTys _ (FunTy fun1 arg1) _ (FunTy fun2 arg2)
= uTys fun1 fun1 fun2 fun2 `thenTc_` uTys arg1 arg1 arg2 arg2
-- Type constructors must match
uTys ps_ty1 (TyConApp con1 tys1) ps_ty2 (TyConApp con2 tys2)
- = checkTcM (con1 `matchesTyCon` con2 && length tys1 == length tys2)
- (failWithTcM (unifyMisMatch ps_ty1 ps_ty2)) `thenTc_`
- unifyTauTyLists tys1 tys2
+ | con1 == con2 && length tys1 == length tys2
+ = unifyTauTyLists tys1 tys2
+
+ | con1 == openKindCon
+ -- When we are doing kind checking, we might match a kind '?'
+ -- against a kind '*' or '#'. Notably, CCallable :: ? -> *, and
+ -- (CCallable Int) and (CCallable Int#) are both OK
+ = unifyOpenTypeKind ps_ty2
-- Applications need a bit of care!
-- They can match FunTy and TyConApp, so use splitAppTy_maybe
uTys ps_ty1 (AppTy s1 t1) ps_ty2 ty2
= case splitAppTy_maybe ty2 of
Just (s2,t2) -> uTys s1 s1 s2 s2 `thenTc_` uTys t1 t1 t2 t2
- Nothing -> failWithTcM (unifyMisMatch ps_ty1 ps_ty2)
+ Nothing -> unifyMisMatch ps_ty1 ps_ty2
-- Now the same, but the other way round
- -- ** DON'T ** swap the types, because when unifying kinds
- -- we need to check that the expected type has less boxity info
- -- than the inferred one; so we need to keep them the right way round
+ -- Don't swap the types, because the error messages get worse
uTys ps_ty1 ty1 ps_ty2 (AppTy s2 t2)
= case splitAppTy_maybe ty1 of
Just (s1,t1) -> uTys s1 s1 s2 s2 `thenTc_` uTys t1 t1 t2 t2
- Nothing -> failWithTcM (unifyMisMatch ps_ty1 ps_ty2)
+ Nothing -> unifyMisMatch ps_ty1 ps_ty2
-- Not expecting for-alls in unification
-- ... but the error message from the unifyMisMatch more informative
-- than a panic message!
-- Anything else fails
-uTys ps_ty1 ty1 ps_ty2 ty2 = failWithTcM (unifyMisMatch ps_ty1 ps_ty2)
+uTys ps_ty1 ty1 ps_ty2 ty2 = unifyMisMatch ps_ty1 ps_ty2
\end{code}
Notes on synonyms
\begin{code}
uVar :: Bool -- False => tyvar is the "expected"
-- True => ty is the "expected" thing
- -> TcTyVar s
- -> TcTauType s -> TcTauType s -- printing and real versions
- -> TcM s ()
+ -> TcTyVar
+ -> TcTauType -> TcTauType -- printing and real versions
+ -> TcM ()
uVar swapped tv1 ps_ty2 ty2
- = tcReadTyVar tv1 `thenNF_Tc` \ maybe_ty1 ->
+ = tcGetTyVar tv1 `thenNF_Tc` \ maybe_ty1 ->
case maybe_ty1 of
- BoundTo ty1 | swapped -> uTys ps_ty2 ty2 ty1 ty1 -- Swap back
- | otherwise -> uTys ty1 ty1 ps_ty2 ty2 -- Same order
- other -> uUnboundVar tv1 maybe_ty1 ps_ty2 ty2
+ Just ty1 | swapped -> uTys ps_ty2 ty2 ty1 ty1 -- Swap back
+ | otherwise -> uTys ty1 ty1 ps_ty2 ty2 -- Same order
+ other -> uUnboundVar swapped tv1 maybe_ty1 ps_ty2 ty2
- -- Expand synonyms
-uUnboundVar tv1 maybe_ty1 ps_ty2 (NoteTy _ ty2)
- = uUnboundVar tv1 maybe_ty1 ps_ty2 ty2
+ -- Expand synonyms; ignore FTVs; ignore usage annots
+uUnboundVar swapped tv1 maybe_ty1 ps_ty2 (NoteTy _ ty2)
+ = uUnboundVar swapped tv1 maybe_ty1 ps_ty2 ty2
-- The both-type-variable case
-uUnboundVar tv1 maybe_ty1 ps_ty2 ty2@(TyVarTy tv2)
+uUnboundVar swapped tv1 maybe_ty1 ps_ty2 ty2@(TyVarTy tv2)
-- Same type variable => no-op
| tv1 == tv2
= returnTc ()
-- Distinct type variables
- -- ASSERT maybe_ty1 /= BoundTo
+ -- ASSERT maybe_ty1 /= Just
| otherwise
- = tcReadTyVar tv2 `thenNF_Tc` \ maybe_ty2 ->
+ = tcGetTyVar tv2 `thenNF_Tc` \ maybe_ty2 ->
case maybe_ty2 of
- BoundTo ty2' -> uUnboundVar tv1 maybe_ty1 ty2' ty2'
-
- -- Try to update sys-y type variables in preference to sig-y ones
- -- (the latter respond False to isSysLocalName)
- UnBound | can_update_tv2
- && (tv2_is_sys_y || not can_update_tv1)
- -> tcWriteTyVar tv2 (TyVarTy tv1) `thenNF_Tc_` returnTc ()
-
- | can_update_tv1
- -> tcWriteTyVar tv1 ps_ty2 `thenNF_Tc_` returnTc ()
-
- other -> failWithTc (unifyKindErr tv1 ps_ty2)
- where
- kind1 = tyVarKind tv1
- kind2 = tyVarKind tv2
+ Just ty2' -> uUnboundVar swapped tv1 maybe_ty1 ty2' ty2'
- can_update_tv1 = kind2 `hasMoreBoxityInfo` kind1
- can_update_tv2 = kind1 `hasMoreBoxityInfo` kind2
+ Nothing | tv1_dominates_tv2
- -- Try to overwrite sys-y things with sig-y things
- tv2_is_sys_y = isSysLocalName (varName tv2)
+ -> WARN( not (k1 `hasMoreBoxityInfo` k2), (ppr tv1 <+> ppr k1) $$ (ppr tv2 <+> ppr k2) )
+ tcPutTyVar tv2 (TyVarTy tv1) `thenNF_Tc_`
+ returnTc ()
+ | otherwise
+ -> WARN( not (k2 `hasMoreBoxityInfo` k1), (ppr tv2 <+> ppr k2) $$ (ppr tv1 <+> ppr k1) )
+ (ASSERT( isNotUsgTy ps_ty2 )
+ tcPutTyVar tv1 ps_ty2 `thenNF_Tc_`
+ returnTc ())
+ where
+ k1 = tyVarKind tv1
+ k2 = tyVarKind tv2
+ tv1_dominates_tv2 = isSigTyVar tv1
+ -- Don't unify a signature type variable if poss
+ || k2 == openTypeKind
+ -- Try to get rid of open type variables as soon as poss
+ || isSystemName (varName tv2)
+ -- Try to update sys-y type variables in preference to sig-y ones
-- Second one isn't a type variable
-uUnboundVar tv1 maybe_ty1 ps_ty2 non_var_ty2
- | non_var_ty2 == openTypeKind
- = -- We never bind a kind variable to openTypeKind;
- -- instead we refine it to boxedTypeKind
- -- This is a rather dark corner, I have to admit. SLPJ May 98
- tcWriteTyVar tv1 boxedTypeKind `thenNF_Tc_`
- returnTc ()
-
- | tyvar_kind == superKind
- || typeKind non_var_ty2 `hasMoreBoxityInfo` tyvar_kind
- -- OK to bind if we're at the kind level, or
- -- (at the type level) the variable has less boxity info than the type
- = occur_check non_var_ty2 `thenTc_`
- tcWriteTyVar tv1 ps_ty2 `thenNF_Tc_`
- returnTc ()
-
- | otherwise
- = failWithTc (unifyKindErr tv1 ps_ty2)
-
+uUnboundVar swapped tv1 maybe_ty1 ps_ty2 non_var_ty2
+ = checkKinds swapped tv1 non_var_ty2 `thenTc_`
+ occur_check non_var_ty2 `thenTc_`
+ ASSERT( isNotUsgTy ps_ty2 )
+ checkTcM (not (isSigTyVar tv1))
+ (failWithTcM (unifyWithSigErr tv1 ps_ty2)) `thenTc_`
+
+ warnTc (not (typeKind non_var_ty2 `hasMoreBoxityInfo` tyVarKind tv1))
+ ((ppr tv1 <+> ppr (tyVarKind tv1)) $$
+ (ppr non_var_ty2 <+> ppr (typeKind non_var_ty2))) `thenNF_Tc_`
+
+ tcPutTyVar tv1 non_var_ty2 `thenNF_Tc_`
+ -- This used to say "ps_ty2" instead of "non_var_ty2"
+
+ -- But that led to an infinite loop in the type checker!
+ -- Consider
+ -- type A a = ()
+ --
+ -- f :: (A a -> a -> ()) -> ()
+ -- f = \ _ -> ()
+ --
+ -- x :: ()
+ -- x = f (\ x p -> p x)
+ --
+ -- Here, we try to match "t" with "A t", and succeed
+ -- because the unifier looks through synonyms. The occurs
+ -- check doesn't kick in because we are "really" binding "t" to "()",
+ -- but we *actually* bind "t" to "A t" if we store ps_ty2.
+ -- That leads the typechecker into an infinite loop later.
+
+ returnTc ()
where
- tyvar_kind = tyVarKind tv1
-
occur_check ty = mapTc occur_check_tv (varSetElems (tyVarsOfType ty)) `thenTc_`
returnTc ()
failWithTcM (unifyOccurCheck tv1 zonked_ty2)
| otherwise -- A different tyvar
- = tcReadTyVar tv2 `thenNF_Tc` \ maybe_ty2 ->
+ = tcGetTyVar tv2 `thenNF_Tc` \ maybe_ty2 ->
case maybe_ty2 of
- BoundTo ty2' -> occur_check ty2'
- other -> returnTc ()
+ Just ty2' -> occur_check ty2'
+ other -> returnTc ()
+
+checkKinds swapped tv1 ty2
+-- We're about to unify a type variable tv1 with a non-tyvar-type ty2.
+-- We need to check that we don't unify a boxed type variable with an
+-- unboxed type: e.g. (id 3#) is illegal
+ | tk1 == boxedTypeKind && tk2 == unboxedTypeKind
+ = tcAddErrCtxtM (unifyKindCtxt swapped tv1 ty2) $
+ unifyMisMatch k1 k2
+ | otherwise
+ = returnTc ()
+ where
+ (k1,k2) | swapped = (tk2,tk1)
+ | otherwise = (tk1,tk2)
+ tk1 = tyVarKind tv1
+ tk2 = typeKind ty2
\end{code}
+
%************************************************************************
%* *
\subsection[Unify-fun]{@unifyFunTy@}
@unifyFunTy@ is used to avoid the fruitless creation of type variables.
\begin{code}
-unifyFunTy :: TcType s -- Fail if ty isn't a function type
- -> TcM s (TcType s, TcType s) -- otherwise return arg and result types
+unifyFunTy :: TcType -- Fail if ty isn't a function type
+ -> TcM (TcType, TcType) -- otherwise return arg and result types
unifyFunTy ty@(TyVarTy tyvar)
- = tcReadTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+ = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
- BoundTo ty' -> unifyFunTy ty'
+ Just ty' -> unifyFunTy ty'
other -> unify_fun_ty_help ty
unifyFunTy ty
Nothing -> unify_fun_ty_help ty
unify_fun_ty_help ty -- Special cases failed, so revert to ordinary unification
- = newTyVarTy openTypeKind `thenNF_Tc` \ arg ->
- newTyVarTy openTypeKind `thenNF_Tc` \ res ->
+ = newTyVarTy openTypeKind `thenNF_Tc` \ arg ->
+ newTyVarTy openTypeKind `thenNF_Tc` \ res ->
unifyTauTy ty (mkFunTy arg res) `thenTc_`
returnTc (arg,res)
\end{code}
\begin{code}
-unifyListTy :: TcType s -- expected list type
- -> TcM s (TcType s) -- list element type
+unifyListTy :: TcType -- expected list type
+ -> TcM TcType -- list element type
unifyListTy ty@(TyVarTy tyvar)
- = tcReadTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+ = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
- BoundTo ty' -> unifyListTy ty'
+ Just ty' -> unifyListTy ty'
other -> unify_list_ty_help ty
unifyListTy ty
\end{code}
\begin{code}
-unifyTupleTy :: Arity -> TcType s -> TcM s [TcType s]
-unifyTupleTy arity ty@(TyVarTy tyvar)
- = tcReadTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+unifyTupleTy :: Boxity -> Arity -> TcType -> TcM [TcType]
+unifyTupleTy boxity arity ty@(TyVarTy tyvar)
+ = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
- BoundTo ty' -> unifyTupleTy arity ty'
- other -> unify_tuple_ty_help arity ty
+ Just ty' -> unifyTupleTy boxity arity ty'
+ other -> unify_tuple_ty_help boxity arity ty
-unifyTupleTy arity ty
+unifyTupleTy boxity arity ty
= case splitTyConApp_maybe ty of
- Just (tycon, arg_tys) | isTupleTyCon tycon
- && tyConArity tycon == arity
- -> returnTc arg_tys
- other -> unify_tuple_ty_help arity ty
-
-unify_tuple_ty_help arity ty
- = mapNF_Tc (\ _ -> newTyVarTy boxedTypeKind) [1..arity] `thenNF_Tc` \ arg_tys ->
- unifyTauTy ty (mkTupleTy arity arg_tys) `thenTc_`
+ Just (tycon, arg_tys)
+ | isTupleTyCon tycon
+ && tyConArity tycon == arity
+ && tupleTyConBoxity tycon == boxity
+ -> returnTc arg_tys
+ other -> unify_tuple_ty_help boxity arity ty
+
+unify_tuple_ty_help boxity arity ty
+ = newTyVarTys arity kind `thenNF_Tc` \ arg_tys ->
+ unifyTauTy ty (mkTupleTy boxity arity arg_tys) `thenTc_`
returnTc arg_tys
+ where
+ kind | isBoxed boxity = boxedTypeKind
+ | otherwise = openTypeKind
\end{code}
-\begin{code}
-unifyUnboxedTupleTy :: Arity -> TcType s -> TcM s [TcType s]
-unifyUnboxedTupleTy arity ty@(TyVarTy tyvar)
- = tcReadTyVar tyvar `thenNF_Tc` \ maybe_ty ->
- case maybe_ty of
- BoundTo ty' -> unifyUnboxedTupleTy arity ty'
- other -> unify_unboxed_tuple_ty_help arity ty
-
-unifyUnboxedTupleTy arity ty
- = case splitTyConApp_maybe ty of
- Just (tycon, arg_tys) | isUnboxedTupleTyCon tycon
- && tyConArity tycon == arity
- -> returnTc arg_tys
- other -> unify_tuple_ty_help arity ty
-
-unify_unboxed_tuple_ty_help arity ty
- = mapNF_Tc (\ _ -> newTyVarTy openTypeKind) [1..arity]`thenNF_Tc` \ arg_tys ->
- unifyTauTy ty (mkUnboxedTupleTy arity arg_tys) `thenTc_`
- returnTc arg_tys
-\end{code}
%************************************************************************
%* *
text "Inferred" <+> text s <> colon <+> ppr tidy_ty2
]))
where
- (env1, [tidy_ty1,tidy_ty2]) = tidyTypes tidy_env [ty1,ty2]
+ (env1, [tidy_ty1,tidy_ty2]) = tidyOpenTypes tidy_env [ty1,ty2]
-unifyMisMatch ty1 ty2
- = (env2, hang (ptext SLIT("Couldn't match"))
- 4 (sep [quotes (ppr tidy_ty1), ptext SLIT("against"), quotes (ppr tidy_ty2)]))
+unifyKindCtxt swapped tv1 ty2 tidy_env -- not swapped => tv1 expected, ty2 inferred
+ -- tv1 is zonked already
+ = zonkTcType ty2 `thenNF_Tc` \ ty2' ->
+ returnNF_Tc (err ty2')
where
- (env1, tidy_ty1) = tidyType emptyTidyEnv ty1
- (env2, tidy_ty2) = tidyType env1 ty2
+ err ty2 = (env2, ptext SLIT("When matching types") <+>
+ sep [quotes pp_expected, ptext SLIT("and"), quotes pp_actual])
+ where
+ (pp_expected, pp_actual) | swapped = (pp2, pp1)
+ | otherwise = (pp1, pp2)
+ (env1, tv1') = tidyTyVar tidy_env tv1
+ (env2, ty2') = tidyOpenType env1 ty2
+ pp1 = ppr tv1'
+ pp2 = ppr ty2'
-unifyKindErr tyvar ty
- = hang (ptext SLIT("Kind mis-match between"))
- 4 (sep [quotes (hsep [ppr tyvar, ptext SLIT("::"), ppr (tyVarKind tyvar)]),
- ptext SLIT("and"),
- quotes (hsep [ppr ty, ptext SLIT("::"), ppr (typeKind ty)])])
+unifyMisMatch ty1 ty2
+ = zonkTcType ty1 `thenNF_Tc` \ ty1' ->
+ zonkTcType ty2 `thenNF_Tc` \ ty2' ->
+ let
+ (env, [tidy_ty1, tidy_ty2]) = tidyOpenTypes emptyTidyEnv [ty1',ty2']
+ msg = hang (ptext SLIT("Couldn't match"))
+ 4 (sep [quotes (ppr tidy_ty1),
+ ptext SLIT("against"),
+ quotes (ppr tidy_ty2)])
+ in
+ failWithTcM (env, msg)
+
+unifyWithSigErr tyvar ty
+ = (env2, hang (ptext SLIT("Cannot unify the type-signature variable") <+> quotes (ppr tidy_tyvar))
+ 4 (ptext SLIT("with the type") <+> quotes (ppr tidy_ty)))
+ where
+ (env1, tidy_tyvar) = tidyTyVar emptyTidyEnv tyvar
+ (env2, tidy_ty) = tidyOpenType env1 ty
unifyOccurCheck tyvar ty
= (env2, hang (ptext SLIT("Occurs check: cannot construct the infinite type:"))
4 (sep [ppr tidy_tyvar, char '=', ppr tidy_ty]))
where
(env1, tidy_tyvar) = tidyTyVar emptyTidyEnv tyvar
- (env2, tidy_ty) = tidyType env1 ty
+ (env2, tidy_ty) = tidyOpenType env1 ty
\end{code}