Commit 3397396a authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Fix #15236 by removing parentheses from funTyConName

Currently, `funTyConName` is defined as:

```lang=haskell
funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
```

What's strange about this definition is that there are extraneous
parentheses around `->`, which is quite unlike every other infix
`Name`. As a result, the `:info (->)` output is totally garbled (see
Trac #15236).

It's quite straightforward to fix that particular bug by removing the
extraneous parentheses. However, it turns out that this makes some
test output involving `Show` instances for `TypeRep` look less
appealing, since `->` is no longer surrounded with parentheses when
applied prefix. But neither were any /other/ infix type constructors!
The right fix there was to change `showTypeable` to put parentheses
around prefix applications of infix tycons.

Test Plan: ./validate

Reviewers: bgamari, hvr

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #15236

Differential Revision: https://phabricator.haskell.org/D4799
parent 5926b6ed
......@@ -340,7 +340,7 @@ openBetaTy = mkTyVarTy openBetaTyVar
-}
funTyConName :: Name
funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon
-- | The @(->)@ type constructor.
--
......
......@@ -85,7 +85,7 @@ import GHC.Base
import qualified GHC.Arr as A
import GHC.Types ( TYPE )
import Data.Type.Equality
import GHC.List ( splitAt, foldl' )
import GHC.List ( splitAt, foldl', elem )
import GHC.Word
import GHC.Show
import GHC.TypeLits ( KnownSymbol, symbolVal', AppendSymbol )
......@@ -777,11 +777,11 @@ showTypeable _ rep
| isTupleTyCon tc =
showChar '(' . showArgs (showChar ',') tys . showChar ')'
where (tc, tys) = splitApps rep
showTypeable p (TrTyCon {trTyCon = tycon, trKindVars = []})
= showsPrec p tycon
showTypeable _ (TrTyCon {trTyCon = tycon, trKindVars = []})
= showTyCon tycon
showTypeable p (TrTyCon {trTyCon = tycon, trKindVars = args})
= showParen (p > 9) $
showsPrec p tycon .
showTyCon tycon .
showChar ' ' .
showArgs (showChar ' ') args
showTypeable p (TrFun {trFunArg = x, trFunRes = r})
......@@ -841,6 +841,28 @@ isTupleTyCon tc
| ('(':',':_) <- tyConName tc = True
| otherwise = False
-- This is only an approximation. We don't have the general
-- character-classification machinery here, so we just do our best.
-- This should work for promoted Haskell 98 data constructors and
-- for TypeOperators type constructors that begin with ASCII
-- characters, but it will miss Unicode operators.
--
-- If we wanted to catch Unicode as well, we ought to consider moving
-- GHC.Lexeme from ghc-boot-th to base. Then we could just say:
--
-- startsVarSym symb || startsConSym symb
--
-- But this is a fair deal of work just for one corner case, so I think I'll
-- leave it like this unless someone shouts.
isOperatorTyCon :: TyCon -> Bool
isOperatorTyCon tc
| symb : _ <- tyConName tc
, symb `elem` "!#$%&*+./<=>?@\\^|-~:" = True
| otherwise = False
showTyCon :: TyCon -> ShowS
showTyCon tycon = showParen (isOperatorTyCon tycon) (shows tycon)
showArgs :: Show a => ShowS -> [a] -> ShowS
showArgs _ [] = id
showArgs _ [a] = showsPrec 10 a
......
data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
infixr 0 `(->)`
infixr 0 ->
instance Applicative ((->) a) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
instance Monad ((->) r) -- Defined in ‘GHC.Base’
......
data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
infixr 0 `(->)`
infixr 0 ->
instance Applicative ((->) a) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
instance Monad ((->) r) -- Defined in ‘GHC.Base’
......
data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
infixr 0 `(->)`
infixr 0 ->
instance Applicative ((->) a) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
instance Monad ((->) r) -- Defined in ‘GHC.Base’
......
......@@ -21,4 +21,4 @@ Proxy * *
Proxy * *
Proxy RuntimeRep 'LiftedRep
Proxy (Nat,Symbol) ('(,) Nat Symbol 1 "hello")
Proxy (* -> * -> Constraint) (~~ * *)
Proxy (* -> * -> Constraint) ((~~) * *)
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