Skip to content
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 7 additions & 11 deletions src/Data/Binary/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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 =
Expand Down