diff options
| -rw-r--r-- | compiler/prelude/TysPrim.hs | 2 | ||||
| -rw-r--r-- | libraries/base/Data/Typeable/Internal.hs | 30 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T8535.stdout | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/ghci020.stdout | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T10145.stdout | 2 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_run/TypeOf.stdout | 2 |
6 files changed, 31 insertions, 9 deletions
diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index ff61878964..754bb8fb09 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -340,7 +340,7 @@ openBetaTy = mkTyVarTy openBetaTyVar -} funTyConName :: Name -funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon +funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon -- | The @(->)@ type constructor. -- diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 6c52cc5dd1..3b7753de46 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -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 diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout index 873b992a38..6ae0c4ccfe 100644 --- a/testsuite/tests/ghci/scripts/T8535.stdout +++ b/testsuite/tests/ghci/scripts/T8535.stdout @@ -1,5 +1,5 @@ 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’ diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout index 873b992a38..6ae0c4ccfe 100644 --- a/testsuite/tests/ghci/scripts/ghci020.stdout +++ b/testsuite/tests/ghci/scripts/ghci020.stdout @@ -1,5 +1,5 @@ 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’ diff --git a/testsuite/tests/ghci/should_run/T10145.stdout b/testsuite/tests/ghci/should_run/T10145.stdout index 873b992a38..6ae0c4ccfe 100644 --- a/testsuite/tests/ghci/should_run/T10145.stdout +++ b/testsuite/tests/ghci/should_run/T10145.stdout @@ -1,5 +1,5 @@ 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’ diff --git a/testsuite/tests/typecheck/should_run/TypeOf.stdout b/testsuite/tests/typecheck/should_run/TypeOf.stdout index 6e9a28ed7c..912fe39a84 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.stdout +++ b/testsuite/tests/typecheck/should_run/TypeOf.stdout @@ -21,4 +21,4 @@ Proxy * * Proxy * * Proxy RuntimeRep 'LiftedRep Proxy (Nat,Symbol) ('(,) Nat Symbol 1 "hello") -Proxy (* -> * -> Constraint) (~~ * *) +Proxy (* -> * -> Constraint) ((~~) * *) |