[commit: ghc] master: Fixup nullary typeclasses (Trac #8993) (e7b9c41)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e7b9c4125321308a7f71cacf4c24b7d40261ccfd/ghc

>---------------------------------------------------------------

commit e7b9c4125321308a7f71cacf4c24b7d40261ccfd
Author: Krzysztof Gogolewski <krz.gogolewski at gmail.com>
Date:   Tue Jul 1 20:19:20 2014 +0200

    Fixup nullary typeclasses (Trac #8993)
    
    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


>---------------------------------------------------------------

e7b9c4125321308a7f71cacf4c24b7d40261ccfd
 compiler/typecheck/TcTyClsDecls.lhs | 7 +++++--
 compiler/typecheck/TcValidity.lhs   | 4 +++-
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index c21631f..8723d8b 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -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)
 
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index 8f6a773..c7ba56c 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -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