From 335bc125303a226a78b20be8a7b8fec5b6c59d2b Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Wed, 1 Nov 2006 17:33:25 +0000
Subject: [PATCH] Default the kind of unconstrained meta-type variables before
 tcSimplifyTop

This patch fixes a long standing bug, Trac #179,
and a recently reported one, Trac #963.

The problem in both cases was an unconstrained type variable 'a', of kind
argTypeKind (printed "??") or openTypeKind ("?").  At top level we now default
the kind of such variables to liftedTypeKind ("*").  This is important because
then instance declarations can match it. The defaulting function is called
TcMType.zonkTopTyVar, and is commented.  (Most of the extra lines in the
patch are comments!)
---
 compiler/typecheck/TcMType.lhs    |   26 +++++++++++++++++++++++++-
 compiler/typecheck/TcSimplify.lhs |    3 +++
 2 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index dd7b627..4633f49 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -49,7 +49,7 @@ module TcMType (
   zonkType, zonkTcPredType, 
   zonkTcTyVar, zonkTcTyVars, zonkTcTyVarsAndFV, zonkQuantifiedTyVar,
   zonkTcType, zonkTcTypes, zonkTcClassConstraints, zonkTcThetaType,
-  zonkTcKindToKind, zonkTcKind,
+  zonkTcKindToKind, zonkTcKind, zonkTopTyVar,
 
   readKindVar, writeKindVar
 
@@ -443,6 +443,30 @@ zonkTcPredType (EqPred t1 t2)
 		     are used at the end of type checking
 
 \begin{code}
+zonkTopTyVar :: TcTyVar -> TcM TcTyVar
+-- zonkTopTyVar is used, at the top level, on any un-instantiated meta type variables
+-- to default the kind of ? and ?? etc to *.  This is important to ensure that
+-- instance declarations match.  For example consider
+--	instance Show (a->b)
+--	foo x = show (\_ -> True)
+-- Then we'll get a constraint (Show (p ->q)) where p has argTypeKind (printed ??), 
+-- and that won't match the typeKind (*) in the instance decl.
+--
+-- Because we are at top level, no further constraints are going to affect these
+-- type variables, so it's time to do it by hand.  However we aren't ready
+-- to default them fully to () or whatever, because the type-class defaulting
+-- rules have yet to run.
+
+zonkTopTyVar tv
+  | k `eqKind` default_k = return tv
+  | otherwise
+  = do	{ tv' <- newFlexiTyVar default_k
+	; writeMetaTyVar tv (mkTyVarTy tv') 
+	; return tv' }
+  where
+    k = tyVarKind tv
+    default_k = defaultKind k
+
 zonkQuantifiedTyVar :: TcTyVar -> TcM TyVar
 -- zonkQuantifiedTyVar is applied to the a TcTyVar when quantifying over it.
 -- It might be a meta TyVar, in which case we freeze it into an ordinary TyVar.
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index c0ae8ce..ef019df 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -1914,6 +1914,9 @@ tc_simplify_top doc use_extended_defaulting want_scs wanteds
   = do	{ lcl_env <- getLclEnv
 	; traceTc (text "tcSimplifyTop" <+> ppr (lclEnvElts lcl_env))
 
+	; wanteds <- mapM zonkInst wanteds
+	; mapM_ zonkTopTyVar (varSetElems (tyVarsOfInsts wanteds))
+
 	; let try_me inst = ReduceMe want_scs
 	; (frees, binds, irreds) <- simpleReduceLoop doc try_me wanteds
 
-- 
1.7.10.4