[commit: ghc] wip/ttypeable: Binary: Simple serialization test works (6fad3f8)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/6fad3f8cea6599dc9f1ea39241358df2ab454a29/ghc

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

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

    Binary: Simple serialization test works


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

6fad3f8cea6599dc9f1ea39241358df2ab454a29
 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 1e10b2a..d0175b7 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -82,7 +82,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
@@ -591,11 +591,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)
@@ -615,7 +617,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 5e052f7..5710555 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
@@ -83,11 +83,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)
@@ -107,7 +109,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