From: simonpj@microsoft.com <unknown>
Date: Mon, 19 Feb 2007 17:52:48 +0000 (+0000)
Subject: Signature type variables must not be instantiated with tycons
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=ad17cf6e34b6ab03f19914e7d2c1262b073db3fa

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
---

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 95250f8..a59a51d 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 e7083ac..bfff2c8 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 4a5b2cc..99cd7b9 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