Skip to content
Snippets Groups Projects
Commit 51bfcc0e authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Ian Lynagh
Browse files

Allow default superclass methods for multi-parameter type classes

They were prohibited by mistake, a historical hangover
parent 902650db
No related branches found
No related tags found
No related merge requests found
...@@ -1365,17 +1365,10 @@ checkValidClass cls ...@@ -1365,17 +1365,10 @@ checkValidClass cls
-- Check the associated type defaults are well-formed and instantiated -- Check the associated type defaults are well-formed and instantiated
-- See Note [Checking consistent instantiation] -- See Note [Checking consistent instantiation]
; mapM_ check_at_defs at_stuff ; mapM_ check_at_defs at_stuff }
-- Check that if the class has generic methods, then the
-- class has only one parameter. We can't do generic
-- multi-parameter type classes!
; checkTc (unary || no_generics) (genericMultiParamErr cls)
}
where where
(tyvars, fundeps, theta, _, at_stuff, op_stuff) = classExtraBigSig cls (tyvars, fundeps, theta, _, at_stuff, op_stuff) = classExtraBigSig cls
unary = isSingleton (snd (splitKiTyVars tyvars)) -- IA0_NOTE: only count type arguments unary = isSingleton (snd (splitKiTyVars tyvars)) -- IA0_NOTE: only count type arguments
no_generics = null [() | (_, (GenDefMeth _)) <- op_stuff]
check_op constrained_class_methods (sel_id, dm) check_op constrained_class_methods (sel_id, dm)
= addErrCtxt (classOpCtxt sel_id tau) $ do = addErrCtxt (classOpCtxt sel_id tau) $ do
...@@ -1700,11 +1693,6 @@ noClassTyVarErr clas op ...@@ -1700,11 +1693,6 @@ noClassTyVarErr clas op
ptext (sLit "mentions none of the type variables of the class") <+> ptext (sLit "mentions none of the type variables of the class") <+>
ppr clas <+> hsep (map ppr (classTyVars clas))] ppr clas <+> hsep (map ppr (classTyVars clas))]
genericMultiParamErr :: Class -> SDoc
genericMultiParamErr clas
= ptext (sLit "The multi-parameter class") <+> quotes (ppr clas) <+>
ptext (sLit "cannot have generic methods")
recSynErr :: [LTyClDecl Name] -> TcRn () recSynErr :: [LTyClDecl Name] -> TcRn ()
recSynErr syn_decls recSynErr syn_decls
= setSrcSpan (getLoc (head sorted_decls)) $ = setSrcSpan (getLoc (head sorted_decls)) $
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment