From 44e3fc1f918ee82d58e5dc9c63aa145c554867f3 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 8 Jul 2007 12:27:53 +0000 Subject: [PATCH] Add -XMultiParamTypeClasses flag --- compiler/main/DynFlags.hs | 3 +++ compiler/typecheck/TcTyClsDecls.lhs | 5 +++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index cd373f9..86bbf31 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -183,6 +183,7 @@ data DynFlag | Opt_RecordPuns | Opt_GADTs | Opt_RelaxedPolyRec -- -X=RelaxedPolyRec + | Opt_MultiParamTypeClasses | Opt_MagicHash | Opt_EmptyDataDecls | Opt_KindSignatures @@ -1126,6 +1127,7 @@ xFlags = [ ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ), ( "ImplicitParams", Opt_ImplicitParams ), ( "ScopedTypeVariables", Opt_ScopedTypeVariables ), + ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ), ( "AllowOverlappingInstances", Opt_AllowOverlappingInstances ), ( "AllowUndecidableInstances", Opt_AllowUndecidableInstances ), ( "AllowIncoherentInstances", Opt_AllowIncoherentInstances ) @@ -1141,6 +1143,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts , Opt_GADTs , Opt_ImplicitParams , Opt_ScopedTypeVariables + , Opt_MultiParamTypeClasses , Opt_MagicHash , Opt_EmptyDataDecls , Opt_KindSignatures diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index b942ec2..7623b19 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1060,10 +1060,11 @@ checkValidClass :: Class -> TcM () checkValidClass cls = do { -- CHECK ARITY 1 FOR HASKELL 1.4 gla_exts <- doptM Opt_GlasgowExts + ; multi_param_type_classes <- doptM Opt_MultiParamTypeClasses -- Check that the class is unary, unless GlaExs ; checkTc (notNull tyvars) (nullaryClassErr cls) - ; checkTc (gla_exts || unary) (classArityErr cls) + ; checkTc (multi_param_type_classes || unary) (classArityErr cls) -- Check the super-classes ; checkValidTheta (ClassSCCtxt (className cls)) theta @@ -1138,7 +1139,7 @@ nullaryClassErr cls classArityErr cls = vcat [ptext SLIT("Too many parameters for class") <+> quotes (ppr cls), - parens (ptext SLIT("Use -fglasgow-exts to allow multi-parameter classes"))] + parens (ptext SLIT("Use -XMultiParamTypeClasses to allow multi-parameter classes"))] noClassTyVarErr clas op = sep [ptext SLIT("The class method") <+> quotes (ppr op), -- 1.7.10.4