+ ; let givens = red_givens env
+ (given_eqs0, given_dicts0) = partition isEqInst givens
+ (wanted_eqs0, wanted_non_eqs) = partition isEqInst wanteds
+ (wanted_implics0, wanted_dicts) = partition isImplicInst wanted_non_eqs
+
+ -- We want to add as wanted equalities those that (transitively)
+ -- occur in superclass contexts of wanted class constraints.
+ -- See Note [Ancestor Equalities]
+ ; ancestor_eqs <- ancestorEqualities wanted_dicts
+ ; let wanted_eqs = wanted_eqs0 ++ ancestor_eqs
+ ; traceTc $ text "reduceContext: ancestor eqs" <+> ppr ancestor_eqs
+
+ -- 1. Normalise the *given* *equality* constraints
+ ; (given_eqs, eliminate_skolems) <- normaliseGivenEqs given_eqs0
+
+ -- 2. Normalise the *given* *dictionary* constraints
+ -- wrt. the toplevel and given equations
+ ; (given_dicts, given_binds) <- normaliseGivenDicts given_eqs
+ given_dicts0
+
+ -- 5. Build the Avail mapping from "given_dicts"
+ ; (init_state, extra_givens) <- getLIE $ do
+ { init_state <- foldlM addGiven emptyAvails given_dicts
+ ; return init_state
+ }
+
+ -- *** ToDo: what to do with the "extra_givens"? For the
+ -- moment I'm simply discarding them, which is probably wrong
+
+ -- 6. Solve the *wanted* *dictionary* constraints (not implications)
+ -- This may expose some further equational constraints...
+ ; (avails, extra_eqs) <- getLIE (reduceList env wanted_dicts init_state)
+ ; (dict_binds, bound_dicts, dict_irreds)
+ <- extractResults avails wanted_dicts
+ ; traceTc $ text "reduceContext extractresults" <+> vcat
+ [ppr avails, ppr wanted_dicts, ppr dict_binds]
+
+ -- Solve the wanted *implications*. In doing so, we can provide
+ -- as "given" all the dicts that were originally given,
+ -- *or* for which we now have bindings,
+ -- *or* which are now irreds
+ ; let implic_env = env { red_givens = givens ++ bound_dicts
+ ++ dict_irreds }
+ ; (implic_binds_s, implic_irreds_s)
+ <- mapAndUnzipM (reduceImplication implic_env) wanted_implics0
+ ; let implic_binds = unionManyBags implic_binds_s
+ implic_irreds = concat implic_irreds_s
+
+ -- Normalise the wanted equality constraints
+ ; eq_irreds <- normaliseWantedEqs given_eqs (wanted_eqs ++ extra_eqs)
+
+ -- Normalise the wanted dictionaries
+ ; let irreds = dict_irreds ++ implic_irreds
+ eqs = eq_irreds ++ given_eqs
+ ; (norm_irreds, normalise_binds) <- normaliseWantedDicts eqs irreds
+
+ -- Figure out whether we should go round again. We do so in either
+ -- two cases:
+ -- (1) If any of the mutable tyvars in givens or irreds has been
+ -- filled in by improvement, there is merit in going around
+ -- again, because we may make further progress.
+ -- (2) If we managed to normalise any dicts, there is merit in going
+ -- around gain, because reduceList may be able to get further.
+ --
+ -- ToDo: We may have exposed new
+ -- equality constraints and should probably go round again
+ -- then as well. But currently we are dropping them on the
+ -- floor anyway.
+
+ ; let all_irreds = norm_irreds ++ eq_irreds
+ ; improvedMetaTy <- anyM isFilledMetaTyVar $ varSetElems $
+ tyVarsOfInsts (givens ++ all_irreds)
+ ; let improvedDicts = not $ isEmptyBag normalise_binds
+ improved = improvedMetaTy || improvedDicts
+
+ -- The old plan (fragile)
+ -- improveed = availsImproved avails
+ -- || (not $ isEmptyBag normalise_binds1)
+ -- || (not $ isEmptyBag normalise_binds2)
+ -- || (any isEqInst irreds)