[commit: ghc] master: When zonking, get rid of empty implications (28c1461)

[Simon Peyton Jones]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/28c14617606661d639c6f7676034c45e4bcab4f1

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

commit 28c14617606661d639c6f7676034c45e4bcab4f1
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sat Apr 6 21:27:11 2013 +0100

    When zonking, get rid of empty implications
    
    Zonking can make implications empty becuase it gets rid
    of type-function flattening equalities

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

 compiler/typecheck/TcMType.lhs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index f0dd6e9..d8d4b63 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -641,7 +641,7 @@ skolemiseSigTv tv
 \end{code}
 
 \begin{code}
-zonkImplication :: Implication -> TcM Implication
+zonkImplication :: Implication -> TcM (Bag Implication)
 zonkImplication implic@(Implic { ic_untch  = untch
                                , ic_binds  = binds_var
                                , ic_skols  = skols
@@ -653,11 +653,14 @@ zonkImplication implic@(Implic { ic_untch  = untch
        ; given'  <- mapM zonkEvVar given
        ; info'   <- zonkSkolemInfo info
        ; wanted' <- zonkWCRec binds_var untch wanted
-       ; return (implic { ic_skols = skols'
-                        , ic_given = given'
-                        , ic_fsks  = []  -- Zonking removes all FlatSkol tyvars
-                        , ic_wanted = wanted'
-                        , ic_info = info' }) }
+       ; if isEmptyWC wanted' 
+         then return emptyBag
+         else return $ unitBag $
+              implic { ic_fsks   = []  -- Zonking removes all FlatSkol tyvars
+                     , ic_skols  = skols'
+                     , ic_given  = given'
+                     , ic_wanted = wanted'
+                     , ic_info   = info' } }
 
 zonkEvVar :: EvVar -> TcM EvVar
 zonkEvVar var = do { ty' <- zonkTcType (varType var)
@@ -675,7 +678,7 @@ zonkWCRec :: EvBindsVar
           -> WantedConstraints -> TcM WantedConstraints
 zonkWCRec binds_var untch (WC { wc_flat = flat, wc_impl = implic, wc_insol = insol })
   = do { flat'   <- zonkFlats binds_var untch flat
-       ; implic' <- mapBagM zonkImplication implic
+       ; implic' <- flatMapBagM zonkImplication implic
        ; insol'  <- zonkCts insol -- No need to do the more elaborate zonkFlats thing
        ; return (WC { wc_flat = flat', wc_impl = implic', wc_insol = insol' }) }