X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcClassDcl.lhs;h=abfaacacde59640611a9a08edf29a25aa1b1b34c;hb=28561da97db5e1b6ec04bbfc9240e432d40de3c2;hp=0114a0345030f3f0c21d728af0d4a202c0ffb998;hpb=0e7025cb075a559094af36a4655fbf5212a08209;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs
index 0114a03..abfaaca 100644
--- a/ghc/compiler/typecheck/TcClassDcl.lhs
+++ b/ghc/compiler/typecheck/TcClassDcl.lhs
@@ -108,8 +108,14 @@ tcClassDecl1 is_rec rec_env
 			 tcdSigs = class_sigs, tcdMeths = def_methods,
 			 tcdSysNames = sys_names, tcdLoc = src_loc})
   = 	-- CHECK ARITY 1 FOR HASKELL 1.4
-    doptsTc Opt_GlasgowExts				`thenTc` \ glaExts ->
-    checkTc (glaExts || length tyvar_names == 1)
+    doptsTc Opt_GlasgowExts				`thenTc` \ gla_ext_opt ->
+    let
+	gla_exts = gla_ext_opt || not (maybeToBool def_methods)
+		-- Accept extensions if gla_exts is on,
+		-- 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
@@ -131,7 +137,7 @@ tcClassDecl1 is_rec rec_env
     )							   `thenTc` \ mb_dm_env ->
 	
 	-- CHECK THE CONTEXT
-    tcSuperClasses is_rec clas context sc_sel_names	`thenTc` \ (sc_theta, sc_sel_ids) ->
+    tcSuperClasses is_rec gla_exts clas context sc_sel_names	`thenTc` \ (sc_theta, sc_sel_ids) ->
 
 	-- CHECK THE CLASS SIGNATURES,
     mapTc (tcClassSig is_rec rec_env clas tyvars mb_dm_env) op_sigs	`thenTc` \ sig_stuff ->
@@ -207,20 +213,19 @@ checkGenericClassIsUnary clas dm_env
 
 
 \begin{code}
-tcSuperClasses :: RecFlag -> Class
+tcSuperClasses :: RecFlag -> Bool -> Class
 	       -> RenamedContext 	-- class context
 	       -> [Name]		-- Names for superclass selectors
 	       -> TcM (ClassContext,	-- the superclass context
 		         [Id])  	-- superclass selector Ids
 
-tcSuperClasses is_rec clas context sc_sel_names
+tcSuperClasses is_rec gla_exts clas context sc_sel_names
   = 	-- Check the context.
 	-- The renamer has already checked that the context mentions
 	-- only the type variable of the class decl.
 
 	-- For std Haskell check that the context constrains only tyvars
-    doptsTc Opt_GlasgowExts			`thenTc` \ glaExts ->
-    (if glaExts then
+    (if gla_exts then
 	returnTc ()
      else
 	mapTc_ check_constraint context