[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

diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs
index 2628afc..6ff39bc 100644 (file)
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ b/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!
 
 
 ---------------------------------------------------------------------