[commit: ghc] wip/T15809: Tc-tracing, and order of arguments only (4e42a78)

[git at git.haskell.org]

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

On branch  : wip/T15809
Link       : http://ghc.haskell.org/trac/ghc/changeset/4e42a78536554b5edc6b9623bf3592c9712ef279/ghc

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

commit 4e42a78536554b5edc6b9623bf3592c9712ef279
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Oct 31 08:31:38 2018 +0000

    Tc-tracing, and order of arguments only
    
    I changed the order of arguments to reportAllUnsolved,
    and the tc-tracing that surrounds it.
    
    No change in behaviour


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

4e42a78536554b5edc6b9623bf3592c9712ef279
 compiler/typecheck/TcErrors.hs   | 29 ++++++++++++++++-------------
 compiler/typecheck/TcRnMonad.hs  |  2 ++
 compiler/typecheck/TcSimplify.hs |  4 ----
 3 files changed, 18 insertions(+), 17 deletions(-)

diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 6443fbd..3a124b4 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -146,8 +146,9 @@ reportUnsolved wanted
                                 | warn_out_of_scope      = HoleWarn
                                 | otherwise              = HoleDefer
 
-       ; report_unsolved binds_var type_errors expr_holes
-          type_holes out_of_scope_holes wanted
+       ; report_unsolved type_errors expr_holes
+                         type_holes out_of_scope_holes
+                         binds_var wanted
 
        ; ev_binds <- getTcEvBindsMap binds_var
        ; return (evBindMapBinds ev_binds)}
@@ -162,8 +163,8 @@ reportUnsolved wanted
 reportAllUnsolved :: WantedConstraints -> TcM ()
 reportAllUnsolved wanted
   = do { ev_binds <- newNoTcEvBinds
-       ; report_unsolved ev_binds TypeError
-                         HoleError HoleError HoleError wanted }
+       ; report_unsolved TypeError HoleError HoleError HoleError
+                         ev_binds wanted }
 
 -- | Report all unsolved goals as warnings (but without deferring any errors to
 -- run-time). See Note [Safe Haskell Overlapping Instances Implementation] in
@@ -171,22 +172,23 @@ reportAllUnsolved wanted
 warnAllUnsolved :: WantedConstraints -> TcM ()
 warnAllUnsolved wanted
   = do { ev_binds <- newTcEvBinds
-       ; report_unsolved ev_binds (TypeWarn NoReason)
-                         HoleWarn HoleWarn HoleWarn wanted }
+       ; report_unsolved (TypeWarn NoReason) HoleWarn HoleWarn HoleWarn
+                         ev_binds wanted }
 
 -- | Report unsolved goals as errors or warnings.
-report_unsolved :: EvBindsVar        -- cec_binds
-                -> TypeErrorChoice   -- Deferred type errors
+report_unsolved :: TypeErrorChoice   -- Deferred type errors
                 -> HoleChoice        -- Expression holes
                 -> HoleChoice        -- Type holes
                 -> HoleChoice        -- Out of scope holes
+                -> EvBindsVar        -- cec_binds
                 -> WantedConstraints -> TcM ()
-report_unsolved mb_binds_var type_errors expr_holes
-    type_holes out_of_scope_holes wanted
+report_unsolved type_errors expr_holes
+    type_holes out_of_scope_holes binds_var wanted
   | isEmptyWC wanted
   = return ()
   | otherwise
-  = do { traceTc "reportUnsolved warning/error settings:" $
+  = do { traceTc "reportUnsolved {" empty
+       ; traceTc "reportUnsolved warning/error settings:" $
            vcat [ text "type errors:" <+> ppr type_errors
                 , text "expr holes:" <+> ppr expr_holes
                 , text "type holes:" <+> ppr type_holes
@@ -219,10 +221,11 @@ report_unsolved mb_binds_var type_errors expr_holes
                                  -- See Trac #15539 and c.f. setting ic_status
                                  -- in TcSimplify.setImplicationStatus
                             , cec_warn_redundant = warn_redundant
-                            , cec_binds    = mb_binds_var }
+                            , cec_binds    = binds_var }
 
        ; tc_lvl <- getTcLevel
-       ; reportWanteds err_ctxt tc_lvl wanted }
+       ; reportWanteds err_ctxt tc_lvl wanted
+       ; traceTc "reportUnsolved }" empty }
 
 --------------------------------------------
 --      Internal functions
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index a033bc4..b923d49 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -1532,8 +1532,10 @@ pushLevelAndCaptureConstraints :: TcM a -> TcM (TcLevel, WantedConstraints, a)
 pushLevelAndCaptureConstraints thing_inside
   = do { env <- getLclEnv
        ; let tclvl' = pushTcLevel (tcl_tclvl env)
+       ; traceTc "pushLevelAndCaptureConstraints {" (ppr tclvl')
        ; (res, lie) <- setLclEnv (env { tcl_tclvl = tclvl' }) $
                        captureConstraints thing_inside
+       ; traceTc "pushLevelAndCaptureConstraints }" (ppr tclvl')
        ; return (tclvl', lie, res) }
 
 pushTcLevelM_ :: TcM a -> TcM a
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 6ef62c8..c424a02 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -178,9 +178,7 @@ solveEqualities thing_inside
           -- vars to LiftedRep. This is needed to avoid #14991.
        ; traceTc "End solveEqualities }" empty
 
-       ; traceTc "reportAllUnsolved {" empty
        ; reportAllUnsolved final_wc
-       ; traceTc "reportAllUnsolved }" empty
        ; return result }
 
 -- | Simplify top-level constraints, but without reporting any unsolved
@@ -514,9 +512,7 @@ simplifyDefault theta
   = do { traceTc "simplifyDefault" empty
        ; wanteds  <- newWanteds DefaultOrigin theta
        ; unsolved <- runTcSDeriveds (solveWantedsAndDrop (mkSimpleWC wanteds))
-       ; traceTc "reportUnsolved {" empty
        ; reportAllUnsolved unsolved
-       ; traceTc "reportUnsolved }" empty
        ; return () }
 
 ------------------