projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Canonicalise flags in error message
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcTyClsDecls.lhs
diff --git
a/compiler/typecheck/TcTyClsDecls.lhs
b/compiler/typecheck/TcTyClsDecls.lhs
index
3d2e4ba
..
fc685a3
100644
(file)
--- a/
compiler/typecheck/TcTyClsDecls.lhs
+++ b/
compiler/typecheck/TcTyClsDecls.lhs
@@
-241,9
+241,9
@@
tcFamInstDecl (L loc decl)
tcAddDeclCtxt decl $
do { -- type families require -ftype-families and can't be in an
-- hs-boot file
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?
; 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
; checkTc (not is_boot) $ badBootFamInstDeclErr
-- perform kind and type checking
@@
-693,7
+693,8
@@
tcTyClDecl1 calc_isrec
; stupid_theta <- tcHsKindedContext ctxt
; want_generic <- doptM Opt_Generics
; unbox_strict <- doptM Opt_UnboxStrictFields
; 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
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
; gadt_ok <- doptM Opt_GADTs
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
@@
-701,14
+702,14
@@
tcTyClDecl1 calc_isrec
; checkTc (gadt_ok || h98_syntax) (badGadtDecl tc_name)
-- Check that we don't use kind signatures without Glasgow extensions
; checkTc (gadt_ok || h98_syntax) (badGadtDecl tc_name)
-- Check that we don't use kind signatures without Glasgow extensions
- ; checkTc (gla_exts || isNothing mb_ksig) (badSigTyDecl tc_name)
+ ; checkTc (kind_signatures || isNothing mb_ksig) (badSigTyDecl tc_name)
-- Check that the stupid theta is empty for a GADT-style declaration
; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name)
-- Check that there's at least one condecl,
-- Check that the stupid theta is empty for a GADT-style declaration
; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name)
-- Check that there's at least one condecl,
- -- or else we're reading an hs-boot file, or -fglasgow-exts
- ; checkTc (not (null cons) || gla_exts || is_boot)
+ -- or else we're reading an hs-boot file, or -XEmptyDataDecls
+ ; checkTc (not (null cons) || empty_data_decls || is_boot)
(emptyConDeclsErr tc_name)
-- Check that a newtype has exactly one constructor
(emptyConDeclsErr tc_name)
-- Check that a newtype has exactly one constructor
@@
-1056,18
+1057,20
@@
checkNewDataCon con
-------------------------------
checkValidClass :: Class -> TcM ()
checkValidClass cls
-------------------------------
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)
-- Check that the class is unary, unless GlaExs
; checkTc (notNull tyvars) (nullaryClassErr cls)
- ; checkTc (gla_exts || unary) (classArityErr 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
-- 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
-- Check that if the class has generic methods, then the
-- class has only one parameter. We can't do generic
@@
-1075,11
+1078,11
@@
checkValidClass cls
; checkTc (unary || no_generics) (genericMultiParamErr cls)
}
where
; 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]
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
= addErrCtxt (classOpCtxt sel_id tau) $ do
{ checkValidTheta SigmaCtxt (tail theta)
-- The 'tail' removes the initial (C a) from the
@@
-1107,11
+1110,11
@@
checkValidClass cls
op_ty = idType sel_id
(_,theta1,tau1) = tcSplitSigmaTy op_ty
(_,theta2,tau2) = tcSplitSigmaTy tau1
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
-- 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!
-- 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!
@@
-1136,7
+1139,11
@@
nullaryClassErr cls
classArityErr cls
= vcat [ptext SLIT("Too many parameters for class") <+> quotes (ppr cls),
classArityErr cls
= vcat [ptext SLIT("Too many parameters for class") <+> quotes (ppr cls),
- parens (ptext SLIT("Use -fglasgow-exts to allow multi-parameter classes"))]
+ 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),
noClassTyVarErr clas op
= sep [ptext SLIT("The class method") <+> quotes (ppr op),
@@
-1180,7
+1187,7
@@
badDataConTyCon data_con
badGadtDecl tc_name
= vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+> quotes (ppr tc_name)
badGadtDecl tc_name
= vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+> quotes (ppr tc_name)
- , nest 2 (parens $ ptext SLIT("Use -X=GADT to allow GADTs")) ]
+ , nest 2 (parens $ ptext SLIT("Use -XGADTs to allow GADTs")) ]
badStupidTheta tc_name
= ptext SLIT("A data type declared in GADT style cannot have a context:") <+> quotes (ppr tc_name)
badStupidTheta tc_name
= ptext SLIT("A data type declared in GADT style cannot have a context:") <+> quotes (ppr tc_name)
@@
-1208,12
+1215,12
@@
newtypeFieldErr con_name n_flds
badSigTyDecl tc_name
= vcat [ ptext SLIT("Illegal kind signature") <+>
quotes (ppr tc_name)
badSigTyDecl tc_name
= vcat [ ptext SLIT("Illegal kind signature") <+>
quotes (ppr tc_name)
- , nest 2 (parens $ ptext SLIT("Use -fglasgow-exts to allow kind signatures")) ]
+ , nest 2 (parens $ ptext SLIT("Use -XKindSignatures to allow kind signatures")) ]
badFamInstDecl tc_name
= vcat [ ptext SLIT("Illegal family instance for") <+>
quotes (ppr tc_name)
badFamInstDecl tc_name
= vcat [ ptext SLIT("Illegal family instance for") <+>
quotes (ppr tc_name)
- , nest 2 (parens $ ptext SLIT("Use -X=TypeFamilies to allow indexed type families")) ]
+ , nest 2 (parens $ ptext SLIT("Use -XTypeFamilies to allow indexed type families")) ]
badGadtIdxTyDecl tc_name
= vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+>
badGadtIdxTyDecl tc_name
= vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+>
@@
-1250,5
+1257,5
@@
tyFamAppInIndexErr ty
emptyConDeclsErr tycon
= sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
emptyConDeclsErr tycon
= sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
- nest 2 $ ptext SLIT("(-fglasgow-exts permits this)")]
+ nest 2 $ ptext SLIT("(-XEmptyDataDecls permits this)")]
\end{code}
\end{code}