[commit: ghc] wip/gadtpm: Take environment EvVars into account when checking pattern matching (2476df2)

[git at git.haskell.org]

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

On branch  : wip/gadtpm
Link       : http://ghc.haskell.org/trac/ghc/changeset/2476df238f2aec62b54a08a1f2090fbb66e3bdee/ghc

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

commit 2476df238f2aec62b54a08a1f2090fbb66e3bdee
Author: George Karachalias <george.karachalias at gmail.com>
Date:   Wed Feb 18 12:18:02 2015 +0100

    Take environment EvVars into account when checking pattern matching


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

2476df238f2aec62b54a08a1f2090fbb66e3bdee
 compiler/deSugar/Check.hs | 3 ++-
 compiler/deSugar/Match.hs | 6 ++----
 2 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 0e5f491..f525d58 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -570,7 +570,8 @@ wt sig (_, vec)
   | length sig == length vec = do
       (tys, cs) <- inferTyPmPats vec
       cs' <- zipWithM newEqPmM sig tys -- The vector should match the signature type
-      isSatisfiable (listToBag cs' `unionBags` cs) -- {COMEHERE: LOAD ENV CONSTRAINTS}
+      env_cs <- getDictsDs
+      isSatisfiable (listToBag cs' `unionBags` cs `unionBags` env_cs)
   | otherwise = pprPanic "wt: length mismatch:" (ppr sig $$ ppr vec)
 
 {-
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index 2092598..e3928bd 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -705,10 +705,8 @@ matchWrapper ctxt (MG { mg_alts = matches
   where
     mk_eqn_info (L _ (Match pats _ grhss))
       = do { let upats  = map unLoc pats
-           --       dicts  = toTcTypeBag (collectEvVarsPats upats) -- check rhs with constraints from match in scope -- Only TcTyVars
-           -- ; match_result <- addDictsDs dicts $ dsGRHSs ctxt upats grhss rhs_ty
-           -- {COMEHERE: ACTIVATE THIS BEFORE THE END, TO BE ABLE TO CATCH #4139}
-           ; match_result <- dsGRHSs ctxt upats grhss rhs_ty
+                 dicts  = toTcTypeBag (collectEvVarsPats upats) -- check rhs with constraints from match in scope -- Only TcTyVars
+           ; match_result <- addDictsDs dicts $ dsGRHSs ctxt upats grhss rhs_ty
            ; return (EqnInfo { eqn_pats = upats, eqn_rhs  = match_result}) }
 
     handleWarnings = if isGenerated origin