Commit 081632b8 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Fix up TcInstDcls

I really don't know how this module got left out of my last
patch, namely
  Thu Dec  2 12:35:47 GMT 2010  simonpj@microsoft.com
  * Re-jig simplifySuperClass (again)

I suggest you don't pull either the patch above, or this
one, unless you really have to.  I'm not fully confident
that it works properly yet.  Ran out of time. Sigh.
parent c9bb9c46
......@@ -697,7 +697,7 @@ tcSpecInstPrags dfun_id (VanillaInst binds uprags _)
------------------------------
tcSuperClass :: [TyVar] -> [EvVar]
-> EvBind
-> (Id, PredType) -> TcM (Id, LHsBind Id)
-> (Id, PredType) -> TcM (Id, LHsBind Id)
-- Build a top level decl like
-- sc_op = /\a \d. let this = ... in
-- let sc = ... in
......@@ -705,16 +705,10 @@ tcSuperClass :: [TyVar] -> [EvVar]
-- The "this" part is just-in-case (discarded if not used)
-- See Note [Recursive superclasses]
tcSuperClass tyvars dicts
self_ev_bind@(EvBind self_dict _)
(sc_sel, sc_pred)
= do { (ev_binds, wanted, sc_dict)
<- newImplication InstSkol tyvars dicts $
emitWanted ScOrigin sc_pred
; simplifySuperClass self_dict wanted
-- We include self_dict in the 'givens'; the simplifier
-- is clever enough to stop sc_pred geting bound by just
-- selecting from self_dict!!
self_ev_bind
(sc_sel, sc_pred)
= do { sc_dict <- newWantedEvVar sc_pred
; ev_binds <- simplifySuperClass tyvars dicts sc_dict self_ev_bind
; uniq <- newUnique
; let sc_op_ty = mkForAllTys tyvars $ mkPiTypes dicts (varType sc_dict)
......@@ -725,8 +719,7 @@ tcSuperClass tyvars dicts
, var_rhs = L noSrcSpan $ wrapId sc_wrapper sc_dict }
sc_wrapper = mkWpTyLams tyvars
<.> mkWpLams dicts
<.> mkWpLet (EvBinds (unitBag self_ev_bind))
<.> mkWpLet ev_binds
<.> mkWpLet ev_binds
; return (sc_op_id, noLoc sc_op_bind) }
\end{code}
......
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