[project @ 2005-09-05 15:28:07 by simonpj]

GHC claims to lift the H98 restriction that a class method must not
add a constraint on the class type variable (manual 7.4.2.1 "Class
method types").  But the validity check was incorrect in the case
where the class method had a forall.  E.g.
	class C a where
	  op :: forall b. (Show b, Show a) => ...

This commit fixes the bug.

tcrun037, and tcfail149, test with and without -fglasgow-exts.

	MERGE TO STABLE

ghc/compiler/typecheck/TcTyClsDecls.lhs

@@ -32,7 +32,7 @@ import TcHsType		( kcHsTyVars, kcHsLiftedSigType, kcHsType,
 			  kcHsSigType, tcHsBangType, tcLHsConSig, tcDataKindSig )
 import TcMType		( newKindVar, checkValidTheta, checkValidType, checkFreeness, 
 			  UserTypeCtxt(..), SourceTyCtxt(..) ) 
-import TcType		( TcKind, TcType, tyVarsOfType, 
+import TcType		( TcKind, TcType, tyVarsOfType, mkPhiTy,
 			  mkArrowKind, liftedTypeKind, mkTyVarTys, tcEqTypes,
 			  tcSplitSigmaTy, tcEqType )
 import Type		( splitTyConApp_maybe, pprThetaArrow, pprParendType )
@@ -653,7 +653,7 @@ checkValidClass cls
 	; checkValidTheta (ClassSCCtxt (className cls)) theta
 
 	-- Check the class operations
-	; mappM_ check_op op_stuff
+	; mappM_ (check_op gla_exts) op_stuff
 
   	-- Check that if the class has generic methods, then the
 	-- class has only one parameter.  We can't do generic
@@ -665,7 +665,7 @@ checkValidClass cls
     unary 	= isSingleton tyvars
     no_generics = null [() | (_, GenDefMeth) <- op_stuff]
 
-    check_op (sel_id, dm) 
+    check_op gla_exts (sel_id, dm) 
       = addErrCtxt (classOpCtxt sel_id tau) $ do
 	{ checkValidTheta SigmaCtxt (tail theta)
 		-- The 'tail' removes the initial (C a) from the
@@ -686,8 +686,16 @@ checkValidClass cls
 	where
 	  op_name = idName sel_id
 	  op_ty   = idType sel_id
-	  (_,theta,tau) = tcSplitSigmaTy op_ty
-
+	  (_,theta1,tau1) = tcSplitSigmaTy op_ty
+	  (_,theta2,tau2)  = tcSplitSigmaTy tau1
+	  (theta,tau) | gla_exts  = (theta1 ++ theta2, tau2)
+		      | otherwise = (theta1, 	       mkPhiTy (tail theta1) tau1)
+		-- Ugh!  The function might have a type like
+		-- 	op :: forall a. C a => forall b. (Eq b, Eq a) => tau2
+		-- With -fglasgow-exts, we want to allow this, even though the inner 
+		-- forall has an (Eq a) constraint.  Whereas in general, each constraint 
+		-- in the context of a for-all must mention at least one quantified
+		-- type variable.  What a mess!
 
 
 ---------------------------------------------------------------------