[commit: ghc] wip/ttypeable: Finally serialization is both general and correct (e762e12)

[git at git.haskell.org]

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

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

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

commit e762e1242cde7fcd12b1d2560ea2bd07bd3b44fb
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Mar 16 12:16:20 2016 +0100

    Finally serialization is both general and correct


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

e762e1242cde7fcd12b1d2560ea2bd07bd3b44fb
 compiler/utils/Binary.hs         | 13 +++++--------
 libraries/ghci/GHCi/TH/Binary.hs | 11 ++++-------
 2 files changed, 9 insertions(+), 15 deletions(-)

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 52bc33f..e7f0183 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -603,15 +603,12 @@ getTypeRepX bh = do
                 TypeRepX x <- getTypeRepX bh
                 case typeRepKind f of
                     TRFun arg _ ->
-                        case (typeRep :: TypeRep Type) `eqTypeRep` arg of
-                            Just HRefl ->  -- FIXME: Generalize (->)
-                                case x `eqTypeRep` arg of
-                                    Just HRefl ->
-                                        pure $ TypeRepX $ mkTrApp f x
-                                    _ -> fail "getTypeRepX: Kind mismatch"
-                            Nothing -> fail "getTypeRepX: Arrow of non-Type argument"
+                        case arg `eqTypeRep` typeRepKind x of
+                            Just HRefl ->
+                                pure $ TypeRepX $ mkTrApp f x
+                            _ -> fail "getTypeRepX: Kind mismatch"
                     _ -> fail "getTypeRepX: Applied non-arrow type"
-        _ -> fail "Binary: Invalid TypeRepX"
+        _ -> fail "getTypeRepX: Invalid TypeRepX"
 
 instance Typeable a => Binary (TypeRep (a :: k)) where
     put_ = putTypeRep
diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs
index 8d297a1..573a9e4 100644
--- a/libraries/ghci/GHCi/TH/Binary.hs
+++ b/libraries/ghci/GHCi/TH/Binary.hs
@@ -106,13 +106,10 @@ getTypeRepX = do
                 TypeRepX x <- getTypeRepX
                 case typeRepKind f of
                     TRFun arg _ ->
-                        case (typeRep :: TypeRep Type) `eqTypeRep` arg of
-                            Just HRefl -> -- FIXME: Generalize (->)
-                                case arg `eqTypeRep` x of
-                                    Just HRefl ->
-                                        pure $ TypeRepX $ mkTrApp f x
-                                    _ -> fail "getTypeRepX: Kind mismatch"
-                            _ -> fail "getTypeRepX: Arrow of non-Type argument"
+                        case arg `eqTypeRep` typeRepKind x of
+                            Just HRefl ->
+                                pure $ TypeRepX $ mkTrApp f x
+                            _ -> fail "getTypeRepX: Kind mismatch"
                     _ -> fail "getTypeRepX: Applied non-arrow type"
         _ -> fail "getTypeRepX: Invalid TypeRepX"