diff options
Diffstat (limited to 'compiler/GHC/Tc/Solver.hs')
| -rw-r--r-- | compiler/GHC/Tc/Solver.hs | 14 |
1 files changed, 5 insertions, 9 deletions
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs index 40266c3319..f790d4e98c 100644 --- a/compiler/GHC/Tc/Solver.hs +++ b/compiler/GHC/Tc/Solver.hs @@ -1851,11 +1851,13 @@ neededEvVars implic@(Implic { ic_given = givens ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; let seeds1 = foldr add_implic_seeds old_needs implics - seeds2 = foldEvBindMap add_wanted seeds1 ev_binds + seeds2 = nonDetStrictFoldEvBindMap add_wanted seeds1 ev_binds + -- It's OK to use a non-deterministic fold here + -- because add_wanted is commutative seeds3 = seeds2 `unionVarSet` tcvs need_inner = findNeededEvVars ev_binds seeds3 live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds - need_outer = foldEvBindMap del_ev_bndr need_inner live_ev_binds + need_outer = varSetMinusEvBindMap need_inner live_ev_binds `delVarSetList` givens ; TcS.setTcEvBindsMap ev_binds_var live_ev_binds @@ -1879,9 +1881,6 @@ neededEvVars implic@(Implic { ic_given = givens | is_given = ev_var `elemVarSet` needed | otherwise = True -- Keep all wanted bindings - del_ev_bndr :: EvBind -> VarSet -> VarSet - del_ev_bndr (EvBind { eb_lhs = v }) needs = delVarSet needs v - add_wanted :: EvBind -> VarSet -> VarSet add_wanted (EvBind { eb_is_given = is_given, eb_rhs = rhs }) needs | is_given = needs -- Add the rhs vars of the Wanted bindings only @@ -2377,7 +2376,7 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs seed_skols = mkVarSet skols `unionVarSet` mkVarSet given_ids `unionVarSet` foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` - foldEvBindMap add_one_bind emptyVarSet binds + evBindMapToVarSet binds -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) -- Include the EvIds of any non-floating constraints @@ -2402,9 +2401,6 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) } where - add_one_bind :: EvBind -> VarSet -> VarSet - add_one_bind bind acc = extendVarSet acc (evBindVar bind) - add_non_flt_ct :: Ct -> VarSet -> VarSet add_non_flt_ct ct acc | isDerivedCt ct = acc | otherwise = extendVarSet acc (ctEvId ct) |