[commit: ghc] master: Simplify the generation of superclass constraints in tcInstDecl2 (7251798)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/725179875b1d7c9d42291ac338ab317ab6597c0d/ghc

>---------------------------------------------------------------

commit 725179875b1d7c9d42291ac338ab317ab6597c0d
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Oct 29 15:34:14 2014 +0000

    Simplify the generation of superclass constraints in tcInstDecl2
    
    The simplified function is tcSuperClasses;
    no need for an implication constraint here


>---------------------------------------------------------------

725179875b1d7c9d42291ac338ab317ab6597c0d
 compiler/typecheck/TcInstDcls.lhs | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index b986fa8..a471e11 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -840,7 +840,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
 
        ; dfun_ev_vars <- newEvVars dfun_theta
 
-       ; (sc_binds, sc_ev_vars) <- tcSuperClasses dfun_id inst_tyvars dfun_ev_vars sc_theta'
+       ; sc_ev_vars <- tcSuperClasses dfun_id inst_tyvars dfun_ev_vars sc_theta'
 
        -- Deal with 'SPECIALISE instance' pragmas
        -- See Note [SPECIALISE instance pragmas]
@@ -908,7 +908,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
              main_bind = AbsBinds { abs_tvs = inst_tyvars
                                   , abs_ev_vars = dfun_ev_vars
                                   , abs_exports = [export]
-                                  , abs_ev_binds = sc_binds
+                                  , abs_ev_binds = emptyTcEvBinds
                                   , abs_binds = unitBag dict_bind }
 
        ; return (unitBag (L loc main_bind) `unionBags`
@@ -920,22 +920,23 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
 
 ------------------------------
 tcSuperClasses :: DFunId -> [TcTyVar] -> [EvVar] -> TcThetaType
-               -> TcM (TcEvBinds, [EvVar])
+               -> TcM [EvVar]
 -- See Note [Silent superclass arguments]
 tcSuperClasses dfun_id inst_tyvars dfun_ev_vars sc_theta
+  | null inst_tyvars && null dfun_ev_vars
+  = emitWanteds ScOrigin sc_theta
+
+  | otherwise
   = do {   -- Check that all superclasses can be deduced from
            -- the originally-specified dfun arguments
-       ; (sc_binds, sc_evs) <- checkConstraints InstSkol inst_tyvars orig_ev_vars $
-                               emitWanteds ScOrigin sc_theta
+       ; _ <- checkConstraints InstSkol inst_tyvars orig_ev_vars $
+              emitWanteds ScOrigin sc_theta
 
-       ; if null inst_tyvars && null dfun_ev_vars
-         then return (sc_binds,       sc_evs)
-         else return (emptyTcEvBinds, sc_lam_args) }
+       ; return (map (find dfun_ev_vars) sc_theta) }
   where
     n_silent     = dfunNSilent dfun_id
     orig_ev_vars = drop n_silent dfun_ev_vars
 
-    sc_lam_args = map (find dfun_ev_vars) sc_theta
     find [] pred
       = pprPanic "tcInstDecl2" (ppr dfun_id $$ ppr (idType dfun_id) $$ ppr pred)
     find (ev:evs) pred