Commit e0653697 authored by Simon Peyton Jones's avatar Simon Peyton Jones

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.
parent 32eb4199
......@@ -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,7 +573,7 @@ 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
......@@ -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 ()
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment