[commit: ghc] wip/generalized-arrow: Another recursive serialization case (9453c38)

[git at git.haskell.org]

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

On branch  : wip/generalized-arrow
Link       : http://ghc.haskell.org/trac/ghc/changeset/9453c38a9b71312190d4c63baf95c7d08e124042/ghc

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

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

    Another recursive serialization case


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

9453c38a9b71312190d4c63baf95c7d08e124042
 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 b26778e..879a67f 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -580,19 +580,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"
@@ -603,13 +606,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 fcd81d3..e1782f9 100644
--- a/libraries/ghci/GHCi/TH/Binary.hs
+++ b/libraries/ghci/GHCi/TH/Binary.hs
@@ -80,19 +80,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"
@@ -103,13 +106,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 _ ->