[commit: ghc] wip/ttypeable: Another recursive serialization case (01820df)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/01820df734a204f1e824547ac1c39178cb0c97b8/ghc

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

commit 01820df734a204f1e824547ac1c39178cb0c97b8
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Mar 16 14:05:43 2016 +0100

    Another recursive serialization case


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

01820df734a204f1e824547ac1c39178cb0c97b8
 compiler/utils/Binary.hs         | 14 +++++++++-----
 libraries/ghci/GHCi/TH/Binary.hs | 14 +++++++++-----
 2 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 366fb26..23b90f5 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -591,19 +591,22 @@ instance Binary TyCon where
 
 #if MIN_VERSION_base(4,9,0)
 putTypeRep :: BinHandle -> TypeRep a -> IO ()
--- Special handling for Type and RuntimeRep due to recursive kind relations.
+-- 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 (0 :: Word8)
   | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep)
   = put_ bh (1 :: Word8)
+  | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep (->))
+  = put_ bh (2 :: Word8)
 putTypeRep bh rep@(TRCon con) = do
-    put_ bh (2 :: Word8)
+    put_ bh (3 :: Word8)
     put_ bh con
     putTypeRep bh (typeRepKind rep)
 putTypeRep bh (TRApp f x) = do
-    put_ bh (3 :: Word8)
+    put_ bh (4 :: Word8)
     putTypeRep bh f
     putTypeRep bh x
 putTypeRep _ _ = fail "putTypeRep: Impossible"
@@ -614,13 +617,14 @@ getTypeRepX bh = do
     case tag of
         0 -> return $ TypeRepX (typeRep :: TypeRep Type)
         1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep)
-        2 -> do con <- get bh :: IO TyCon
+        2 -> return $ TypeRepX (typeRep :: TypeRep (->))
+        3 -> do con <- get bh :: IO TyCon
                 TypeRepX rep_k <- getTypeRepX bh
                 case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of
                     Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k
                     Nothing    -> fail "getTypeRepX: Kind mismatch"
 
-        3 -> do TypeRepX f <- getTypeRepX bh
+        4 -> do TypeRepX f <- getTypeRepX bh
                 TypeRepX x <- getTypeRepX bh
                 case typeRepKind f of
                     TRFun arg _ ->
diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs
index bcf58bb..c351cd1 100644
--- a/libraries/ghci/GHCi/TH/Binary.hs
+++ b/libraries/ghci/GHCi/TH/Binary.hs
@@ -83,19 +83,22 @@ instance Binary TyCon where
     get = mkTyCon <$> get <*> get <*> get
 
 putTypeRep :: TypeRep a -> Put
--- Special handling for Type and RuntimeRep due to recursive kind relations.
+-- 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 (0 :: Word8)
   | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep)
   = put (1 :: Word8)
+  | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep (->))
+  = put (2 :: Word8)
 putTypeRep rep@(TRCon con) = do
-    put (2 :: Word8)
+    put (3 :: Word8)
     put con
     putTypeRep (typeRepKind rep)
 putTypeRep (TRApp f x) = do
-    put (3 :: Word8)
+    put (4 :: Word8)
     putTypeRep f
     putTypeRep x
 putTypeRep _ = fail "putTypeRep: Impossible"
@@ -106,13 +109,14 @@ getTypeRepX = do
     case tag of
         0 -> return $ TypeRepX (typeRep :: TypeRep Type)
         1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep)
-        2 -> do con <- get :: Get TyCon
+        2 -> return $ TypeRepX (typeRep :: TypeRep (->))
+        3 -> do con <- get :: Get TyCon
                 TypeRepX rep_k <- getTypeRepX
                 case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of
                     Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k
                     Nothing    -> fail "getTypeRepX: Kind mismatch"
 
-        3 -> do TypeRepX f <- getTypeRepX
+        4 -> do TypeRepX f <- getTypeRepX
                 TypeRepX x <- getTypeRepX
                 case typeRepKind f of
                     TRFun arg _ ->