[commit: ghc] wip/T8584: Check provided constraints from pattern type signature (10d5a7b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T8584
Link       : http://ghc.haskell.org/trac/ghc/changeset/10d5a7be074f65322aa384df62d20c2d9851eaa1/ghc

>---------------------------------------------------------------

commit 10d5a7be074f65322aa384df62d20c2d9851eaa1
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Wed Oct 22 18:06:50 2014 +0800

    Check provided constraints from pattern type signature


>---------------------------------------------------------------

10d5a7be074f65322aa384df62d20c2d9851eaa1
 compiler/typecheck/TcPatSyn.lhs | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs
index 6a329ac..c0ef09b 100644
--- a/compiler/typecheck/TcPatSyn.lhs
+++ b/compiler/typecheck/TcPatSyn.lhs
@@ -39,7 +39,7 @@ import Bag
 import TcEvidence
 import BuildTyCl
 import TypeRep
-import Control.Monad (forM)
+import Control.Monad (forM, forM_)
 
 #include "HsVersions.h"
 \end{code}
@@ -136,6 +136,15 @@ tcCheckPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = details,
        ; let ex_tvs'     = varSetElems ex_vars'
              prov_theta' = map evVarPred prov_dicts'
 
+
+       ; checkConstraints skol_info ex_tvs' prov_dicts' $ do
+           ctLoc <- getCtLoc PatSigOrigin
+           forM_ prov_theta $ \pred -> do
+               let ctEv = CtWanted{ ctev_pred = pred
+                                  , ctev_evar = panic "ctev_evar"
+                                  , ctev_loc = ctLoc
+                                  }
+               emitFlat $ mkNonCanonical ctEv
        ; let (args', _wraps) = unzip arg_w_wraps
              -- wrap = foldr (<.>) idHsWrapper wraps
              wrap = idHsWrapper