diff options
| author | simonpj@microsoft.com <unknown> | 2010-12-03 18:07:58 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2010-12-03 18:07:58 +0000 |
| commit | 081632b8f49b5afae43afa8b4fac9c2334e7a3ec (patch) | |
| tree | 9679ab141ba62cd19a7360d6538b45ee7cb4ef93 /compiler | |
| parent | c9bb9c464e9f1ab778db936cd389e5ab3550da43 (diff) | |
| download | haskell-081632b8f49b5afae43afa8b4fac9c2334e7a3ec.tar.gz | |
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.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/typecheck/TcInstDcls.lhs | 19 |
1 files changed, 6 insertions, 13 deletions
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index dd7424a52a..801992c7ad 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -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} |