[commit: ghc] master: Define TcSimplify.simplifyTopImplic and use it (2d3cb34)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2d3cb34a603ed0008b551cbc3e16b69d7f6dbbe6/ghc

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

commit 2d3cb34a603ed0008b551cbc3e16b69d7f6dbbe6
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Mar 10 12:50:05 2017 +0000

    Define TcSimplify.simplifyTopImplic and use it
    
    A very small refactoring


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

2d3cb34a603ed0008b551cbc3e16b69d7f6dbbe6
 compiler/typecheck/TcDerivInfer.hs |  2 +-
 compiler/typecheck/TcPatSyn.hs     |  7 ++-----
 compiler/typecheck/TcSimplify.hs   | 14 ++++++++++++--
 3 files changed, 15 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs
index 4ac0741..93dcf43 100644
--- a/compiler/typecheck/TcDerivInfer.hs
+++ b/compiler/typecheck/TcDerivInfer.hs
@@ -666,7 +666,7 @@ simplifyDeriv pred tvs thetas
        -- See Note [Error reporting for deriving clauses]
        -- See also Note [Exotic derived instance contexts], which are caught
        -- in this line of code.
-       ; _ <- simplifyTop $ mkImplicWC leftover_implic
+       ; simplifyTopImplic leftover_implic
 
        ; return (substTheta subst_skol min_theta) }
 
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index cbeb231..15895b5 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -168,7 +168,7 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details
               ; args'      <- zipWithM (tc_arg subst) arg_names arg_tys
               ; return (ex_tvs', prov_dicts, args') }
 
-       ; let skol_info = SigSkol (PatSynCtxt name) (mkPhiTy req_theta pat_ty)
+       ; let skol_info = SigSkol (PatSynCtxt name) pat_ty []
                          -- The type here is a bit bogus, but we do not print
                          -- the type for PatSynCtxt, so it doesn't matter
                          -- See TcRnTypes Note [Skolem info for pattern synonyms]
@@ -176,10 +176,7 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details
 
        -- Solve the constraints now, because we are about to make a PatSyn,
        -- which should not contain unification variables and the like (Trac #10997)
-       ; empty_binds <- simplifyTop (mkImplicWC implics)
-
-       -- Since all the inputs are implications the returned bindings will be empty
-       ; MASSERT2( isEmptyBag empty_binds, ppr empty_binds )
+       ; simplifyTopImplic implics
 
        -- ToDo: in the bidirectional case, check that the ex_tvs' are all distinct
        -- Otherwise we may get a type error when typechecking the builder,
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index e2598b5..d3fd768 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -5,7 +5,7 @@ module TcSimplify(
        growThetaTyVars,
        simplifyAmbiguityCheck,
        simplifyDefault,
-       simplifyTop, captureTopConstraints,
+       simplifyTop, simplifyTopImplic, captureTopConstraints,
        simplifyInteractive, solveEqualities,
        simplifyWantedsTcM,
        tcCheckSatisfiability,
@@ -81,6 +81,15 @@ captureTopConstraints thing_inside
                 -- This call to reportUnsolved is the reason
                 -- this function is here instead of TcRnMonad
 
+simplifyTopImplic :: Bag Implication -> TcM ()
+simplifyTopImplic implics
+  = do { empty_binds <- simplifyTop (mkImplicWC implics)
+
+       -- Since all the inputs are implications the returned bindings will be empty
+       ; MASSERT2( isEmptyBag empty_binds, ppr empty_binds )
+
+       ; return () }
+
 simplifyTop :: WantedConstraints -> TcM (Bag EvBind)
 -- Simplify top-level constraints
 -- Usually these will be implications,
@@ -729,7 +738,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
               , text "psig_theta =" <+> ppr psig_theta
               , text "bound_theta =" <+> ppr bound_theta
               , text "full_theta =" <+> ppr full_theta
-              , text "qtvs =" <+> ppr qtvs
+              , text "all_qtvs =" <+> ppr all_qtvs
               , text "implic =" <+> ppr implic ]
 
        ; return ( qtvs, full_theta_vars, TcEvBinds ev_binds_var ) }
@@ -878,6 +887,7 @@ decideQuantification infer_mode name_taus psig_theta candidates
            (vcat [ text "infer_mode:"   <+> ppr infer_mode
                  , text "gbl_cand:"     <+> ppr gbl_cand
                  , text "quant_cand:"   <+> ppr quant_cand
+                 , text "zonked_taus:" <+> ppr zonked_taus
                  , text "gbl_tvs:"      <+> ppr gbl_tvs
                  , text "mono_tvs:"     <+> ppr mono_tvs
                  , text "cand_tvs"      <+> ppr cand_tvs