Skip to content

GitLab

Glasgow Haskell Compiler
Glasgow Haskell Compiler
Commit 70317043 authored by johnleo's avatar johnleo Committed by Ben Gamari
Browse files
Options

print * in unicode correctly (fixes #12550) 

Test Plan: validate

Reviewers: simonpj, austin, bgamari, goldfire

Reviewed By: bgamari, goldfire

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2829
parent aa123f44
Hide whitespace changes
Inline Side-by-side
Showing with 88 additions and 36 deletions
compiler/basicTypes/BasicTypes.hs
View file @ 70317043
......@@ -692,7 +692,7 @@ pprSafeOverlap False = empty
************************************************************************
-}
data TyPrec -- See Note [Prededence in types]
data TyPrec -- See Note [Precedence in types] in TyCoRep.hs
= TopPrec -- No parens
| FunPrec -- Function args; no parens for tycon apps
| TyOpPrec -- Infix operator
......
compiler/iface/IfaceType.hs
View file @ 70317043
......@@ -188,7 +188,7 @@ data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon
{- Note [TcTyVars in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Nowadays (since Nov 16) we pretty-print a Type by converting to an
Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to an
IfaceType and pretty printing that. This eliminates a lot of
pretty-print duplication, and it matches what we do with
pretty-printing TyThings.
......@@ -966,7 +966,7 @@ pprTyTcApp' ctxt_prec tc tys dflags style
| tc `ifaceTyConHasKey` tYPETyConKey
, ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
, rep `ifaceTyConHasKey` ptrRepLiftedDataConKey
= unicodeSyntax (char '★') (char '*')
= kindStar
| tc `ifaceTyConHasKey` tYPETyConKey
, ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
......@@ -1050,22 +1050,23 @@ ppr_iface_tc_app pp _ tc [ty]
| tc `ifaceTyConHasKey` parrTyConKey = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
ppr_iface_tc_app pp ctxt_prec tc tys
| not (isSymOcc (nameOccName tc_name))
| tc `ifaceTyConHasKey` starKindTyConKey
|| tc `ifaceTyConHasKey` liftedTypeKindTyConKey
|| tc `ifaceTyConHasKey` unicodeStarKindTyConKey
= kindStar -- Handle unicode; do not wrap * in parens
| tc `ifaceTyConHasKey` unliftedTypeKindTyConKey
= ppr tc -- Do not wrap # in parens
| not (isSymOcc (nameOccName (ifaceTyConName tc)))
= pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp TyConPrec) tys)
| [ty1,ty2] <- tys -- Infix, two arguments;
-- we know nothing of precedence though
= pprIfaceInfixApp pp ctxt_prec (ppr tc) ty1 ty2
| tc `ifaceTyConHasKey` starKindTyConKey
|| tc `ifaceTyConHasKey` unliftedTypeKindTyConKey
|| tc `ifaceTyConHasKey` unicodeStarKindTyConKey
= ppr tc -- Do not wrap *, # in parens
| otherwise
= pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp TyConPrec) tys)
where
tc_name = ifaceTyConName tc
pprSum :: Arity -> IsPromoted -> IfaceTcArgs -> SDoc
pprSum _arity is_promoted args
......
compiler/types/TyCoRep.hs
View file @ 70317043
......@@ -2368,7 +2368,7 @@ works just by setting the initial context precedence very high.
Note [Precedence in types]
~~~~~~~~~~~~~~~~~~~~~~~~~~
We don't keep the fixity of type operators in the operator. So the pretty printer
operates the following precedene structre:
follows the following precedence order:
Type constructor application binds more tightly than
Operator applications which bind more tightly than
Function arrow
......@@ -2378,7 +2378,7 @@ meaning (a :+: (T b)) -> c
Maybe operator applications should bind a bit less tightly?
Anyway, that's the current story, and it is used consistently for Type and HsType
Anyway, that's the current story; it is used consistently for Type and HsType.
-}
------------------
......
compiler/utils/Outputable.hs
View file @ 70317043
......@@ -29,7 +29,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,
blankLine, forAllLit, kindStar,
(<>), (<+>), hcat, hsep,
($$), ($+$), vcat,
sep, cat,
......@@ -590,6 +590,9 @@ rbrace = docToSDoc $ Pretty.rbrace
forAllLit :: SDoc
forAllLit = unicodeSyntax (char '∀') (text "forall")
kindStar :: SDoc
kindStar = unicodeSyntax (char '★') (char '*')
unicodeSyntax :: SDoc -> SDoc -> SDoc
unicodeSyntax unicode plain = sdocWithDynFlags $ \dflags ->
if useUnicode dflags && useUnicodeSyntax dflags
......
testsuite/tests/generics/T10604/T10604_deriving.stderr
View file @ 70317043
......@@ -56,7 +56,7 @@ Derived class instances:
-> T10604_deriving.Wrap g1 }
instance GHC.Generics.Generic1
(GHC.Types.* -> GHC.Types.*) T10604_deriving.Wrap where
(* -> *) T10604_deriving.Wrap where
GHC.Generics.from1 x
= GHC.Generics.M1
(case x of {
......@@ -67,7 +67,7 @@ Derived class instances:
(GHC.Generics.M1 (GHC.Generics.M1 g1))
-> T10604_deriving.Wrap (GHC.Generics.unRec1 g1) }
instance forall k (a :: k -> GHC.Types.*).
instance forall k (a :: k -> *).
GHC.Generics.Generic (T10604_deriving.Wrap2 k a) where
GHC.Generics.from x
= GHC.Generics.M1
......@@ -80,7 +80,7 @@ Derived class instances:
-> T10604_deriving.Wrap2 g1 }
instance GHC.Generics.Generic1
(k -> GHC.Types.*) (T10604_deriving.Wrap2 k) where
(k -> *) (T10604_deriving.Wrap2 k) where
GHC.Generics.from1 x
= GHC.Generics.M1
(case x of {
......@@ -250,23 +250,23 @@ Derived type family instances:
(GHC.Generics.Rec0
*
(T10604_deriving.Proxy
(GHC.Types.* -> GHC.Types.*) a))))
(* -> *) a))))
type GHC.Generics.Rep1
(GHC.Types.* -> GHC.Types.*) T10604_deriving.Wrap = GHC.Generics.D1
(GHC.Types.* -> GHC.Types.*)
(* -> *) T10604_deriving.Wrap = GHC.Generics.D1
(* -> *)
('GHC.Generics.MetaData
"Wrap"
"T10604_deriving"
"main"
'GHC.Types.False)
(GHC.Generics.C1
(GHC.Types.* -> GHC.Types.*)
(* -> *)
('GHC.Generics.MetaCons
"Wrap"
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
(GHC.Types.* -> GHC.Types.*)
(* -> *)
('GHC.Generics.MetaSel
('GHC.Base.Nothing
GHC.Types.Symbol)
......@@ -274,10 +274,10 @@ Derived type family instances:
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec1
(GHC.Types.* -> GHC.Types.*)
(* -> *)
(T10604_deriving.Proxy
(GHC.Types.*
-> GHC.Types.*)))))
(*
-> *)))))
type GHC.Generics.Rep (T10604_deriving.Wrap2 k a) = GHC.Generics.D1
*
('GHC.Generics.MetaData
......@@ -304,23 +304,23 @@ Derived type family instances:
(T10604_deriving.Proxy
*
(T10604_deriving.Proxy
(k -> GHC.Types.*) a)))))
(k -> *) a)))))
type GHC.Generics.Rep1
(k -> GHC.Types.*) (T10604_deriving.Wrap2 k) = GHC.Generics.D1
(k -> GHC.Types.*)
(k -> *) (T10604_deriving.Wrap2 k) = GHC.Generics.D1
(k -> *)
('GHC.Generics.MetaData
"Wrap2"
"T10604_deriving"
"main"
'GHC.Types.False)
(GHC.Generics.C1
(k -> GHC.Types.*)
(k -> *)
('GHC.Generics.MetaCons
"Wrap2"
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
(k -> GHC.Types.*)
(k -> *)
('GHC.Generics.MetaSel
('GHC.Base.Nothing
GHC.Types.Symbol)
......@@ -329,12 +329,12 @@ Derived type family instances:
'GHC.Generics.DecidedLazy)
((GHC.Generics.:.:)
*
(k -> GHC.Types.*)
(k -> *)
(T10604_deriving.Proxy *)
(GHC.Generics.Rec1
(k -> GHC.Types.*)
(k -> *)
(T10604_deriving.Proxy
(k -> GHC.Types.*))))))
(k -> *))))))
type GHC.Generics.Rep
(T10604_deriving.SumOfProducts k a) = GHC.Generics.D1
*
......
testsuite/tests/ghci/scripts/T12550.script
View file @ 70317043
:set -fprint-unicode-syntax -fprint-explicit-foralls
:set -fprint-explicit-foralls -XKindSignatures -XExplicitNamespaces
import Data.Kind (type Type)
class C a where f :: a b
:t f
class C (a :: * -> * ) where f :: a b
:t f
class C (a :: ★ -> * ) where f :: a b
:t f
class C (a :: * -> ★ ) where f :: a b
:t f
class C (a :: ★ -> ★ ) where f :: a b
:t f
class C (a :: Type -> Type ) where f :: a b
:t f
:set -fprint-unicode-syntax
class C a where f :: a b
:t f
class C (a :: * -> * ) where f :: a b
:t f
class C (a :: ★ -> * ) where f :: a b
:t f
class C (a :: * -> ★ ) where f :: a b
:t f
class C (a :: ★ -> ★ ) where f :: a b
:t f
class C (a :: Type -> Type ) where f :: a b
:t f
:t fmap
:i fmap
:k Functor
:m + GHC.Generics
import GHC.Generics
:i Functor
:t datatypeName
:i datatypeName
:t (:*:)
:k Rep
:k M1
testsuite/tests/ghci/scripts/T12550.stdout
View file @ 70317043
f :: forall {b} {a :: * -> *}. C a => a b
f :: forall {b} {a :: * -> *}. C a => a b
f :: forall {b} {a :: * -> *}. C a => a b
f :: forall {b} {a :: * -> *}. C a => a b
f :: forall {b} {a :: * -> *}. C a => a b
f :: forall {b} {a :: * -> *}. C a => a b
f ∷ ∀ {b} {a ∷ ★ → ★}. C a ⇒ a b
f ∷ ∀ {b} {a ∷ ★ → ★}. C a ⇒ a b
f ∷ ∀ {b} {a ∷ ★ → ★}. C a ⇒ a b
f ∷ ∀ {b} {a ∷ ★ → ★}. C a ⇒ a b
f ∷ ∀ {b} {a ∷ ★ → ★}. C a ⇒ a b
f ∷ ∀ {b} {a ∷ ★ → ★}. C a ⇒ a b
fmap ∷ ∀ {f ∷ ★ → ★} {b} {a}. Functor f ⇒ (a → b) → f a → f b
class Functor (f ∷ ★ → ★) where
fmap ∷ ∀ a b. (a → b) → f a → f b
......@@ -51,3 +63,5 @@ class Datatype (d ∷ k) where
...
-- Defined in ‘GHC.Generics’
(:*:) ∷ ∀ {g ∷ ★ → ★} {p} {f ∷ ★ → ★}. f p → g p → (:*:) f g p
Rep ∷ ★ → ★ → ★
M1 ∷ ∀ k. ★ → Meta → (k → ★) → k → ★
testsuite/tests/ghci/scripts/all.T
View file @ 70317043
......@@ -267,5 +267,5 @@ test('T12091',
test('T12523', normal, ghci_script, ['T12523.script'])
test('T12024', normal, ghci_script, ['T12024.script'])
test('T12447', expect_broken(12447), ghci_script, ['T12447.script'])
test('T12550', expect_broken(12550), ghci_script, ['T12550.script'])
test('T10249', normal, ghci_script, ['T10249.script'])
test('T12550', normal, ghci_script, ['T12550.script'])
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