Commit 48477ba1 authored by sheaf's avatar sheaf
Browse files

Adapt to changes in TypeRep complete patterns

GHC merge request !963 improved warnings in the presence of
COMPLETE annotations. This allows the removal of the Fun pattern
from the complete set.

This patch accounts for the resulting changes in pattern match warnings.
parent 4eb74688
......@@ -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 =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment