[commit: ghc] wip/ttypeable: Finally serialization is both general and correct (9c8dd2d)
git at git.haskell.org
git at git.haskell.org
Mon Jun 6 11:12:42 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/ttypeable
Link : http://ghc.haskell.org/trac/ghc/changeset/9c8dd2d28460a6cd652ac481d5d1ffe39bda33d8/ghc
>---------------------------------------------------------------
commit 9c8dd2d28460a6cd652ac481d5d1ffe39bda33d8
Author: Ben Gamari <ben at smart-cactus.org>
Date: Wed Mar 16 12:16:20 2016 +0100
Finally serialization is both general and correct
>---------------------------------------------------------------
9c8dd2d28460a6cd652ac481d5d1ffe39bda33d8
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 2dd2182..a346e0d 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"
More information about the ghc-commits
mailing list