diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Hs/Type.hs | 23 | ||||
| -rw-r--r-- | compiler/GHC/Rename/HsType.hs | 100 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 107 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 171 | ||||
| -rw-r--r-- | compiler/GHC/Types/Error/Codes.hs | 11 |
5 files changed, 333 insertions, 79 deletions
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 968fc99b73..eb3a955269 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -60,6 +60,8 @@ module GHC.Hs.Type ( selectorAmbiguousFieldOcc, unambiguousFieldOcc, ambiguousFieldOcc, + OpName(..), + mkAnonWildCardTy, pprAnonWildCard, hsOuterTyVarNames, hsOuterExplicitBndrs, mapHsOuterImplicit, @@ -109,6 +111,7 @@ import GHC.Types.Name import GHC.Types.Name.Reader ( RdrName ) import GHC.Types.Var ( VarBndr, visArgTypeLike ) import GHC.Core.TyCo.Rep ( Type(..) ) +import GHC.Builtin.Names ( negateName ) import GHC.Builtin.Types( manyDataConName, oneDataConName, mkTupleStr ) import GHC.Core.Ppr ( pprOccWithTick) import GHC.Core.Type @@ -950,6 +953,26 @@ ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr {- ************************************************************************ * * + OpName +* * +************************************************************************ +-} + +-- | Name of an operator in an operator application or section +data OpName = NormalOp Name -- ^ A normal identifier + | NegateOp -- ^ Prefix negation + | UnboundOp RdrName -- ^ An unbound identifier + | RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence + +instance Outputable OpName where + ppr (NormalOp n) = ppr n + ppr NegateOp = ppr negateName + ppr (UnboundOp uv) = ppr uv + ppr (RecFldOp fld) = ppr fld + +{- +************************************************************************ +* * \subsection{Pretty printing} * * ************************************************************************ diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index 06ff333ed8..500a6f8407 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -45,7 +45,6 @@ import GHC.Prelude import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType ) import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList ) -import GHC.Driver.Session import GHC.Hs import GHC.Rename.Env import GHC.Rename.Doc @@ -56,8 +55,7 @@ import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn , lookupTyFixityRn ) import GHC.Rename.Unbound ( notInScopeErr, WhereLooking(WL_LocalOnly) ) import GHC.Tc.Errors.Types -import GHC.Tc.Errors.Ppr ( pprScopeError - , inHsDocContext, pprHsDocContext ) +import GHC.Tc.Errors.Ppr ( pprHsDocContext ) import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader import GHC.Builtin.Names @@ -215,14 +213,7 @@ rnHsPatSigTypeBindingVars ctxt sigType thing_inside = case sigType of -- Should the inner `a` refer to the outer one? shadow it? We are, as yet, undecided, -- so we currently reject. when (not (null varsInScope)) $ - addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat - [ text "Type variable" <> plural varsInScope - <+> hcat (punctuate (text ",") (map (quotes . ppr) varsInScope)) - <+> isOrAre varsInScope - <+> text "already in scope." - , text "Type applications in patterns must bind fresh variables, without shadowing." - ] + addErr $ TcRnBindVarAlreadyInScope varsInScope (wcVars, ibVars) <- partition_nwcs varsNotInScope rnImplicitTvBndrs ctxt Nothing ibVars $ \ ibVars' -> do (wcVars', hs_ty', fvs) <- rnWcBody ctxt wcVars hs_ty @@ -371,7 +362,7 @@ rnHsSigType ctx level = setSrcSpanA loc $ do { traceRn "rnHsSigType" (ppr sig_ty) ; case outer_bndrs of - HsOuterExplicit{} -> checkPolyKinds env sig_ty + HsOuterExplicit{} -> checkPolyKinds env (HsSigType sig_ty) HsOuterImplicit{} -> pure () ; imp_vars <- filterInScopeM $ extractHsTyRdrTyVars body ; bindHsOuterTyVarBndrs ctx Nothing imp_vars outer_bndrs $ \outer_bndrs' -> @@ -447,9 +438,7 @@ rnImplicitTvBndrs ctx mb_assoc implicit_vs_with_dups thing_inside = do { implicit_vs <- forM (NE.groupAllWith unLoc $ implicit_vs_with_dups) $ \case (x :| []) -> return x (x :| _) -> do - let msg = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Variable" <+> text "`" <> ppr x <> text "'" <+> text "would be bound multiple times by" <+> pprHsDocContext ctx <> text "." - addErr msg + addErr $ TcRnBindMultipleVariables ctx x return x ; traceRn "rnImplicitTvBndrs" $ @@ -572,7 +561,7 @@ rnLHsTyKi env (L loc ty) rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars) rnHsTyKi env ty@(HsForAllTy { hst_tele = tele, hst_body = tau }) - = do { checkPolyKinds env ty + = do { checkPolyKinds env (HsType ty) ; bindHsForAllTelescope (rtke_ctxt env) tele $ \ tele' -> do { (tau', fvs) <- rnLHsTyKi env tau ; return ( HsForAllTy { hst_xforall = noExtField @@ -593,9 +582,7 @@ rnHsTyKi env (HsTyVar _ ip (L loc rdr_name)) = do { when (isRnKindLevel env && isRdrTyVar rdr_name) $ unlessXOptM LangExt.PolyKinds $ addErr $ TcRnWithHsDocContext (rtke_ctxt env) $ - mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Unexpected kind variable" <+> quotes (ppr rdr_name) - , text "Perhaps you intended to use PolyKinds" ] + TcRnUnexpectedKindVar rdr_name -- Any type variable at the kind level is illegal without the use -- of PolyKinds (see #14710) ; name <- rnTyVar env rdr_name @@ -684,16 +671,13 @@ rnHsTyKi env sumTy@(HsSumTy x tys) rnHsTyKi env tyLit@(HsTyLit src t) = do { data_kinds <- xoptM LangExt.DataKinds ; unless data_kinds (addErr (dataKindsErr env tyLit)) - ; when (negLit t) (addErr negLitErr) + ; when (negLit t) (addErr $ TcRnNegativeNumTypeLiteral tyLit) ; return (HsTyLit src (rnHsTyLit t), emptyFVs) } where negLit :: HsTyLit (GhcPass p) -> Bool negLit (HsStrTy _ _) = False negLit (HsNumTy _ i) = i < 0 negLit (HsCharTy _ _) = False - negLitErr :: TcRnMessage - negLitErr = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Illegal literal in type (type literals must not be negative):" <+> ppr tyLit rnHsTyKi env (HsAppTy _ ty1 ty2) = do { (ty1', fvs1) <- rnLHsTyKi env ty1 @@ -734,12 +718,10 @@ rnHsTyKi env (XHsType ty) check_in_scope :: RdrName -> RnM () check_in_scope rdr_name = do mb_name <- lookupLocalOccRn_maybe rdr_name - -- TODO: refactor this to avoid mkTcRnUnknownMessage when (isNothing mb_name) $ addErr $ TcRnWithHsDocContext (rtke_ctxt env) $ - mkTcRnUnknownMessage $ mkPlainError noHints $ - pprScopeError rdr_name (notInScopeErr WL_LocalOnly rdr_name) + TcRnNotInScope (notInScopeErr WL_LocalOnly rdr_name) rdr_name [] [] rnHsTyKi env ty@(HsExplicitListTy _ ip tys) = do { data_kinds <- xoptM LangExt.DataKinds @@ -894,27 +876,22 @@ wildCardsAllowed env --------------- -- | Ensures either that we're in a type or that -XPolyKinds is set -checkPolyKinds :: Outputable ty - => RnTyKiEnv - -> ty -- ^ type - -> RnM () +checkPolyKinds :: RnTyKiEnv + -> HsTypeOrSigType GhcPs + -> RnM () checkPolyKinds env ty | isRnKindLevel env = do { polykinds <- xoptM LangExt.PolyKinds ; unless polykinds $ - addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (text "Illegal kind:" <+> ppr ty $$ - text "Did you mean to enable PolyKinds?") } + addErr $ TcRnIllegalKind ty True } checkPolyKinds _ _ = return () -notInKinds :: Outputable ty - => RnTyKiEnv - -> ty +notInKinds :: RnTyKiEnv + -> HsType GhcPs -> RnM () notInKinds env ty | isRnKindLevel env - = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Illegal kind:" <+> ppr ty + = addErr $ TcRnIllegalKind (HsType ty) False notInKinds _ _ = return () {- ***************************************************** @@ -1413,18 +1390,6 @@ data NegationHandling = ReassociateNegation | KeepNegationIntact ---------------------------- --- | Name of an operator in an operator application or section -data OpName = NormalOp Name -- ^ A normal identifier - | NegateOp -- ^ Prefix negation - | UnboundOp RdrName -- ^ An unbound identifier - | RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence - -instance Outputable OpName where - ppr (NormalOp n) = ppr n - ppr NegateOp = ppr negateName - ppr (UnboundOp uv) = ppr uv - ppr (RecFldOp fld) = ppr fld - get_op :: LHsExpr GhcRn -> OpName -- An unbound name could be either HsVar or HsUnboundVar -- See GHC.Rename.Expr.rnUnboundVar @@ -1608,34 +1573,20 @@ precParseErr op1@(n1,_) op2@(n2,_) | is_unbound n1 || is_unbound n2 = return () -- Avoid error cascade | otherwise - = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Precedence parsing error") - 4 (hsep [text "cannot mix", ppr_opfix op1, text "and", - ppr_opfix op2, - text "in the same infix expression"]) + = addErr $ TcRnPrecedenceParsingError op1 op2 sectionPrecErr :: (OpName,Fixity) -> (OpName,Fixity) -> HsExpr GhcPs -> RnM () sectionPrecErr op@(n1,_) arg_op@(n2,_) section | is_unbound n1 || is_unbound n2 = return () -- Avoid error cascade | otherwise - = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [text "The operator" <+> ppr_opfix op <+> text "of a section", - nest 4 (sep [text "must have lower precedence than that of the operand,", - nest 2 (text "namely" <+> ppr_opfix arg_op)]), - nest 4 (text "in the section:" <+> quotes (ppr section))] + = addErr $ TcRnSectionPrecedenceError op arg_op section is_unbound :: OpName -> Bool is_unbound (NormalOp n) = isUnboundName n is_unbound UnboundOp{} = True is_unbound _ = False -ppr_opfix :: (OpName, Fixity) -> SDoc -ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity) - where - pp_op | NegateOp <- op = text "prefix `-'" - | otherwise = quotes (ppr op) - {- ***************************************************** * * @@ -1645,9 +1596,7 @@ ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity) unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> TcRnMessage unexpectedPatSigTypeErr ty - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal type signature:" <+> quotes (ppr ty)) - 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + = TcRnUnexpectedPatSigType ty badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcM () badKindSigErr doc (L loc ty) @@ -1657,21 +1606,16 @@ badKindSigErr doc (L loc ty) dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> TcRnMessage dataKindsErr env thing - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal" <+> pp_what <> colon <+> quotes (ppr thing)) - 2 (text "Perhaps you intended to use DataKinds") + = TcRnDataKindsError type_or_Kind thing where - pp_what | isRnKindLevel env = text "kind" - | otherwise = text "type" + type_or_Kind | isRnKindLevel env = KindLevel + | otherwise = TypeLevel warnUnusedForAll :: OutputableBndrFlag flag 'Renamed => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM () warnUnusedForAll doc (L loc tv) used_names = unless (hsTyVarName tv `elemNameSet` used_names) $ do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnUnusedForalls) noHints $ - vcat [ text "Unused quantified type variable" <+> quotes (ppr tv) - , inHsDocContext doc ] + let msg = TcRnUnusedQuantifiedTypeVar doc (HsTyVarBndrExistentialFlag tv) addDiagnosticAt (locA loc) msg warnCapturedTerm :: LocatedN RdrName -> Either [GlobalRdrElt] Name -> TcM () diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 09918d4014..2d056a31b1 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -1662,6 +1662,61 @@ instance Diagnostic TcRnMessage where 2 (vcat [ text "Expected:" <+> ppr fam_tc_name , text " Actual:" <+> ppr eqn_tc_name ]) + TcRnBindVarAlreadyInScope tv_names_in_scope + -> mkSimpleDecorated $ + vcat + [ text "Type variable" <> plural tv_names_in_scope + <+> hcat (punctuate (text ",") (map (quotes . ppr) tv_names_in_scope)) + <+> isOrAre tv_names_in_scope + <+> text "already in scope." + , text "Type applications in patterns must bind fresh variables, without shadowing." + ] + + TcRnBindMultipleVariables ctx tv_name_w_loc + -> mkSimpleDecorated $ + text "Variable" <+> text "`" <> ppr tv_name_w_loc <> text "'" <+> text "would be bound multiple times by" <+> pprHsDocContext ctx <> text "." + + TcRnUnexpectedKindVar tv_name + -> mkSimpleDecorated $ text "Unexpected kind variable" <+> quotes (ppr tv_name) + + TcRnNegativeNumTypeLiteral tyLit + -> mkSimpleDecorated $ text "Illegal literal in type (type literals must not be negative):" <+> ppr tyLit + + TcRnIllegalKind ty_thing _ + -> mkSimpleDecorated $ text "Illegal kind:" <+> (ppr ty_thing) + + TcRnPrecedenceParsingError op1 op2 + -> mkSimpleDecorated $ + hang (text "Precedence parsing error") + 4 (hsep [text "cannot mix", ppr_opfix op1, text "and", + ppr_opfix op2, + text "in the same infix expression"]) + + TcRnSectionPrecedenceError op arg_op section + -> mkSimpleDecorated $ + vcat [text "The operator" <+> ppr_opfix op <+> text "of a section", + nest 4 (sep [text "must have lower precedence than that of the operand,", + nest 2 (text "namely" <+> ppr_opfix arg_op)]), + nest 4 (text "in the section:" <+> quotes (ppr section))] + + TcRnUnexpectedPatSigType ty + -> mkSimpleDecorated $ + hang (text "Illegal type signature:" <+> quotes (ppr ty)) + 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + + TcRnIllegalKindSignature ty + -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) + + TcRnUnusedQuantifiedTypeVar doc tyVar + -> mkSimpleDecorated $ + vcat [ text "Unused quantified type variable" <+> quotes (ppr tyVar) + , inHsDocContext doc ] + + TcRnDataKindsError typeOrKind thing + -> mkSimpleDecorated $ + text "Illegal" <+> (text $ levelString typeOrKind) <> colon <+> quotes (ppr thing) + + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -2209,6 +2264,28 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnTyFamNameMismatch{} -> ErrorWithoutFlag + TcRnBindVarAlreadyInScope{} + -> ErrorWithoutFlag + TcRnBindMultipleVariables{} + -> ErrorWithoutFlag + TcRnUnexpectedKindVar{} + -> ErrorWithoutFlag + TcRnNegativeNumTypeLiteral{} + -> ErrorWithoutFlag + TcRnIllegalKind{} + -> ErrorWithoutFlag + TcRnPrecedenceParsingError{} + -> ErrorWithoutFlag + TcRnSectionPrecedenceError{} + -> ErrorWithoutFlag + TcRnUnexpectedPatSigType{} + -> ErrorWithoutFlag + TcRnIllegalKindSignature{} + -> ErrorWithoutFlag + TcRnUnusedQuantifiedTypeVar{} + -> WarningWithFlag Opt_WarnUnusedForalls + TcRnDataKindsError{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2782,6 +2859,30 @@ instance Diagnostic TcRnMessage where -> [suggestExtension LangExt.IncoherentInstances] TcRnTyFamNameMismatch{} -> noHints + TcRnBindVarAlreadyInScope{} + -> noHints + TcRnBindMultipleVariables{} + -> noHints + TcRnUnexpectedKindVar{} + -> [suggestExtension LangExt.PolyKinds] + TcRnNegativeNumTypeLiteral{} + -> noHints + TcRnIllegalKind _ suggest_polyKinds + -> if suggest_polyKinds + then [suggestExtension LangExt.PolyKinds] + else noHints + TcRnPrecedenceParsingError{} + -> noHints + TcRnSectionPrecedenceError{} + -> noHints + TcRnUnexpectedPatSigType{} + -> [suggestExtension LangExt.ScopedTypeVariables] + TcRnIllegalKindSignature{} + -> [suggestExtension LangExt.KindSignatures] + TcRnUnusedQuantifiedTypeVar{} + -> noHints + TcRnDataKindsError{} + -> [suggestExtension LangExt.DataKinds] diagnosticCode = constructorCode @@ -2933,6 +3034,12 @@ pprRecordFieldPart = \case RecordFieldPattern{} -> text "pattern" RecordFieldUpdate -> text "update" +ppr_opfix :: (OpName, Fixity) -> SDoc +ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity) + where + pp_op | NegateOp <- op = text "prefix `-'" + | otherwise = quotes (ppr op) + pprBindings :: [Name] -> SDoc pprBindings = pprWithCommas (quotes . ppr) diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 648074f4f3..14ff1ff6b7 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -1,7 +1,10 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE UndecidableInstances #-} module GHC.Tc.Errors.Types ( -- * Main types @@ -103,6 +106,8 @@ module GHC.Tc.Errors.Types ( , RoleValidationFailedReason(..) , DisabledClassExtension(..) , TyFamsDisabledReason(..) + , HsTypeOrSigType(..) + , HsTyVarBndrExistentialFlag(..) ) where import GHC.Prelude @@ -322,6 +327,7 @@ data TcRnMessage where Test cases: th/T17804 -} TcRnImplicitLift :: Name -> !ErrInfo -> TcRnMessage + {-| TcRnUnusedPatternBinds is a warning (controlled with -Wunused-pattern-binds) that occurs if a pattern binding binds no variables at all, unless it is a lone wild-card pattern, or a banged pattern. @@ -335,6 +341,21 @@ data TcRnMessage where Test cases: rename/{T13646,T17c,T17e,T7085} -} TcRnUnusedPatternBinds :: HsBind GhcRn -> TcRnMessage + + {-| TcRnUnusedQuantifiedTypeVar is a warning that occurs if there are unused + quantified type variables. + + Examples: + f :: forall a. Int -> Char + + Test cases: rename/should_compile/ExplicitForAllRules1 + rename/should_compile/T5331 + -} + TcRnUnusedQuantifiedTypeVar + :: HsDocContext + -> HsTyVarBndrExistentialFlag -- ^ tyVar binder. + -> TcRnMessage + {-| TcRnDodgyImports is a warning (controlled with -Wdodgy-imports) that occurs when an import of the form 'T(..)' or 'f(..)' does not actually import anything beside 'T'/'f' itself. @@ -621,6 +642,16 @@ data TcRnMessage where -} TcRnCharLiteralOutOfRange :: !Char -> TcRnMessage + {-| TcRnNegativeNumTypeLiteral is an error that occurs whenever + a type-level number literal is negative. + + type Neg = -1 + + Test cases: th/T8412 + typecheck/should_fail/T8306 + -} + TcRnNegativeNumTypeLiteral :: HsType GhcPs -> TcRnMessage + {-| TcRnIllegalWildcardsInConstructor is an error that occurs whenever the record wildcards '..' are used inside a constructor without labeled fields. @@ -1723,10 +1754,29 @@ data TcRnMessage where -} TcRnCapturedTermName :: RdrName -> Either [GlobalRdrElt] Name -> TcRnMessage + {-| TcRnTypeMultipleOccurenceOfBindVar is an error that occurs if a bound + type variable's name is already in use. + Example: + f :: forall a. ... + f (MkT @a ...) = ... + + Test cases: TyAppPat_ScopedTyVarConflict TyAppPat_NonlinearMultiPat TyAppPat_NonlinearMultiAppPat + -} + TcRnBindVarAlreadyInScope :: [LocatedN RdrName] -> TcRnMessage + + {-| TcRnBindMultipleVariables is an error that occurs in the case of + multiple occurrences of a bound variable. + Example: + foo (MkFoo @(a,a) ...) = ... + + Test case: typecheck/should_fail/TyAppPat_NonlinearSinglePat + -} + TcRnBindMultipleVariables :: HsDocContext -> LocatedN RdrName -> TcRnMessage + {-| TcRnTypeEqualityOutOfScope is a warning (controlled by -Wtype-equality-out-of-scope) that occurs when the type equality (a ~ b) is not in scope. - Test case: T18862b + Test case: warnings/should_compile/T18862b -} TcRnTypeEqualityOutOfScope :: TcRnMessage @@ -2106,6 +2156,31 @@ data TcRnMessage where -> !(Maybe SuggestUnliftedTypes) -- ^ suggested extension -> TcRnMessage + {-| TcRnUnexpectedKindVar is an error that occurs when the user + tries to use kind variables without -XPolyKinds. + + Example: + f :: forall k a. Proxy (a :: k) + + Test cases: polykinds/BadKindVar + polykinds/T14710 + saks/should_fail/T16722 + -} + TcRnUnexpectedKindVar :: RdrName -> TcRnMessage + + {-| TcRnIllegalKind is used for a various illegal kinds errors including + + Example: + type T :: forall k. Type -- without emabled -XPolyKinds + + Test cases: polykinds/T16762b + -} + TcRnIllegalKind + :: HsTypeOrSigType GhcPs + -- ^ The illegal kind + -> Bool -- ^ Whether enabling -XPolyKinds should be suggested + -> TcRnMessage + {- TcRnClassKindNotConstraint is an error for a type class that has a kind that is not equivalent to Constraint. @@ -2167,6 +2242,43 @@ data TcRnMessage where -> !MatchArgBadMatches -> TcRnMessage + {-| TcRnUnexpectedPatSigType is an error occurring when there is + a type signature in a pattern without -XScopedTypeVariables extension + + Examples: + f (a :: Bool) = ... + + Test case: rename/should_fail/T11663 + -} + TcRnUnexpectedPatSigType :: HsPatSigType GhcPs -> TcRnMessage + + {-| TcRnIllegalKindSignature is an error occuring when there is + a kind signature without -XKindSignatures extension + + Examples: + data Foo (a :: Nat) = .... + + Test case: parser/should_fail/readFail036 + -} + TcRnIllegalKindSignature :: HsType GhcPs -> TcRnMessage + + {-| TcRnDataKindsError is an error occurring when there is + an illegal type or kind, probably required -XDataKinds + and is used without the enabled extension. + + Examples: + + type Foo = [Nat, Char] + + type Bar = [Int, String] + + Test cases: linear/should_fail/T18888 + polykinds/T7151 + th/TH_Promoted1Tuple + typecheck/should_fail/tcfail094 + -} + TcRnDataKindsError :: TypeOrKind -> HsType GhcPs -> TcRnMessage + {- TcRnCannotBindScopedTyVarInPatSig is an error stating that scoped type variables cannot be used in pattern bindings. @@ -3638,6 +3750,43 @@ data TcRnMessage where -> !Name -- ^ The name used in the equation -> TcRnMessage + {-| TcRnPrecedenceParsingError is an error caused by attempting to + use operators with the same precedence in one infix expression. + + Example: + eq :: (a ~ b ~ c) :~: () + + Test cases: module/mod61 + parser/should_fail/readFail016 + rename/should_fail/rnfail017 + rename/should_fail/T9077 + typecheck/should_fail/T18252a + -} + TcRnPrecedenceParsingError + :: (OpName, Fixity) -- ^ first operator's name and fixity + -> (OpName, Fixity) -- ^ second operator's name and fixity + -> TcRnMessage + + {-| TcRnPrecedenceParsingError is an error caused by attempting to + use an operator with higher precedence than the operand. + + Example: + k = (-3 **) + where + (**) = const + infixl 7 ** + + Test cases: overloadedrecflds/should_fail/T13132_duplicaterecflds + parser/should_fail/readFail023 + rename/should_fail/rnfail019 + th/TH_unresolvedInfix2 + -} + TcRnSectionPrecedenceError + :: (OpName, Fixity) -- ^ first operator's name and fixity + -> (OpName, Fixity) -- ^ argument operator + -> HsExpr GhcPs -- ^ Section + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4076,6 +4225,7 @@ instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ppr IsExported = text "IsExported" + -------------------------------------------------------------------------------- -- -- Errors used in GHC.Tc.Errors @@ -5023,3 +5173,22 @@ data TyFamsDisabledReason = TyFamsDisabledFamily !Name | TyFamsDisabledInstance !TyCon deriving (Generic) + +-- | Either `HsType p` or `HsSigType p`. +-- +-- Used for reporting errors in `TcRnIllegalKind`. +data HsTypeOrSigType p + = HsType (HsType p) + | HsSigType (HsSigType p) + +instance OutputableBndrId p => Outputable (HsTypeOrSigType (GhcPass p)) where + ppr (HsType ty) = ppr ty + ppr (HsSigType sig_ty) = ppr sig_ty + +-- | A wrapper around HsTyVarBndr. +-- Used for reporting errors in `TcRnUnusedQuantifiedTypeVar`. +data HsTyVarBndrExistentialFlag = forall flag. OutputableBndrFlag flag 'Renamed => + HsTyVarBndrExistentialFlag (HsTyVarBndr flag GhcRn) + +instance Outputable HsTyVarBndrExistentialFlag where + ppr (HsTyVarBndrExistentialFlag hsTyVarBndr) = ppr hsTyVarBndr diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index 90950b3bb4..8f02023fc9 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -434,6 +434,9 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnIllegalImplicitParameterBindings" = 50730 GhcDiagnosticCode "TcRnIllegalTupleSection" = 59155 GhcDiagnosticCode "TcRnTermNameInType" = 37479 + GhcDiagnosticCode "TcRnUnexpectedKindVar" = 12875 + GhcDiagnosticCode "TcRnNegativeNumTypeLiteral" = 93632 + GhcDiagnosticCode "TcRnUnusedQuantifiedTypeVar" = 54180 GhcDiagnosticCode "TcRnUntickedPromotedThing" = 49957 GhcDiagnosticCode "TcRnIllegalBuiltinSyntax" = 39716 @@ -468,6 +471,12 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnNonOverloadedSpecialisePragma" = 35827 GhcDiagnosticCode "TcRnSpecialiseNotVisible" = 85337 GhcDiagnosticCode "TcRnIllegalTypeOperatorDecl" = 50649 + GhcDiagnosticCode "TcRnBindVarAlreadyInScope" = 69710 + GhcDiagnosticCode "TcRnBindMultipleVariables" = 92957 + GhcDiagnosticCode "TcRnIllegalKind" = 64861 + GhcDiagnosticCode "TcRnUnexpectedPatSigType" = 74097 + GhcDiagnosticCode "TcRnIllegalKindSignature" = 91382 + GhcDiagnosticCode "TcRnDataKindsError" = 68567 GhcDiagnosticCode "TcRnIllegalHsigDefaultMethods" = 93006 GhcDiagnosticCode "TcRnHsigFixityMismatch" = 93007 @@ -588,6 +597,8 @@ type family GhcDiagnosticCode c = n | n -> c where -- TcRnTyFamsDisabled/TyFamsDisabledReason GhcDiagnosticCode "TyFamsDisabledFamily" = 39191 GhcDiagnosticCode "TyFamsDisabledInstance" = 06206 + GhcDiagnosticCode "TcRnPrecedenceParsingError" = 88747 + GhcDiagnosticCode "TcRnSectionPrecedenceError" = 46878 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 |