Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
d3e60e97
by Ryan Scott at 2025-06-18T22:29:21-04:00
30 changed files:
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Validity.hs
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/using-warnings.rst
- + testsuite/tests/typecheck/should_compile/T20873c.hs
- − testsuite/tests/typecheck/should_compile/T22141a.stderr
- − testsuite/tests/typecheck/should_compile/T22141b.stderr
- − testsuite/tests/typecheck/should_compile/T22141c.stderr
- − testsuite/tests/typecheck/should_compile/T22141d.stderr
- − testsuite/tests/typecheck/should_compile/T22141e.stderr
- testsuite/tests/typecheck/should_compile/all.T
- − testsuite/tests/typecheck/should_fail/T20873c.hs
- − testsuite/tests/typecheck/should_fail/T20873c.stderr
- testsuite/tests/typecheck/should_compile/T22141a.hs → testsuite/tests/typecheck/should_fail/T22141a.hs
- testsuite/tests/typecheck/should_fail/T22141a.stderr
- testsuite/tests/typecheck/should_compile/T22141b.hs → testsuite/tests/typecheck/should_fail/T22141b.hs
- testsuite/tests/typecheck/should_fail/T22141b.stderr
- testsuite/tests/typecheck/should_compile/T22141c.hs → testsuite/tests/typecheck/should_fail/T22141c.hs
- testsuite/tests/typecheck/should_fail/T22141c.stderr
- testsuite/tests/typecheck/should_compile/T22141d.hs → testsuite/tests/typecheck/should_fail/T22141d.hs
- testsuite/tests/typecheck/should_fail/T22141d.stderr
- testsuite/tests/typecheck/should_compile/T22141e.hs → testsuite/tests/typecheck/should_fail/T22141e.hs
- testsuite/tests/typecheck/should_fail/T22141e.stderr
- testsuite/tests/typecheck/should_compile/T22141e_Aux.hs → testsuite/tests/typecheck/should_fail/T22141e_Aux.hs
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/vdq-rta/should_fail/T23739_fail_case.hs
- testsuite/tests/vdq-rta/should_fail/T23739_fail_case.stderr
Changes:
... | ... | @@ -1364,7 +1364,6 @@ standardWarnings -- see Note [Documenting warning flags] |
1364 | 1364 | Opt_WarnBadlyLevelledTypes,
|
1365 | 1365 | Opt_WarnTypeEqualityRequiresOperators,
|
1366 | 1366 | Opt_WarnInconsistentFlags,
|
1367 | - Opt_WarnDataKindsTC,
|
|
1368 | 1367 | Opt_WarnTypeEqualityOutOfScope,
|
1369 | 1368 | Opt_WarnImplicitRhsQuantification, -- was in -Wcompat since 9.8, enabled by default since 9.14, to turn into a hard error in 9.16
|
1370 | 1369 | Opt_WarnViewPatternSignatures,
|
... | ... | @@ -2382,7 +2382,8 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of |
2382 | 2382 | Opt_WarnImplicitRhsQuantification -> warnSpec x
|
2383 | 2383 | Opt_WarnIncompleteExportWarnings -> warnSpec x
|
2384 | 2384 | Opt_WarnIncompleteRecordSelectors -> warnSpec x
|
2385 | - Opt_WarnDataKindsTC -> warnSpec x
|
|
2385 | + Opt_WarnDataKindsTC
|
|
2386 | + -> depWarnSpec x "DataKinds violations are now always an error"
|
|
2386 | 2387 | Opt_WarnDefaultedExceptionContext -> warnSpec x
|
2387 | 2388 | Opt_WarnViewPatternSignatures -> warnSpec x
|
2388 | 2389 | Opt_WarnUselessSpecialisations -> warnSpec x
|
... | ... | @@ -1750,21 +1750,15 @@ instance Diagnostic TcRnMessage where |
1750 | 1750 | , inHsDocContext doc ]
|
1751 | 1751 | |
1752 | 1752 | TcRnDataKindsError typeOrKind thing
|
1753 | - -- See Note [Checking for DataKinds] (Wrinkle: Migration story for
|
|
1754 | - -- DataKinds typechecker errors) in GHC.Tc.Validity for why we give
|
|
1755 | - -- different diagnostic messages below.
|
|
1756 | 1753 | -> case thing of
|
1757 | 1754 | Left renamer_thing ->
|
1758 | - mkSimpleDecorated $
|
|
1759 | - text "Illegal" <+> ppr_level <> colon <+> quotes (ppr renamer_thing)
|
|
1755 | + mkSimpleDecorated $ msg renamer_thing
|
|
1760 | 1756 | Right typechecker_thing ->
|
1761 | - mkSimpleDecorated $ vcat
|
|
1762 | - [ text "An occurrence of" <+> quotes (ppr typechecker_thing) <+>
|
|
1763 | - text "in a" <+> ppr_level <+> text "requires DataKinds."
|
|
1764 | - , text "Future versions of GHC will turn this warning into an error."
|
|
1765 | - ]
|
|
1757 | + mkSimpleDecorated $ msg typechecker_thing
|
|
1766 | 1758 | where
|
1767 | - ppr_level = text $ levelString typeOrKind
|
|
1759 | + msg :: Outputable a => a -> SDoc
|
|
1760 | + msg thing = text "Illegal" <+> text (levelString typeOrKind) <>
|
|
1761 | + colon <+> quotes (ppr thing)
|
|
1768 | 1762 | |
1769 | 1763 | TcRnTypeSynonymCycle decl_or_tcs
|
1770 | 1764 | -> mkSimpleDecorated $
|
... | ... | @@ -2567,17 +2561,8 @@ instance Diagnostic TcRnMessage where |
2567 | 2561 | -> ErrorWithoutFlag
|
2568 | 2562 | TcRnUnusedQuantifiedTypeVar{}
|
2569 | 2563 | -> WarningWithFlag Opt_WarnUnusedForalls
|
2570 | - TcRnDataKindsError _ thing
|
|
2571 | - -- DataKinds errors can arise from either the renamer (Left) or the
|
|
2572 | - -- typechecker (Right). The latter category of DataKinds errors are a
|
|
2573 | - -- fairly recent addition to GHC (introduced in GHC 9.10), and in order
|
|
2574 | - -- to prevent these new errors from breaking users' code, we temporarily
|
|
2575 | - -- downgrade these errors to warnings. See Note [Checking for DataKinds]
|
|
2576 | - -- (Wrinkle: Migration story for DataKinds typechecker errors)
|
|
2577 | - -- in GHC.Tc.Validity.
|
|
2578 | - -> case thing of
|
|
2579 | - Left _ -> ErrorWithoutFlag
|
|
2580 | - Right _ -> WarningWithFlag Opt_WarnDataKindsTC
|
|
2564 | + TcRnDataKindsError{}
|
|
2565 | + -> ErrorWithoutFlag
|
|
2581 | 2566 | TcRnTypeSynonymCycle{}
|
2582 | 2567 | -> ErrorWithoutFlag
|
2583 | 2568 | TcRnZonkerMessage msg
|
... | ... | @@ -2553,11 +2553,11 @@ data TcRnMessage where |
2553 | 2553 | rename/should_fail/T22478e
|
2554 | 2554 | th/TH_Promoted1Tuple
|
2555 | 2555 | typecheck/should_compile/tcfail094
|
2556 | - typecheck/should_compile/T22141a
|
|
2557 | - typecheck/should_compile/T22141b
|
|
2558 | - typecheck/should_compile/T22141c
|
|
2559 | - typecheck/should_compile/T22141d
|
|
2560 | - typecheck/should_compile/T22141e
|
|
2556 | + typecheck/should_fail/T22141a
|
|
2557 | + typecheck/should_fail/T22141b
|
|
2558 | + typecheck/should_fail/T22141c
|
|
2559 | + typecheck/should_fail/T22141d
|
|
2560 | + typecheck/should_fail/T22141e
|
|
2561 | 2561 | typecheck/should_compile/T22141f
|
2562 | 2562 | typecheck/should_compile/T22141g
|
2563 | 2563 | typecheck/should_fail/T20873c
|
... | ... | @@ -1001,18 +1001,11 @@ checkVdqOK ve tvbs ty = do |
1001 | 1001 | |
1002 | 1002 | -- | Check for a DataKinds violation in a kind context.
|
1003 | 1003 | -- See @Note [Checking for DataKinds]@.
|
1004 | ---
|
|
1005 | --- Note that emitting DataKinds errors from the typechecker is a fairly recent
|
|
1006 | --- addition to GHC (introduced in GHC 9.10), and in order to prevent these new
|
|
1007 | --- errors from breaking users' code, we temporarily downgrade these errors to
|
|
1008 | --- warnings. (This is why we use 'diagnosticTcM' below.) See
|
|
1009 | --- @Note [Checking for DataKinds] (Wrinkle: Migration story for DataKinds
|
|
1010 | --- typechecker errors)@.
|
|
1011 | 1004 | checkDataKinds :: ValidityEnv -> Type -> TcM ()
|
1012 | 1005 | checkDataKinds (ValidityEnv{ ve_ctxt = ctxt, ve_tidy_env = env }) ty = do
|
1013 | 1006 | data_kinds <- xoptM LangExt.DataKinds
|
1014 | - diagnosticTcM
|
|
1015 | - (not (data_kinds || typeLevelUserTypeCtxt ctxt)) $
|
|
1007 | + checkTcM
|
|
1008 | + (data_kinds || typeLevelUserTypeCtxt ctxt) $
|
|
1016 | 1009 | (env, TcRnDataKindsError KindLevel (Right (tidyType env ty)))
|
1017 | 1010 | |
1018 | 1011 | {- Note [No constraints in kinds]
|
... | ... | @@ -1164,28 +1157,6 @@ different places in the code: |
1164 | 1157 | synonym), so we also catch a subset of kind-level violations in the renamer
|
1165 | 1158 | to allow for earlier reporting of these errors.
|
1166 | 1159 | |
1167 | ------
|
|
1168 | --- Wrinkle: Migration story for DataKinds typechecker errors
|
|
1169 | ------
|
|
1170 | - |
|
1171 | -As mentioned above, DataKinds is checked in two different places: the renamer
|
|
1172 | -and the typechecker. The checks in the renamer have been around since DataKinds
|
|
1173 | -was introduced. The checks in the typechecker, on the other hand, are a fairly
|
|
1174 | -recent addition, having been introduced in GHC 9.10. As such, it is possible
|
|
1175 | -that there are some programs in the wild that (1) do not enable DataKinds, and
|
|
1176 | -(2) were accepted by a previous GHC version, but would now be rejected by the
|
|
1177 | -new DataKinds checks in the typechecker.
|
|
1178 | - |
|
1179 | -To prevent the new DataKinds checks in the typechecker from breaking users'
|
|
1180 | -code, we temporarily allow programs to compile if they violate a DataKinds
|
|
1181 | -check in the typechecker, but GHC will emit a warning if such a violation
|
|
1182 | -occurs. Users can then silence the warning by enabling DataKinds in the module
|
|
1183 | -where the affected code lives. It is fairly straightforward to distinguish
|
|
1184 | -between DataKinds violations arising from the renamer versus the typechecker,
|
|
1185 | -as TcRnDataKindsError (the error message type classifying all DataKinds errors)
|
|
1186 | -stores an Either field that is Left when the error comes from the renamer and
|
|
1187 | -Right when the error comes from the typechecker.
|
|
1188 | - |
|
1189 | 1160 | ************************************************************************
|
1190 | 1161 | * *
|
1191 | 1162 | \subsection{Checking a theta or source type}
|
... | ... | @@ -70,6 +70,21 @@ Language |
70 | 70 | * The :extension:`ExplicitNamespaces` extension now allows the ``data``
|
71 | 71 | namespace specifier in import and export lists.
|
72 | 72 | |
73 | +* The ``-Wdata-kinds-tc`` warning has been deprecated, and the use of promoted
|
|
74 | + data types in kinds is now an error (rather than a warning) unless the
|
|
75 | + :extension:`DataKinds` extension is enabled. For example, the following code
|
|
76 | + will be rejected unless :extension:`DataKinds` is on:
|
|
77 | + |
|
78 | + import Data.Kind (Type)
|
|
79 | + import GHC.TypeNats (Nat)
|
|
80 | + |
|
81 | + -- Nat shouldn't be allowed here without DataKinds
|
|
82 | + data Vec :: Nat -> Type -> Type
|
|
83 | + |
|
84 | + (The ``-Wdata-kinds-tc`` warning was introduced in GHC 9.10 as part of a fix
|
|
85 | + for an accidental oversight in which programs like the one above were
|
|
86 | + mistakenly accepted without the use of :extension:`DataKinds`.)
|
|
87 | + |
|
73 | 88 | * The :extension:`MonadComprehensions` extension now implies :extension:`ParallelListComp` as was originally intended (see `Monad Comprehensions <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/monad_comprehensions.html>`_).
|
74 | 89 | |
75 | 90 | Compiler
|
... | ... | @@ -82,7 +82,6 @@ as ``-Wno-...`` for every individual warning in the group. |
82 | 82 | * :ghc-flag:`-Winconsistent-flags`
|
83 | 83 | * :ghc-flag:`-Wnoncanonical-monoid-instances`
|
84 | 84 | * :ghc-flag:`-Wnoncanonical-monad-instances`
|
85 | - * :ghc-flag:`-Wdata-kinds-tc`
|
|
86 | 85 | * :ghc-flag:`-Wimplicit-rhs-quantification`
|
87 | 86 | * :ghc-flag:`-Wunusable-unpack-pragmas`
|
88 | 87 | |
... | ... | @@ -2601,24 +2600,19 @@ of ``-W(no-)*``. |
2601 | 2600 | is passed.
|
2602 | 2601 | |
2603 | 2602 | .. ghc-flag:: -Wdata-kinds-tc
|
2604 | - :shortdesc: warn when an illegal use of a type or kind without
|
|
2605 | - :extension:`DataKinds` is caught by the typechecker
|
|
2603 | + :shortdesc: *(deprecated)* Does nothing
|
|
2606 | 2604 | :type: dynamic
|
2607 | - :reverse: -Wno-data-kinds-tc
|
|
2608 | 2605 | |
2609 | 2606 | :since: 9.10.1
|
2610 | 2607 | |
2611 | - Introduced in GHC 9.10.1, this warns when an illegal use of a type or kind
|
|
2612 | - (without having enabled the :extension:`DataKinds` extension) is caught in
|
|
2613 | - the typechecker (hence the ``-tc`` suffix). These warnings complement the
|
|
2614 | - existing :extension:`DataKinds` checks (that have existed since
|
|
2615 | - :extension:`DataKinds` was first introduced), which result in errors
|
|
2616 | - instead of warnings.
|
|
2617 | - |
|
2618 | - This warning is scheduled to be changed to an error in a future GHC
|
|
2619 | - version, at which point the :ghc-flag:`-Wdata-kinds-tc` flag will be
|
|
2620 | - removed. Users can enable the :extension:`DataKinds` extension to avoid
|
|
2621 | - issues (thus silencing the warning).
|
|
2608 | + This warning is deprecated. It no longer has any effect since GHC 9.14.
|
|
2609 | + |
|
2610 | + In the past, GHC 9.10 and 9.12 was overly permissive about which types or
|
|
2611 | + kinds could be used without enabling the :extension:`DataKinds` extension.
|
|
2612 | + In GHC 9.14 or later, however, GHC now consistently requires
|
|
2613 | + :extension:`DataKinds`, and all :extension:`DataKinds` violations are now
|
|
2614 | + errors. :ghc-flag:`-Wdata-kinds-tc` was used in the migration period before
|
|
2615 | + the breaking change took place.
|
|
2622 | 2616 | |
2623 | 2617 | .. ghc-flag:: -Wdefaulted-exception-context
|
2624 | 2618 | :shortdesc: warn when an :base-ref:`Control.Exception.Context.ExceptionContext`
|
1 | + |
|
2 | +{-# LANGUAGE GADTSyntax, KindSignatures, NoDataKinds #-}
|
|
3 | + |
|
4 | +module T20873c where
|
|
5 | + |
|
6 | +import Data.Kind ( Type )
|
|
7 | + |
|
8 | +type U a = Type
|
|
9 | + |
|
10 | +-- This should be allowed without enabling DataKinds, This is because the return
|
|
11 | +-- kind only mentions Type, which is always permitted in kinds, and U, which is
|
|
12 | +-- simply a type synonym that expands to Type.
|
|
13 | +data Foo :: U Type where
|
|
14 | + MkFoo :: Foo |
1 | -T22141a.hs:8:1: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
2 | - • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
|
|
3 | - Future versions of GHC will turn this warning into an error.
|
|
4 | - • In the expansion of type synonym ‘Nat’
|
|
5 | - In the data type declaration for ‘Vector’
|
|
6 | - Suggested fix:
|
|
7 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
8 | - |
1 | -T22141b.hs:10:1: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
2 | - • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
|
|
3 | - Future versions of GHC will turn this warning into an error.
|
|
4 | - • In the expansion of type synonym ‘Nat’
|
|
5 | - In the expansion of type synonym ‘MyNat’
|
|
6 | - In the data type declaration for ‘Vector’
|
|
7 | - Suggested fix:
|
|
8 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
9 | - |
1 | -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
2 | - • An occurrence of ‘(# *, * #)’ in a kind requires DataKinds.
|
|
3 | - Future versions of GHC will turn this warning into an error.
|
|
4 | - • In the expansion of type synonym ‘T’
|
|
5 | - In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
6 | - Suggested fix:
|
|
7 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
8 | - |
|
9 | -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
10 | - • An occurrence of ‘'[]’ in a kind requires DataKinds.
|
|
11 | - Future versions of GHC will turn this warning into an error.
|
|
12 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
13 | - Suggested fix:
|
|
14 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
15 | - |
|
16 | -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
17 | - • An occurrence of ‘'[GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds.
|
|
18 | - Future versions of GHC will turn this warning into an error.
|
|
19 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
20 | - Suggested fix:
|
|
21 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
22 | - |
|
23 | -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
24 | - • An occurrence of ‘[GHC.Internal.Types.LiftedRep,
|
|
25 | - GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds.
|
|
26 | - Future versions of GHC will turn this warning into an error.
|
|
27 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
28 | - Suggested fix:
|
|
29 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
30 | - |
|
31 | -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
32 | - • An occurrence of ‘Proxy T’ in a kind requires DataKinds.
|
|
33 | - Future versions of GHC will turn this warning into an error.
|
|
34 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
35 | - Suggested fix:
|
|
36 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
37 | - |
1 | -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
2 | - • An occurrence of ‘(# * | * #)’ in a kind requires DataKinds.
|
|
3 | - Future versions of GHC will turn this warning into an error.
|
|
4 | - • In the expansion of type synonym ‘T’
|
|
5 | - In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
6 | - Suggested fix:
|
|
7 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
8 | - |
|
9 | -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
10 | - • An occurrence of ‘'[]’ in a kind requires DataKinds.
|
|
11 | - Future versions of GHC will turn this warning into an error.
|
|
12 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
13 | - Suggested fix:
|
|
14 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
15 | - |
|
16 | -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
17 | - • An occurrence of ‘'[GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds.
|
|
18 | - Future versions of GHC will turn this warning into an error.
|
|
19 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
20 | - Suggested fix:
|
|
21 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
22 | - |
|
23 | -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
24 | - • An occurrence of ‘[GHC.Internal.Types.LiftedRep,
|
|
25 | - GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds.
|
|
26 | - Future versions of GHC will turn this warning into an error.
|
|
27 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
28 | - Suggested fix:
|
|
29 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
30 | - |
|
31 | -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
32 | - • An occurrence of ‘Proxy T’ in a kind requires DataKinds.
|
|
33 | - Future versions of GHC will turn this warning into an error.
|
|
34 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
35 | - Suggested fix:
|
|
36 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
37 | - |
1 | -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
2 | - • An occurrence of ‘42’ in a kind requires DataKinds.
|
|
3 | - Future versions of GHC will turn this warning into an error.
|
|
4 | - • In the expansion of type synonym ‘T’
|
|
5 | - In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
6 | - Suggested fix:
|
|
7 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
8 | - |
|
9 | -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
10 | - • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
|
|
11 | - Future versions of GHC will turn this warning into an error.
|
|
12 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
13 | - Suggested fix:
|
|
14 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
15 | - |
|
16 | -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
|
|
17 | - • An occurrence of ‘Proxy T’ in a kind requires DataKinds.
|
|
18 | - Future versions of GHC will turn this warning into an error.
|
|
19 | - • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
20 | - Suggested fix:
|
|
21 | - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
22 | - |
... | ... | @@ -819,6 +819,7 @@ test('T20588d', [extra_files(['T20588d.hs', 'T20588d.hs-boot', 'T20588d_aux.hs'] |
819 | 819 | test('T20661', [extra_files(['T20661.hs', 'T20661.hs-boot', 'T20661_aux.hs'])], multimod_compile, ['T20661_aux.hs', '-v0'])
|
820 | 820 | test('T20873', normal, compile, [''])
|
821 | 821 | test('T20873b', [extra_files(['T20873b_aux.hs'])], multimod_compile, ['T20873b', '-v0'])
|
822 | +test('T20873c', normal, compile, [''])
|
|
822 | 823 | test('StaticPtrTypeFamily', normal, compile, [''])
|
823 | 824 | test('T20946', normal, compile, [''])
|
824 | 825 | test('T20996', normal, compile, [''])
|
... | ... | @@ -864,11 +865,6 @@ test('T21951a', normal, compile, ['-Wredundant-strictness-flags']) |
864 | 865 | test('T21951b', normal, compile, ['-Wredundant-strictness-flags'])
|
865 | 866 | test('DataToTagSolving', normal, compile, [''])
|
866 | 867 | test('T21550', normal, compile, [''])
|
867 | -test('T22141a', normal, compile, [''])
|
|
868 | -test('T22141b', normal, compile, [''])
|
|
869 | -test('T22141c', normal, compile, [''])
|
|
870 | -test('T22141d', normal, compile, [''])
|
|
871 | -test('T22141e', [extra_files(['T22141e_Aux.hs'])], multimod_compile, ['T22141e.hs', '-v0'])
|
|
872 | 868 | test('T22141f', normal, compile, [''])
|
873 | 869 | test('T22141g', normal, compile, [''])
|
874 | 870 | test('T22310', normal, compile, [''])
|
1 | - |
|
2 | -{-# LANGUAGE GADTSyntax, NoKindSignatures, NoDataKinds #-}
|
|
3 | - |
|
4 | -module T20873c where
|
|
5 | - |
|
6 | -import Data.Kind ( Type )
|
|
7 | - |
|
8 | -type U a = Type
|
|
9 | - |
|
10 | -data Foo :: U Int where
|
|
11 | - MkFoo :: Foo |
1 | -T20873c.hs:10:1: error: [GHC-49378]
|
|
2 | - • Illegal kind signature ‘Foo :: U Int’
|
|
3 | - • In the data type declaration for ‘Foo’
|
|
4 | - Suggested fix:
|
|
5 | - Perhaps you intended to use the ‘KindSignatures’ extension (implied by ‘TypeFamilies’ and ‘PolyKinds’)
|
|
6 | - |
1 | - |
|
2 | 1 | T22141a.hs:8:1: error: [GHC-68567]
|
3 | - • Illegal kind: ‘GHC.Num.Natural.Natural’
|
|
2 | + • Illegal kind: ‘GHC.Internal.Bignum.Natural.Natural’
|
|
4 | 3 | • In the expansion of type synonym ‘Nat’
|
5 | 4 | In the data type declaration for ‘Vector’
|
6 | - Suggested fix: Perhaps you intended to use DataKinds |
|
5 | + Suggested fix:
|
|
6 | + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
7 | + |
1 | - |
|
2 | 1 | T22141b.hs:10:1: error: [GHC-68567]
|
3 | - • Illegal kind: ‘GHC.Num.Natural.Natural’
|
|
2 | + • Illegal kind: ‘GHC.Internal.Bignum.Natural.Natural’
|
|
4 | 3 | • In the expansion of type synonym ‘Nat’
|
5 | 4 | In the expansion of type synonym ‘MyNat’
|
6 | 5 | In the data type declaration for ‘Vector’
|
7 | - Suggested fix: Perhaps you intended to use DataKinds |
|
6 | + Suggested fix:
|
|
7 | + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
8 | + |
1 | +T22141c.hs:10:11: error: [GHC-68567]
|
|
2 | + • Illegal kind: ‘Proxy T’
|
|
3 | + • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
4 | + Suggested fix:
|
|
5 | + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
1 | 6 | |
2 | -T22141c.hs:8:17: error: [GHC-68567]
|
|
3 | - Illegal kind: ‘(# Type, Type #)’
|
|
4 | - Suggested fix: Perhaps you intended to use DataKinds |
1 | +T22141d.hs:10:11: error: [GHC-68567]
|
|
2 | + • Illegal kind: ‘Proxy T’
|
|
3 | + • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
4 | + Suggested fix:
|
|
5 | + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
1 | 6 | |
2 | -T22141d.hs:8:17: error: [GHC-68567]
|
|
3 | - Illegal kind: ‘(# Type | Type #)’
|
|
4 | - Suggested fix: Perhaps you intended to use DataKinds |
1 | +T22141e.hs:8:11: error: [GHC-68567]
|
|
2 | + • Illegal kind: ‘Proxy T’
|
|
3 | + • In a standalone kind signature for ‘D’: Proxy T -> Type
|
|
4 | + Suggested fix:
|
|
5 | + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
|
|
1 | 6 | |
2 | -T22141e.hs:7:17: error: [GHC-68567]
|
|
3 | - Illegal kind: ‘42’
|
|
4 | - Suggested fix: Perhaps you intended to use DataKinds |
... | ... | @@ -646,7 +646,6 @@ test('T20542', normal, compile_fail, ['']) |
646 | 646 | test('T20588', [extra_files(['T20588.hs', 'T20588.hs-boot', 'T20588_aux.hs'])], multimod_compile_fail, ['T20588_aux.hs', '-v0'])
|
647 | 647 | test('T20588c', [extra_files(['T20588c.hs', 'T20588c.hs-boot', 'T20588c_aux.hs'])], multimod_compile_fail, ['T20588c_aux.hs', '-v0'])
|
648 | 648 | test('T20189', normal, compile_fail, [''])
|
649 | -test('T20873c', normal, compile_fail, [''])
|
|
650 | 649 | test('T20873d', normal, compile_fail, [''])
|
651 | 650 | test('FunDepOrigin1b', normal, compile_fail, [''])
|
652 | 651 | test('FD1', normal, compile_fail, [''])
|
... | ... | @@ -667,6 +666,11 @@ test('T21447', normal, compile_fail, ['']) |
667 | 666 | test('T21530a', normal, compile_fail, [''])
|
668 | 667 | test('T21530b', normal, compile_fail, [''])
|
669 | 668 | test('Or4', normal, compile_fail, [''])
|
669 | +test('T22141a', normal, compile_fail, [''])
|
|
670 | +test('T22141b', normal, compile_fail, [''])
|
|
671 | +test('T22141c', normal, compile_fail, [''])
|
|
672 | +test('T22141d', normal, compile_fail, [''])
|
|
673 | +test('T22141e', [extra_files(['T22141e_Aux.hs'])], multimod_compile_fail, ['T22141e.hs', '-v0'])
|
|
670 | 674 | test('T22570', normal, compile_fail, [''])
|
671 | 675 | test('T22645', normal, compile_fail, [''])
|
672 | 676 | test('T20666', normal, compile_fail, [''])
|
1 | +{-# LANGUAGE DataKinds #-}
|
|
1 | 2 | {-# LANGUAGE RequiredTypeArguments #-}
|
2 | 3 | |
3 | 4 | module T23739_fail_case where
|
... | ... | @@ -6,4 +7,4 @@ bad :: forall (b :: Bool) -> String |
6 | 7 | bad t =
|
7 | 8 | case t of
|
8 | 9 | False -> "False"
|
9 | - True -> "True" |
|
\ No newline at end of file | ||
10 | + True -> "True" |
1 | - |
|
2 | -T23739_fail_case.hs:7:8: error: [GHC-01928]
|
|
1 | +T23739_fail_case.hs:8:8: error: [GHC-01928]
|
|
3 | 2 | • Illegal term-level use of the type variable ‘t’
|
4 | - • bound at T23739_fail_case.hs:6:5
|
|
3 | + • bound at T23739_fail_case.hs:7:5
|
|
5 | 4 | • In the expression: t
|
6 | 5 | In the expression:
|
7 | 6 | case t of
|
... | ... | @@ -12,3 +11,4 @@ T23739_fail_case.hs:7:8: error: [GHC-01928] |
12 | 11 | = case t of
|
13 | 12 | False -> "False"
|
14 | 13 | True -> "True"
|
14 | + |