[commit: ghc] wip/ttypeable: Binary: Simple serialization test works (2a7b4e8)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/2a7b4e811470ee1cc57dc3dff30f224a4e4ca2c3/ghc

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

commit 2a7b4e811470ee1cc57dc3dff30f224a4e4ca2c3
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Sun Jul 17 23:55:02 2016 +0200

    Binary: Simple serialization test works


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

2a7b4e811470ee1cc57dc3dff30f224a4e4ca2c3
 compiler/utils/Binary.hs         | 9 ++++++---
 libraries/ghci/GHCi/TH/Binary.hs | 9 ++++++---
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 8ac57bf..a82e55f 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -80,7 +80,7 @@ import Data.Time
 import Type.Reflection
 import Type.Reflection.Unsafe
 import Data.Kind (Type)
-import GHC.Exts (RuntimeRep)
+import GHC.Exts (TYPE, RuntimeRep)
 #else
 import Data.Typeable
 #endif
@@ -583,11 +583,13 @@ instance Binary TyCon where
 
 #if MIN_VERSION_base(4,10,0)
 putTypeRep :: BinHandle -> TypeRep a -> IO ()
--- Special handling for Type, (->), and RuntimeRep due to recursive kind
+-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind
 -- relations.
 -- See Note [Mutually recursive representations of primitive types]
 putTypeRep bh rep
   | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type)
+  = put_ bh (5 :: Word8)
+  | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep TYPE)
   = put_ bh (0 :: Word8)
   | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep)
   = put_ bh (1 :: Word8)
@@ -607,7 +609,8 @@ getTypeRepX :: BinHandle -> IO TypeRepX
 getTypeRepX bh = do
     tag <- get bh :: IO Word8
     case tag of
-        0 -> return $ TypeRepX (typeRep :: TypeRep Type)
+        5 -> return $ TypeRepX (typeRep :: TypeRep Type)
+        0 -> return $ TypeRepX (typeRep :: TypeRep TYPE)
         1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep)
         2 -> return $ TypeRepX (typeRep :: TypeRep (->))
         3 -> do con <- get bh :: IO TyCon
diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs
index 267cc03..86960e2 100644
--- a/libraries/ghci/GHCi/TH/Binary.hs
+++ b/libraries/ghci/GHCi/TH/Binary.hs
@@ -14,7 +14,7 @@ import qualified Data.ByteString as B
 import Type.Reflection
 import Type.Reflection.Unsafe
 import Data.Kind (Type)
-import GHC.Exts (RuntimeRep)
+import GHC.Exts (TYPE, RuntimeRep)
 #else
 import Data.Typeable
 #endif
@@ -85,11 +85,13 @@ instance Binary TyCon where
     get = mkTyCon <$> get <*> get <*> get
 
 putTypeRep :: TypeRep a -> Put
--- Special handling for Type, (->), and RuntimeRep due to recursive kind
+-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind
 -- relations.
 -- See Note [Mutually recursive representations of primitive types]
 putTypeRep rep
   | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type)
+  = put (5 :: Word8)
+  | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep TYPE)
   = put (0 :: Word8)
   | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep)
   = put (1 :: Word8)
@@ -109,7 +111,8 @@ getTypeRepX :: Get TypeRepX
 getTypeRepX = do
     tag <- get :: Get Word8
     case tag of
-        0 -> return $ TypeRepX (typeRep :: TypeRep Type)
+        5 -> return $ TypeRepX (typeRep :: TypeRep Type)
+        0 -> return $ TypeRepX (typeRep :: TypeRep TYPE)
         1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep)
         2 -> return $ TypeRepX (typeRep :: TypeRep (->))
         3 -> do con <- get :: Get TyCon