Commit 3354c68e authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Marge Bot

Pretty-printing of the * kind

Before this patch, GHC always printed the * kind unparenthesized.

This led to two issues:

1. Sometimes GHC printed invalid or incorrect code.
   For example, GHC would print:  type F @*   x = x
         when it meant to print:  type F @(*) x = x
   In the former case, instead of a kind application we were getting a
   type operator (@*).

2. Sometimes GHC printed kinds that were correct but hard to read.
   Should  Either * Int  be read as  Either (*) Int
                              or as  (*) Either Int  ?
   This depends on whether -XStarIsType is enabled, but it would be
   easier if we didn't have to check for the flag when reading the code.

We can solve both problems by assigning (*) a different precedence. Note
that Haskell98 kinds are not affected:

  ((* -> *) -> *) -> *  does NOT become  (((*) -> (*)) -> (*)) -> (*)

The parentheses are added when (*) is used in a function argument
position:

   F * * *   becomes  F (*) (*) (*)
   F A * B   becomes  F A (*) B
   Proxy *   becomes  Proxy (*)
   a * -> *  becomes  a (*) -> *
parent c4ca29c7
......@@ -1676,7 +1676,7 @@ hsTypeNeedsParens p = go
go (HsExplicitTupleTy{}) = False
go (HsTyLit{}) = False
go (HsWildCardTy{}) = False
go (HsStarTy{}) = False
go (HsStarTy{}) = p >= starPrec
go (HsAppTy{}) = p >= appPrec
go (HsAppKindTy{}) = p >= appPrec
go (HsOpTy{}) = p >= opPrec
......
......@@ -51,7 +51,8 @@ module BasicTypes(
Boxity(..), isBoxed,
PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,
PprPrec(..), topPrec, sigPrec, opPrec, funPrec, starPrec, appPrec,
maybeParen,
TupleSort(..), tupleSortBoxity, boxityTupleSort,
tupleParens,
......@@ -729,14 +730,16 @@ pprSafeOverlap False = empty
newtype PprPrec = PprPrec Int deriving (Eq, Ord, Show)
-- See Note [Precedence in types]
topPrec, sigPrec, funPrec, opPrec, appPrec :: PprPrec
topPrec, sigPrec, funPrec, opPrec, starPrec, appPrec :: PprPrec
topPrec = PprPrec 0 -- No parens
sigPrec = PprPrec 1 -- Explicit type signatures
funPrec = PprPrec 2 -- Function args; no parens for constructor apps
-- See [Type operator precedence] for why both
-- funPrec and opPrec exist.
opPrec = PprPrec 2 -- Infix operator
appPrec = PprPrec 3 -- Constructor args; no parens for atomic
starPrec = PprPrec 3 -- Star syntax for the type of types, i.e. the * in (* -> *)
-- See Note [Star kind precedence]
appPrec = PprPrec 4 -- Constructor args; no parens for atomic
maybeParen :: PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen ctxt_prec inner_prec pretty
......@@ -775,6 +778,33 @@ By treating opPrec = funPrec we end up with more parens
But the two are different constructors of PprPrec so we could make
(->) bind more or less tightly if we wanted.
Note [Star kind precedence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
We parenthesize the (*) kind to avoid two issues:
1. Printing invalid or incorrect code.
For example, instead of type F @(*) x = x
GHC used to print type F @* x = x
However, (@*) is a type operator, not a kind application.
2. Printing kinds that are correct but hard to read.
Should Either * Int be read as Either (*) Int
or as (*) Either Int ?
This depends on whether -XStarIsType is enabled, but it would be
easier if we didn't have to check for the flag when reading the code.
At the same time, we cannot parenthesize (*) blindly.
Consider this Haskell98 kind: ((* -> *) -> *) -> *
With parentheses, it is less readable: (((*) -> (*)) -> (*)) -> (*)
The solution is to assign a special precedence to (*), 'starPrec', which is
higher than 'funPrec' but lower than 'appPrec':
F * * * becomes F (*) (*) (*)
F A * B becomes F A (*) B
Proxy * becomes Proxy (*)
a * -> * becomes a (*) -> *
-}
{-
......
......@@ -1315,7 +1315,7 @@ pprTyTcApp' ctxt_prec tc tys dflags style
| tc `ifaceTyConHasKey` tYPETyConKey
, IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys
, rep `ifaceTyConHasKey` liftedRepDataConKey
= kindType
= ppr_kind_type ctxt_prec
| otherwise
= getPprDebug $ \dbg ->
......@@ -1332,6 +1332,14 @@ pprTyTcApp' ctxt_prec tc tys dflags style
info = ifaceTyConInfo tc
tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags tys
ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type ctxt_prec =
sdocWithDynFlags $ \dflags ->
if useStarIsType dflags
then maybeParen ctxt_prec starPrec $
unicodeSyntax (char '★') (char '*')
else text "Type"
-- | Pretty-print a type-level equality.
-- Returns (Just doc) if the argument is a /saturated/ application
-- of eqTyCon (~)
......@@ -1440,7 +1448,7 @@ ppr_iface_tc_app pp _ tc [ty]
ppr_iface_tc_app pp ctxt_prec tc tys
| tc `ifaceTyConHasKey` liftedTypeKindTyConKey
= kindType
= ppr_kind_type ctxt_prec
| not (isSymOcc (nameOccName (ifaceTyConName tc)))
= pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
......
......@@ -13,7 +13,6 @@ pprCols :: DynFlags -> Int
unsafeGlobalDynFlags :: DynFlags
useUnicode :: DynFlags -> Bool
useUnicodeSyntax :: DynFlags -> Bool
useStarIsType :: DynFlags -> Bool
shouldUseColor :: DynFlags -> Bool
shouldUseHexWordLiterals :: DynFlags -> Bool
hasPprDebug :: DynFlags -> Bool
......
......@@ -28,7 +28,7 @@ module Outputable (
semi, comma, colon, dcolon, space, equals, dot, vbar,
arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt,
lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
blankLine, forAllLit, kindType, bullet,
blankLine, forAllLit, bullet,
(<>), (<+>), hcat, hsep,
($$), ($+$), vcat,
sep, cat,
......@@ -91,7 +91,7 @@ import GhcPrelude
import {-# SOURCE #-} DynFlags( DynFlags, hasPprDebug, hasNoDebugOutput,
targetPlatform, pprUserLength, pprCols,
useUnicode, useUnicodeSyntax, useStarIsType,
useUnicode, useUnicodeSyntax,
shouldUseColor, unsafeGlobalDynFlags,
shouldUseHexWordLiterals )
import {-# SOURCE #-} Module( UnitId, Module, ModuleName, moduleName )
......@@ -649,12 +649,6 @@ rbrace = docToSDoc $ Pretty.rbrace
forAllLit :: SDoc
forAllLit = unicodeSyntax (char '∀') (text "forall")
kindType :: SDoc
kindType = sdocWithDynFlags $ \dflags ->
if useStarIsType dflags
then unicodeSyntax (char '★') (char '*')
else text "Type"
bullet :: SDoc
bullet = unicode (char '•') (char '*')
......
T11361a.hs:7:3: error:
• Illegal argument ‘*’ in:
‘type F @* x = x’
‘type F @(*) x = x’
The arguments to ‘F’ must all be distinct type variables
• In the default type instance declaration for ‘F’
In the class declaration for ‘C’
......@@ -2,6 +2,6 @@
T12041.hs:12:3: error:
• Type indexes must match class instance head
Expected: Ob @i (I @{i} @{i})
Actual: Ob @* (I @{*} @{*})
Actual: Ob @(*) (I @{*} @{*})
• In the type instance declaration for ‘Ob’
In the instance declaration for ‘Category I’
T13877.hs:65:41: error:
• Expecting one more argument to ‘p’
Expected kind ‘(-?>) [a] * (':->)’, but ‘p’ has kind ‘[a] ~> *’
Expected kind ‘(-?>) [a] (*) (':->)’, but ‘p’ has kind ‘[a] ~> *’
• In the type ‘p’
In the expression: listElimPoly @(:->) @a @p @l
In an equation for ‘listElimTyFun’:
......
T13971.hs:7:3: error:
• Illegal argument ‘*’ in:
‘type T @{k} @* a = Int’
‘type T @{k} @(*) a = Int’
The arguments to ‘T’ must all be distinct type variables
• In the default type instance declaration for ‘T’
In the class declaration for ‘C’
......@@ -6,14 +6,14 @@ T14246.hs:18:5: error:
T14246.hs:22:27: error:
• Expected kind ‘Vect (KLN f) L’,
but ‘Cons (Label (t :: v)) l’ has kind ‘Vect ('S (KLN (f t))) *
but ‘Cons (Label (t :: v)) l’ has kind ‘Vect ('S (KLN (f t))) (*)
• In the second argument of ‘Reveal’, namely
‘(Cons (Label (t :: v)) l)’
In the type family declaration for ‘Reveal’
T14246.hs:22:67: error:
• Expected kind ‘Vect (KLN (f t)) L’,
but ‘l’ has kind ‘Vect (KLN (f t)) *
but ‘l’ has kind ‘Vect (KLN (f t)) (*)
• In the second argument of ‘Reveal’, namely ‘l’
In the type ‘Reveal (f t) l’
In the type family declaration for ‘Reveal’
......
T16356_Fail1.hs:10:3: error:
• Illegal argument ‘*’ in:
‘type T @* a = Maybe a’
‘type T @(*) a = Maybe a’
The arguments to ‘T’ must all be distinct type variables
• In the default type instance declaration for ‘T’
In the class declaration for ‘C’
T9160.hs:19:3: error:
• Type indexes must match class instance head
Expected: F @*
Expected: F @(*)
Actual: F @(* -> *)
• In the type instance declaration for ‘F’
In the instance declaration for ‘C (a :: *)’
T9171.hs:10:20: error:
• Couldn't match expected type ‘GetParam
@* @k2 @* Base (GetParam @* @* @k2 Base Int)’
@(*) @k2 @(*) Base (GetParam @(*) @(*) @k2 Base Int)’
with actual type ‘GetParam
@* @k20 @* Base (GetParam @* @* @k20 Base Int)’
@(*) @k20 @(*) Base (GetParam @(*) @(*) @k20 Base Int)’
NB: ‘GetParam’ is a non-injective type family
The type variable ‘k20’ is ambiguous
• In the ambiguity check for an expression type signature
......
......@@ -37,21 +37,21 @@ T15039b.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
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 @* 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 @* 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 @* 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 @* 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 @* a b => Coercion @{*} 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)
......@@ -38,21 +38,21 @@ T15039d.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
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 @* 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 @* 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 @* 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 ‘Coercible @* 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 @* a b => Coercion @{*} a b
the inferred type of ex7 :: Coercible @(*) a b => Coercion @{*} a b
at T15039d.hs:36:1-14
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
......@@ -13,5 +13,5 @@ T10503.hs:8:6: error:
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
In the type signature:
h :: forall k r.
(Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy *) => r)
(Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy (*)) => r)
-> r
......@@ -4,6 +4,6 @@ T11399.hs:10:32: error:
When matching kinds
a :: * -> *
TYPE :: GHC.Types.RuntimeRep -> *
Expected kind ‘* -> *’, but ‘UhOh a’ has kind ‘a * -> *’
Expected kind ‘* -> *’, but ‘UhOh a’ has kind ‘a (*) -> *’
• In the first argument of ‘Functor’, namely ‘(UhOh a)’
In the instance declaration for ‘Functor (UhOh a)’
......@@ -2,6 +2,6 @@
T14450.hs:33:3: error:
• Type indexes must match class instance head
Expected: Dom @k @k (IddSym0 @k)
Actual: Dom @* @* (IddSym0 @*)
Actual: Dom @(*) @(*) (IddSym0 @(*))
• In the type instance declaration for ‘Dom’
In the instance declaration for ‘Varpi (IddSym0 :: k ~> k)’
T14520.hs:15:24: error:
• Expected kind ‘bat w w’,
but ‘Id’ has kind ‘XXX @a0 @* (XXX @a0 @(a0 ~>> *) kat0 b0) b0’
but ‘Id’ has kind ‘XXX @a0 @(*) (XXX @a0 @(a0 ~>> *) kat0 b0) b0’
• In the first argument of ‘Sing’, namely ‘(Id :: bat w w)’
In the type signature: sId :: Sing w -> Sing (Id :: bat w w)
......@@ -6,7 +6,7 @@ T8566.hs:34:9: error:
bound by the instance declaration at T8566.hs:32:10-67
or from: 'AA t (a : as) ~ 'AA t1 as1
bound by a pattern with constructor:
A :: forall v (t :: v) (as :: [U *]) (r :: [*]). I ('AA t as) r,
A :: forall v (t :: v) (as :: [U (*)]) (r :: [*]). I ('AA t as) r,
in an equation for ‘c’
at T8566.hs:34:5
The type variable ‘fs0’ is ambiguous
......
saks007_fail.hs:15:10: error:
• Couldn't match kind ‘'True’ with ‘'False’
Expected kind: G *
Actual kind: F *
Expected kind: G (*)
Actual kind: F (*)
• In the type ‘X Integer String’
In the definition of data constructor ‘MkX’
In the data declaration for ‘X’
......@@ -3,4 +3,4 @@ T15801.hs:52:10: error:
• Couldn't match representation of type ‘UnOp op_a -> UnOp b’
with that of ‘op_a --> b’
arising from the superclasses of an instance declaration
• In the instance declaration for ‘OpRíki (Op *)’
• In the instance declaration for ‘OpRíki (Op (*))’
T16821.hs:12:1: error:
• Kind signature on newtype declaration has non-TYPE
return kind ‘Id *
return kind ‘Id (*)
• In the newtype declaration for ‘T’
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment