tcAddDeclCtxt decl $
do { -- type families require -ftype-families and can't be in an
-- hs-boot file
- ; gla_exts <- doptM Opt_TypeFamilies
+ ; type_families <- doptM Opt_TypeFamilies
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
- ; checkTc gla_exts $ badFamInstDecl (tcdLName decl)
+ ; checkTc type_families $ badFamInstDecl (tcdLName decl)
; checkTc (not is_boot) $ badBootFamInstDeclErr
-- perform kind and type checking
; stupid_theta <- tcHsKindedContext ctxt
; want_generic <- doptM Opt_Generics
; unbox_strict <- doptM Opt_UnboxStrictFields
- ; gla_exts <- doptM Opt_GlasgowExts
; empty_data_decls <- doptM Opt_EmptyDataDecls
; kind_signatures <- doptM Opt_KindSignatures
; gadt_ok <- doptM Opt_GADTs
-------------------------------
checkValidClass :: Class -> TcM ()
checkValidClass cls
- = do { -- CHECK ARITY 1 FOR HASKELL 1.4
- gla_exts <- doptM Opt_GlasgowExts
+ = do { constrained_class_methods <- doptM Opt_ConstrainedClassMethods
; multi_param_type_classes <- doptM Opt_MultiParamTypeClasses
+ ; fundep_classes <- doptM Opt_FunctionalDependencies
-- Check that the class is unary, unless GlaExs
; checkTc (notNull tyvars) (nullaryClassErr cls)
; checkTc (multi_param_type_classes || unary) (classArityErr cls)
+ ; checkTc (fundep_classes || null fundeps) (classFunDepsErr cls)
-- Check the super-classes
; checkValidTheta (ClassSCCtxt (className cls)) theta
-- Check the class operations
- ; mappM_ (check_op gla_exts) op_stuff
+ ; mappM_ (check_op constrained_class_methods) op_stuff
-- Check that if the class has generic methods, then the
-- class has only one parameter. We can't do generic
; checkTc (unary || no_generics) (genericMultiParamErr cls)
}
where
- (tyvars, theta, _, op_stuff) = classBigSig cls
+ (tyvars, fundeps, theta, _, _, op_stuff) = classExtraBigSig cls
unary = isSingleton tyvars
no_generics = null [() | (_, GenDefMeth) <- op_stuff]
- check_op gla_exts (sel_id, dm)
+ check_op constrained_class_methods (sel_id, dm)
= addErrCtxt (classOpCtxt sel_id tau) $ do
{ checkValidTheta SigmaCtxt (tail theta)
-- The 'tail' removes the initial (C a) from the
op_ty = idType sel_id
(_,theta1,tau1) = tcSplitSigmaTy op_ty
(_,theta2,tau2) = tcSplitSigmaTy tau1
- (theta,tau) | gla_exts = (theta1 ++ theta2, tau2)
- | otherwise = (theta1, mkPhiTy (tail theta1) tau1)
+ (theta,tau) | constrained_class_methods = (theta1 ++ theta2, tau2)
+ | otherwise = (theta1, mkPhiTy (tail theta1) tau1)
-- Ugh! The function might have a type like
-- op :: forall a. C a => forall b. (Eq b, Eq a) => tau2
- -- With -fglasgow-exts, we want to allow this, even though the inner
+ -- With -XConstrainedClassMethods, we want to allow this, even though the inner
-- forall has an (Eq a) constraint. Whereas in general, each constraint
-- in the context of a for-all must mention at least one quantified
-- type variable. What a mess!
= vcat [ptext SLIT("Too many parameters for class") <+> quotes (ppr cls),
parens (ptext SLIT("Use -XMultiParamTypeClasses to allow multi-parameter classes"))]
+classFunDepsErr cls
+ = vcat [ptext SLIT("Fundeps in class") <+> quotes (ppr cls),
+ parens (ptext SLIT("Use -XFunctionalDependencies to allow fundeps"))]
+
noClassTyVarErr clas op
= sep [ptext SLIT("The class method") <+> quotes (ppr op),
ptext SLIT("mentions none of the type variables of the class") <+>