Proper error message for unsupported pattern signatures

- 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

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 3a8326f..8ea9b13 100644 (file)
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -35,6 +35,7 @@ import TcIface
 import TcType
 import {- Kind parts of -} Type
 import Var
+import Coercion
 import TyCon
 import Class
 import Name
@@ -763,16 +764,17 @@ tcPatSig :: UserTypeCtxt
         -> 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
+                 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
-                 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
@@ -795,7 +797,8 @@ tcPatSig ctxt sig res_ty
                -- 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,
@@ -805,7 +808,7 @@ tcPatSig ctxt sig res_ty
        ; check binds_in_scope tv_binds
        
                -- Phew!
-       ; return (res_ty, tv_binds)
+       ; return (res_ty, tv_binds, coi)
        } }
   where
     check _ [] = return ()

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 2a2409e..fd28455 100644 (file)
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -422,7 +422,10 @@ tc_pat pstate (orig@(ViewPat expr pat _)) overall_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) }
@@ -992,6 +995,10 @@ polyPatSig 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