Fixup nullary typeclasses (Trac #8993)
authorKrzysztof Gogolewski <krz.gogolewski@gmail.com>
Tue, 1 Jul 2014 18:19:20 +0000 (20:19 +0200)
committerKrzysztof Gogolewski <krz.gogolewski@gmail.com>
Tue, 1 Jul 2014 18:19:20 +0000 (20:19 +0200)
Summary: Fix test broken after Trac #8993

Test Plan: validate

Reviewers: austin, simonpj, hvr

Reviewed By: austin, hvr

Subscribers: simonmar, relrod, carter

Differential Revision: https://phabricator.haskell.org/D34

compiler/typecheck/TcTyClsDecls.lhs
compiler/typecheck/TcValidity.lhs

index c21631f..8723d8b 100644 (file)
@@ -1578,11 +1578,14 @@ checkValidClass :: Class -> TcM ()
 checkValidClass cls
   = do  { constrained_class_methods <- xoptM Opt_ConstrainedClassMethods
         ; multi_param_type_classes <- xoptM Opt_MultiParamTypeClasses
+        ; nullary_type_classes <- xoptM Opt_NullaryTypeClasses
         ; fundep_classes <- xoptM Opt_FunctionalDependencies
 
         -- Check that the class is unary, unless multiparameter type classes
-        -- are enabled (which allows nullary type classes)
-        ; checkTc (multi_param_type_classes || arity == 1)
+        -- are enabled; also recognize deprecated nullary type classes
+        -- extension (subsumed by multiparameter type classes, Trac #8993)
+        ; checkTc (multi_param_type_classes || arity == 1 ||
+                    (nullary_type_classes && arity == 0))
                   (classArityErr arity cls)
         ; checkTc (fundep_classes || null fundeps) (classFunDepsErr cls)
 
index 8f6a773..c7ba56c 100644 (file)
@@ -776,7 +776,9 @@ checkValidInstHead ctxt clas cls_args
                        all tcInstHeadTyAppAllTyVars ty_args)
                  (instTypeErr clas cls_args head_type_args_tyvars_msg)
             ; checkTc (xopt Opt_MultiParamTypeClasses dflags ||
-                       length ty_args == 1)  -- Only count type arguments
+                       length ty_args == 1 ||  -- Only count type arguments
+                       (xopt Opt_NullaryTypeClasses dflags &&
+                        null ty_args))
                  (instTypeErr clas cls_args head_one_type_msg) }
 
          -- May not contain type family applications