diff options
author | Torsten Schmits <git@tryp.io> | 2023-03-24 19:03:30 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-04-01 09:43:12 -0400 |
commit | a84fba6eb5cae43bd79cc1b26eadd7a2aa36099b (patch) | |
tree | cee09fd93bc60ba97ac8b873ce96c6ec63ccccca | |
parent | 3b5be05ac29e2ec033e108e15f052f2a13898f24 (diff) | |
download | haskell-a84fba6eb5cae43bd79cc1b26eadd7a2aa36099b.tar.gz |
Add structured error messages for GHC.Tc.TyCl
Tracking ticket: #20117
MR: !10183
This converts uses of `mkTcRnUnknownMessage` to newly added constructors
of `TcRnMessage`.
97 files changed, 1028 insertions, 440 deletions
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs index cd7379b136..2b4ecf2bc7 100644 --- a/compiler/GHC/Rename/Env.hs +++ b/compiler/GHC/Rename/Env.hs @@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} {- (c) The GRASP/AQUA Project, Glasgow University, 1992-2006 diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index d67a60efd0..06ff333ed8 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -1653,9 +1653,7 @@ badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcM () badKindSigErr doc (L loc ty) = setSrcSpanA loc $ addErr $ TcRnWithHsDocContext doc $ - mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal kind signature:" <+> quotes (ppr ty)) - 2 (text "Perhaps you intended to use KindSignatures") + TcRnKindSignaturesDisabled (Left ty) dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> TcRnMessage dataKindsErr env thing diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 4f1d88aaa5..d33a5647ae 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -1268,9 +1268,6 @@ instance Diagnostic TcRnMessage where -> mkSimpleDecorated $ text "Associated type" <+> quotes (ppr name) <+> text "must be inside a class instance" - TcRnBadFamInstDecl tc_name - -> mkSimpleDecorated $ - text "Illegal family instance for" <+> quotes (ppr tc_name) TcRnNotOpenFamily tc -> mkSimpleDecorated $ text "Illegal instance for closed family" <+> quotes (ppr tc) @@ -1508,14 +1505,14 @@ instance Diagnostic TcRnMessage where (vcat [ text "Cannot default kind variable" <+> quotes (ppr var) , text "of kind:" <+> ppr knd , text "Perhaps enable PolyKinds or add a kind signature" ]) - TcRnUninferrableTyvar tidied_tvs context -> + TcRnUninferrableTyVar tidied_tvs context -> mkSimpleDecorated $ pprWithExplicitKindsWhen True $ vcat [ text "Uninferrable type variable" <> plural tidied_tvs <+> pprWithCommas pprTyVar tidied_tvs <+> text "in" - , pprUninferrableTyvarCtx context ] + , pprUninferrableTyVarCtx context ] TcRnSkolemEscape escapees tv orig_ty -> mkSimpleDecorated $ pprWithExplicitKindsWhen True $ @@ -1552,11 +1549,118 @@ instance Diagnostic TcRnMessage where hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" <+> speakNOf decl_arity (text "argument")) 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") - TcRnPatSynInvalidRhs ps_name lpat args reason -> mkSimpleDecorated $ + TcRnPatSynInvalidRhs ps_name lpat _ reason -> mkSimpleDecorated $ vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" <+> quotes (ppr ps_name) <> colon) - 2 (pprPatSynInvalidRhsReason ps_name lpat args reason) + 2 (pprPatSynInvalidRhsReason reason) , text "RHS pattern:" <+> ppr lpat ] + TcRnMultiAssocTyFamDefaults name -> mkSimpleDecorated $ + text "More than one default declaration for" + <+> ppr name + TcRnTyFamDepsDisabled -> mkSimpleDecorated $ + text "Illegal injectivity annotation" + TcRnAbstractClosedTyFamDecl -> mkSimpleDecorated $ + text "You may define an abstract closed type family" $$ + text "only in a .hs-boot file" + TcRnPartialFieldSelector fld -> mkSimpleDecorated $ + sep [text "Use of partial record field selector" <> colon, + nest 2 $ quotes (ppr (occName fld))] + TcRnBadFieldAnnotation n con reason -> mkSimpleDecorated $ + hang (pprBadFieldAnnotationReason reason) + 2 (text "on the" <+> speakNth n + <+> text "argument of" <+> quotes (ppr con)) + TcRnSuperclassCycle (MkSuperclassCycle cls definite details) -> + let herald | definite = text "Superclass cycle for" + | otherwise = text "Potential superclass cycle for" + in mkSimpleDecorated $ + vcat [ herald <+> quotes (ppr cls), nest 2 (vcat (pprSuperclassCycleDetail <$> details))] + TcRnDefaultSigMismatch sel_id dm_ty -> mkSimpleDecorated $ + hang (text "The default type signature for" + <+> ppr sel_id <> colon) + 2 (ppr dm_ty) + $$ (text "does not match its corresponding" + <+> text "non-default type signature") + TcRnTyFamsDisabled reason -> mkSimpleDecorated $ + text "Illegal family" <+> text sort <+> text "for" <+> quotes name + where + (sort, name) = case reason of + TyFamsDisabledFamily n -> ("declaration", ppr n) + TyFamsDisabledInstance n -> ("instance", ppr n) + TcRnTyFamResultDisabled tc_name tvb -> mkSimpleDecorated $ + text "Illegal result type variable" <+> ppr tvb <+> text "for" <+> quotes (ppr tc_name) + TcRnRoleValidationFailed role reason -> mkSimpleDecorated $ + vcat [text "Internal error in role inference:", + pprRoleValidationFailedReason role reason, + text "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug"] + TcRnCommonFieldResultTypeMismatch con1 con2 field_name -> mkSimpleDecorated $ + vcat [sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, + text "have a common field" <+> quotes (ppr field_name) <> comma], + nest 2 $ text "but have different result types"] + TcRnCommonFieldTypeMismatch con1 con2 field_name -> mkSimpleDecorated $ + sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, + text "give different types for field", quotes (ppr field_name)] + TcRnClassExtensionDisabled cls reason -> mkSimpleDecorated $ + pprDisabledClassExtension cls reason + TcRnAssocNoClassTyVar cls fam_tc -> mkSimpleDecorated $ + sep [ text "The associated type" <+> quotes (ppr fam_tc <+> hsep (map ppr (tyConTyVars fam_tc))) + , text "mentions none of the type or kind variables of the class" <+> + quotes (ppr cls <+> hsep (map ppr (classTyVars cls)))] + TcRnDataConParentTypeMismatch data_con res_ty_tmpl -> mkSimpleDecorated $ + hang (text "Data constructor" <+> quotes (ppr data_con) <+> + text "returns type" <+> quotes (ppr actual_res_ty)) + 2 (text "instead of an instance of its parent type" <+> quotes (ppr res_ty_tmpl)) + where + actual_res_ty = dataConOrigResTy data_con + TcRnGADTsDisabled tc_name -> mkSimpleDecorated $ + text "Illegal generalised algebraic data declaration for" <+> quotes (ppr tc_name) + TcRnExistentialQuantificationDisabled con -> mkSimpleDecorated $ + sdocOption sdocLinearTypes (\show_linear_types -> + hang (text "Data constructor" <+> quotes (ppr con) <+> + text "has existential type variables, a context, or a specialised result type") + 2 (ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con))) + TcRnGADTDataContext tc_name -> mkSimpleDecorated $ + text "A data type declared in GADT style cannot have a context:" <+> quotes (ppr tc_name) + TcRnMultipleConForNewtype tycon n -> mkSimpleDecorated $ + sep [text "A newtype must have exactly one constructor,", + nest 2 $ text "but" <+> quotes (ppr tycon) <+> text "has" <+> speakN n] + TcRnKindSignaturesDisabled thing -> mkSimpleDecorated $ + text "Illegal kind signature" <+> quotes (either ppr with_sig thing) + where + with_sig (tc_name, ksig) = ppr tc_name <+> dcolon <+> ppr ksig + TcRnEmptyDataDeclsDisabled tycon -> mkSimpleDecorated $ + quotes (ppr tycon) <+> text "has no constructors" + TcRnFamilyCategoryMismatch family -> mkSimpleDecorated $ + text "Wrong category of family instance; declaration was for a" + <+> kindOfFamily + where + kindOfFamily | isTypeFamilyTyCon family = text "type family" + | isDataFamilyTyCon family = text "data family" + | otherwise = pprPanic "wrongKindOfFamily" (ppr family) + TcRnFamilyArityMismatch _ max_args -> mkSimpleDecorated $ + text "Number of parameters must match family declaration; expected" + <+> ppr max_args + TcRnRoleMismatch var annot inferred -> mkSimpleDecorated $ + hang (text "Role mismatch on variable" <+> ppr var <> colon) + 2 (sep [ text "Annotation says", ppr annot + , text "but role", ppr inferred + , text "is required" ]) + TcRnRoleCountMismatch tyvars d@(L _ (RoleAnnotDecl _ _ annots)) -> mkSimpleDecorated $ + hang (text "Wrong number of roles listed in role annotation;" $$ + text "Expected" <+> (ppr tyvars) <> comma <+> + text "got" <+> (ppr $ length annots) <> colon) + 2 (ppr d) + TcRnIllegalRoleAnnotation (RoleAnnotDecl _ tycon _) -> mkSimpleDecorated $ + (text "Illegal role annotation for" <+> ppr tycon <> char ';' $$ + text "they are allowed only for datatypes and classes.") + TcRnRoleAnnotationsDisabled tc -> mkSimpleDecorated $ + text "Illegal role annotation for" <+> ppr tc + TcRnIncoherentRoles _ -> mkSimpleDecorated $ + (text "Roles other than" <+> quotes (text "nominal") <+> + text "for class parameters can lead to incoherence.") + TcRnTyFamNameMismatch fam_tc_name eqn_tc_name -> mkSimpleDecorated $ + hang (text "Mismatched type name in type family instance.") + 2 (vcat [ text "Expected:" <+> ppr fam_tc_name + , text " Actual:" <+> ppr eqn_tc_name ]) diagnosticReason = \case TcRnUnknownMessage m @@ -1941,8 +2045,6 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnMissingClassAssoc{} -> ErrorWithoutFlag - TcRnBadFamInstDecl{} - -> ErrorWithoutFlag TcRnNotOpenFamily{} -> ErrorWithoutFlag TcRnNoRebindableSyntaxRecordDot{} @@ -2035,7 +2137,7 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnCannotDefaultKindVar{} -> ErrorWithoutFlag - TcRnUninferrableTyvar{} + TcRnUninferrableTyVar{} -> ErrorWithoutFlag TcRnSkolemEscape{} -> ErrorWithoutFlag @@ -2047,6 +2149,66 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnPatSynInvalidRhs{} -> ErrorWithoutFlag + TcRnMultiAssocTyFamDefaults{} + -> ErrorWithoutFlag + TcRnTyFamDepsDisabled{} + -> ErrorWithoutFlag + TcRnAbstractClosedTyFamDecl{} + -> ErrorWithoutFlag + TcRnPartialFieldSelector{} + -> WarningWithFlag Opt_WarnPartialFields + TcRnBadFieldAnnotation _ _ LazyFieldsDisabled + -> ErrorWithoutFlag + TcRnBadFieldAnnotation{} + -> WarningWithoutFlag + TcRnSuperclassCycle{} + -> ErrorWithoutFlag + TcRnDefaultSigMismatch{} + -> ErrorWithoutFlag + TcRnTyFamsDisabled{} + -> ErrorWithoutFlag + TcRnTyFamResultDisabled{} + -> ErrorWithoutFlag + TcRnRoleValidationFailed{} + -> ErrorWithoutFlag + TcRnCommonFieldResultTypeMismatch{} + -> ErrorWithoutFlag + TcRnCommonFieldTypeMismatch{} + -> ErrorWithoutFlag + TcRnClassExtensionDisabled{} + -> ErrorWithoutFlag + TcRnAssocNoClassTyVar{} + -> ErrorWithoutFlag + TcRnDataConParentTypeMismatch{} + -> ErrorWithoutFlag + TcRnGADTsDisabled{} + -> ErrorWithoutFlag + TcRnExistentialQuantificationDisabled{} + -> ErrorWithoutFlag + TcRnGADTDataContext{} + -> ErrorWithoutFlag + TcRnMultipleConForNewtype{} + -> ErrorWithoutFlag + TcRnKindSignaturesDisabled{} + -> ErrorWithoutFlag + TcRnEmptyDataDeclsDisabled{} + -> ErrorWithoutFlag + TcRnFamilyCategoryMismatch{} + -> ErrorWithoutFlag + TcRnFamilyArityMismatch{} + -> ErrorWithoutFlag + TcRnRoleMismatch{} + -> ErrorWithoutFlag + TcRnRoleCountMismatch{} + -> ErrorWithoutFlag + TcRnIllegalRoleAnnotation{} + -> ErrorWithoutFlag + TcRnRoleAnnotationsDisabled{} + -> ErrorWithoutFlag + TcRnIncoherentRoles{} + -> ErrorWithoutFlag + TcRnTyFamNameMismatch{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2437,8 +2599,6 @@ instance Diagnostic TcRnMessage where -> noHints TcRnMissingClassAssoc{} -> noHints - TcRnBadFamInstDecl{} - -> [suggestExtension LangExt.TypeFamilies] TcRnNotOpenFamily{} -> noHints TcRnNoRebindableSyntaxRecordDot{} @@ -2543,7 +2703,7 @@ instance Diagnostic TcRnMessage where -> noHints TcRnCannotDefaultKindVar{} -> noHints - TcRnUninferrableTyvar{} + TcRnUninferrableTyVar{} -> noHints TcRnSkolemEscape{} -> noHints @@ -2553,8 +2713,75 @@ instance Diagnostic TcRnMessage where -> noHints TcRnPatSynArityMismatch{} -> noHints + TcRnPatSynInvalidRhs name pat args (PatSynNotInvertible _) + -> [SuggestExplicitBidiPatSyn name pat args] TcRnPatSynInvalidRhs{} -> noHints + TcRnMultiAssocTyFamDefaults{} + -> noHints + TcRnTyFamDepsDisabled{} + -> [suggestExtension LangExt.TypeFamilyDependencies] + TcRnAbstractClosedTyFamDecl{} + -> noHints + TcRnPartialFieldSelector{} + -> noHints + TcRnBadFieldAnnotation _ _ LazyFieldsDisabled + -> [suggestExtension LangExt.StrictData] + TcRnBadFieldAnnotation{} + -> noHints + TcRnSuperclassCycle{} + -> [suggestExtension LangExt.UndecidableSuperClasses] + TcRnDefaultSigMismatch{} + -> noHints + TcRnTyFamsDisabled{} + -> [suggestExtension LangExt.TypeFamilies] + TcRnTyFamResultDisabled{} + -> [suggestExtension LangExt.TypeFamilyDependencies] + TcRnRoleValidationFailed{} + -> noHints + TcRnCommonFieldResultTypeMismatch{} + -> noHints + TcRnCommonFieldTypeMismatch{} + -> noHints + TcRnClassExtensionDisabled _ MultiParamDisabled{} + -> [suggestExtension LangExt.MultiParamTypeClasses] + TcRnClassExtensionDisabled _ FunDepsDisabled{} + -> [suggestExtension LangExt.FunctionalDependencies] + TcRnClassExtensionDisabled _ ConstrainedClassMethodsDisabled{} + -> [suggestExtension LangExt.ConstrainedClassMethods] + TcRnAssocNoClassTyVar{} + -> noHints + TcRnDataConParentTypeMismatch{} + -> noHints + TcRnGADTsDisabled{} + -> [suggestExtension LangExt.GADTs] + TcRnExistentialQuantificationDisabled{} + -> [suggestExtension LangExt.ExistentialQuantification, + suggestExtension LangExt.GADTs] + TcRnGADTDataContext{} + -> noHints + TcRnMultipleConForNewtype{} + -> noHints + TcRnKindSignaturesDisabled{} + -> [suggestExtension LangExt.KindSignatures] + TcRnEmptyDataDeclsDisabled{} + -> [suggestExtension LangExt.EmptyDataDecls] + TcRnFamilyCategoryMismatch{} + -> noHints + TcRnFamilyArityMismatch{} + -> noHints + TcRnRoleMismatch{} + -> noHints + TcRnRoleCountMismatch{} + -> noHints + TcRnIllegalRoleAnnotation{} + -> noHints + TcRnRoleAnnotationsDisabled{} + -> [suggestExtension LangExt.RoleAnnotations] + TcRnIncoherentRoles{} + -> [suggestExtension LangExt.IncoherentInstances] + TcRnTyFamNameMismatch{} + -> noHints diagnosticCode = constructorCode @@ -4644,33 +4871,70 @@ pprStageCheckReason = \case StageCheckSplice t -> quotes (ppr t) -pprUninferrableTyvarCtx :: UninferrableTyvarCtx -> SDoc -pprUninferrableTyvarCtx = \case +pprUninferrableTyVarCtx :: UninferrableTyVarCtx -> SDoc +pprUninferrableTyVarCtx = \case UninfTyCtx_ClassContext theta -> sep [ text "the class context:", pprTheta theta ] UninfTyCtx_DataContext theta -> sep [ text "the datatype context:", pprTheta theta ] UninfTyCtx_ProvidedContext theta -> sep [ text "the provided context:" , pprTheta theta ] - UninfTyCtx_TyfamRhs rhs_ty -> + UninfTyCtx_TyFamRhs rhs_ty -> sep [ text "the type family equation right-hand side:" , ppr rhs_ty ] - UninfTyCtx_TysynRhs rhs_ty -> + UninfTyCtx_TySynRhs rhs_ty -> sep [ text "the type synonym right-hand side:" , ppr rhs_ty ] UninfTyCtx_Sig exp_kind full_hs_ty -> hang (text "the kind" <+> ppr exp_kind) 2 (text "of the type signature:" <+> ppr full_hs_ty) -pprPatSynInvalidRhsReason :: Name -> LPat GhcRn -> [LIdP GhcRn] -> PatSynInvalidRhsReason -> SDoc -pprPatSynInvalidRhsReason name pat args = \case +pprPatSynInvalidRhsReason :: PatSynInvalidRhsReason -> SDoc +pprPatSynInvalidRhsReason = \case PatSynNotInvertible p -> text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" - $+$ hang (text "Suggestion: instead use an explicitly bidirectional" - <+> text "pattern synonym, e.g.") - 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow - <+> ppr pat <+> text "where") - 2 (pp_name <+> pp_args <+> equals <+> text "...")) - where - pp_name = ppr name - pp_args = hsep (map ppr args) PatSynUnboundVar var -> quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym" + +pprBadFieldAnnotationReason :: BadFieldAnnotationReason -> SDoc +pprBadFieldAnnotationReason = \case + LazyFieldsDisabled -> + text "Lazy field annotations (~) are disabled" + UnpackWithoutStrictness -> + text "UNPACK pragma lacks '!'" + BackpackUnpackAbstractType -> + text "Ignoring unusable UNPACK pragma" + +pprSuperclassCycleDetail :: SuperclassCycleDetail -> SDoc +pprSuperclassCycleDetail = \case + SCD_HeadTyVar pred -> + hang (text "one of whose superclass constraints is headed by a type variable:") + 2 (quotes (ppr pred)) + SCD_HeadTyFam pred -> + hang (text "one of whose superclass constraints is headed by a type family:") + 2 (quotes (ppr pred)) + SCD_Superclass cls -> + text "one of whose superclasses is" <+> quotes (ppr cls) + +pprRoleValidationFailedReason :: Role -> RoleValidationFailedReason -> SDoc +pprRoleValidationFailedReason role = \case + TyVarRoleMismatch tv role' -> + text "type variable" <+> quotes (ppr tv) <+> + text "cannot have role" <+> ppr role <+> + text "because it was assigned role" <+> ppr role' + TyVarMissingInEnv tv -> + text "type variable" <+> quotes (ppr tv) <+> text "missing in environment" + BadCoercionRole co -> + text "coercion" <+> ppr co <+> text "has bad role" <+> ppr role + +pprDisabledClassExtension :: Class -> DisabledClassExtension -> SDoc +pprDisabledClassExtension cls = \case + MultiParamDisabled n -> + text howMany <+> text "parameters for class" <+> quotes (ppr cls) + where + howMany | n == 0 = "No" + | otherwise = "Too many" + FunDepsDisabled -> + text "Fundeps in class" <+> quotes (ppr cls) + ConstrainedClassMethodsDisabled sel_id pred -> + vcat [ hang (text "Constraint" <+> quotes (ppr pred) + <+> text "in the type of" <+> quotes (ppr sel_id)) + 2 (text "constrains only the class type variables")] diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index c2f19613d4..5f567495a3 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -95,8 +95,14 @@ module GHC.Tc.Errors.Types ( , HsigShapeMismatchReason(..) , WrongThingSort(..) , StageCheckReason(..) - , UninferrableTyvarCtx(..) + , UninferrableTyVarCtx(..) , PatSynInvalidRhsReason(..) + , BadFieldAnnotationReason(..) + , SuperclassCycle(..) + , SuperclassCycleDetail(..) + , RoleValidationFailedReason(..) + , DisabledClassExtension(..) + , TyFamsDisabledReason(..) ) where import GHC.Prelude @@ -110,7 +116,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.Rank (Rank) -import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType, TcSigmaType) +import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType, TcSigmaType, TcPredType) import GHC.Types.Avail (AvailInfo) import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) @@ -127,14 +133,15 @@ import GHC.Types.Var.Set (TyVarSet, VarSet) import GHC.Unit.Types (Module) import GHC.Utils.Outputable import GHC.Core.Class (Class, ClassMinimalDef) +import GHC.Core.Coercion (Coercion) import GHC.Core.Coercion.Axiom (CoAxBranch) import GHC.Core.ConLike (ConLike) -import GHC.Core.DataCon (DataCon) +import GHC.Core.DataCon (DataCon, FieldLabel) import GHC.Core.FamInstEnv (FamInst) import GHC.Core.InstEnv (LookupInstanceErrReason, ClsInst) import GHC.Core.PatSyn (PatSyn) import GHC.Core.Predicate (EqRel, predTypeEqRel) -import GHC.Core.TyCon (TyCon) +import GHC.Core.TyCon (TyCon, Role) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState) @@ -2682,13 +2689,6 @@ data TcRnMessage where testsuite/tests/indexed-types/should_fail/SimpleFail7 -} TcRnMissingClassAssoc :: TyCon -> TcRnMessage - {- | 'TcRnBadFamInstDecl' is an error that is triggered by a type or data family - instance without the @TypeFamilies@ extension. - - Test case: - testsuite/tests/indexed-types/should_fail/BadFamInstDecl - -} - TcRnBadFamInstDecl :: TyCon -> TcRnMessage {- | 'TcRnNotOpenFamily' is an error that is triggered by attempting to give a top-level (open) type family instance for a closed type family. @@ -3291,15 +3291,15 @@ data TcRnMessage where -> !Kind -- ^ Kind of the variable. -> TcRnMessage - {-| TcRnUninferrableTyvar is an error that occurs when metavariables + {-| TcRnUninferrableTyVar is an error that occurs when metavariables in a type could not be defaulted. Test cases: T17301, T17562, T17567, T17567StupidTheta, T15474, T21479 -} - TcRnUninferrableTyvar + TcRnUninferrableTyVar :: ![TyCoVar] -- ^ The variables that could not be defaulted. - -> !UninferrableTyvarCtx -- ^ Description of the surrounding context. + -> !UninferrableTyVarCtx -- ^ Description of the surrounding context. -> TcRnMessage {-| TcRnSkolemEscape is an error that occurs when type variables from an @@ -3361,6 +3361,283 @@ data TcRnMessage where -> !PatSynInvalidRhsReason -- ^ The number of equation arguments -> TcRnMessage + {-| TcRnMultiAssocTyFamDefaults is an error indicating that multiple default + declarations were specified for an associated type family. + + Test cases: + none + -} + TcRnMultiAssocTyFamDefaults :: !(IdP GhcRn) -- ^ Name of the associated type + -> TcRnMessage + + {-| TcRnTyFamDepsDisabled is an error indicating that a type family injectivity + annotation was used without enabling the extension TypeFamilyDependencies. + + Test cases: + T11381 + -} + TcRnTyFamDepsDisabled :: TcRnMessage + + {-| TcRnAbstractClosedTyFamDecl is an error indicating that an abstract closed + type family was declared in a regular source file, while it is only allowed + in hs-boot files. + + Test cases: + ClosedFam4 + -} + TcRnAbstractClosedTyFamDecl :: TcRnMessage + + {-| TcRnPartialFieldSelector is a warning indicating that a record selector + was not defined for all constructors of a data type. + + Test cases: + DRFPartialFields, T7169 + -} + TcRnPartialFieldSelector :: !FieldLabel -- ^ The selector + -> TcRnMessage + + {-| TcRnBadFieldAnnotation is an error/warning group indicating that a + strictness/unpack related data type field annotation is invalid. + -} + TcRnBadFieldAnnotation :: !Int -- ^ The index of the field + -> !DataCon -- ^ The constructor in which the field is defined + -> !BadFieldAnnotationReason -- ^ The error specifics + -> TcRnMessage + + {-| TcRnSuperclassCycle is an error indicating that a class has a superclass + cycle. + + Test cases: + mod40, tcfail027, tcfail213, tcfail216, tcfail217, T9415, T9739 + -} + TcRnSuperclassCycle :: !SuperclassCycle -- ^ The details of the cycle + -> TcRnMessage + + {-| TcRnDefaultSigMismatch is an error indicating that a default method + signature doesn't match the regular method signature. + + Test cases: + T7437, T12918a, T12918b, T12151 + -} + TcRnDefaultSigMismatch :: !Id -- ^ The name of the method + -> !Type -- ^ The type of the default signature + -> TcRnMessage + + {-| TcRnTyFamsDisabled is an error indicating that a type family or instance + was declared while the extension TypeFamilies was disabled. + + Test cases: + TyFamsDisabled + -} + TcRnTyFamsDisabled :: !TyFamsDisabledReason -- ^ The name of the family or instance + -> TcRnMessage + + {-| TcRnTyFamResultDisabled is an error indicating that a result variable + was used on a type family while the extension TypeFamilyDependencies was + disabled. + + Test cases: + T13571, T13571a + -} + TcRnTyFamResultDisabled :: !Name -- ^ The name of the type family + -> !(LHsTyVarBndr () GhcRn) -- ^ Name of the result variable + -> TcRnMessage + + {-| TcRnRoleValidationFailed is an error indicating that a variable was + assigned an invalid role by the inference algorithm. + This is only performed with -dcore-lint. + -} + TcRnRoleValidationFailed :: !Role -- ^ The validated role + -> !RoleValidationFailedReason -- ^ The failure reason + -> TcRnMessage + + {-| TcRnCommonFieldResultTypeMismatch is an error indicating that a sum type + declares the same field name in multiple constructors, but the constructors' + result types differ. + + Test cases: + CommonFieldResultTypeMismatch + -} + TcRnCommonFieldResultTypeMismatch :: !DataCon -- ^ First constructor + -> !DataCon -- ^ Second constructor + -> !FieldLabelString -- ^ Field name + -> TcRnMessage + + {-| TcRnCommonFieldTypeMismatch is an error indicating that a sum type + declares the same field name in multiple constructors, but their types + differ. + + Test cases: + CommonFieldTypeMismatch + -} + TcRnCommonFieldTypeMismatch :: !DataCon -- ^ First constructor + -> !DataCon -- ^ Second constructor + -> !FieldLabelString -- ^ Field name + -> TcRnMessage + + {-| TcRnClassExtensionDisabled is an error indicating that a class + was declared with an extension feature while the extension was disabled. + -} + TcRnClassExtensionDisabled :: !Class -- ^ The class + -> !DisabledClassExtension -- ^ The extension + -> TcRnMessage + + {-| TcRnAssocNoClassTyVar is an error indicating that no class parameters + are used in an associated type family. + + Test cases: + T2888, T9167, T12867 + -} + TcRnAssocNoClassTyVar :: !Class -- ^ The class + -> !TyCon -- ^ The associated family + -> TcRnMessage + + {-| TcRnDataConParentTypeMismatch is an error indicating that a data + constructor was declared with a type that doesn't match its type + constructor (i.e. a GADT result type and its data name). + + Test cases: + T7175, T13300, T14719, T18357, T18357b, gadt11, tcfail155, tcfail176 + -} + TcRnDataConParentTypeMismatch :: !DataCon -- ^ The data constructor + -> !Type -- ^ The parent type + -> TcRnMessage + + {-| TcRnGADTsDisabled is an error indicating that a GADT was declared + while the extension GADTs was disabled. + + Test cases: + ghci057, T9293 + -} + TcRnGADTsDisabled :: !Name -- ^ The name of the GADT + -> TcRnMessage + + {-| TcRnExistentialQuantificationDisabled is an error indicating that + a data constructor was declared with existential features while the + extension ExistentialQuantification was disabled. + + Test cases: + ghci057, T9293, gadtSyntaxFail001, gadtSyntaxFail002, gadtSyntaxFail003, + prog006, rnfail053, T12083a + -} + TcRnExistentialQuantificationDisabled :: !DataCon -- ^ The constructor + -> TcRnMessage + + {-| TcRnGADTDataContext is an error indicating that a GADT was declared with a + data type context. + This error is emitted in the tc, but it is also caught in the renamer. + -} + TcRnGADTDataContext :: !Name -- ^ The data type name + -> TcRnMessage + + {-| TcRnMultipleConForNewtype is an error indicating that a newtype was + declared with multiple constructors. + This error is caught by the parser. + -} + TcRnMultipleConForNewtype :: !Name -- ^ The newtype name + -> !Int -- ^ The number of constructors + -> TcRnMessage + + {-| TcRnKindSignaturesDisabled is an error indicating that a kind signature + was used in a data type declaration while the extension KindSignatures was + disabled. + + Test cases: + T20873c, readFail036 + -} + TcRnKindSignaturesDisabled :: !(Either (HsType GhcPs) (Name, HsType GhcRn)) + -- ^ The data type name + -> TcRnMessage + + {-| TcRnEmptyDataDeclsDisabled is an error indicating that a data type + was declared with no constructors while the extension EmptyDataDecls was + disabled. + + Test cases: + readFail035 + -} + TcRnEmptyDataDeclsDisabled :: !Name -- ^ The data type name + -> TcRnMessage + + {-| TcRnFamilyCategoryMismatch is an error indicating that a family instance + was declared for a family of a different kind, i.e. data vs type family. + + Test cases: + T9896, SimpleFail3a + -} + TcRnFamilyCategoryMismatch :: !TyCon -- ^ The family tycon + -> TcRnMessage + + {-| TcRnFamilyArityMismatch is an error indicating that a family instance + was declared with a different number of arguments than the family. + See Note [Oversaturated type family equations] in "GHC.Tc.Validity". + + Test cases: + TyFamArity1, TyFamArity2, T11136, Overlap4, AssocTyDef05, AssocTyDef06, + T14110 + -} + TcRnFamilyArityMismatch :: !TyCon -- ^ The family tycon + -> !Arity -- ^ The right number of parameters + -> TcRnMessage + + {-| TcRnRoleMismatch is an error indicating that the role specified + in an annotation differs from its inferred role. + + Test cases: + T7253, Roles11 + -} + TcRnRoleMismatch :: !Name -- ^ The type variable + -> !Role -- ^ The annotated role + -> !Role -- ^ The inferred role + -> TcRnMessage + + {-| TcRnRoleCountMismatch is an error indicating that the number of + roles in an annotation doesn't match the number of type parameters. + + Test cases: + Roles6 + -} + TcRnRoleCountMismatch :: !Int -- ^ The number of type variables + -> !(LRoleAnnotDecl GhcRn) -- ^ The role annotation + -> TcRnMessage + + {-| TcRnIllegalRoleAnnotation is an error indicating that a role + annotation was attached to a decl that doesn't allow it. + + Test cases: + Roles5 + -} + TcRnIllegalRoleAnnotation :: !(RoleAnnotDecl GhcRn) -- ^ The role annotation + -> TcRnMessage + + {-| TcRnRoleAnnotationsDisabled is an error indicating that a role + annotation was declared while the extension RoleAnnotations was disabled. + + Test cases: + Roles5, TH_Roles1 + -} + TcRnRoleAnnotationsDisabled :: !TyCon -- ^ The annotated type + -> TcRnMessage + + {-| TcRnIncoherentRoles is an error indicating that a role + annotation for a class parameter was declared as not nominal. + + Test cases: + T8773 + -} + TcRnIncoherentRoles :: !TyCon -- ^ The class tycon + -> TcRnMessage + + {-| TcRnIncoherentRoles is an error indicating that a type family equation + used a different name than the family. + + Test cases: + Overlap5, T15362, T16002, T20260, T11623 + -} + TcRnTyFamNameMismatch :: !Name -- ^ The family name + -> !Name -- ^ The name used in the equation + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4666,15 +4943,81 @@ data StageCheckReason = StageCheckInstance !InstanceWhat !PredType | StageCheckSplice !Name -data UninferrableTyvarCtx +data UninferrableTyVarCtx = UninfTyCtx_ClassContext [TcType] | UninfTyCtx_DataContext [TcType] | UninfTyCtx_ProvidedContext [TcType] - | UninfTyCtx_TyfamRhs TcType - | UninfTyCtx_TysynRhs TcType + | UninfTyCtx_TyFamRhs TcType + | UninfTyCtx_TySynRhs TcType | UninfTyCtx_Sig TcType (LHsSigType GhcRn) data PatSynInvalidRhsReason = PatSynNotInvertible !(Pat GhcRn) | PatSynUnboundVar !Name deriving (Generic) + +data BadFieldAnnotationReason where + {-| A lazy data type field annotation (~) was used without enabling the + extension StrictData. + + Test cases: + LazyFieldsDisabled + -} + LazyFieldsDisabled :: BadFieldAnnotationReason + {-| An UNPACK pragma was applied to a field without strictness annotation (!). + + Test cases: + T14761a, T7562 + -} + UnpackWithoutStrictness :: BadFieldAnnotationReason + {-| An UNPACK pragma was applied to an abstract type in an indefinite package + in Backpack. + + Test cases: + unpack_sums_5, T3966, T7050 + -} + BackpackUnpackAbstractType :: BadFieldAnnotationReason + deriving (Generic) + +data SuperclassCycle = + MkSuperclassCycle { cls :: Class, definite :: Bool, reasons :: [SuperclassCycleDetail] } + +data SuperclassCycleDetail + = SCD_HeadTyVar !PredType + | SCD_HeadTyFam !PredType + | SCD_Superclass !Class + +data RoleValidationFailedReason + = TyVarRoleMismatch !TyVar !Role + | TyVarMissingInEnv !TyVar + | BadCoercionRole !Coercion + deriving (Generic) + +data DisabledClassExtension where + {-| MultiParamTypeClasses is required. + + Test cases: + readFail037, TcNoNullaryTC + -} + MultiParamDisabled :: !Int -- ^ The arity + -> DisabledClassExtension + {-| FunctionalDependencies is required. + + Test cases: + readFail041 + -} + FunDepsDisabled :: DisabledClassExtension + {-| ConstrainedClassMethods is required. + + Test cases: + mod39, tcfail150 + -} + ConstrainedClassMethodsDisabled :: !Id + -> !TcPredType + -> DisabledClassExtension + deriving (Generic) + +data TyFamsDisabledReason + = TyFamsDisabledFamily !Name + | TyFamsDisabledInstance !TyCon + deriving (Generic) diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index 3acfe274d7..966b612a50 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -23,7 +23,7 @@ module GHC.Tc.TyCl ( tcFamTyPats, tcTyFamInstEqn, tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt, unravelFamInstPats, addConsistencyConstraints, - wrongKindOfFamily, checkFamTelescope + checkFamTelescope ) where import GHC.Prelude @@ -35,8 +35,12 @@ import GHC.Driver.Config.HsToCore import GHC.Hs import GHC.Tc.Errors.Types ( TcRnMessage(..), FixedRuntimeRepProvenance(..) - , mkTcRnUnknownMessage, IllegalNewtypeReason (..) - , UninferrableTyvarCtx (..) ) + , IllegalNewtypeReason (..) + , UninferrableTyVarCtx (..) + , BadFieldAnnotationReason (..) + , RoleValidationFailedReason (..) + , DisabledClassExtension (..) + , TyFamsDisabledReason (..) ) import GHC.Tc.TyCl.Build import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities ) @@ -2536,9 +2540,7 @@ tcDefaultAssocDecl _ [] = return Nothing -- No default declaration tcDefaultAssocDecl _ (d1:_:_) - = failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints $ - text "More than one default declaration for" - <+> ppr (tyFamInstDeclName (unLoc d1))) + = failWithTc (TcRnMultiAssocTyFamDefaults (tyFamInstDeclName (unLoc d1))) tcDefaultAssocDecl fam_tc [L loc (TyFamInstDecl { tfid_eqn = @@ -2556,11 +2558,11 @@ tcDefaultAssocDecl fam_tc -- Kind of family check ; assert (fam_tc_name == tc_name) $ - checkTc (isTypeFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc) + checkTc (isTypeFamilyTyCon fam_tc) (TcRnFamilyCategoryMismatch fam_tc) -- Arity check ; checkTc (vis_pats == vis_arity) - (wrongNumberOfParmsErr vis_arity) + (TcRnFamilyArityMismatch fam_tc vis_arity) -- Typecheck RHS -- @@ -2822,10 +2824,10 @@ tcInjectivity tcbs (Just (L loc (InjectivityAnn _ _ lInjNames))) = setSrcSpanA loc $ do { let tvs = binderVars tcbs ; dflags <- getDynFlags + -- Fail eagerly to avoid reporting injectivity errors when + -- TypeFamilyDependencies is not enabled. ; checkTc (xopt LangExt.TypeFamilyDependencies dflags) - (mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Illegal injectivity annotation" $$ - text "Use TypeFamilyDependencies to allow this") + TcRnTyFamDepsDisabled ; inj_tvs <- mapM (tcLookupTyVar . unLoc) lInjNames ; inj_tvs <- zonkTcTyVarsToTcTyVars inj_tvs -- zonk the kinds ; let inj_ktvs = filterVarSet isTyVar $ -- no injective coercion vars @@ -2850,7 +2852,7 @@ tcTySynRhs roles_info tc_name hs_ty -- The kind of `a` is unconstrained. ; dvs <- candidateQTyVarsOfType rhs_ty ; let err_ctx tidy_env = do { (tidy_env2, rhs_ty) <- zonkTidyTcType tidy_env rhs_ty - ; return (tidy_env2, UninfTyCtx_TysynRhs rhs_ty) } + ; return (tidy_env2, UninfTyCtx_TySynRhs rhs_ty) } ; doNotQuantifyTyVars dvs err_ctx ; ze <- mkEmptyZonkEnv NoFlexi @@ -2899,8 +2901,11 @@ tcDataDefn err_ctxt roles_info tc_name -- Check that we don't use kind signatures without the extension ; kind_signatures <- xoptM LangExt.KindSignatures - ; when (isJust mb_ksig) $ - checkTc (kind_signatures) (badSigTyDecl tc_name) + ; case mb_ksig of + Just (L _ ksig) + | not kind_signatures + -> addErrTc $ TcRnKindSignaturesDisabled (Right (tc_name, ksig)) + _ -> return () ; ze <- mkEmptyZonkEnv NoFlexi ; (ze, bndrs) <- zonkTyVarBindersX ze tc_bndrs @@ -3024,7 +3029,7 @@ checkTyFamInstEqn tc_fam_tc eqn_tc_name hs_pats = -- type family F a where { G Int = Bool } let tc_fam_tc_name = getName tc_fam_tc ; checkTc (tc_fam_tc_name == eqn_tc_name) $ - wrongTyFamName tc_fam_tc_name eqn_tc_name + TcRnTyFamNameMismatch tc_fam_tc_name eqn_tc_name -- Check the arity of visible arguments -- If we wait until validity checking, we'll get kind errors @@ -3032,7 +3037,7 @@ checkTyFamInstEqn tc_fam_tc eqn_tc_name hs_pats = ; let vis_arity = length (tyConVisibleTyVars tc_fam_tc) vis_pats = numVisibleArgs hs_pats ; checkTc (vis_pats == vis_arity) $ - wrongNumberOfParmsErr vis_arity + TcRnFamilyArityMismatch tc_fam_tc vis_arity } {- Note [Instantiating a family tycon] @@ -3152,7 +3157,7 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo outer_hs_bndrs hs_pats hs_rhs_ty ; dvs_rhs <- candidateQTyVarsOfType rhs_ty ; let err_ctx tidy_env = do { (tidy_env2, rhs_ty) <- zonkTidyTcType tidy_env rhs_ty - ; return (tidy_env2, UninfTyCtx_TyfamRhs rhs_ty) } + ; return (tidy_env2, UninfTyCtx_TyFamRhs rhs_ty) } ; doNotQuantifyTyVars dvs_rhs err_ctx ; ze <- mkEmptyZonkEnv NoFlexi @@ -3306,18 +3311,19 @@ dataDeclChecks tc_name mctxt cons -- Check that we don't use GADT syntax in H98 world ; gadtSyntax_ok <- xoptM LangExt.GADTSyntax ; let gadt_syntax = anyLConIsGadt cons - ; checkTc (gadtSyntax_ok || not gadt_syntax) (badGadtDecl tc_name) + ; unless (gadtSyntax_ok || not gadt_syntax) $ + addErrTc (TcRnGADTsDisabled tc_name) -- Check that the stupid theta is empty for a GADT-style declaration. -- See Note [The stupid context] in GHC.Core.DataCon. - ; checkTc (null stupid_theta || not gadt_syntax) (badStupidTheta tc_name) + ; checkTc (null stupid_theta || not gadt_syntax) (TcRnGADTDataContext tc_name) -- Check that there's at least one condecl, -- or else we're reading an hs-boot file, or -XEmptyDataDecls ; empty_data_decls <- xoptM LangExt.EmptyDataDecls ; is_boot <- tcIsHsBootOrSig -- Are we compiling an hs-boot file? - ; checkTc (not (null cons) || empty_data_decls || is_boot) - (emptyConDeclsErr tc_name) + ; unless (not (null cons) || empty_data_decls || is_boot) $ + addErrTc (TcRnEmptyDataDeclsDisabled tc_name) ; return gadt_syntax } @@ -3355,7 +3361,7 @@ concatMapDataDefnConsTcM :: Name -> (NewOrData -> a -> TcM (NonEmpty b)) -> Data concatMapDataDefnConsTcM name f = \ case NewTypeCon a -> f NewType a >>= \ case b:|[] -> pure (NewTypeCon b) - bs -> failWithTc $ newtypeConError name (length bs) + bs -> failWithTc $ TcRnMultipleConForNewtype name (length bs) DataTypeCons is_type_data as -> DataTypeCons is_type_data <$> concatMapM (fmap toList . f DataType) as tcConDecl :: NewOrData @@ -4232,9 +4238,7 @@ checkValidTyCon tc ; ClosedSynFamilyTyCon Nothing -> return () ; AbstractClosedSynFamilyTyCon -> do { hsBoot <- tcIsHsBootOrSig - ; checkTc hsBoot $ mkTcRnUnknownMessage $ mkPlainError noHints $ - text "You may define an abstract closed type family" $$ - text "only in a .hs-boot file" } + ; checkTc hsBoot $ TcRnAbstractClosedTyFamDecl } ; DataFamilyTyCon {} -> return () ; OpenSynFamilyTyCon -> return () ; BuiltInSynFamTyCon _ -> return () } @@ -4310,9 +4314,7 @@ checkPartialRecordField :: [DataCon] -> FieldLabel -> TcM () checkPartialRecordField all_cons fld = setSrcSpan loc $ warnIf (not is_exhaustive && not (startsWithUnderscore occ_name)) - (mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnPartialFields) noHints $ - sep [text "Use of partial record field selector" <> colon, - nest 2 $ quotes (ppr occ_name)]) + (TcRnPartialFieldSelector fld) where sel = flSelector fld loc = getSrcSpan sel @@ -4328,8 +4330,8 @@ checkPartialRecordField all_cons fld checkFieldCompat :: FieldLabelString -> DataCon -> DataCon -> Type -> Type -> Type -> Type -> TcM () checkFieldCompat fld con1 con2 res1 res2 fty1 fty2 - = do { checkTc (isJust mb_subst1) (resultTypeMisMatch fld con1 con2) - ; checkTc (isJust mb_subst2) (fieldTypeMisMatch fld con1 con2) } + = do { checkTc (isJust mb_subst1) (TcRnCommonFieldResultTypeMismatch con1 con2 fld) + ; checkTc (isJust mb_subst2) (TcRnCommonFieldTypeMismatch con1 con2 fld) } where mb_subst1 = tcMatchTy res1 res2 mb_subst2 = tcMatchTyX (expectJust "checkFieldCompat" mb_subst1) fty1 fty2 @@ -4363,7 +4365,7 @@ checkValidDataCon dflags existential_ok tc con -- data instance D [a] where { MkD :: D (Maybe b) } -- see Note [GADT return types] ; checkTc (isJust (tcMatchTyKi res_ty_tmpl orig_res_ty)) - (badDataConTyCon con res_ty_tmpl) + (TcRnDataConParentTypeMismatch con res_ty_tmpl) -- Note that checkTc aborts if it finds an error. This is -- critical to avoid panicking when we call dataConDisplayType -- on an un-rejiggable datacon! @@ -4406,8 +4408,8 @@ checkValidDataCon dflags existential_ok tc con ; checkValidType ctxt data_con_display_type -- Check that existentials are allowed if they are used - ; checkTc (existential_ok || isVanillaDataCon con) - (badExistential con) + ; unless (existential_ok || isVanillaDataCon con) $ + addErrTc (TcRnExistentialQuantificationDisabled con) -- Check that the only constraints in signatures of constructors -- in a "type data" declaration are equality constraints. @@ -4422,16 +4424,14 @@ checkValidDataCon dflags existential_ok tc con check_bang orig_arg_ty bang rep_bang n | HsSrcBang _ _ SrcLazy <- bang , not (bang_opt_strict_data bang_opts) - = addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (bad_bang n (text "Lazy annotation (~) without StrictData")) + = addErrTc (bad_bang n LazyFieldsDisabled) -- Warn about UNPACK without "!" -- e.g. data T = MkT {-# UNPACK #-} Int | HsSrcBang _ want_unpack strict_mark <- bang , isSrcUnpacked want_unpack, not (is_strict strict_mark) , not (isUnliftedType orig_arg_ty) - = addDiagnosticTc $ mkTcRnUnknownMessage $ - mkPlainDiagnostic WarningWithoutFlag noHints (bad_bang n (text "UNPACK pragma lacks '!'")) + = addDiagnosticTc (bad_bang n UnpackWithoutStrictness) -- Warn about a redundant ! on an unlifted type -- e.g. data T = MkT !Int# @@ -4460,8 +4460,7 @@ checkValidDataCon dflags existential_ok tc con -- warn in this case (it gives users the wrong idea about whether -- or not UNPACK on abstract types is supported; it is!) , isHomeUnitDefinite (hsc_home_unit hsc_env) - = addDiagnosticTc $ mkTcRnUnknownMessage $ - mkPlainDiagnostic WarningWithoutFlag noHints (bad_bang n (text "Ignoring unusable UNPACK pragma")) + = addDiagnosticTc (bad_bang n BackpackUnpackAbstractType) | otherwise = return () @@ -4496,9 +4495,8 @@ checkValidDataCon dflags existential_ok tc con NoSrcStrict -> bang_opt_strict_data bang_opts bang -> isSrcStrict bang - bad_bang n herald - = hang herald 2 (text "on the" <+> speakNth n - <+> text "argument of" <+> quotes (ppr con)) + bad_bang n + = TcRnBadFieldAnnotation n con show_linear_types = xopt LangExt.LinearTypes dflags data_con_display_type = dataConDisplayType show_linear_types con @@ -4558,8 +4556,9 @@ checkValidClass cls -- extension (subsumed by multiparameter type classes, #8993) ; checkTc (multi_param_type_classes || cls_arity == 1 || (nullary_type_classes && cls_arity == 0)) - (classArityErr cls_arity cls) - ; checkTc (fundep_classes || null fundeps) (classFunDepsErr cls) + (TcRnClassExtensionDisabled cls (MultiParamDisabled cls_arity)) + ; unless (fundep_classes || null fundeps) $ + addErrTc (TcRnClassExtensionDisabled cls FunDepsDisabled) -- Check the super-classes ; checkValidTheta (ClassSCCtxt (className cls)) theta @@ -4569,7 +4568,7 @@ checkValidClass cls ; unless undecidable_super_classes $ case checkClassCycles cls of Just err -> setSrcSpan (getSrcSpan cls) $ - addErrTc (mkTcRnUnknownMessage $ mkPlainError noHints err) + addErrTc (TcRnSuperclassCycle err) Nothing -> return () -- Check the class operations. @@ -4620,14 +4619,14 @@ checkValidClass cls check_constraint pred -- See Note [Class method constraints] = when (not (isEmptyVarSet pred_tvs) && pred_tvs `subVarSet` cls_tv_set) - (addErrTc (badMethPred sel_id pred)) + (addErrTc (TcRnClassExtensionDisabled cls (ConstrainedClassMethodsDisabled sel_id pred))) where pred_tvs = tyCoVarsOfType pred check_at (ATI fam_tc m_dflt_rhs) = do { traceTc "ati" (ppr fam_tc $$ ppr tyvars $$ ppr fam_tvs) ; checkTc (cls_arity == 0 || any (`elemVarSet` cls_tv_set) fam_tvs) - (noClassTyVarErr cls fam_tc) + (TcRnAssocNoClassTyVar cls fam_tc) -- Check that the associated type mentions at least -- one of the class type variables -- The check is disabled for nullary type classes, @@ -4712,12 +4711,7 @@ checkValidClass cls -- default foo2 :: a -> b unless (isJust $ tcMatchTys [dm_phi_ty, vanilla_phi_ty] [vanilla_phi_ty, dm_phi_ty]) $ addErrTc $ - mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "The default type signature for" - <+> ppr sel_id <> colon) - 2 (ppr dm_ty) - $$ (text "does not match its corresponding" - <+> text "non-default type signature") + TcRnDefaultSigMismatch sel_id dm_ty -- Now do an ambiguity check on the default type signature. checkValidType ctxt (mkDefaultMethodType cls sel_id dm_spec) @@ -4729,19 +4723,12 @@ checkFamFlag :: Name -> TcM () -- client might have a go! checkFamFlag tc_name = do { idx_tys <- xoptM LangExt.TypeFamilies - ; checkTc idx_tys err_msg } - where - err_msg :: TcRnMessage - err_msg = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal family declaration for" <+> quotes (ppr tc_name)) - 2 (text "Enable TypeFamilies to allow indexed type families") + ; unless idx_tys $ addErrTc (TcRnTyFamsDisabled (TyFamsDisabledFamily tc_name)) } checkResultSigFlag :: Name -> FamilyResultSig GhcRn -> TcM () checkResultSigFlag tc_name (TyVarSig _ tvb) = do { ty_fam_deps <- xoptM LangExt.TypeFamilyDependencies - ; checkTc ty_fam_deps $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal result type variable" <+> ppr tvb <+> text "for" <+> quotes (ppr tc_name)) - 2 (text "Enable TypeFamilyDependencies to allow result variable names") } + ; unless ty_fam_deps $ addErrTc (TcRnTyFamResultDisabled tc_name tvb) } checkResultSigFlag _ _ = return () -- other cases OK {- Note [Class method constraints] @@ -4980,9 +4967,9 @@ checkValidRoleAnnots role_annots tc addRoleAnnotCtxt name $ setSrcSpanA loc $ do { role_annots_ok <- xoptM LangExt.RoleAnnotations - ; checkTc role_annots_ok $ needXRoleAnnotations tc + ; unless role_annots_ok $ addErrTc $ TcRnRoleAnnotationsDisabled tc ; checkTc (vis_vars `equalLength` the_role_annots) - (wrongNumberOfRoles vis_vars decl) + (TcRnRoleCountMismatch (length vis_vars) decl) ; _ <- zipWith3M checkRoleAnnot vis_vars the_role_annots vis_roles -- Representational or phantom roles for class parameters -- quickly lead to incoherence. So, we require @@ -4991,7 +4978,7 @@ checkValidRoleAnnots role_annots tc ; checkTc ( incoherent_roles_ok || (not $ isClassTyCon tc) || (all (== Nominal) vis_roles)) - incoherentRoles + (TcRnIncoherentRoles tc) ; lint <- goptM Opt_DoCoreLinting ; when lint $ checkValidRoles tc } @@ -5003,7 +4990,7 @@ checkRoleAnnot :: TyVar -> LocatedAn NoEpAnns (Maybe Role) -> Role -> TcM () checkRoleAnnot _ (L _ Nothing) _ = return () checkRoleAnnot tv (L _ (Just r1)) r2 = when (r1 /= r2) $ - addErrTc $ badRoleAnnot (tyVarName tv) r1 r2 + addErrTc $ TcRnRoleMismatch (tyVarName tv) r1 r2 -- This is a double-check on the role inference algorithm. It is only run when -- -dcore-lint is enabled. See Note [Role inference] in GHC.Tc.TyCl.Utils @@ -5039,11 +5026,8 @@ checkValidRoles tc check_ty_roles env role (TyVarTy tv) = case lookupVarEnv env tv of Just role' -> unless (role' `ltRole` role || role' == role) $ - report_error $ text "type variable" <+> quotes (ppr tv) <+> - text "cannot have role" <+> ppr role <+> - text "because it was assigned role" <+> ppr role' - Nothing -> report_error $ text "type variable" <+> quotes (ppr tv) <+> - text "missing in environment" + report_error role $ TyVarRoleMismatch tv role' + Nothing -> report_error role $ TyVarMissingInEnv tv check_ty_roles env Representational (TyConApp tc tys) = let roles' = tyConRoles tc in @@ -5075,17 +5059,14 @@ checkValidRoles tc check_ty_roles _ role (CoercionTy co) = unless (role == Phantom) $ - report_error $ text "coercion" <+> ppr co <+> text "has bad role" <+> ppr role + report_error role $ BadCoercionRole co maybe_check_ty_roles env role ty = when (role == Nominal || role == Representational) $ check_ty_roles env role ty - report_error doc - = addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [text "Internal error in role inference:", - doc, - text "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug"] + report_error role reason + = addErrTc $ TcRnRoleValidationFailed role reason {- ************************************************************************ @@ -5163,19 +5144,6 @@ tcAddClosedTypeFamilyDeclCtxt tc ctxt = text "In the equations for closed type family" <+> quotes (ppr tc) -resultTypeMisMatch :: FieldLabelString -> DataCon -> DataCon -> TcRnMessage -resultTypeMisMatch field_name con1 con2 - = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, - text "have a common field" <+> quotes (ppr field_name) <> comma], - nest 2 $ text "but have different result types"] - -fieldTypeMisMatch :: FieldLabelString -> DataCon -> DataCon -> TcRnMessage -fieldTypeMisMatch field_name con1 con2 - = mkTcRnUnknownMessage $ mkPlainError noHints $ - sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, - text "give different types for field", quotes (ppr field_name)] - dataConCtxt :: NonEmpty (LocatedN Name) -> SDoc dataConCtxt cons = text "In the definition of data constructor" <> plural (toList cons) <+> ppr_cons (toList cons) @@ -5192,147 +5160,11 @@ classOpCtxt :: Var -> Type -> SDoc classOpCtxt sel_id tau = sep [text "When checking the class method:", nest 2 (pprPrefixOcc sel_id <+> dcolon <+> ppr tau)] -classArityErr :: Int -> Class -> TcRnMessage -classArityErr n cls - | n == 0 = mkErr "No" "no-parameter" - | otherwise = mkErr "Too many" "multi-parameter" - where - mkErr howMany allowWhat = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [text (howMany ++ " parameters for class") <+> quotes (ppr cls), - parens (text ("Enable MultiParamTypeClasses to allow " - ++ allowWhat ++ " classes"))] - -classFunDepsErr :: Class -> TcRnMessage -classFunDepsErr cls - = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [text "Fundeps in class" <+> quotes (ppr cls), - parens (text "Enable FunctionalDependencies to allow fundeps")] - -badMethPred :: Id -> TcPredType -> TcRnMessage -badMethPred sel_id pred - = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ hang (text "Constraint" <+> quotes (ppr pred) - <+> text "in the type of" <+> quotes (ppr sel_id)) - 2 (text "constrains only the class type variables") - , text "Enable ConstrainedClassMethods to allow it" ] - -noClassTyVarErr :: Class -> TyCon -> TcRnMessage -noClassTyVarErr clas fam_tc - = mkTcRnUnknownMessage $ mkPlainError noHints $ - sep [ text "The associated type" <+> quotes (ppr fam_tc <+> hsep (map ppr (tyConTyVars fam_tc))) - , text "mentions none of the type or kind variables of the class" <+> - quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))] - -badDataConTyCon :: DataCon -> Type -> TcRnMessage -badDataConTyCon data_con res_ty_tmpl - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Data constructor" <+> quotes (ppr data_con) <+> - text "returns type" <+> quotes (ppr actual_res_ty)) - 2 (text "instead of an instance of its parent type" <+> quotes (ppr res_ty_tmpl)) - where - actual_res_ty = dataConOrigResTy data_con - -badGadtDecl :: Name -> TcRnMessage -badGadtDecl tc_name - = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Illegal generalised algebraic data declaration for" <+> quotes (ppr tc_name) - , nest 2 (parens $ text "Enable the GADTs extension to allow this") ] - -badExistential :: DataCon -> TcRnMessage -badExistential con - = mkTcRnUnknownMessage $ mkPlainError noHints $ - sdocOption sdocLinearTypes (\show_linear_types -> - hang (text "Data constructor" <+> quotes (ppr con) <+> - text "has existential type variables, a context, or a specialised result type") - 2 (vcat [ ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con) - , parens $ text "Enable ExistentialQuantification or GADTs to allow this" ])) - -badStupidTheta :: Name -> TcRnMessage -badStupidTheta tc_name - = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "A data type declared in GADT style cannot have a context:" <+> quotes (ppr tc_name) - -newtypeConError :: Name -> Int -> TcRnMessage -newtypeConError tycon n - = mkTcRnUnknownMessage $ mkPlainError noHints $ - sep [text "A newtype must have exactly one constructor,", - nest 2 $ text "but" <+> quotes (ppr tycon) <+> text "has" <+> speakN n ] - -badSigTyDecl :: Name -> TcRnMessage -badSigTyDecl tc_name - = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Illegal kind signature" <+> - quotes (ppr tc_name) - , nest 2 (parens $ text "Use KindSignatures to allow kind signatures") ] - -emptyConDeclsErr :: Name -> TcRnMessage -emptyConDeclsErr tycon - = mkTcRnUnknownMessage $ mkPlainError noHints $ - sep [quotes (ppr tycon) <+> text "has no constructors", - nest 2 $ text "(EmptyDataDecls permits this)"] - -wrongKindOfFamily :: TyCon -> TcRnMessage -wrongKindOfFamily family - = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Wrong category of family instance; declaration was for a" - <+> kindOfFamily - where - kindOfFamily | isTypeFamilyTyCon family = text "type family" - | isDataFamilyTyCon family = text "data family" - | otherwise = pprPanic "wrongKindOfFamily" (ppr family) - --- | Produce an error for oversaturated type family equations with too many --- required arguments. --- See Note [Oversaturated type family equations] in "GHC.Tc.Validity". -wrongNumberOfParmsErr :: Arity -> TcRnMessage -wrongNumberOfParmsErr max_args - = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Number of parameters must match family declaration; expected" - <+> ppr max_args - -badRoleAnnot :: Name -> Role -> Role -> TcRnMessage -badRoleAnnot var annot inferred - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Role mismatch on variable" <+> ppr var <> colon) - 2 (sep [ text "Annotation says", ppr annot - , text "but role", ppr inferred - , text "is required" ]) - -wrongNumberOfRoles :: [a] -> LRoleAnnotDecl GhcRn -> TcRnMessage -wrongNumberOfRoles tyvars d@(L _ (RoleAnnotDecl _ _ annots)) - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Wrong number of roles listed in role annotation;" $$ - text "Expected" <+> (ppr $ length tyvars) <> comma <+> - text "got" <+> (ppr $ length annots) <> colon) - 2 (ppr d) - - illegalRoleAnnotDecl :: LRoleAnnotDecl GhcRn -> TcM () -illegalRoleAnnotDecl (L loc (RoleAnnotDecl _ tycon _)) +illegalRoleAnnotDecl (L loc role) = setErrCtxt [] $ setSrcSpanA loc $ - addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (text "Illegal role annotation for" <+> ppr tycon <> char ';' $$ - text "they are allowed only for datatypes and classes.") - -needXRoleAnnotations :: TyCon -> TcRnMessage -needXRoleAnnotations tc - = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Illegal role annotation for" <+> ppr tc <> char ';' $$ - text "did you intend to use RoleAnnotations?" - -incoherentRoles :: TcRnMessage -incoherentRoles = mkTcRnUnknownMessage $ mkPlainError noHints $ - (text "Roles other than" <+> quotes (text "nominal") <+> - text "for class parameters can lead to incoherence.") $$ - (text "Use IncoherentInstances to allow this; bad role found") - -wrongTyFamName :: Name -> Name -> TcRnMessage -wrongTyFamName fam_tc_name eqn_tc_name - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Mismatched type name in type family instance.") - 2 (vcat [ text "Expected:" <+> ppr fam_tc_name - , text " Actual:" <+> ppr eqn_tc_name ]) + addErrTc $ TcRnIllegalRoleAnnotation role addTyConCtxt :: TyCon -> TcM a -> TcM a addTyConCtxt tc = addTyConFlavCtxt name flav diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs index bf710f0fe9..caae46ce36 100644 --- a/compiler/GHC/Tc/TyCl/Instance.hs +++ b/compiler/GHC/Tc/TyCl/Instance.hs @@ -589,7 +589,7 @@ tcTyFamInstDecl mb_clsinfo (L loc decl@(TyFamInstDecl { tfid_eqn = eqn })) ; tcFamInstDeclChecks mb_clsinfo fam_tc -- (0) Check it's an open type family - ; checkTc (isTypeFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc) + ; checkTc (isTypeFamilyTyCon fam_tc) (TcRnFamilyCategoryMismatch fam_tc) ; checkTc (isOpenTypeFamilyTyCon fam_tc) (TcRnNotOpenFamily fam_tc) -- (1) do the work of verifying the synonym group @@ -617,7 +617,7 @@ tcFamInstDeclChecks mb_clsinfo fam_tc ; traceTc "tcFamInstDecl" (ppr fam_tc) ; type_families <- xoptM LangExt.TypeFamilies ; is_boot <- tcIsHsBootOrSig -- Are we compiling an hs-boot file? - ; checkTc type_families (TcRnBadFamInstDecl fam_tc) + ; checkTc type_families (TcRnTyFamsDisabled (TyFamsDisabledInstance fam_tc)) ; checkTc (not is_boot) TcRnBadBootFamInstDecl -- Check that it is a family TyCon, and that @@ -684,7 +684,7 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env ; tcFamInstDeclChecks mb_clsinfo fam_tc -- Check that the family declaration is for the right kind - ; checkTc (isDataFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc) + ; checkTc (isDataFamilyTyCon fam_tc) (TcRnFamilyCategoryMismatch fam_tc) ; gadt_syntax <- dataDeclChecks fam_name hs_ctxt hs_cons -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index b37977bb47..e052cb7633 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -305,19 +305,14 @@ Each step expands superclasses one layer, and clearly does not terminate. type ClassSet = UniqSet Class -checkClassCycles :: Class -> Maybe SDoc +checkClassCycles :: Class -> Maybe SuperclassCycle -- Nothing <=> ok -- Just err <=> possible cycle error checkClassCycles cls - = do { (definite_cycle, err) <- go (unitUniqSet cls) + = do { (definite_cycle, details) <- go (unitUniqSet cls) cls (mkTyVarTys (classTyVars cls)) - ; let herald | definite_cycle = text "Superclass cycle for" - | otherwise = text "Potential superclass cycle for" - ; return (vcat [ herald <+> quotes (ppr cls) - , nest 2 err, hint]) } + ; return (MkSuperclassCycle cls definite_cycle details) } where - hint = text "Use UndecidableSuperClasses to accept this" - -- Expand superclasses starting with (C a b), complaining -- if you find the same class a second time, or a type function -- or predicate headed by a type variable @@ -325,12 +320,12 @@ checkClassCycles cls -- NB: this code duplicates TcType.transSuperClasses, but -- with more error message generation clobber -- Make sure the two stay in sync. - go :: ClassSet -> Class -> [Type] -> Maybe (Bool, SDoc) + go :: ClassSet -> Class -> [Type] -> Maybe (Bool, [SuperclassCycleDetail]) go so_far cls tys = firstJusts $ map (go_pred so_far) $ immSuperClasses cls tys - go_pred :: ClassSet -> PredType -> Maybe (Bool, SDoc) + go_pred :: ClassSet -> PredType -> Maybe (Bool, [SuperclassCycleDetail]) -- Nothing <=> ok -- Just (True, err) <=> definite cycle -- Just (False, err) <=> possible cycle @@ -338,31 +333,28 @@ checkClassCycles cls | Just (tc, tys) <- tcSplitTyConApp_maybe pred = go_tc so_far pred tc tys | hasTyVarHead pred - = Just (False, hang (text "one of whose superclass constraints is headed by a type variable:") - 2 (quotes (ppr pred))) + = Just (False, [SCD_HeadTyVar pred]) | otherwise = Nothing - go_tc :: ClassSet -> PredType -> TyCon -> [Type] -> Maybe (Bool, SDoc) + go_tc :: ClassSet -> PredType -> TyCon -> [Type] -> Maybe (Bool, [SuperclassCycleDetail]) go_tc so_far pred tc tys | isFamilyTyCon tc - = Just (False, hang (text "one of whose superclass constraints is headed by a type family:") - 2 (quotes (ppr pred))) + = Just (False, [SCD_HeadTyFam pred]) | Just cls <- tyConClass_maybe tc = go_cls so_far cls tys | otherwise -- Equality predicate, for example = Nothing - go_cls :: ClassSet -> Class -> [Type] -> Maybe (Bool, SDoc) + go_cls :: ClassSet -> Class -> [Type] -> Maybe (Bool, [SuperclassCycleDetail]) go_cls so_far cls tys | cls `elementOfUniqSet` so_far - = Just (True, text "one of whose superclasses is" <+> quotes (ppr cls)) + = Just (True, [SCD_Superclass cls]) | isCTupleClass cls = go so_far cls tys | otherwise - = do { (b,err) <- go (so_far `addOneToUniqSet` cls) cls tys - ; return (b, text "one of whose superclasses is" <+> quotes (ppr cls) - $$ err) } + = do { (b, details) <- go (so_far `addOneToUniqSet` cls) cls tys + ; return (b, SCD_Superclass cls : details) } {- ************************************************************************ diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index e14dae75cf..46643a4c8d 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -2049,7 +2049,7 @@ C. Examine the class declaration at the top of this Note again. -} doNotQuantifyTyVars :: CandidatesQTvs - -> (TidyEnv -> TcM (TidyEnv, UninferrableTyvarCtx)) + -> (TidyEnv -> TcM (TidyEnv, UninferrableTyVarCtx)) -- ^ like "the class context (D a b, E foogle)" -> TcM () -- See Note [Error on unconstrained meta-variables] @@ -2068,7 +2068,7 @@ doNotQuantifyTyVars dvs where_found ; unless (null leftover_metas) $ do { let (tidy_env1, tidied_tvs) = tidyOpenTyCoVars emptyTidyEnv leftover_metas ; (tidy_env2, where_doc) <- where_found tidy_env1 - ; let msg = TcRnUninferrableTyvar tidied_tvs where_doc + ; let msg = TcRnUninferrableTyVar tidied_tvs where_doc ; failWithTcM (tidy_env2, msg) } ; traceTc "doNotQuantifyTyVars success" empty } diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index aa4360908b..7edcbbddbd 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -502,7 +502,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnBadBootFamInstDecl" = 06203 GhcDiagnosticCode "TcRnIllegalFamilyInstance" = 06204 GhcDiagnosticCode "TcRnMissingClassAssoc" = 06205 - GhcDiagnosticCode "TcRnBadFamInstDecl" = 06206 GhcDiagnosticCode "TcRnNotOpenFamily" = 06207 GhcDiagnosticCode "TcRnCapturedTermName" = 54201 GhcDiagnosticCode "TcRnBindingOfExistingName" = 58805 @@ -538,13 +537,57 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnStageRestriction" = 18157 GhcDiagnosticCode "TcRnTyThingUsedWrong" = 10969 GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924 - GhcDiagnosticCode "TcRnUninferrableTyvar" = 16220 + GhcDiagnosticCode "TcRnUninferrableTyVar" = 16220 GhcDiagnosticCode "TcRnSkolemEscape" = 71451 GhcDiagnosticCode "TcRnPatSynEscapedCoercion" = 88986 GhcDiagnosticCode "TcRnPatSynExistentialInResult" = 33973 GhcDiagnosticCode "TcRnPatSynArityMismatch" = 18365 GhcDiagnosticCode "PatSynNotInvertible" = 69317 GhcDiagnosticCode "PatSynUnboundVar" = 28572 + GhcDiagnosticCode "TcRnMultiAssocTyFamDefaults" = 59128 + GhcDiagnosticCode "TcRnTyFamDepsDisabled" = 43991 + GhcDiagnosticCode "TcRnAbstractClosedTyFamDecl" = 60012 + GhcDiagnosticCode "TcRnPartialFieldSelector" = 82712 + GhcDiagnosticCode "TcRnSuperclassCycle" = 29210 + GhcDiagnosticCode "TcRnDefaultSigMismatch" = 72771 + GhcDiagnosticCode "TcRnTyFamResultDisabled" = 44012 + GhcDiagnosticCode "TcRnCommonFieldResultTypeMismatch" = 31004 + GhcDiagnosticCode "TcRnCommonFieldTypeMismatch" = 91827 + GhcDiagnosticCode "TcRnAssocNoClassTyVar" = 55912 + GhcDiagnosticCode "TcRnDataConParentTypeMismatch" = 45219 + GhcDiagnosticCode "TcRnGADTsDisabled" = 23894 + GhcDiagnosticCode "TcRnExistentialQuantificationDisabled" = 25709 + GhcDiagnosticCode "TcRnGADTDataContext" = 61072 + GhcDiagnosticCode "TcRnMultipleConForNewtype" = 16409 + GhcDiagnosticCode "TcRnKindSignaturesDisabled" = 49378 + GhcDiagnosticCode "TcRnEmptyDataDeclsDisabled" = 32478 + GhcDiagnosticCode "TcRnFamilyCategoryMismatch" = 52347 + GhcDiagnosticCode "TcRnFamilyArityMismatch" = 12985 + GhcDiagnosticCode "TcRnRoleMismatch" = 29178 + GhcDiagnosticCode "TcRnRoleCountMismatch" = 54298 + GhcDiagnosticCode "TcRnIllegalRoleAnnotation" = 77192 + GhcDiagnosticCode "TcRnRoleAnnotationsDisabled" = 17779 + GhcDiagnosticCode "TcRnIncoherentRoles" = 18273 + GhcDiagnosticCode "TcRnTyFamNameMismatch" = 88221 + + -- TcRnBadFieldAnnotation/BadFieldAnnotationReason + GhcDiagnosticCode "LazyFieldsDisabled" = 81601 + GhcDiagnosticCode "UnpackWithoutStrictness" = 10107 + GhcDiagnosticCode "BackpackUnpackAbstractType" = 40091 + + -- TcRnRoleValidationFailed/RoleInferenceFailedReason + GhcDiagnosticCode "TyVarRoleMismatch" = 22221 + GhcDiagnosticCode "TyVarMissingInEnv" = 99991 + GhcDiagnosticCode "BadCoercionRole" = 92834 + + -- TcRnClassExtensionDisabled/DisabledClassExtension + GhcDiagnosticCode "MultiParamDisabled" = 28349 + GhcDiagnosticCode "FunDepsDisabled" = 15708 + GhcDiagnosticCode "ConstrainedClassMethodsDisabled" = 25079 + + -- TcRnTyFamsDisabled/TyFamsDisabledReason + GhcDiagnosticCode "TyFamsDisabledFamily" = 39191 + GhcDiagnosticCode "TyFamsDisabledInstance" = 06206 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -722,6 +765,10 @@ type family ConRecursInto con where ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason ConRecursInto "TcRnPatSynInvalidRhs" = 'Just PatSynInvalidRhsReason ConRecursInto "TcRnBadRecordUpdate" = 'Just BadRecordUpdateReason + ConRecursInto "TcRnBadFieldAnnotation" = 'Just BadFieldAnnotationReason + ConRecursInto "TcRnRoleValidationFailed" = 'Just RoleValidationFailedReason + ConRecursInto "TcRnClassExtensionDisabled" = 'Just DisabledClassExtension + ConRecursInto "TcRnTyFamsDisabled" = 'Just TyFamsDisabledReason -- -- TH errors diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs index 654d798ef7..635b965035 100644 --- a/compiler/GHC/Types/Hint.hs +++ b/compiler/GHC/Types/Hint.hs @@ -29,7 +29,7 @@ import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt import Data.Typeable import GHC.Unit.Module (ModuleName, Module) -import GHC.Hs.Extension (GhcTc) +import GHC.Hs.Extension (GhcTc, GhcRn) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) import GHC.Core.Type (PredType) @@ -43,6 +43,7 @@ import GHC.Parser.Errors.Basic import {-# SOURCE #-} Language.Haskell.Syntax.Expr import GHC.Unit.Module.Imported (ImportedModsVal) import GHC.Data.FastString (fsLit) +import Language.Haskell.Syntax (LPat, LIdP) -- This {-# SOURCE #-} import should be removable once -- 'Language.Haskell.Syntax.Bind' no longer depends on 'GHC.Tc.Types.Evidence'. @@ -433,6 +434,8 @@ data GhcHint | LoopySuperclassSolveHint PredType ClsInstOrQC + | SuggestExplicitBidiPatSyn Name (LPat GhcRn) [LIdP GhcRn] + -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way -- to instantiate a particular signature, where the first argument is diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs index 32e1b38bb2..641dbb1691 100644 --- a/compiler/GHC/Types/Hint/Ppr.hs +++ b/compiler/GHC/Types/Hint/Ppr.hs @@ -223,6 +223,15 @@ instance Outputable GhcHint where what = case cls_or_qc of IsClsInst -> text "instance context" IsQC {} -> text "context of the quantified constraint" + SuggestExplicitBidiPatSyn name pat args + -> hang (text "Instead use an explicitly bidirectional" + <+> text "pattern synonym, e.g.") + 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow + <+> ppr pat <+> text "where") + 2 (pp_name <+> pp_args <+> equals <+> text "...")) + where + pp_name = ppr name + pp_args = hsep (map ppr args) perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" diff --git a/testsuite/tests/driver/T11381.hs b/testsuite/tests/driver/T11381.hs index a2464ef0cf..378b007bce 100644 --- a/testsuite/tests/driver/T11381.hs +++ b/testsuite/tests/driver/T11381.hs @@ -5,5 +5,5 @@ module T11381 where -- ensure that this code does not compile without TypeFamilyDependencies and that -- injectivity error is not reported. type family F a = r | r -> a -type instance F Int = Bool -type instance F Int = Char +type instance F Bool = Int +type instance F Char = Int diff --git a/testsuite/tests/driver/T11381.stderr b/testsuite/tests/driver/T11381.stderr index 7390ff64c6..aab437a66b 100644 --- a/testsuite/tests/driver/T11381.stderr +++ b/testsuite/tests/driver/T11381.stderr @@ -1,5 +1,5 @@ -T11381.hs:7:23: +T11381.hs:7:23: [GHC-43991] Illegal injectivity annotation - Use TypeFamilyDependencies to allow this In the type family declaration for ‘F’ + Suggested fix: Perhaps you intended to use TypeFamilyDependencies diff --git a/testsuite/tests/gadt/T14719.stderr b/testsuite/tests/gadt/T14719.stderr index e71f0e78e5..0457817796 100644 --- a/testsuite/tests/gadt/T14719.stderr +++ b/testsuite/tests/gadt/T14719.stderr @@ -1,5 +1,5 @@ -T14719.hs:5:3: error: +T14719.hs:5:3: error: [GHC-45219] • Data constructor ‘MkFoo1’ returns type ‘Bool’ instead of an instance of its parent type ‘Foo1’ • In the definition of data constructor ‘MkFoo1’ diff --git a/testsuite/tests/gadt/gadt11.stderr b/testsuite/tests/gadt/gadt11.stderr index 09c54d6e87..5303f5a57e 100644 --- a/testsuite/tests/gadt/gadt11.stderr +++ b/testsuite/tests/gadt/gadt11.stderr @@ -1,5 +1,5 @@ -gadt11.hs:12:3: error: +gadt11.hs:12:3: error: [GHC-45219] • Data constructor ‘L2’ returns type ‘T1 Bool’ instead of an instance of its parent type ‘T2 a’ • In the definition of data constructor ‘L2’ diff --git a/testsuite/tests/gadt/gadtSyntaxFail001.stderr b/testsuite/tests/gadt/gadtSyntaxFail001.stderr index aad7b63e54..a8bb357efc 100644 --- a/testsuite/tests/gadt/gadtSyntaxFail001.stderr +++ b/testsuite/tests/gadt/gadtSyntaxFail001.stderr @@ -1,7 +1,9 @@ -gadtSyntaxFail001.hs:9:5: error: +gadtSyntaxFail001.hs:9:5: error: [GHC-25709] • Data constructor ‘C2’ has existential type variables, a context, or a specialised result type C2 :: forall a. a -> Char -> Foo a Int - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C2’ In the data type declaration for ‘Foo’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs diff --git a/testsuite/tests/gadt/gadtSyntaxFail002.stderr b/testsuite/tests/gadt/gadtSyntaxFail002.stderr index f144b2e247..8a75e9f358 100644 --- a/testsuite/tests/gadt/gadtSyntaxFail002.stderr +++ b/testsuite/tests/gadt/gadtSyntaxFail002.stderr @@ -1,7 +1,9 @@ -gadtSyntaxFail002.hs:9:5: error: +gadtSyntaxFail002.hs:9:5: error: [GHC-25709] • Data constructor ‘C2’ has existential type variables, a context, or a specialised result type C2 :: forall a. a -> Char -> Foo a a - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C2’ In the data type declaration for ‘Foo’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs diff --git a/testsuite/tests/gadt/gadtSyntaxFail003.stderr b/testsuite/tests/gadt/gadtSyntaxFail003.stderr index f5255aa4a2..589095c8d5 100644 --- a/testsuite/tests/gadt/gadtSyntaxFail003.stderr +++ b/testsuite/tests/gadt/gadtSyntaxFail003.stderr @@ -1,7 +1,9 @@ -gadtSyntaxFail003.hs:8:5: error: +gadtSyntaxFail003.hs:8:5: error: [GHC-25709] • Data constructor ‘C1’ has existential type variables, a context, or a specialised result type C1 :: forall a c b. a -> Int -> c -> Foo b a - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C1’ In the data type declaration for ‘Foo’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs diff --git a/testsuite/tests/ghci/prog006/prog006.stderr b/testsuite/tests/ghci/prog006/prog006.stderr index 8b23e548ed..d801e5221f 100644 --- a/testsuite/tests/ghci/prog006/prog006.stderr +++ b/testsuite/tests/ghci/prog006/prog006.stderr @@ -1,7 +1,9 @@ -Boot.hs:6:13: error: +Boot.hs:6:13: error: [GHC-25709] • Data constructor ‘D’ has existential type variables, a context, or a specialised result type D :: forall n. Class n => n -> Data - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘D’ In the data type declaration for ‘Data’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs diff --git a/testsuite/tests/ghci/scripts/T9293.stderr b/testsuite/tests/ghci/scripts/T9293.stderr index 93925a5443..6dcd966d3d 100644 --- a/testsuite/tests/ghci/scripts/T9293.stderr +++ b/testsuite/tests/ghci/scripts/T9293.stderr @@ -1,19 +1,32 @@ -<interactive>:4:1: error: +<interactive>:4:1: error: [GHC-23894] • Illegal generalised algebraic data declaration for ‘T’ - (Enable the GADTs extension to allow this) • In the data declaration for ‘T’ + Suggested fix: Perhaps you intended to use GADTs -ghci057.hs:4:3: error: +<interactive>:4:16: [GHC-25709] + Data constructor ‘C’ has existential type variables, a context, or a specialised result type + C :: T Int + In the definition of data constructor ‘C’ + In the data type declaration for ‘T’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs + +ghci057.hs:4:3: error: [GHC-25709] • Data constructor ‘C’ has existential type variables, a context, or a specialised result type C :: T Int - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C’ In the data type declaration for ‘T’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs -ghci057.hs:4:3: error: +ghci057.hs:4:3: error: [GHC-25709] • Data constructor ‘C’ has existential type variables, a context, or a specialised result type C :: T Int - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C’ In the data type declaration for ‘T’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs diff --git a/testsuite/tests/ghci/scripts/ghci057.stderr b/testsuite/tests/ghci/scripts/ghci057.stderr index 93925a5443..6dcd966d3d 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stderr +++ b/testsuite/tests/ghci/scripts/ghci057.stderr @@ -1,19 +1,32 @@ -<interactive>:4:1: error: +<interactive>:4:1: error: [GHC-23894] • Illegal generalised algebraic data declaration for ‘T’ - (Enable the GADTs extension to allow this) • In the data declaration for ‘T’ + Suggested fix: Perhaps you intended to use GADTs -ghci057.hs:4:3: error: +<interactive>:4:16: [GHC-25709] + Data constructor ‘C’ has existential type variables, a context, or a specialised result type + C :: T Int + In the definition of data constructor ‘C’ + In the data type declaration for ‘T’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs + +ghci057.hs:4:3: error: [GHC-25709] • Data constructor ‘C’ has existential type variables, a context, or a specialised result type C :: T Int - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C’ In the data type declaration for ‘T’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs -ghci057.hs:4:3: error: +ghci057.hs:4:3: error: [GHC-25709] • Data constructor ‘C’ has existential type variables, a context, or a specialised result type C :: T Int - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C’ In the data type declaration for ‘T’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs diff --git a/testsuite/tests/ghci/should_run/T7253.stderr b/testsuite/tests/ghci/should_run/T7253.stderr index 5478ad817f..0a386fe0f9 100644 --- a/testsuite/tests/ghci/should_run/T7253.stderr +++ b/testsuite/tests/ghci/should_run/T7253.stderr @@ -2,7 +2,7 @@ <interactive>:19:1: warning: [GHC-42044] [-Wunrecognised-pragmas (in -Wdefault)] Unrecognised pragma: FOO -<interactive>:61:1: error: +<interactive>:61:1: error: [GHC-29178] • Role mismatch on variable b: Annotation says phantom but role representational is required • while checking a role annotation for ‘T1’ diff --git a/testsuite/tests/indexed-types/should_fail/BadFamInstDecl.stderr b/testsuite/tests/indexed-types/should_fail/BadFamInstDecl.stderr index 8b87a97cba..a0f6157ca5 100644 --- a/testsuite/tests/indexed-types/should_fail/BadFamInstDecl.stderr +++ b/testsuite/tests/indexed-types/should_fail/BadFamInstDecl.stderr @@ -2,6 +2,6 @@ [2 of 2] Compiling BadFamInstDecl ( BadFamInstDecl.hs, BadFamInstDecl.o ) BadFamInstDecl.hs:4:1: [GHC-06206] - Illegal family instance for ‘T’ + Illegal family instance for ‘T’ In the type instance declaration for ‘T’ Suggested fix: Perhaps you intended to use TypeFamilies diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr index ac68f1acde..e586fe6b5b 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr @@ -1,5 +1,5 @@ -ClosedFam4.hs:5:1: +ClosedFam4.hs:5:1: [GHC-60012] You may define an abstract closed type family only in a .hs-boot file In the type family declaration for ‘Foo’ diff --git a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr index 53dc8b4ac0..027e943e61 100644 --- a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr +++ b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr @@ -1,4 +1,4 @@ -Overlap4.hs:7:3: error: +Overlap4.hs:7:3: error: [GHC-12985] • Number of parameters must match family declaration; expected 2 • In the type family declaration for ‘F’ diff --git a/testsuite/tests/indexed-types/should_fail/Overlap5.stderr b/testsuite/tests/indexed-types/should_fail/Overlap5.stderr index f67549104b..8df01f2cbc 100644 --- a/testsuite/tests/indexed-types/should_fail/Overlap5.stderr +++ b/testsuite/tests/indexed-types/should_fail/Overlap5.stderr @@ -1,5 +1,5 @@ -Overlap5.hs:8:3: error: +Overlap5.hs:8:3: error: [GHC-88221] • Mismatched type name in type family instance. Expected: F Actual: G diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr index 795188e922..7b9b42b269 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr @@ -1,5 +1,5 @@ -SimpleFail3a.hs:10:3: +SimpleFail3a.hs:10:3: [GHC-52347] Wrong category of family instance; declaration was for a data family In the type instance declaration for ‘S1’ In the instance declaration for ‘C1 Int’ diff --git a/testsuite/tests/indexed-types/should_fail/T11136.stderr b/testsuite/tests/indexed-types/should_fail/T11136.stderr index f90ef74149..8f5a3eefce 100644 --- a/testsuite/tests/indexed-types/should_fail/T11136.stderr +++ b/testsuite/tests/indexed-types/should_fail/T11136.stderr @@ -1,5 +1,5 @@ -T11136.hs:7:3: error: +T11136.hs:7:3: error: [GHC-12985] • Number of parameters must match family declaration; expected 1 • In the default type instance declaration for ‘D’ In the class declaration for ‘C’ diff --git a/testsuite/tests/indexed-types/should_fail/T12867.stderr b/testsuite/tests/indexed-types/should_fail/T12867.stderr index 892f9c9d76..ee229c55ca 100644 --- a/testsuite/tests/indexed-types/should_fail/T12867.stderr +++ b/testsuite/tests/indexed-types/should_fail/T12867.stderr @@ -5,7 +5,7 @@ T12867.hs:8:21: error: [GHC-83865] In the type ‘(Eq (TestM a))’ In the type declaration for ‘Test2’ -T12867.hs:10:1: error: +T12867.hs:10:1: error: [GHC-55912] • The associated type ‘TestM’ mentions none of the type or kind variables of the class ‘Test a’ • In the class declaration for ‘Test’ diff --git a/testsuite/tests/indexed-types/should_fail/T13571.stderr b/testsuite/tests/indexed-types/should_fail/T13571.stderr index 482d6024a0..6723b19322 100644 --- a/testsuite/tests/indexed-types/should_fail/T13571.stderr +++ b/testsuite/tests/indexed-types/should_fail/T13571.stderr @@ -1,5 +1,5 @@ -T13571.hs:5:1: error: +T13571.hs:5:1: error: [GHC-44012] • Illegal result type variable r for ‘F’ - Enable TypeFamilyDependencies to allow result variable names • In the type family declaration for ‘F’ + Suggested fix: Perhaps you intended to use TypeFamilyDependencies diff --git a/testsuite/tests/indexed-types/should_fail/T13571a.stderr b/testsuite/tests/indexed-types/should_fail/T13571a.stderr index f92e5a909a..a12c0ce594 100644 --- a/testsuite/tests/indexed-types/should_fail/T13571a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T13571a.stderr @@ -1,5 +1,5 @@ -T13571a.hs:7:1: error: +T13571a.hs:7:1: error: [GHC-44012] • Illegal result type variable (r :: Type) for ‘G’ - Enable TypeFamilyDependencies to allow result variable names • In the type family declaration for ‘G’ + Suggested fix: Perhaps you intended to use TypeFamilyDependencies diff --git a/testsuite/tests/indexed-types/should_fail/T2888.stderr b/testsuite/tests/indexed-types/should_fail/T2888.stderr index 068eab1d3d..3f227d7f9e 100644 --- a/testsuite/tests/indexed-types/should_fail/T2888.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2888.stderr @@ -1,5 +1,5 @@ -T2888.hs:7:1: error: +T2888.hs:7:1: error: [GHC-55912] • The associated type ‘D’ mentions none of the type or kind variables of the class ‘C w’ • In the class declaration for ‘C’ diff --git a/testsuite/tests/indexed-types/should_fail/T9167.stderr b/testsuite/tests/indexed-types/should_fail/T9167.stderr index 8b08e4fddd..b4d539adec 100644 --- a/testsuite/tests/indexed-types/should_fail/T9167.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9167.stderr @@ -1,5 +1,5 @@ -T9167.hs:6:1: error: +T9167.hs:6:1: error: [GHC-55912] • The associated type ‘F b’ mentions none of the type or kind variables of the class ‘C a’ • In the class declaration for ‘C’ diff --git a/testsuite/tests/indexed-types/should_fail/T9896.stderr b/testsuite/tests/indexed-types/should_fail/T9896.stderr index f46e406f03..27514ebbe9 100644 --- a/testsuite/tests/indexed-types/should_fail/T9896.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9896.stderr @@ -1,5 +1,5 @@ -T9896.hs:8:3: +T9896.hs:8:3: [GHC-52347] Wrong category of family instance; declaration was for a type family In the newtype instance declaration for ‘TestT’ In the instance declaration for ‘Test Bool’ diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr index 46521deeba..69af469b95 100644 --- a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr +++ b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr @@ -1,4 +1,4 @@ -TyFamArity1.hs:4:15: error: +TyFamArity1.hs:4:15: error: [GHC-12985] • Number of parameters must match family declaration; expected 2 • In the type instance declaration for ‘T’ diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr index 8d48921946..b5f36f6367 100644 --- a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr +++ b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr @@ -1,4 +1,4 @@ -TyFamArity2.hs:4:15: error: +TyFamArity2.hs:4:15: error: [GHC-12985] • Number of parameters must match family declaration; expected 1 • In the type instance declaration for ‘T’ diff --git a/testsuite/tests/module/mod39.stderr b/testsuite/tests/module/mod39.stderr index d54a231152..2d093f36a4 100644 --- a/testsuite/tests/module/mod39.stderr +++ b/testsuite/tests/module/mod39.stderr @@ -1,7 +1,7 @@ -mod39.hs:4:17: error: +mod39.hs:4:17: error: [GHC-25079] • Constraint ‘Eq a’ in the type of ‘f’ constrains only the class type variables - Enable ConstrainedClassMethods to allow it • When checking the class method: f :: forall a. (C a, Eq a) => a In the class declaration for ‘C’ + Suggested fix: Perhaps you intended to use ConstrainedClassMethods diff --git a/testsuite/tests/module/mod40.stderr b/testsuite/tests/module/mod40.stderr index bd4fcf4bd9..b434d12761 100644 --- a/testsuite/tests/module/mod40.stderr +++ b/testsuite/tests/module/mod40.stderr @@ -1,14 +1,14 @@ -mod40.hs:3:1: error: +mod40.hs:3:1: error: [GHC-29210] • Superclass cycle for ‘C1’ one of whose superclasses is ‘C2’ one of whose superclasses is ‘C1’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘C1’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses -mod40.hs:4:1: error: +mod40.hs:4:1: error: [GHC-29210] • Superclass cycle for ‘C2’ one of whose superclasses is ‘C1’ one of whose superclasses is ‘C2’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘C2’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.stderr b/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.stderr index f1801abd73..d40b994cb6 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.stderr @@ -1,3 +1,3 @@ -DRFPartialFields.hs:4:17: error: [-Wpartial-fields, Werror=partial-fields] +DRFPartialFields.hs:4:17: error: [GHC-82712] [-Wpartial-fields, Werror=partial-fields] Use of partial record field selector: ‘foo’ diff --git a/testsuite/tests/parser/should_fail/readFail035.stderr b/testsuite/tests/parser/should_fail/readFail035.stderr index 574cde49ab..e470427eae 100644 --- a/testsuite/tests/parser/should_fail/readFail035.stderr +++ b/testsuite/tests/parser/should_fail/readFail035.stderr @@ -1,4 +1,5 @@ -readFail035.hs:6:1: - ‘Foo’ has no constructors (EmptyDataDecls permits this) +readFail035.hs:6:1: [GHC-32478] + ‘Foo’ has no constructors In the data declaration for ‘Foo’ + Suggested fix: Perhaps you intended to use EmptyDataDecls diff --git a/testsuite/tests/parser/should_fail/readFail036.stderr b/testsuite/tests/parser/should_fail/readFail036.stderr index 469f5fb985..0a53a4be86 100644 --- a/testsuite/tests/parser/should_fail/readFail036.stderr +++ b/testsuite/tests/parser/should_fail/readFail036.stderr @@ -1,5 +1,5 @@ -readFail036.hs:6:16: error: - Illegal kind signature: ‘Type’ - Perhaps you intended to use KindSignatures +readFail036.hs:6:16: error: [GHC-49378] + Illegal kind signature ‘Type’ In the data type declaration for ‘Foo’ + Suggested fix: Perhaps you intended to use KindSignatures diff --git a/testsuite/tests/parser/should_fail/readFail037.stderr b/testsuite/tests/parser/should_fail/readFail037.stderr index 27e36ab344..fd1ba5e14c 100644 --- a/testsuite/tests/parser/should_fail/readFail037.stderr +++ b/testsuite/tests/parser/should_fail/readFail037.stderr @@ -1,5 +1,5 @@ -readFail037.hs:5:1: error: +readFail037.hs:5:1: error: [GHC-28349] • Too many parameters for class ‘Foo’ - (Enable MultiParamTypeClasses to allow multi-parameter classes) • In the class declaration for ‘Foo’ + Suggested fix: Perhaps you intended to use MultiParamTypeClasses diff --git a/testsuite/tests/parser/should_fail/readFail041.stderr b/testsuite/tests/parser/should_fail/readFail041.stderr index 028b96510b..a41ffc8805 100644 --- a/testsuite/tests/parser/should_fail/readFail041.stderr +++ b/testsuite/tests/parser/should_fail/readFail041.stderr @@ -1,5 +1,5 @@ -readFail041.hs:6:1: error: +readFail041.hs:6:1: error: [GHC-15708] • Fundeps in class ‘Foo’ - (Enable FunctionalDependencies to allow fundeps) • In the class declaration for ‘Foo’ + Suggested fix: Perhaps you intended to use FunctionalDependencies diff --git a/testsuite/tests/patsyn/should_fail/T14112.stderr b/testsuite/tests/patsyn/should_fail/T14112.stderr index 833eee188b..32b584c5e1 100644 --- a/testsuite/tests/patsyn/should_fail/T14112.stderr +++ b/testsuite/tests/patsyn/should_fail/T14112.stderr @@ -2,6 +2,7 @@ T14112.hs:5:21: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘MyJust1’: Pattern ‘!a’ is not invertible - Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. - pattern MyJust1 a <- Just !a where MyJust1 a = ... RHS pattern: Just !a + Suggested fix: + Instead use an explicitly bidirectional pattern synonym, e.g. + pattern MyJust1 a <- Just !a where MyJust1 a = ... diff --git a/testsuite/tests/patsyn/should_fail/unidir.stderr b/testsuite/tests/patsyn/should_fail/unidir.stderr index 649dc9cf05..0a14283295 100644 --- a/testsuite/tests/patsyn/should_fail/unidir.stderr +++ b/testsuite/tests/patsyn/should_fail/unidir.stderr @@ -2,6 +2,7 @@ unidir.hs:4:18: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘Head’: Pattern ‘_’ is not invertible - Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. - pattern Head x <- x : _ where Head x = ... RHS pattern: x : _ + Suggested fix: + Instead use an explicitly bidirectional pattern synonym, e.g. + pattern Head x <- x : _ where Head x = ... diff --git a/testsuite/tests/polykinds/T14110.stderr b/testsuite/tests/polykinds/T14110.stderr index aedfacb324..979a292193 100644 --- a/testsuite/tests/polykinds/T14110.stderr +++ b/testsuite/tests/polykinds/T14110.stderr @@ -1,5 +1,5 @@ -T14110.hs:9:8: error: +T14110.hs:9:8: error: [GHC-12985] • Number of parameters must match family declaration; expected 1 • In the type instance declaration for ‘R_’ In the instance declaration for ‘R Eq’ diff --git a/testsuite/tests/rename/should_fail/T16002.stderr b/testsuite/tests/rename/should_fail/T16002.stderr index 91279ffeeb..1d75800952 100644 --- a/testsuite/tests/rename/should_fail/T16002.stderr +++ b/testsuite/tests/rename/should_fail/T16002.stderr @@ -1,5 +1,5 @@ -T16002.hs:6:3: error: +T16002.hs:6:3: error: [GHC-88221] • Mismatched type name in type family instance. Expected: B Actual: A diff --git a/testsuite/tests/rename/should_fail/rnfail053.stderr b/testsuite/tests/rename/should_fail/rnfail053.stderr index 4d438c3821..5f286374cb 100644 --- a/testsuite/tests/rename/should_fail/rnfail053.stderr +++ b/testsuite/tests/rename/should_fail/rnfail053.stderr @@ -1,7 +1,9 @@ -rnfail053.hs:6:10: error: +rnfail053.hs:6:10: error: [GHC-25709] • Data constructor ‘MkT’ has existential type variables, a context, or a specialised result type MkT :: forall a. a -> T - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘MkT’ In the data type declaration for ‘T’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs diff --git a/testsuite/tests/roles/should_fail/Roles11.stderr b/testsuite/tests/roles/should_fail/Roles11.stderr index 1fa09997c5..16e1636553 100644 --- a/testsuite/tests/roles/should_fail/Roles11.stderr +++ b/testsuite/tests/roles/should_fail/Roles11.stderr @@ -1,5 +1,5 @@ -Roles11.hs:5:1: +Roles11.hs:5:1: [GHC-29178] Role mismatch on variable a: Annotation says representational but role nominal is required while checking a role annotation for ‘T2’ diff --git a/testsuite/tests/roles/should_fail/Roles5.stderr b/testsuite/tests/roles/should_fail/Roles5.stderr index cb79845a55..052e2d3fa9 100644 --- a/testsuite/tests/roles/should_fail/Roles5.stderr +++ b/testsuite/tests/roles/should_fail/Roles5.stderr @@ -1,14 +1,19 @@ -Roles5.hs:7:1: - Illegal role annotation for T; - did you intend to use RoleAnnotations? +Roles5.hs:7:1: [GHC-17779] + Illegal role annotation for T while checking a role annotation for ‘T’ + Suggested fix: Perhaps you intended to use RoleAnnotations -Roles5.hs:8:1: - Illegal role annotation for C; - did you intend to use RoleAnnotations? +Roles5.hs:8:1: [GHC-18273] + Roles other than ‘nominal’ for class parameters can lead to incoherence. + while checking a role annotation for ‘C’ + Suggested fix: Perhaps you intended to use IncoherentInstances + +Roles5.hs:8:1: [GHC-17779] + Illegal role annotation for C while checking a role annotation for ‘C’ + Suggested fix: Perhaps you intended to use RoleAnnotations -Roles5.hs:9:1: +Roles5.hs:9:1: [GHC-77192] Illegal role annotation for S; they are allowed only for datatypes and classes. diff --git a/testsuite/tests/roles/should_fail/Roles6.stderr b/testsuite/tests/roles/should_fail/Roles6.stderr index 91bcce99c8..23f36fb29f 100644 --- a/testsuite/tests/roles/should_fail/Roles6.stderr +++ b/testsuite/tests/roles/should_fail/Roles6.stderr @@ -1,5 +1,5 @@ -Roles6.hs:7:1: +Roles6.hs:7:1: [GHC-54298] Wrong number of roles listed in role annotation; Expected 2, got 3: type role Foo nominal representational phantom diff --git a/testsuite/tests/roles/should_fail/T8773.stderr b/testsuite/tests/roles/should_fail/T8773.stderr index fac02f30d1..7cf09c4253 100644 --- a/testsuite/tests/roles/should_fail/T8773.stderr +++ b/testsuite/tests/roles/should_fail/T8773.stderr @@ -1,5 +1,5 @@ -T8773.hs:5:1: +T8773.hs:5:1: [GHC-18273] Roles other than ‘nominal’ for class parameters can lead to incoherence. - Use IncoherentInstances to allow this; bad role found while checking a role annotation for ‘C2’ + Suggested fix: Perhaps you intended to use IncoherentInstances diff --git a/testsuite/tests/th/T15362.stderr b/testsuite/tests/th/T15362.stderr index b63cb3553e..8468d4319f 100644 --- a/testsuite/tests/th/T15362.stderr +++ b/testsuite/tests/th/T15362.stderr @@ -1,5 +1,5 @@ -T15362.hs:7:2: error: +T15362.hs:7:2: error: [GHC-88221] • Mismatched type name in type family instance. Expected: + Actual: Maybe diff --git a/testsuite/tests/th/TH_Roles1.stderr b/testsuite/tests/th/TH_Roles1.stderr index 2b665852ca..e7b138c2c6 100644 --- a/testsuite/tests/th/TH_Roles1.stderr +++ b/testsuite/tests/th/TH_Roles1.stderr @@ -1,5 +1,5 @@ -TH_Roles1.hs:7:2: error: - • Illegal role annotation for T; - did you intend to use RoleAnnotations? +TH_Roles1.hs:7:2: error: [GHC-17779] + • Illegal role annotation for T • while checking a role annotation for ‘T’ + Suggested fix: Perhaps you intended to use RoleAnnotations diff --git a/testsuite/tests/typecheck/should_compile/T7050.stderr b/testsuite/tests/typecheck/should_compile/T7050.stderr index e115954bc8..3efb704434 100644 --- a/testsuite/tests/typecheck/should_compile/T7050.stderr +++ b/testsuite/tests/typecheck/should_compile/T7050.stderr @@ -1,5 +1,5 @@ -T7050.hs:3:14: warning: +T7050.hs:3:14: warning: [GHC-40091] • Ignoring unusable UNPACK pragma on the first argument of ‘Foo’ • In the definition of data constructor ‘Foo’ In the data type declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_compile/T7169.stderr b/testsuite/tests/typecheck/should_compile/T7169.stderr index 0cc82e03cc..8fbe93c4e7 100644 --- a/testsuite/tests/typecheck/should_compile/T7169.stderr +++ b/testsuite/tests/typecheck/should_compile/T7169.stderr @@ -1,2 +1,2 @@ -T7169.hs:11:5: warning: [-Wpartial-fields] +T7169.hs:11:5: warning: [GHC-82712] [-Wpartial-fields] Use of partial record field selector: ‘m2’ diff --git a/testsuite/tests/typecheck/should_compile/T7562.stderr b/testsuite/tests/typecheck/should_compile/T7562.stderr index 9c1b846b91..9aebdae6cf 100644 --- a/testsuite/tests/typecheck/should_compile/T7562.stderr +++ b/testsuite/tests/typecheck/should_compile/T7562.stderr @@ -1,5 +1,5 @@ -T7562.hs:3:14: warning: +T7562.hs:3:14: warning: [GHC-10107] • UNPACK pragma lacks '!' on the first argument of ‘Pair2’ • In the definition of data constructor ‘Pair2’ In the data type declaration for ‘Pair2’ diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr index 0f0c951a1d..68b289a0e6 100644 --- a/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr +++ b/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr @@ -1,5 +1,5 @@ -AssocTyDef03.hs:6:5: +AssocTyDef03.hs:6:5: [GHC-52347] Wrong category of family instance; declaration was for a data family In the default type instance declaration for ‘Typ’ In the class declaration for ‘Cls’ diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr index 07812dc5fa..7065642eb0 100644 --- a/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr +++ b/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr @@ -1,5 +1,5 @@ -AssocTyDef05.hs:6:5: error: +AssocTyDef05.hs:6:5: error: [GHC-12985] • Number of parameters must match family declaration; expected 1 • In the default type instance declaration for ‘Typ’ In the class declaration for ‘Cls’ diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr index d51ce8ff6c..eb624b3bc7 100644 --- a/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr +++ b/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr @@ -1,5 +1,5 @@ -AssocTyDef06.hs:6:5: +AssocTyDef06.hs:6:5: [GHC-12985] Number of parameters must match family declaration; expected 1 In the default type instance declaration for ‘Typ’ In the class declaration for ‘Cls’ diff --git a/testsuite/tests/typecheck/should_fail/CommonFieldResultTypeMismatch.hs b/testsuite/tests/typecheck/should_fail/CommonFieldResultTypeMismatch.hs new file mode 100644 index 0000000000..fdf1a95878 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/CommonFieldResultTypeMismatch.hs @@ -0,0 +1,5 @@ +module CommonFieldResultTypeMismatch where + +data A a where + A1 :: { fld :: Int } -> A Int + A2 :: { fld :: Int } -> A Double diff --git a/testsuite/tests/typecheck/should_fail/CommonFieldResultTypeMismatch.stderr b/testsuite/tests/typecheck/should_fail/CommonFieldResultTypeMismatch.stderr new file mode 100644 index 0000000000..320a978612 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/CommonFieldResultTypeMismatch.stderr @@ -0,0 +1,4 @@ +CommonFieldResultTypeMismatch.hs:3:1: [GHC-31004] + Constructors A1 and A2 have a common field ‘fld’, + but have different result types + In the data type declaration for ‘A’ diff --git a/testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.hs b/testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.hs new file mode 100644 index 0000000000..3167114146 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.hs @@ -0,0 +1,6 @@ +module CommonFieldTypeMismatch where + +data A = + A1 { fld :: Int } + | + A2 { fld :: String } diff --git a/testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr b/testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr new file mode 100644 index 0000000000..c235f2e566 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr @@ -0,0 +1,3 @@ +CommonFieldTypeMismatch.hs:3:1: [GHC-91827] + Constructors A1 and A2 give different types for field ‘fld’ + In the data type declaration for ‘A’ diff --git a/testsuite/tests/typecheck/should_fail/GADTDataContext.stderr b/testsuite/tests/typecheck/should_fail/GADTDataContext.stderr new file mode 100644 index 0000000000..8bd6648ed1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/GADTDataContext.stderr @@ -0,0 +1 @@ +asdf diff --git a/testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.hs b/testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.hs new file mode 100644 index 0000000000..db384c2b8b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.hs @@ -0,0 +1,3 @@ +module LazyFieldsDisabled where + +data A = A { lazy :: ~Int } diff --git a/testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr b/testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr new file mode 100644 index 0000000000..5e1b44dd12 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr @@ -0,0 +1,6 @@ +LazyFieldsDisabled.hs:3:10: [GHC-81601] + Lazy field annotations (~) are disabled + on the first argument of ‘A’ + In the definition of data constructor ‘A’ + In the data type declaration for ‘A’ + Suggested fix: Perhaps you intended to use StrictData diff --git a/testsuite/tests/typecheck/should_fail/MultiAssocDefaults.hs b/testsuite/tests/typecheck/should_fail/MultiAssocDefaults.hs new file mode 100644 index 0000000000..05265db804 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/MultiAssocDefaults.hs @@ -0,0 +1,10 @@ +{-# language TypeFamilies #-} + +module MultiAssocDefaults where + +import Data.Kind (Type) + +class C a where + type A a :: Type + type A a = Int + type A a = Double diff --git a/testsuite/tests/typecheck/should_fail/MultiAssocDefaults.stderr b/testsuite/tests/typecheck/should_fail/MultiAssocDefaults.stderr new file mode 100644 index 0000000000..5e9e0671f7 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/MultiAssocDefaults.stderr @@ -0,0 +1,3 @@ +MultiAssocDefaults.hs:7:1: [GHC-59128] + More than one default declaration for A + In the class declaration for ‘C’ diff --git a/testsuite/tests/typecheck/should_fail/T11623.stderr b/testsuite/tests/typecheck/should_fail/T11623.stderr index 0f6253f103..aebd2e1af6 100644 --- a/testsuite/tests/typecheck/should_fail/T11623.stderr +++ b/testsuite/tests/typecheck/should_fail/T11623.stderr @@ -1,5 +1,5 @@ -T11623.hs:5:23: error: +T11623.hs:5:23: error: [GHC-88221] • Mismatched type name in type family instance. Expected: T Actual: Maybe diff --git a/testsuite/tests/typecheck/should_fail/T12083a.stderr b/testsuite/tests/typecheck/should_fail/T12083a.stderr index 54457a7d09..a10d19bb13 100644 --- a/testsuite/tests/typecheck/should_fail/T12083a.stderr +++ b/testsuite/tests/typecheck/should_fail/T12083a.stderr @@ -4,9 +4,11 @@ T12083a.hs:6:1: error: [GHC-91510] • In the type synonym declaration for ‘Constrd’ Suggested fix: Perhaps you intended to use RankNTypes -T12083a.hs:10:26: error: +T12083a.hs:10:26: error: [GHC-25709] • Data constructor ‘ExistentiallyLost’ has existential type variables, a context, or a specialised result type ExistentiallyLost :: forall u. TC u => u -> ExistentiallyLost - (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘ExistentiallyLost’ In the data type declaration for ‘ExistentiallyLost’ + Suggested fixes: + Perhaps you intended to use ExistentialQuantification + Perhaps you intended to use GADTs diff --git a/testsuite/tests/typecheck/should_fail/T12151.stderr b/testsuite/tests/typecheck/should_fail/T12151.stderr index 21fea0bdeb..2bfc2f2c3f 100644 --- a/testsuite/tests/typecheck/should_fail/T12151.stderr +++ b/testsuite/tests/typecheck/should_fail/T12151.stderr @@ -1,5 +1,5 @@ -T12151.hs:9:13: error: +T12151.hs:9:13: error: [GHC-72771] • The default type signature for put: forall t. t does not match its corresponding non-default type signature • When checking the class method: put :: forall a. Put a => a diff --git a/testsuite/tests/typecheck/should_fail/T12918a.stderr b/testsuite/tests/typecheck/should_fail/T12918a.stderr index 3712a33f9a..a8bc386712 100644 --- a/testsuite/tests/typecheck/should_fail/T12918a.stderr +++ b/testsuite/tests/typecheck/should_fail/T12918a.stderr @@ -1,5 +1,5 @@ -T12918a.hs:8:11: error: +T12918a.hs:8:11: error: [GHC-72771] • The default type signature for fresh: forall (t :: (* -> *) -> * -> *). MonadTrans t => t m Integer does not match its corresponding non-default type signature diff --git a/testsuite/tests/typecheck/should_fail/T12918b.stderr b/testsuite/tests/typecheck/should_fail/T12918b.stderr index b812096660..bc53c4195e 100644 --- a/testsuite/tests/typecheck/should_fail/T12918b.stderr +++ b/testsuite/tests/typecheck/should_fail/T12918b.stderr @@ -1,12 +1,12 @@ -T12918b.hs:8:11: error: +T12918b.hs:8:11: error: [GHC-72771] • The default type signature for bar1: forall b. b -> a does not match its corresponding non-default type signature • When checking the class method: bar1 :: forall a b. Foo1 a => a -> b In the class declaration for ‘Foo1’ -T12918b.hs:12:11: error: +T12918b.hs:12:11: error: [GHC-72771] • The default type signature for bar2: forall x. x does not match its corresponding non-default type signature • When checking the class method: @@ -26,14 +26,14 @@ T12918b.hs:12:11: error: [GHC-39999] bar2 :: forall a b. Foo1 a => a -> b In the class declaration for ‘Foo1’ -T12918b.hs:16:11: error: +T12918b.hs:16:11: error: [GHC-72771] • The default type signature for bar3: a -> Int does not match its corresponding non-default type signature • When checking the class method: bar3 :: forall a b. Foo1 a => a -> b In the class declaration for ‘Foo1’ -T12918b.hs:20:11: error: +T12918b.hs:20:11: error: [GHC-72771] • The default type signature for bar4: forall b. a -> b does not match its corresponding non-default type signature • When checking the class method: diff --git a/testsuite/tests/typecheck/should_fail/T13300.stderr b/testsuite/tests/typecheck/should_fail/T13300.stderr index 5bc8e4d3e3..8848060740 100644 --- a/testsuite/tests/typecheck/should_fail/T13300.stderr +++ b/testsuite/tests/typecheck/should_fail/T13300.stderr @@ -1,5 +1,5 @@ -T13300.hs:5:3: error: +T13300.hs:5:3: error: [GHC-45219] • Data constructor ‘WI’ returns type ‘Int’ instead of an instance of its parent type ‘W’ • In the definition of data constructor ‘WI’ diff --git a/testsuite/tests/typecheck/should_fail/T14761a.stderr b/testsuite/tests/typecheck/should_fail/T14761a.stderr index 867cf6dae6..75effca532 100644 --- a/testsuite/tests/typecheck/should_fail/T14761a.stderr +++ b/testsuite/tests/typecheck/should_fail/T14761a.stderr @@ -1,15 +1,15 @@ -T14761a.hs:13:10: error: [-Werror] +T14761a.hs:13:10: error: [GHC-10107] [-Werror] • UNPACK pragma lacks '!' on the first argument of ‘A’ • In the definition of data constructor ‘A’ In the data type declaration for ‘A’ -T14761a.hs:17:10: error: [-Werror] +T14761a.hs:17:10: error: [GHC-10107] [-Werror] • UNPACK pragma lacks '!' on the first argument of ‘B’ • In the definition of data constructor ‘B’ In the data type declaration for ‘B’ -T14761a.hs:20:3: error: [-Werror] +T14761a.hs:20:3: error: [GHC-10107] [-Werror] • UNPACK pragma lacks '!' on the first argument of ‘MkG2’ • In the definition of data constructor ‘MkG2’ In the data type declaration for ‘G’ diff --git a/testsuite/tests/typecheck/should_fail/T18357.stderr b/testsuite/tests/typecheck/should_fail/T18357.stderr index 60762c4dcb..0fee78cd5d 100644 --- a/testsuite/tests/typecheck/should_fail/T18357.stderr +++ b/testsuite/tests/typecheck/should_fail/T18357.stderr @@ -1,5 +1,5 @@ -T18357.hs:13:3: error: +T18357.hs:13:3: error: [GHC-45219] • Data constructor ‘MkT’ returns type ‘W’ instead of an instance of its parent type ‘T’ • In the definition of data constructor ‘MkT’ diff --git a/testsuite/tests/typecheck/should_fail/T18357b.stderr b/testsuite/tests/typecheck/should_fail/T18357b.stderr index c758e81543..24937c2432 100644 --- a/testsuite/tests/typecheck/should_fail/T18357b.stderr +++ b/testsuite/tests/typecheck/should_fail/T18357b.stderr @@ -1,5 +1,5 @@ -T18357b.hs:10:3: error: +T18357b.hs:10:3: error: [GHC-45219] • Data constructor ‘MkT’ returns type ‘T’ instead of an instance of its parent type ‘T’ • In the definition of data constructor ‘MkT’ diff --git a/testsuite/tests/typecheck/should_fail/T20260.stderr b/testsuite/tests/typecheck/should_fail/T20260.stderr index 574d72163d..5415252cd3 100644 --- a/testsuite/tests/typecheck/should_fail/T20260.stderr +++ b/testsuite/tests/typecheck/should_fail/T20260.stderr @@ -1,5 +1,5 @@ -T20260.hs:8:3: error: +T20260.hs:8:3: error: [GHC-88221] • Mismatched type name in type family instance. Expected: Foo Actual: Bar diff --git a/testsuite/tests/typecheck/should_fail/T20873c.stderr b/testsuite/tests/typecheck/should_fail/T20873c.stderr index 972d01c583..58b98d32ef 100644 --- a/testsuite/tests/typecheck/should_fail/T20873c.stderr +++ b/testsuite/tests/typecheck/should_fail/T20873c.stderr @@ -1,5 +1,5 @@ -T20873c.hs:10:1: error: - • Illegal kind signature ‘Foo’ - (Use KindSignatures to allow kind signatures) +T20873c.hs:10:1: error: [GHC-49378] + • Illegal kind signature ‘Foo :: U Int’ • In the data declaration for ‘Foo’ + Suggested fix: Perhaps you intended to use KindSignatures diff --git a/testsuite/tests/typecheck/should_fail/T3966.stderr b/testsuite/tests/typecheck/should_fail/T3966.stderr index cab45c21e6..0708250dea 100644 --- a/testsuite/tests/typecheck/should_fail/T3966.stderr +++ b/testsuite/tests/typecheck/should_fail/T3966.stderr @@ -1,5 +1,5 @@ -T3966.hs:5:16: error: [-Werror] +T3966.hs:5:16: error: [GHC-40091] [-Werror] • Ignoring unusable UNPACK pragma on the first argument of ‘Foo’ • In the definition of data constructor ‘Foo’ In the data type declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T7175.stderr b/testsuite/tests/typecheck/should_fail/T7175.stderr index 57d798fb0a..bc20efb233 100644 --- a/testsuite/tests/typecheck/should_fail/T7175.stderr +++ b/testsuite/tests/typecheck/should_fail/T7175.stderr @@ -1,11 +1,11 @@ -T7175.hs:8:4: error: +T7175.hs:8:4: error: [GHC-45219] Data constructor ‘G1C’ returns type ‘F Int’ instead of an instance of its parent type ‘G1 a’ In the definition of data constructor ‘G1C’ In the data type declaration for ‘G1’ -T7175.hs:11:4: error: +T7175.hs:11:4: error: [GHC-45219] Data constructor ‘G2C’ returns type ‘F Int’ instead of an instance of its parent type ‘G2 a’ In the definition of data constructor ‘G2C’ diff --git a/testsuite/tests/typecheck/should_fail/T7437.stderr b/testsuite/tests/typecheck/should_fail/T7437.stderr index d5577873f6..cf461f529a 100644 --- a/testsuite/tests/typecheck/should_fail/T7437.stderr +++ b/testsuite/tests/typecheck/should_fail/T7437.stderr @@ -1,5 +1,5 @@ -T7437.hs:14:13: error: +T7437.hs:14:13: error: [GHC-72771] • The default type signature for put: forall t. (Generic t, GPut (Rep t)) => t -> [()] does not match its corresponding non-default type signature diff --git a/testsuite/tests/typecheck/should_fail/T9415.stderr b/testsuite/tests/typecheck/should_fail/T9415.stderr index 3250b67cd3..0606c5a5a0 100644 --- a/testsuite/tests/typecheck/should_fail/T9415.stderr +++ b/testsuite/tests/typecheck/should_fail/T9415.stderr @@ -1,14 +1,14 @@ -T9415.hs:3:1: error: +T9415.hs:3:1: error: [GHC-29210] • Superclass cycle for ‘C’ one of whose superclasses is ‘D’ one of whose superclasses is ‘C’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘C’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses -T9415.hs:5:1: error: +T9415.hs:5:1: error: [GHC-29210] • Superclass cycle for ‘D’ one of whose superclasses is ‘C’ one of whose superclasses is ‘D’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘D’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses diff --git a/testsuite/tests/typecheck/should_fail/T9739.stderr b/testsuite/tests/typecheck/should_fail/T9739.stderr index c35440a234..ae91c4b00f 100644 --- a/testsuite/tests/typecheck/should_fail/T9739.stderr +++ b/testsuite/tests/typecheck/should_fail/T9739.stderr @@ -1,14 +1,14 @@ -T9739.hs:4:1: error: +T9739.hs:4:1: error: [GHC-29210] • Superclass cycle for ‘Class1’ one of whose superclasses is ‘Class3’ one of whose superclasses is ‘Class1’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘Class1’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses -T9739.hs:9:1: error: +T9739.hs:9:1: error: [GHC-29210] • Superclass cycle for ‘Class3’ one of whose superclasses is ‘Class1’ one of whose superclasses is ‘Class3’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘Class3’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses diff --git a/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr b/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr index 15c9cd2ab6..700db44271 100644 --- a/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr +++ b/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr @@ -1,5 +1,5 @@ -TcNoNullaryTC.hs:4:1: error: +TcNoNullaryTC.hs:4:1: error: [GHC-28349] • No parameters for class ‘A’ - (Enable MultiParamTypeClasses to allow no-parameter classes) • In the class declaration for ‘A’ + Suggested fix: Perhaps you intended to use MultiParamTypeClasses diff --git a/testsuite/tests/typecheck/should_fail/TyfamsDisabled.hs b/testsuite/tests/typecheck/should_fail/TyfamsDisabled.hs new file mode 100644 index 0000000000..e91c4e9a16 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/TyfamsDisabled.hs @@ -0,0 +1,3 @@ +module TyfamsDisabled where + +type family A diff --git a/testsuite/tests/typecheck/should_fail/TyfamsDisabled.stderr b/testsuite/tests/typecheck/should_fail/TyfamsDisabled.stderr new file mode 100644 index 0000000000..e9d756f9a7 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/TyfamsDisabled.stderr @@ -0,0 +1,4 @@ +TyfamsDisabled.hs:3:1: [GHC-39191] + Illegal family declaration for ‘A’ + In the type family declaration for ‘A’ + Suggested fix: Perhaps you intended to use TypeFamilies diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 07bfcd8436..ebcec31f8d 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -675,3 +675,8 @@ test('PatSynExistential', normal, compile_fail, ['']) test('PatSynArity', normal, compile_fail, ['']) test('PatSynUnboundVar', normal, compile_fail, ['']) test('T21444', normal, compile_fail, ['']) +test('MultiAssocDefaults', normal, compile_fail, ['']) +test('LazyFieldsDisabled', normal, compile_fail, ['']) +test('TyfamsDisabled', normal, compile_fail, ['']) +test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) +test('CommonFieldTypeMismatch', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail027.stderr b/testsuite/tests/typecheck/should_fail/tcfail027.stderr index e8b2770e2b..2ce8d99dde 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail027.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail027.stderr @@ -1,14 +1,14 @@ -tcfail027.hs:4:1: error: +tcfail027.hs:4:1: error: [GHC-29210] • Superclass cycle for ‘A’ one of whose superclasses is ‘B’ one of whose superclasses is ‘A’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘A’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses -tcfail027.hs:7:1: error: +tcfail027.hs:7:1: error: [GHC-29210] • Superclass cycle for ‘B’ one of whose superclasses is ‘A’ one of whose superclasses is ‘B’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘B’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses diff --git a/testsuite/tests/typecheck/should_fail/tcfail150.stderr b/testsuite/tests/typecheck/should_fail/tcfail150.stderr index 50a2793add..b7729c04d7 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail150.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail150.stderr @@ -1,8 +1,8 @@ -tcfail150.hs:7:3: error: +tcfail150.hs:7:3: error: [GHC-25079] • Constraint ‘Eq a’ in the type of ‘op’ constrains only the class type variables - Enable ConstrainedClassMethods to allow it • When checking the class method: op :: forall a. (Foo a, Eq a) => a -> a In the class declaration for ‘Foo’ + Suggested fix: Perhaps you intended to use ConstrainedClassMethods diff --git a/testsuite/tests/typecheck/should_fail/tcfail155.stderr b/testsuite/tests/typecheck/should_fail/tcfail155.stderr index 868daaf322..82756ed514 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail155.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail155.stderr @@ -1,5 +1,5 @@ -tcfail155.hs:8:6: error: +tcfail155.hs:8:6: error: [GHC-45219] • Data constructor ‘P’ returns type ‘L2’ instead of an instance of its parent type ‘T a’ • In the definition of data constructor ‘P’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail176.stderr b/testsuite/tests/typecheck/should_fail/tcfail176.stderr index 35c96d3332..db12864c70 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail176.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail176.stderr @@ -1,5 +1,5 @@ -tcfail176.hs:7:21: +tcfail176.hs:7:21: [GHC-45219] Data constructor ‘Bug’ returns type ‘Maybe a’ instead of an instance of its parent type ‘Bug a’ In the definition of data constructor ‘Bug’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail213.stderr b/testsuite/tests/typecheck/should_fail/tcfail213.stderr index 319a2b10e2..7d7e2d7da5 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail213.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail213.stderr @@ -1,7 +1,7 @@ -tcfail213.hs:8:1: error: +tcfail213.hs:8:1: error: [GHC-29210] • Potential superclass cycle for ‘C’ one of whose superclass constraints is headed by a type family: ‘F a’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘C’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses diff --git a/testsuite/tests/typecheck/should_fail/tcfail216.stderr b/testsuite/tests/typecheck/should_fail/tcfail216.stderr index 520f5590dd..4c9fbf5712 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail216.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail216.stderr @@ -1,7 +1,7 @@ -tcfail216.hs:4:1: error: +tcfail216.hs:4:1: error: [GHC-29210] • Potential superclass cycle for ‘A’ one of whose superclass constraints is headed by a type variable: ‘cls (A cls)’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘A’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses diff --git a/testsuite/tests/typecheck/should_fail/tcfail217.stderr b/testsuite/tests/typecheck/should_fail/tcfail217.stderr index 729080373c..57afa3edab 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail217.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail217.stderr @@ -1,6 +1,6 @@ -tcfail217.hs:7:1: error: +tcfail217.hs:7:1: error: [GHC-29210] • Superclass cycle for ‘A’ one of whose superclasses is ‘A’ - Use UndecidableSuperClasses to accept this • In the class declaration for ‘A’ + Suggested fix: Perhaps you intended to use UndecidableSuperClasses diff --git a/testsuite/tests/unboxedsums/unpack_sums_5.stderr b/testsuite/tests/unboxedsums/unpack_sums_5.stderr index 96e786895a..2108d2b6b6 100644 --- a/testsuite/tests/unboxedsums/unpack_sums_5.stderr +++ b/testsuite/tests/unboxedsums/unpack_sums_5.stderr @@ -1,10 +1,10 @@ -unpack_sums_5.hs:4:22: warning: +unpack_sums_5.hs:4:22: warning: [GHC-40091] • Ignoring unusable UNPACK pragma on the first argument of ‘JustT’ • In the definition of data constructor ‘JustT’ In the data type declaration for ‘SMaybeT’ -unpack_sums_5.hs:7:10: warning: +unpack_sums_5.hs:7:10: warning: [GHC-40091] • Ignoring unusable UNPACK pragma on the first argument of ‘MkT’ • In the definition of data constructor ‘MkT’ In the data type declaration for ‘T’ |