[project @ 2001-02-20 15:38:27 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcClassDcl.lhs

diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs
index 5999c9f..c3d2074 100644 (file)
--- a/ghc/compiler/typecheck/TcClassDcl.lhs
+++ b/ghc/compiler/typecheck/TcClassDcl.lhs
@@ -26,7 +26,7 @@ import TcHsSyn                ( TcMonoBinds )
 
 import Inst            ( Inst, InstOrigin(..), LIE, emptyLIE, plusLIE, plusLIEs, 
                          instToId, newDicts, newMethod )
-import TcEnv           ( TcId, TcEnv, RecTcEnv, TyThingDetails(..), tcAddImportedIdInfo,
+import TcEnv           ( TcEnv, RecTcEnv, TyThingDetails(..), tcAddImportedIdInfo,
                          tcLookupClass, tcExtendTyVarEnvForMeths, tcExtendGlobalTyVars,
                          tcExtendLocalValEnv, tcExtendTyVarEnv
                        )
@@ -115,9 +115,6 @@ tcClassDecl1 is_rec rec_env
                -- or if we're looking at an interface file decl
     in         -- (in which case def_methods = Nothing
 
-    checkTc (gla_exts || length tyvar_names == 1)
-           (classArityErr class_name)                  `thenTc_`
-
        -- LOOK THINGS UP IN THE ENVIRONMENT
     tcLookupClass class_name                           `thenTc` \ clas ->
     let
@@ -130,8 +127,14 @@ tcClassDecl1 is_rec rec_env
 
        -- SOURCE-CODE CONSISTENCY CHECKS
     (case def_methods of
-       Nothing  -> returnTc Nothing    -- Not source
-       Just dms -> checkDefaultBinds clas op_names dms   `thenTc` \ dm_env ->
+       Nothing  ->     -- Not source
+                   returnTc Nothing    
+
+       Just dms ->     -- Source so do error checks
+                   checkTc (gla_exts || length tyvar_names == 1)
+                           (classArityErr class_name)                  `thenTc_`
+
+                   checkDefaultBinds clas op_names dms   `thenTc` \ dm_env ->
                    checkGenericClassIsUnary clas dm_env  `thenTc_`
                    returnTc (Just dm_env)
     )                                                     `thenTc` \ mb_dm_env ->
@@ -288,7 +291,7 @@ tcClassSig is_rec unf_env clas clas_tyvars maybe_dm_env
        DefMeth dm_name = sig_dm
 
        dm_info = case maybe_dm_env of
-                   Nothing      -> iface_dm_info
+                   Nothing     -> iface_dm_info
                    Just dm_env -> mk_src_dm_info dm_env
 
        iface_dm_info = case sig_dm of