[commit: ghc] master: Refactor try_solve_fromInstance in shortCutSolver (e065369)

[git at git.haskell.org]

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

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

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

commit e0653697366670cd65ecedf680c2aa131821d68f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Jun 22 11:28:37 2018 +0100

    Refactor try_solve_fromInstance in shortCutSolver
    
    This patch just removes the CtLoc parameter from trySolveFromInstance,
    since it can just as easily (and more uniformly) be gotten from the
    CtEvidence it is trying to solve.


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

e0653697366670cd65ecedf680c2aa131821d68f
 compiler/typecheck/TcInteract.hs | 30 +++++++++++++++---------------
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 2ad93b0..97d1dde 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -563,7 +563,7 @@ solveOneFromTheOther ev_i ev_w
        ; return (same_level_strategy binds) }
 
   | otherwise   -- Both are Given, levels differ
-  = return (different_level_strategy)
+  = return different_level_strategy
   where
      pred  = ctEvPred ev_i
      loc_i = ctEvLoc ev_i
@@ -573,12 +573,12 @@ solveOneFromTheOther ev_i ev_w
      ev_id_i = ctEvEvId ev_i
      ev_id_w = ctEvEvId ev_w
 
-     different_level_strategy
+     different_level_strategy  -- Both Given
        | isIPPred pred, lvl_w > lvl_i = KeepWork
        | lvl_w < lvl_i                = KeepWork
        | otherwise                    = KeepInert
 
-     same_level_strategy binds        -- Both Given
+     same_level_strategy binds -- Both Given
        | GivenOrigin (InstSC s_i) <- ctLocOrigin loc_i
        = case ctLocOrigin loc_w of
             GivenOrigin (InstSC s_w) | s_w < s_i -> KeepWork
@@ -1012,8 +1012,7 @@ IncoherentInstances is `1`. If we were to do the optimization, the output of
 Note [Shortcut try_solve_from_instance]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The workhorse of the short-cut solver is
-    try_solve_from_instance :: CtLoc
-                            -> (EvBindMap, DictMap CtEvidence)
+    try_solve_from_instance :: (EvBindMap, DictMap CtEvidence)
                             -> CtEvidence       -- Solve this
                             -> MaybeT TcS (EvBindMap, DictMap CtEvidence)
 Note that:
@@ -1103,7 +1102,7 @@ shortCutSolver dflags ev_w ev_i
                      getTcEvBindsMap ev_binds_var
        ; solved_dicts <- getSolvedDicts
 
-       ; mb_stuff <- runMaybeT $ try_solve_from_instance loc_w
+       ; mb_stuff <- runMaybeT $ try_solve_from_instance
                                    (ev_binds, solved_dicts) ev_w
 
        ; case mb_stuff of
@@ -1122,12 +1121,13 @@ shortCutSolver dflags ev_w ev_i
     loc_w = ctEvLoc ev_w
 
     try_solve_from_instance   -- See Note [Shortcut try_solve_from_instance]
-      :: CtLoc -> (EvBindMap, DictMap CtEvidence) -> CtEvidence
+      :: (EvBindMap, DictMap CtEvidence) -> CtEvidence
       -> MaybeT TcS (EvBindMap, DictMap CtEvidence)
-    try_solve_from_instance loc (ev_binds, solved_dicts) ev
+    try_solve_from_instance (ev_binds, solved_dicts) ev
       | let pred = ctEvPred ev
+            loc  = ctEvLoc  ev
       , ClassPred cls tys <- classifyPredType pred
-      = do { inst_res <- lift $ matchGlobalInst dflags True cls tys loc_w
+      = do { inst_res <- lift $ matchGlobalInst dflags True cls tys loc
            ; case inst_res of
                OneInst { lir_new_theta = preds
                        , lir_mk_ev = mk_ev
@@ -1141,9 +1141,9 @@ shortCutSolver dflags ev_w ev_i
                              -- up in a loop while solving recursive dictionaries.
 
                        ; lift $ traceTcS "shortCutSolver: found instance" (ppr preds)
-                       ; lift $ checkReductionDepth loc' pred
+                       ; lift $ checkReductionDepth loc pred
 
-                       ; evc_vs <- mapM (new_wanted_cached solved_dicts') preds
+                       ; evc_vs <- mapM (new_wanted_cached loc' solved_dicts') preds
                                   -- Emit work for subgoals but use our local cache
                                   -- so we can solve recursive dictionaries.
 
@@ -1151,7 +1151,7 @@ shortCutSolver dflags ev_w ev_i
                              ev_binds' = extendEvBinds ev_binds $
                                          mkWantedEvBind (ctEvEvId ev) ev_tm
 
-                       ; foldlM (try_solve_from_instance loc')
+                       ; foldlM try_solve_from_instance
                                 (ev_binds', solved_dicts')
                                 (freshGoals evc_vs) }
 
@@ -1162,12 +1162,12 @@ shortCutSolver dflags ev_w ev_i
     -- Use a local cache of solved dicts while emitting EvVars for new work
     -- We bail out of the entire computation if we need to emit an EvVar for
     -- a subgoal that isn't a ClassPred.
-    new_wanted_cached :: DictMap CtEvidence -> TcPredType -> MaybeT TcS MaybeNew
-    new_wanted_cached cache pty
+    new_wanted_cached :: CtLoc -> DictMap CtEvidence -> TcPredType -> MaybeT TcS MaybeNew
+    new_wanted_cached loc cache pty
       | ClassPred cls tys <- classifyPredType pty
       = lift $ case findDict cache loc_w cls tys of
           Just ctev -> return $ Cached (ctEvExpr ctev)
-          Nothing -> Fresh <$> newWantedNC loc_w pty
+          Nothing   -> Fresh <$> newWantedNC loc pty
       | otherwise = mzero
 
 addFunDepWork :: InertCans -> CtEvidence -> Class -> TcS ()