diff options
| -rw-r--r-- | compiler/typecheck/TcSimplify.lhs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcType.lhs | 20 | ||||
| -rw-r--r-- | compiler/typecheck/TcUnify.lhs | 6 |
3 files changed, 22 insertions, 6 deletions
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 95250f8c6d..a59a51d7e0 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -2280,7 +2280,7 @@ disambiguate extended_defaulting insts defaultable_group :: [(Inst,Class,TcTyVar)] -> Bool defaultable_group ds@((_,_,tv):_) - = not (isImmutableTyVar tv) -- Note [Avoiding spurious errors] + = isTyConableTyVar tv -- Note [Avoiding spurious errors] && not (tv `elemVarSet` bad_tvs) && defaultable_classes [c | (_,c,_) <- ds] defaultable_group [] = panic "defaultable_group" diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index e7083acb74..bfff2c8e55 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -28,7 +28,8 @@ module TcType ( UserTypeCtxt(..), pprUserTypeCtxt, TcTyVarDetails(..), BoxInfo(..), pprTcTyVarDetails, MetaDetails(Flexi, Indirect), SkolemInfo(..), pprSkolTvBinding, pprSkolInfo, - isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar, isSigTyVar, isExistentialTyVar, + isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar, + isSigTyVar, isExistentialTyVar, isTyConableTyVar, metaTvRef, isFlexi, isIndirect, @@ -478,11 +479,26 @@ instance Outputable MetaDetails where %************************************************************************ \begin{code} -isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isBoxyTyVar, isMetaTyVar :: TyVar -> Bool +isImmutableTyVar :: TyVar -> Bool + isImmutableTyVar tv | isTcTyVar tv = isSkolemTyVar tv | otherwise = True +isTyConableTyVar, isSkolemTyVar, isExistentialTyVar, + isBoxyTyVar, isMetaTyVar :: TcTyVar -> Bool + +isTyConableTyVar tv + -- True of a meta-type variable tha can be filled in + -- with a type constructor application; in particular, + -- not a SigTv + = ASSERT( isTcTyVar tv) + case tcTyVarDetails tv of + MetaTv BoxTv _ -> True + MetaTv TauTv _ -> True + MetaTv (SigTv {}) _ -> False + SkolemTv {} -> False + isSkolemTyVar tv = ASSERT( isTcTyVar tv ) case tcTyVarDetails tv of diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 4a5b2cc5e2..99cd7b9fa9 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -142,7 +142,7 @@ subFunTys error_herald n_pats res_ty thing_inside else loop n args_so_far (FunTy arg_ty' res_ty') } loop n args_so_far (TyVarTy tv) - | not (isImmutableTyVar tv) + | isTyConableTyVar tv = do { cts <- readMetaTyVar tv ; case cts of Indirect ty -> loop n args_so_far ty @@ -196,7 +196,7 @@ boxySplitTyConApp tc orig_ty = loop (n_req - 1) (arg:args_so_far) fun loop n_req args_so_far (TyVarTy tv) - | not (isImmutableTyVar tv) + | isTyConableTyVar tv = do { cts <- readMetaTyVar tv ; case cts of Indirect ty -> loop n_req args_so_far ty @@ -232,7 +232,7 @@ boxySplitAppTy orig_ty = return (fun_ty, arg_ty) loop (TyVarTy tv) - | not (isImmutableTyVar tv) + | isTyConableTyVar tv = do { cts <- readMetaTyVar tv ; case cts of Indirect ty -> loop ty |