- Pattern signatures must be identical to the type expected for the pattern;
see Note [Pattern coercions]
- We now signal an appropriate error if an equality coercion would be needed
(instead of just generating Core that doesn't typecheck)
MERGE TO 6.10
import TcType
import {- Kind parts of -} Type
import Var
import TcType
import {- Kind parts of -} Type
import Var
import TyCon
import Class
import Name
import TyCon
import Class
import Name
-> LHsType Name
-> BoxySigmaType
-> TcM (TcType, -- The type to use for "inside" the signature
-> LHsType Name
-> BoxySigmaType
-> TcM (TcType, -- The type to use for "inside" the signature
- [(Name,TcType)]) -- The new bit of type environment, binding
+ [(Name, TcType)], -- The new bit of type environment, binding
-- the scoped type variables
-- the scoped type variables
+ CoercionI) -- Coercion due to unification with actual ty
tcPatSig ctxt sig res_ty
= do { (sig_tvs, sig_ty) <- tcHsPatSigType ctxt sig
; if null sig_tvs then do {
-- The type signature binds no type variables,
-- and hence is rigid, so use it to zap the res_ty
tcPatSig ctxt sig res_ty
= do { (sig_tvs, sig_ty) <- tcHsPatSigType ctxt sig
; if null sig_tvs then do {
-- The type signature binds no type variables,
-- and hence is rigid, so use it to zap the res_ty
- boxyUnify sig_ty res_ty
- ; return (sig_ty, [])
+ coi <- boxyUnify sig_ty res_ty
+ ; return (sig_ty, [], coi)
} else do {
-- Type signature binds at least one scoped type variable
} else do {
-- Type signature binds at least one scoped type variable
-- unifying, and reading out the results.
-- This is a strictly local operation.
; box_tvs <- mapM tcInstBoxyTyVar sig_tvs
-- unifying, and reading out the results.
-- This is a strictly local operation.
; box_tvs <- mapM tcInstBoxyTyVar sig_tvs
- ; boxyUnify (substTyWith sig_tvs (mkTyVarTys box_tvs) sig_ty) res_ty
+ ; coi <- boxyUnify (substTyWith sig_tvs (mkTyVarTys box_tvs) sig_ty)
+ res_ty
; sig_tv_tys <- mapM readFilledBox box_tvs
-- Check that each is bound to a distinct type variable,
; sig_tv_tys <- mapM readFilledBox box_tvs
-- Check that each is bound to a distinct type variable,
; check binds_in_scope tv_binds
-- Phew!
; check binds_in_scope tv_binds
-- Phew!
- ; return (res_ty, tv_binds)
+ ; return (res_ty, tv_binds, coi)
} }
where
check _ [] = return ()
} }
where
check _ [] = return ()
-- Type signatures in patterns
-- See Note [Pattern coercions] below
tc_pat pstate (SigPatIn pat sig_ty) pat_ty thing_inside
-- Type signatures in patterns
-- See Note [Pattern coercions] below
tc_pat pstate (SigPatIn pat sig_ty) pat_ty thing_inside
- = do { (inner_ty, tv_binds) <- tcPatSig (patSigCtxt pstate) sig_ty pat_ty
+ = do { (inner_ty, tv_binds, coi) <- tcPatSig (patSigCtxt pstate) sig_ty
+ pat_ty
+ ; unless (isIdentityCoercion coi) $
+ failWithTc (badSigPat pat_ty)
; (pat', tvs, res) <- tcExtendTyVarEnv2 tv_binds $
tc_lpat pat inner_ty pstate thing_inside
; return (SigPatOut pat' inner_ty, tvs, res) }
; (pat', tvs, res) <- tcExtendTyVarEnv2 tv_binds $
tc_lpat pat inner_ty pstate thing_inside
; return (SigPatOut pat' inner_ty, tvs, res) }
= hang (ptext (sLit "Illegal polymorphic type signature in pattern:"))
2 (ppr sig_ty)
= hang (ptext (sLit "Illegal polymorphic type signature in pattern:"))
2 (ppr sig_ty)
+badSigPat :: TcType -> SDoc
+badSigPat pat_ty = ptext (sLit "Pattern signature must exactly match:") <+>
+ ppr pat_ty
+
badTypePat :: Pat Name -> SDoc
badTypePat pat = ptext (sLit "Illegal type pattern") <+> ppr pat
badTypePat :: Pat Name -> SDoc
badTypePat pat = ptext (sLit "Illegal type pattern") <+> ppr pat