[commit: ghc] master: Show TYPE 'Lifted/TYPE 'Unlifted as */# in Show TypeRep instance (65b810b)

git at git.haskell.org git at git.haskell.org
Sun Jan 17 23:14:17 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/65b810bdda625f2e98069c2c56ec93e1c65667a6/ghc

>---------------------------------------------------------------

commit 65b810bdda625f2e98069c2c56ec93e1c65667a6
Author: RyanGlScott <ryan.gl.scott at gmail.com>
Date:   Sun Jan 17 19:28:10 2016 +0100

    Show TYPE 'Lifted/TYPE 'Unlifted as */# in Show TypeRep instance
    
    Kind equalities changed how `*`/`#` are represented internally, which
    means that showing a `TypeRep` that contains either of those kinds
    produces a rather gross-looking result, e.g.,
    
    ```
    > typeOf (Proxy :: Proxy 'Just)
    Proxy (TYPE 'Lifted -> Maybe (TYPE 'Lifted)) 'Just
    ```
    
    We can at least special-case the `Show` instance for `TypeRep` so that
    it prints `*` to represent `TYPE 'Lifted` and `#` to represent `TYPE
    'Unlifted`.
    
    Addresses one of the issues uncovered in #11334.
    
    Test Plan: ./validate
    
    Reviewers: simonpj, hvr, austin, goldfire, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1757
    
    GHC Trac Issues: #11334


>---------------------------------------------------------------

65b810bdda625f2e98069c2c56ec93e1c65667a6
 libraries/base/Data/Typeable/Internal.hs |  5 ++++-
 libraries/base/tests/T11334.hs           | 11 +++++++++++
 libraries/base/tests/T11334.stdout       |  3 +++
 libraries/base/tests/all.T               |  3 ++-
 4 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index 548df30..46e6e82 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -357,7 +357,10 @@ instance Show TypeRep where
   showsPrec p (TypeRep _ tycon kinds tys) =
     case tys of
       [] -> showsPrec p tycon
-      [x]   | tycon == tcList -> showChar '[' . shows x . showChar ']'
+      [x@(TypeRep _ argCon _ _)]
+        | tycon == tcList -> showChar '[' . shows x . showChar ']'
+        | tycon == tcTYPE && argCon == tc'Lifted   -> showChar '*'
+        | tycon == tcTYPE && argCon == tc'Unlifted -> showChar '#'
       [a,r] | tycon == tcFun  -> showParen (p > 8) $
                                  showsPrec 9 a .
                                  showString " -> " .
diff --git a/libraries/base/tests/T11334.hs b/libraries/base/tests/T11334.hs
new file mode 100644
index 0000000..22864d9
--- /dev/null
+++ b/libraries/base/tests/T11334.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE DataKinds #-}
+module Main (main) where
+
+import Data.Typeable
+import GHC.Types
+
+main :: IO ()
+main = do
+  print (typeOf (Proxy :: Proxy 'Just))
+  print (typeOf (Proxy :: Proxy (TYPE 'Lifted)))
+  print (typeOf (Proxy :: Proxy (TYPE 'Unlifted)))
diff --git a/libraries/base/tests/T11334.stdout b/libraries/base/tests/T11334.stdout
new file mode 100644
index 0000000..a00f275
--- /dev/null
+++ b/libraries/base/tests/T11334.stdout
@@ -0,0 +1,3 @@
+Proxy (* -> Maybe *) 'Just
+Proxy * *
+Proxy * #
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 0cb48bb..06ef3bb 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -210,4 +210,5 @@ test('T9848',
         , only_ways(['normal'])],
       compile_and_run,
       ['-O'])
-test('T10149',normal, compile_and_run,[''])
+test('T10149', normal, compile_and_run, [''])
+test('T11334', normal, compile_and_run, [''])



More information about the ghc-commits mailing list