+ ; let givens = red_givens env
+ (given_eqs0, given_dicts0) = partition isEqInst givens
+ (wanted_eqs0, wanted_dicts) = partition isEqInst wanteds
+
+ -- 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
+
+ -- 3. Solve the *wanted* *equation* constraints
+ ; eq_irreds0 <- solveWantedEqs given_eqs wanted_eqs
+
+ -- 4. Normalise the *wanted* equality constraints with respect to
+ -- each other
+ ; eq_irreds <- normaliseWantedEqs eq_irreds0
+
+ -- 5. Build the Avail mapping from "given_dicts"
+ -- Add dicts refined by the current type refinement
+ ; init_state <- foldlM addGiven emptyAvails given_dicts
+ ; let reft = red_reft env
+ ; init_state <- if isEmptyRefinement reft then return init_state
+ else foldlM (addRefinedGiven reft)
+ init_state given_dicts
+
+ -- 6. Solve the *wanted* *dictionary* constraints
+ -- This may expose some further equational constraints...
+ ; wanted_dicts' <- zonkInsts wanted_dicts
+ ; avails <- reduceList env wanted_dicts' init_state
+ ; let (binds, irreds0, needed_givens) = extractResults avails wanted_dicts'
+ ; traceTc $ text "reduceContext extractresults" <+> vcat
+ [ppr avails,ppr wanted_dicts',ppr binds,ppr needed_givens]
+
+ -- 7. Normalise the *wanted* *dictionary* constraints
+ -- wrt. the toplevel and given equations
+ ; (irreds1,normalise_binds1) <- normaliseWantedDicts given_eqs irreds0
+
+ -- 8. Substitute the wanted *equations* in the wanted *dictionaries*
+ ; (irreds,normalise_binds2) <- substEqInDictInsts eq_irreds irreds1
+
+ -- 9. eliminate the artificial skolem constants introduced in 1.
+ ; eliminate_skolems
+
+ -- If there was some FD improvement,
+ -- or new wanted equations have been exposed,
+ -- we should have another go at solving.
+ ; let improved = availsImproved avails
+ || (not $ isEmptyBag normalise_binds1)
+ || (not $ isEmptyBag normalise_binds2)
+ || (any isEqInst irreds)