Commit 74721612 authored by Ian Lynagh's avatar Ian Lynagh

Implement -XFunctionalDependencies

parent c71662b2
......@@ -184,6 +184,7 @@ data DynFlag
| Opt_GADTs
| Opt_RelaxedPolyRec -- -X=RelaxedPolyRec
| Opt_MultiParamTypeClasses
| Opt_FunctionalDependencies
| Opt_MagicHash
| Opt_EmptyDataDecls
| Opt_KindSignatures
......@@ -1133,6 +1134,7 @@ xFlags = [
( "ImplicitParams", Opt_ImplicitParams ),
( "ScopedTypeVariables", Opt_ScopedTypeVariables ),
( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ),
( "FunctionalDependencies", Opt_FunctionalDependencies ),
( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ),
( "AllowOverlappingInstances", Opt_AllowOverlappingInstances ),
( "AllowUndecidableInstances", Opt_AllowUndecidableInstances ),
......@@ -1150,6 +1152,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
, Opt_ImplicitParams
, Opt_ScopedTypeVariables
, Opt_MultiParamTypeClasses
, Opt_FunctionalDependencies
, Opt_MagicHash
, Opt_RecursiveDo
, Opt_ParallelListComp
......
......@@ -1061,10 +1061,12 @@ checkValidClass cls
= do { -- CHECK ARITY 1 FOR HASKELL 1.4
gla_exts <- doptM Opt_GlasgowExts
; 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
......@@ -1078,7 +1080,7 @@ checkValidClass cls
; 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]
......@@ -1141,6 +1143,10 @@ classArityErr cls
= 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") <+>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment