From 615dbe7edd0a51bcb61565081dfa09a9bf37058d Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Mon, 9 Jul 2007 20:43:43 +0000 Subject: [PATCH] Add flag -XConstrainedClassMethods --- compiler/main/DynFlags.hs | 3 +++ compiler/typecheck/TcTyClsDecls.lhs | 13 ++++++------- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c9d3e1a..b3bea06 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -190,6 +190,7 @@ data DynFlag | Opt_TypeSynonymInstances | Opt_FlexibleContexts | Opt_FlexibleInstances + | Opt_ConstrainedClassMethods | Opt_MultiParamTypeClasses | Opt_FunctionalDependencies | Opt_UnicodeSyntax @@ -1169,6 +1170,7 @@ xFlags = [ ( "TypeSynonymInstances", Opt_TypeSynonymInstances ), ( "FlexibleContexts", Opt_FlexibleContexts ), ( "FlexibleInstances", Opt_FlexibleInstances ), + ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods ), ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ), ( "FunctionalDependencies", Opt_FunctionalDependencies ), ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ), @@ -1195,6 +1197,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts , Opt_TypeSynonymInstances , Opt_FlexibleContexts , Opt_FlexibleInstances + , Opt_ConstrainedClassMethods , Opt_MultiParamTypeClasses , Opt_FunctionalDependencies , Opt_MagicHash diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 35b7d24..3155e09 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1057,8 +1057,7 @@ checkNewDataCon con ------------------------------- checkValidClass :: Class -> TcM () checkValidClass cls - = do { -- CHECK ARITY 1 FOR HASKELL 1.4 - gla_exts <- doptM Opt_GlasgowExts + = do { constrained_class_methods <- doptM Opt_ConstrainedClassMethods ; multi_param_type_classes <- doptM Opt_MultiParamTypeClasses ; fundep_classes <- doptM Opt_FunctionalDependencies @@ -1071,7 +1070,7 @@ checkValidClass cls ; checkValidTheta (ClassSCCtxt (className cls)) theta -- Check the class operations - ; mappM_ (check_op gla_exts) op_stuff + ; mappM_ (check_op constrained_class_methods) op_stuff -- Check that if the class has generic methods, then the -- class has only one parameter. We can't do generic @@ -1083,7 +1082,7 @@ checkValidClass cls unary = isSingleton tyvars no_generics = null [() | (_, GenDefMeth) <- op_stuff] - check_op gla_exts (sel_id, dm) + check_op constrained_class_methods (sel_id, dm) = addErrCtxt (classOpCtxt sel_id tau) $ do { checkValidTheta SigmaCtxt (tail theta) -- The 'tail' removes the initial (C a) from the @@ -1111,11 +1110,11 @@ checkValidClass cls op_ty = idType sel_id (_,theta1,tau1) = tcSplitSigmaTy op_ty (_,theta2,tau2) = tcSplitSigmaTy tau1 - (theta,tau) | gla_exts = (theta1 ++ theta2, tau2) - | otherwise = (theta1, mkPhiTy (tail theta1) tau1) + (theta,tau) | constrained_class_methods = (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 + -- With -XConstrainedClassMethods, 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! -- 1.7.10.4