summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/basicTypes/RdrName.hs23
-rw-r--r--compiler/main/DynFlags.hs15
-rw-r--r--compiler/parser/Lexer.x5
-rw-r--r--compiler/parser/RdrHsSyn.hs20
-rw-r--r--compiler/rename/RnEnv.hs3
-rw-r--r--docs/users_guide/8.6.1-notes.rst3
-rw-r--r--docs/users_guide/glasgow_exts.rst8
-rw-r--r--docs/users_guide/using-warnings.rst31
-rw-r--r--libraries/base/GHC/TypeNats.hs1
-rw-r--r--testsuite/tests/dependent/ghci/T14238.stdout2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T15039b.stderr33
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T15039d.stderr33
-rw-r--r--testsuite/tests/partial-sigs/should_fail/T14584.stderr4
-rw-r--r--testsuite/tests/polykinds/T10134.hs6
-rw-r--r--testsuite/tests/th/TH_unresolvedInfix.hs1
-rw-r--r--testsuite/tests/th/TH_unresolvedInfix_Lib.hs1
-rw-r--r--testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs16
-rw-r--r--testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs4
-rw-r--r--testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs6
-rw-r--r--testsuite/tests/warnings/should_compile/StarBinder.hs5
-rw-r--r--testsuite/tests/warnings/should_compile/StarBinder.stderr10
-rw-r--r--testsuite/tests/warnings/should_compile/all.T2
22 files changed, 134 insertions, 98 deletions
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs
index 6dfc6babe8..610233ed9a 100644
--- a/compiler/basicTypes/RdrName.hs
+++ b/compiler/basicTypes/RdrName.hs
@@ -1311,14 +1311,10 @@ pprLoc (UnhelpfulSpan {}) = empty
-- coming from GHC.TypeNats). In this case the user will get a kind
-- mismatch error. This is a violation of assumption (c).
--
--- Since NoStarIsType is implied by a fairly common extension TypeOperators,
--- the user might be working on a module with NoStarIsType unbeknownst to him.
--- Even if the user switched off StarIsType manually, he might have forgotten
--- about it and use '*' as 'Data.Kind.Type' out of habit.
---
--- Thus it is very important to give a hint whenever an assumption about '*' is
--- violated. Unfortunately, it is somewhat difficult to deal with (c), so we
--- limit ourselves to (a) and (b).
+-- The user might unknowingly be working on a module with NoStarIsType
+-- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a
+-- hint whenever an assumption about '*' is violated. Unfortunately, it is
+-- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).
--
-- 'starInfo' generates an appropriate hint to the user depending on the
-- extensions enabled in the module and the name that triggered the error.
@@ -1326,10 +1322,10 @@ pprLoc (UnhelpfulSpan {}) = empty
-- Unicode variant, the resulting SDoc will contain a helpful suggestion.
-- Otherwise it is empty.
--
-starInfo :: (Bool, Bool) -> RdrName -> SDoc
-starInfo (type_operators, star_is_type) rdr_name =
+starInfo :: Bool -> RdrName -> SDoc
+starInfo star_is_type rdr_name =
-- One might ask: if can use sdocWithDynFlags here, why bother to take
- -- (type_operators, star_is_type) as input? Why not refactor?
+ -- star_is_type as input? Why not refactor?
--
-- The reason is that sdocWithDynFlags would provide DynFlags that are active
-- in the module that tries to load the problematic definition, not
@@ -1340,10 +1336,7 @@ starInfo (type_operators, star_is_type) rdr_name =
-- with StarIsType enabled!
--
if isUnqualStar && not star_is_type
- then text "With NoStarIsType" <>
- (if type_operators
- then text " (implied by TypeOperators), "
- else text ", ") <>
+ then text "With NoStarIsType, " <>
quotes (ppr rdr_name) <>
text " is treated as a regular type operator. "
$$
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index acdecf26bb..b6664f222e 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -814,6 +814,7 @@ data WarningFlag =
| Opt_WarnMissingExportList
| Opt_WarnInaccessibleCode
| Opt_WarnStarIsType -- Since 8.6
+ | Opt_WarnStarBinder -- Since 8.6
| Opt_WarnImplicitKindVars -- Since 8.6
deriving (Eq, Show, Enum)
@@ -3857,6 +3858,7 @@ wWarningFlagsDeps = [
flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints,
flagSpec "missing-home-modules" Opt_WarnMissingHomeModules,
flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags,
+ flagSpec "star-binder" Opt_WarnStarBinder,
flagSpec "star-is-type" Opt_WarnStarIsType,
flagSpec "partial-fields" Opt_WarnPartialFields ]
@@ -4365,7 +4367,6 @@ impliedXFlags
, (LangExt.TypeInType, turnOn, LangExt.DataKinds)
, (LangExt.TypeInType, turnOn, LangExt.PolyKinds)
, (LangExt.TypeInType, turnOn, LangExt.KindSignatures)
- , (LangExt.TypeInType, turnOff, LangExt.StarIsType)
-- AutoDeriveTypeable is not very useful without DeriveDataTypeable
, (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)
@@ -4377,9 +4378,6 @@ impliedXFlags
, (LangExt.ImpredicativeTypes, turnOn, LangExt.RankNTypes)
- -- See Note [When is StarIsType enabled]
- , (LangExt.TypeOperators, turnOff, LangExt.StarIsType)
-
-- Record wild-cards implies field disambiguation
-- Otherwise if you write (C {..}) you may well get
-- stuff like " 'a' not in scope ", which is a bit silly
@@ -4407,12 +4405,10 @@ impliedXFlags
-- programs expect '*' to be synonymous with 'Type', so by default StarIsType is
-- enabled.
--
--- However, programs that use TypeOperators might expect to repurpose '*' for
--- multiplication or another binary operation, so we make TypeOperators imply
--- NoStarIsType.
+-- Programs that use TypeOperators might expect to repurpose '*' for
+-- multiplication or another binary operation, but making TypeOperators imply
+-- NoStarIsType caused too much breakage on Hackage.
--
--- It is still possible to have TypeOperators and StarIsType enabled at the same
--- time, although it's not recommended.
-- Note [Documenting optimisation flags]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -4562,6 +4558,7 @@ standardWarnings -- see Note [Documenting warning flags]
Opt_WarnTabs,
Opt_WarnUnrecognisedWarningFlags,
Opt_WarnSimplifiableClassConstraints,
+ Opt_WarnStarBinder,
Opt_WarnInaccessibleCode
]
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 2887edff04..a6650acb15 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -68,7 +68,6 @@ module Lexer (
explicitNamespacesEnabled,
patternSynonymsEnabled,
sccProfilingOn, hpcEnabled,
- typeOperatorsEnabled,
starIsTypeEnabled,
addWarning,
lexTokenStream,
@@ -2264,7 +2263,6 @@ data ExtBits
| TypeApplicationsBit
| StaticPointersBit
| NumericUnderscoresBit
- | TypeOperatorsBit
| StarIsTypeBit
deriving Enum
@@ -2334,8 +2332,6 @@ staticPointersEnabled :: ExtsBitmap -> Bool
staticPointersEnabled = xtest StaticPointersBit
numericUnderscoresEnabled :: ExtsBitmap -> Bool
numericUnderscoresEnabled = xtest NumericUnderscoresBit
-typeOperatorsEnabled :: ExtsBitmap -> Bool
-typeOperatorsEnabled = xtest TypeOperatorsBit
starIsTypeEnabled :: ExtsBitmap -> Bool
starIsTypeEnabled = xtest StarIsTypeBit
@@ -2392,7 +2388,6 @@ mkParserFlags flags =
.|. TypeApplicationsBit `xoptBit` LangExt.TypeApplications
.|. StaticPointersBit `xoptBit` LangExt.StaticPointers
.|. NumericUnderscoresBit `xoptBit` LangExt.NumericUnderscores
- .|. TypeOperatorsBit `xoptBit` LangExt.TypeOperators
.|. StarIsTypeBit `xoptBit` LangExt.StarIsType
optBits =
HaddockBit `goptBit` Opt_Haddock
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 7dc3aafb91..1ffde2222c 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -870,6 +870,12 @@ checkTyClHdr is_cls ty
where
goL (L l ty) acc ann fix = go l ty acc ann fix
+ -- workaround to define '*' despite StarIsType
+ go _ (HsParTy _ (L l (HsStarTy _ isUni))) acc ann fix
+ = do { warnStarBndr l
+ ; let name = mkOccName tcClsName (if isUni then "★" else "*")
+ ; return (L l (Unqual name), acc, fix, ann) }
+
go l (HsTyVar _ _ (L _ tc)) acc ann fix
| isRdrTc tc = return (L l tc, acc, fix, ann)
go _ (HsOpTy _ t1 ltc@(L _ tc) t2) acc ann _fix
@@ -1747,11 +1753,19 @@ warnStarIsType span = addWarning Opt_WarnStarIsType span msg
$$ text "Suggested fix: use" <+> quotes (text "Type")
<+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."
+warnStarBndr :: SrcSpan -> P ()
+warnStarBndr span = addWarning Opt_WarnStarBinder span msg
+ where
+ msg = text "Found binding occurrence of" <+> quotes (text "*")
+ <+> text "yet StarIsType is enabled."
+ $$ text "NB. To use (or export) this operator in"
+ <+> text "modules with StarIsType,"
+ $$ text " including the definition module, you must qualify it."
+
failOpFewArgs :: Located RdrName -> P a
failOpFewArgs (L loc op) =
- do { type_operators <- extension typeOperatorsEnabled
- ; star_is_type <- extension starIsTypeEnabled
- ; let msg = too_few $$ starInfo (type_operators, star_is_type) op
+ do { star_is_type <- extension starIsTypeEnabled
+ ; let msg = too_few $$ starInfo star_is_type op
; parseErrorSDoc loc msg }
where
too_few = text "Operator applied to too few arguments:" <+> ppr op
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index abfaf22c3e..16897c2681 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -930,9 +930,8 @@ lookup_demoted rdr_name
| Just demoted_rdr <- demoteRdrName rdr_name
-- Maybe it's the name of a *data* constructor
= do { data_kinds <- xoptM LangExt.DataKinds
- ; type_operators <- xoptM LangExt.TypeOperators
; star_is_type <- xoptM LangExt.StarIsType
- ; let star_info = starInfo (type_operators, star_is_type) rdr_name
+ ; let star_info = starInfo star_is_type rdr_name
; if data_kinds
then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr
; case mb_demoted_name of
diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst
index 72a3790bfd..3a24384493 100644
--- a/docs/users_guide/8.6.1-notes.rst
+++ b/docs/users_guide/8.6.1-notes.rst
@@ -51,8 +51,7 @@ Language
- A new :extension:`StarIsType` language extension has been added which controls
whether ``*`` is parsed as ``Data.Kind.Type`` or a regular type operator.
- :extension:`StarIsType` is enabled by default and disabled by
- :extension:`TypeOperators`.
+ :extension:`StarIsType` is enabled by default.
- GHC now permits the use of a wildcard type as the context of a standalone
``deriving`` declaration with the use of the
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 14d01f6123..5cf5c583ad 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -8712,8 +8712,7 @@ Kind polymorphism
.. extension:: TypeInType
:shortdesc: Deprecated. Enable kind polymorphism and datatype promotion.
- :implies: :extension:`PolyKinds`, :extension:`DataKinds`, :extension:`KindSignatures`,
- :extension:`NoStarIsType`
+ :implies: :extension:`PolyKinds`, :extension:`DataKinds`, :extension:`KindSignatures`
:since: 8.0.1
In the past this extension used to enable advanced type-level programming
@@ -9160,13 +9159,12 @@ The kind ``Type``
-----------------
.. extension:: StarIsType
- :shortdesc: Desugar ``*`` to ``Data.Kind.Type``.
+ :shortdesc: Treat ``*`` as ``Data.Kind.Type``.
:since: 8.6.1
Treat the unqualified uses of the ``*`` type operator as nullary and desugar
- to ``Data.Kind.Type``. Disabled by :extension:`TypeOperators` and
- :extension:`TypeInType`.
+ to ``Data.Kind.Type``.
The kind ``Type`` (imported from ``Data.Kind``) classifies ordinary types. With
:extension:`StarIsType` (currently enabled by default), ``*`` is desugared to
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 575e28119f..8d09b4488b 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -34,6 +34,7 @@ generally likely to indicate bugs in your program. These are:
* :ghc-flag:`-Wtabs`
* :ghc-flag:`-Wunrecognised-warning-flags`
* :ghc-flag:`-Winaccessible-code`
+ * :ghc-flag:`-Wstar-binder`
The following flags are simple ways to select standard "packages" of warnings:
@@ -1169,6 +1170,36 @@ of ``-W(no-)*``.
since we're passing ``Foo1`` and ``Foo2`` here, it follows that ``t ~
Char``, and ``u ~ Int``, and thus ``t ~ u`` cannot hold.
+.. ghc-flag:: -Wstar-binder
+ :shortdesc: warn about binding the ``(*)`` type operator despite
+ :ghc-flag:`-XStarIsType`
+ :type: dynamic
+ :reverse: -Wno-star-binder
+
+ Under :ghc-flag:`-XStarIsType`, a ``*`` in types is not an operator nor
+ even a name, it is special syntax that stands for ``Data.Kind.Type``. This
+ means that an expression like ``Either * Char`` is parsed as ``Either (*)
+ Char`` and not ``(*) Either Char``.
+
+ In binding positions, we have similar parsing rules. Consider the following
+ example ::
+
+ {-# LANGUAGE TypeOperators, TypeFamilies, StarIsType #-}
+
+ type family a + b
+ type family a * b
+
+ While ``a + b`` is parsed as ``(+) a b`` and becomes a binding position for
+ the ``(+)`` type operator, ``a * b`` is parsed as ``a (*) b`` and is rejected.
+
+ As a workaround, we allow to bind ``(*)`` in prefix form::
+
+ type family (*) a b
+
+ This is a rather fragile arrangement, as generally a programmer expects
+ ``(*) a b`` to be equivalent to ``a * b``. With :ghc-flag:`-Wstar-binder`
+ we warn when this special treatment of ``(*)`` takes place.
+
.. ghc-flag:: -Wsimplifiable-class-constraints
:shortdesc: 2arn about class constraints in a type signature that can
be simplified using a top-level instance declaration.
diff --git a/libraries/base/GHC/TypeNats.hs b/libraries/base/GHC/TypeNats.hs
index c9055ddb42..b78608af89 100644
--- a/libraries/base/GHC/TypeNats.hs
+++ b/libraries/base/GHC/TypeNats.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
diff --git a/testsuite/tests/dependent/ghci/T14238.stdout b/testsuite/tests/dependent/ghci/T14238.stdout
index 729f821af7..fddbc0de54 100644
--- a/testsuite/tests/dependent/ghci/T14238.stdout
+++ b/testsuite/tests/dependent/ghci/T14238.stdout
@@ -1 +1 @@
-Foo :: forall k -> k -> Type
+Foo :: forall k -> k -> *
diff --git a/testsuite/tests/partial-sigs/should_compile/T15039b.stderr b/testsuite/tests/partial-sigs/should_compile/T15039b.stderr
index 020c253516..5726c7fa65 100644
--- a/testsuite/tests/partial-sigs/should_compile/T15039b.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/T15039b.stderr
@@ -1,62 +1,57 @@
T15039b.hs:19:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’
- standing for ‘Dict ((a :: Type) ~ (b :: Type))’
+ • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’
Where: ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
- ex1 :: forall a b. Dict ((a :: Type) ~ (b :: Type)) -> ()
+ ex1 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> ()
at T15039b.hs:18:1-45
• In a pattern type signature: _
In the pattern: Dict :: _
In an equation for ‘ex1’: ex1 (Dict :: _) = ()
• Relevant bindings include
- ex1 :: Dict ((a :: Type) ~ (b :: Type)) -> ()
- (bound at T15039b.hs:19:1)
+ ex1 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039b.hs:19:1)
T15039b.hs:22:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’
- standing for ‘Dict ((a :: Type) ~ (b :: Type))’
+ • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’
Where: ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
- ex2 :: forall a b. Dict ((a :: Type) ~ (b :: Type)) -> ()
+ ex2 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> ()
at T15039b.hs:21:1-46
• In a pattern type signature: _
In the pattern: Dict :: _
In an equation for ‘ex2’: ex2 (Dict :: _) = ()
• Relevant bindings include
- ex2 :: Dict ((a :: Type) ~ (b :: Type)) -> ()
- (bound at T15039b.hs:22:1)
+ ex2 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039b.hs:22:1)
T15039b.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’
- standing for ‘Dict ((a :: Type) ~~ (b :: k))’
+ standing for ‘Dict ((a :: *) ~~ (b :: k))’
Where: ‘a’, ‘b’, ‘k’ are rigid type variables bound by
the type signature for:
- ex3 :: forall k a (b :: k). Dict ((a :: Type) ~~ (b :: k)) -> ()
+ ex3 :: forall k a (b :: k). Dict ((a :: *) ~~ (b :: k)) -> ()
at T15039b.hs:24:1-43
• In a pattern type signature: _
In the pattern: Dict :: _
In an equation for ‘ex3’: ex3 (Dict :: _) = ()
• Relevant bindings include
- ex3 :: Dict ((a :: Type) ~~ (b :: k)) -> ()
- (bound at T15039b.hs:25:1)
+ ex3 :: Dict ((a :: *) ~~ (b :: k)) -> () (bound at T15039b.hs:25:1)
T15039b.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘Dict (Coercible Type a b)’
+ • Found type wildcard ‘_’ standing for ‘Dict (Coercible * a b)’
Where: ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
- ex6 :: forall a b. Dict (Coercible Type a b) -> ()
+ ex6 :: forall a b. Dict (Coercible * a b) -> ()
at T15039b.hs:32:1-53
• In a pattern type signature: _
In the pattern: Dict :: _
In an equation for ‘ex6’: ex6 (Dict :: _) = ()
• Relevant bindings include
- ex6 :: Dict (Coercible Type a b) -> () (bound at T15039b.hs:33:1)
+ ex6 :: Dict (Coercible * a b) -> () (bound at T15039b.hs:33:1)
T15039b.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘Coercible Type a b’
+ • Found type wildcard ‘_’ standing for ‘Coercible * a b’
Where: ‘a’, ‘b’ are rigid type variables bound by
- the inferred type of ex7 :: Coercible Type a b => Coercion Type a b
+ the inferred type of ex7 :: Coercible * a b => Coercion * a b
at T15039b.hs:36:1-14
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
diff --git a/testsuite/tests/partial-sigs/should_compile/T15039d.stderr b/testsuite/tests/partial-sigs/should_compile/T15039d.stderr
index 6c6e1a0c24..7a0f4acf26 100644
--- a/testsuite/tests/partial-sigs/should_compile/T15039d.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/T15039d.stderr
@@ -1,64 +1,59 @@
T15039d.hs:19:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’
- standing for ‘Dict ((a :: Type) ~ (b :: Type))’
+ • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’
Where: ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
- ex1 :: forall a b. Dict ((a :: Type) ~ (b :: Type)) -> ()
+ ex1 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> ()
at T15039d.hs:18:1-45
• In a pattern type signature: _
In the pattern: Dict :: _
In an equation for ‘ex1’: ex1 (Dict :: _) = ()
• Relevant bindings include
- ex1 :: Dict ((a :: Type) ~ (b :: Type)) -> ()
- (bound at T15039d.hs:19:1)
+ ex1 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039d.hs:19:1)
T15039d.hs:22:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’
- standing for ‘Dict ((a :: Type) ~~ (b :: Type))’
+ standing for ‘Dict ((a :: *) ~~ (b :: *))’
Where: ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
- ex2 :: forall a b. Dict ((a :: Type) ~~ (b :: Type)) -> ()
+ ex2 :: forall a b. Dict ((a :: *) ~~ (b :: *)) -> ()
at T15039d.hs:21:1-46
• In a pattern type signature: _
In the pattern: Dict :: _
In an equation for ‘ex2’: ex2 (Dict :: _) = ()
• Relevant bindings include
- ex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> ()
- (bound at T15039d.hs:22:1)
+ ex2 :: Dict ((a :: *) ~~ (b :: *)) -> () (bound at T15039d.hs:22:1)
T15039d.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’
- standing for ‘Dict ((a :: Type) ~~ (b :: k))’
+ standing for ‘Dict ((a :: *) ~~ (b :: k))’
Where: ‘a’, ‘b’, ‘k’ are rigid type variables bound by
the type signature for:
- ex3 :: forall k a (b :: k). Dict ((a :: Type) ~~ (b :: k)) -> ()
+ ex3 :: forall k a (b :: k). Dict ((a :: *) ~~ (b :: k)) -> ()
at T15039d.hs:24:1-43
• In a pattern type signature: _
In the pattern: Dict :: _
In an equation for ‘ex3’: ex3 (Dict :: _) = ()
• Relevant bindings include
- ex3 :: Dict ((a :: Type) ~~ (b :: k)) -> ()
- (bound at T15039d.hs:25:1)
+ ex3 :: Dict ((a :: *) ~~ (b :: k)) -> () (bound at T15039d.hs:25:1)
T15039d.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘Dict (Coercible Type a b)’
+ • Found type wildcard ‘_’ standing for ‘Dict (Coercible * a b)’
Where: ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
- ex6 :: forall a b. Dict (Coercible Type a b) -> ()
+ ex6 :: forall a b. Dict (Coercible * a b) -> ()
at T15039d.hs:32:1-53
• In a pattern type signature: _
In the pattern: Dict :: _
In an equation for ‘ex6’: ex6 (Dict :: _) = ()
• Relevant bindings include
- ex6 :: Dict (Coercible Type a b) -> () (bound at T15039d.hs:33:1)
+ ex6 :: Dict (Coercible * a b) -> () (bound at T15039d.hs:33:1)
T15039d.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’
- standing for ‘(a :: Type) ~R# (b :: Type)’
+ • Found type wildcard ‘_’ standing for ‘(a :: *) ~R# (b :: *)’
Where: ‘a’, ‘b’ are rigid type variables bound by
the inferred type of
- ex7 :: ((a :: Type) ~R# (b :: Type)) => Coercion Type a b
+ ex7 :: ((a :: *) ~R# (b :: *)) => Coercion * a b
at T15039d.hs:36:1-14
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.stderr b/testsuite/tests/partial-sigs/should_fail/T14584.stderr
index f4f1887f4d..f22178774e 100644
--- a/testsuite/tests/partial-sigs/should_fail/T14584.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/T14584.stderr
@@ -1,13 +1,13 @@
T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)]
- • Could not deduce: m1 ~ Type
+ • Could not deduce: m1 ~ *
from the context: (Action act, Monoid a, Good m1)
bound by the instance declaration at T14584.hs:54:10-89
‘m1’ is a rigid type variable bound by
the instance declaration
at T14584.hs:54:10-89
When matching types
- a :: Type
+ a :: *
a0 :: m
Expected type: Sing a0
Actual type: Sing a
diff --git a/testsuite/tests/polykinds/T10134.hs b/testsuite/tests/polykinds/T10134.hs
index 0b64625f28..746758ce2f 100644
--- a/testsuite/tests/polykinds/T10134.hs
+++ b/testsuite/tests/polykinds/T10134.hs
@@ -3,7 +3,7 @@
module T10134 where
-import GHC.TypeLits
+import GHC.TypeLits as L
import T10134a
import Prelude
@@ -11,9 +11,9 @@ type Positive n = ((n-1)+1)~n
data Dummy n d = Dummy { vec :: Vec n (Vec d Bool) }
-nextDummy :: Positive (2*(n+d)) => Dummy n d -> Dummy n d
+nextDummy :: Positive (2 L.* (n+d)) => Dummy n d -> Dummy n d
nextDummy d = Dummy { vec = vec dFst }
where (dFst,dSnd) = nextDummy' d
-nextDummy' :: Positive (2*(n+d)) => Dummy n d -> ( Dummy n d, Bool )
+nextDummy' :: Positive (2 L.* (n+d)) => Dummy n d -> ( Dummy n d, Bool )
nextDummy' _ = undefined
diff --git a/testsuite/tests/th/TH_unresolvedInfix.hs b/testsuite/tests/th/TH_unresolvedInfix.hs
index 49f283bcd8..aa684f7f23 100644
--- a/testsuite/tests/th/TH_unresolvedInfix.hs
+++ b/testsuite/tests/th/TH_unresolvedInfix.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE QuasiQuotes #-}
module Main where
diff --git a/testsuite/tests/th/TH_unresolvedInfix_Lib.hs b/testsuite/tests/th/TH_unresolvedInfix_Lib.hs
index e6ad9f027b..a88b93fc8a 100644
--- a/testsuite/tests/th/TH_unresolvedInfix_Lib.hs
+++ b/testsuite/tests/th/TH_unresolvedInfix_Lib.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE NoStarIsType #-}
module TH_unresolvedInfix_Lib where
diff --git a/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs b/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs
index 911a43e507..d0077edbdb 100644
--- a/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs
+++ b/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}
module TcTypeNatSimple where
-import GHC.TypeLits
+import GHC.TypeLits as L
import Data.Proxy
--------------------------------------------------------------------------------
@@ -8,7 +8,7 @@ import Data.Proxy
e1 :: Proxy (2 + 3) -> Proxy 5
e1 = id
-e2 :: Proxy (2 * 3) -> Proxy 6
+e2 :: Proxy (2 L.* 3) -> Proxy 6
e2 = id
e3 :: Proxy (2 ^ 3) -> Proxy 8
@@ -20,16 +20,16 @@ e4 = id
e5 :: Proxy (x + 0) -> Proxy x
e5 = id
-e6 :: Proxy (x * 0) -> Proxy 0
+e6 :: Proxy (x L.* 0) -> Proxy 0
e6 = id
-e7 :: Proxy (0 * x) -> Proxy 0
+e7 :: Proxy (0 L.* x) -> Proxy 0
e7 = id
-e8 :: Proxy (x * 1) -> Proxy x
+e8 :: Proxy (x L.* 1) -> Proxy x
e8 = id
-e9 :: Proxy (1 * x) -> Proxy x
+e9 :: Proxy (1 L.* x) -> Proxy x
e9 = id
e10 :: Proxy (x ^ 1) -> Proxy x
@@ -83,10 +83,10 @@ e23 = id
ti2 :: Proxy (y + x) -> Proxy x -> ()
ti2 _ _ = ()
-ti3 :: Proxy (2 * y) -> ()
+ti3 :: Proxy (2 L.* y) -> ()
ti3 _ = ()
-ti4 :: Proxy (y * 2) -> ()
+ti4 :: Proxy (y L.* 2) -> ()
ti4 _ = ()
ti5 :: Proxy (2 ^ y) -> ()
diff --git a/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs
index 92d20daa56..566f8aa102 100644
--- a/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs
+++ b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs
@@ -2,7 +2,7 @@
UndecidableInstances, ConstraintKinds #-}
module TypeInTypeSubstitutions where
-import GHC.TypeLits
+import GHC.TypeLits as L
import Data.Type.Bool
import Data.Type.Equality
import Data.List (sort)
@@ -21,7 +21,7 @@ type One = NLogN 0 0
type O (a :: AsympPoly) = a
type family (^.) (n :: AsympPoly) (m :: Nat) :: AsympPoly where
- (NLogN a b) ^. n = (NLogN (a * n) (b * n))
+ (NLogN a b) ^. n = (NLogN (a L.* n) (b L.* n))
type family (*.) (n :: AsympPoly) (m :: AsympPoly) :: AsympPoly where
(NLogN a b) *. (NLogN c d) = NLogN (a+c) (b+d)
diff --git a/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs b/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs
index fb1463cc86..c12d53cde6 100644
--- a/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs
+++ b/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}
module Main(main) where
-import GHC.TypeLits
+import GHC.TypeLits as L
import Data.Proxy
--------------------------------------------------------------------------------
@@ -12,10 +12,10 @@ tsub _ _ = Proxy
tsub2 :: Proxy (x + y) -> (Proxy x, Proxy y)
tsub2 _ = (Proxy, Proxy)
-tdiv :: Proxy (x * y) -> Proxy y -> Proxy x
+tdiv :: Proxy (x L.* y) -> Proxy y -> Proxy x
tdiv _ _ = Proxy
-tdiv2 :: Proxy (x * y) -> (Proxy x, Proxy y)
+tdiv2 :: Proxy (x L.* y) -> (Proxy x, Proxy y)
tdiv2 _ = (Proxy, Proxy)
troot :: Proxy (x ^ y) -> Proxy y -> Proxy x
diff --git a/testsuite/tests/warnings/should_compile/StarBinder.hs b/testsuite/tests/warnings/should_compile/StarBinder.hs
new file mode 100644
index 0000000000..09f51684ac
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/StarBinder.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeOperators, TypeFamilies #-}
+
+module X (type (X.*)) where
+
+type family (*) a b where { (*) a b = Either b a }
diff --git a/testsuite/tests/warnings/should_compile/StarBinder.stderr b/testsuite/tests/warnings/should_compile/StarBinder.stderr
new file mode 100644
index 0000000000..2dbcf0e800
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/StarBinder.stderr
@@ -0,0 +1,10 @@
+
+StarBinder.hs:5:14: warning: [-Wstar-binder (in -Wdefault)]
+ Found binding occurrence of ‘*’ yet StarIsType is enabled.
+ NB. To use (or export) this operator in modules with StarIsType,
+ including the definition module, you must qualify it.
+
+StarBinder.hs:5:30: warning: [-Wstar-binder (in -Wdefault)]
+ Found binding occurrence of ‘*’ yet StarIsType is enabled.
+ NB. To use (or export) this operator in modules with StarIsType,
+ including the definition module, you must qualify it.
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
index 6740990853..fd2ba85035 100644
--- a/testsuite/tests/warnings/should_compile/all.T
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -20,3 +20,5 @@ test('Werror01', normal, compile, [''])
test('Werror02', normal, compile, [''])
test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modules'])
+
+test('StarBinder', normal, compile, ['']) \ No newline at end of file