diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs index 895f43b..671e9fe 100644 --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -994,9 +994,6 @@ instance Binary TypeLitSort where _ -> fail "GHCi.TH.Binary.putTypeLitSort: invalid tag" putTypeRep :: TypeRep a -> Put --- Special handling for TYPE, (->), and RuntimeRep due to recursive kind --- relations. --- See Note [Mutually recursive representations of primitive types] putTypeRep rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put (0 :: Word8) @@ -1008,10 +1005,17 @@ putTypeRep (App f x) = do put (2 :: Word8) putTypeRep f putTypeRep x +#if __GLASGOW_HASKELL__ < 903 +-- N.B. This pattern never matches, +-- even on versions of GHC older than 9.3: +-- a `Fun` typerep will match with the `App` pattern. +-- This match is kept solely for pattern-match warnings, +-- which are incorrect on GHC prior to 9.3. putTypeRep (Fun arg res) = do put (3 :: Word8) putTypeRep arg putTypeRep res +#endif getSomeTypeRep :: Get SomeTypeRep getSomeTypeRep = do @@ -1039,14 +1043,6 @@ getSomeTypeRep = do [ "Applied type: " ++ show f , "To argument: " ++ show x ] - 3 -> do SomeTypeRep arg <- getSomeTypeRep - SomeTypeRep res <- getSomeTypeRep - case typeRepKind arg `eqTypeRep` (typeRep :: TypeRep Type) of - Just HRefl -> - case typeRepKind res `eqTypeRep` (typeRep :: TypeRep Type) of - Just HRefl -> return $ SomeTypeRep $ Fun arg res - Nothing -> failure "Kind mismatch" [] - Nothing -> failure "Kind mismatch" [] _ -> failure "Invalid SomeTypeRep" [] where failure description info =