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

[git at git.haskell.org]

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

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

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

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

    Finally serialization is both general and correct


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

8a893ff81366cd3ff581db54fe94330ae5f2bc54
 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 d0cbae5..c5fc8cb 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -614,15 +614,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"