- ; let dict_wanteds = filter (not . isEqInst) wanteds
- -- TOMDO: given equational constraints bug!
- -- we need a different evidence for given
- -- equations depending on whether we solve
- -- dictionary constraints or equational constraints
-
- (extra_eq_givens, extra_dict_givens)
- = partition isEqInst extra_givens
- -- SLPJ Sept 07: I think this is bogus; currently
- -- there are no Eqinsts in extra_givens
- dict_ids = map instToId extra_dict_givens
-
- -- Note [Reducing implication constraints]
- -- Tom -- update note, put somewhere!
- ; let eq_tyvars = varSetElems $ tyVarsOfTypes $
- map eqInstType extra_eq_givens
- -- SLPJ Sept07: this looks Utterly Wrong to me, but I think
- -- that current extra_givens has no EqInsts, so
- -- it makes no difference
- co = wrap_inline -- Note [Always inline implication constraints]
- <.> mkWpTyLams tvs
- <.> mkWpTyLams eq_tyvars
- <.> mkWpLams dict_ids
- <.> WpLet (binds `unionBags` bind)
- wrap_inline | null dict_ids = idHsWrapper
- | otherwise = WpInline
- rhs = mkLHsWrap co payload
- loc = instLocSpan inst_loc
- payload = mkBigLHsTup (map (L loc . HsVar . instToId) dict_wanteds)
-
+ ; let -- extract Id binders for dicts and CoTyVar binders for eqs;
+ -- see Note [Binders for equalities]
+ (extra_eq_givens, extra_dict_givens) = partition isEqInst
+ extra_givens
+ eq_cotvs = map instToVar extra_eq_givens
+ dict_ids = map instToId extra_dict_givens
+
+ co = mkWpTyLams tvs
+ <.> mkWpTyLams eq_cotvs
+ <.> mkWpLams dict_ids
+ <.> WpLet (binds `unionBags` bind)
+ rhs = mkLHsWrap co payload
+ loc = instLocSpan inst_loc
+ -- wanted equalities are solved by updating their
+ -- cotv; we don't generate bindings for them
+ dict_bndrs = map (L loc . HsVar . instToId)
+ . filter (not . isEqInst)
+ $ wanteds
+ payload = mkBigLHsTup dict_bndrs