summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2007-02-19 17:52:48 +0000
committersimonpj@microsoft.com <unknown>2007-02-19 17:52:48 +0000
commitad17cf6e34b6ab03f19914e7d2c1262b073db3fa (patch)
treea56c29025660cf18c4ac44f8b3b7256fbc9a2a3d
parent67f8c4685920582ad82000e7840a1ffe91682f35 (diff)
downloadhaskell-ad17cf6e34b6ab03f19914e7d2c1262b073db3fa.tar.gz
Signature type variables must not be instantiated with tycons
An egregious bug in the type checker meant that it was possible for a "signature type variable" (a MetaTv of SigTv form) to be instantatiated with a type-constructor application. This destroys the invariant for SigTv. The fix is easy; adding the predicate TcType.isTyConableTyVar Fixes Trac #1153
-rw-r--r--compiler/typecheck/TcSimplify.lhs2
-rw-r--r--compiler/typecheck/TcType.lhs20
-rw-r--r--compiler/typecheck/TcUnify.lhs6
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