Fix recursive superclasses (again). Fixes Trac #4809.

[ghc-hetmet.git] / compiler / typecheck / TcClassDcl.lhs

diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs
index 839a5a2..542ce20 100644 (file)
--- a/compiler/typecheck/TcClassDcl.lhs
+++ b/compiler/typecheck/TcClassDcl.lhs
@@ -229,45 +229,35 @@ tcDefMeth clas tyvars this_dict binds_in sig_fn prag_fn (sel_id, dm_info)
           tcInstanceMethodBody (ClsSkol clas)
                                tyvars 
                                [this_dict]
-                               Nothing
                                dm_id_w_inline local_dm_id
                                dm_sig_fn IsDefaultMethod meth_bind }
 
 ---------------
 tcInstanceMethodBody :: SkolemInfo -> [TcTyVar] -> [EvVar]
-                    -> Maybe EvBind
                      -> Id -> Id
                     -> SigFun -> TcSpecPrags -> LHsBind Name 
                     -> TcM (LHsBind Id)
 tcInstanceMethodBody skol_info tyvars dfun_ev_vars
-                    this_dict meth_id local_meth_id
+                     meth_id local_meth_id
                     meth_sig_fn specs 
                      (L loc bind)
   = do {       -- Typecheck the binding, first extending the envt
                -- so that when tcInstSig looks up the local_meth_id to find
                -- its signature, we'll find it in the environment
-         let full_given = case this_dict of
-                             Nothing -> dfun_ev_vars
-                            Just (EvBind dict _) -> dict : dfun_ev_vars
-              lm_bind = L loc (bind { fun_id = L loc (idName local_meth_id) })
-                            -- Substitue the local_meth_name for the binder
+          let lm_bind = L loc (bind { fun_id = L loc (idName local_meth_id) })
+                             -- Substitute the local_meth_name for the binder
                             -- NB: the binding is always a FunBind
 
        ; (ev_binds, (tc_bind, _)) 
-               <- checkConstraints skol_info tyvars full_given $
+               <- checkConstraints skol_info tyvars dfun_ev_vars $
                  tcExtendIdEnv [local_meth_id] $
                  tcPolyBinds TopLevel meth_sig_fn no_prag_fn 
                             NonRecursive NonRecursive
                             [lm_bind]
 
-        -- Add the binding for this_dict, if we have one
-        ; ev_binds' <- case this_dict of
-                         Nothing                -> return ev_binds
-                         Just (EvBind self rhs) -> extendTcEvBinds ev_binds self rhs
-
-       ; let full_bind = AbsBinds { abs_tvs = tyvars, abs_ev_vars = dfun_ev_vars
+        ; let full_bind = AbsBinds { abs_tvs = tyvars, abs_ev_vars = dfun_ev_vars
                                    , abs_exports = [(tyvars, meth_id, local_meth_id, specs)]
-                                  , abs_ev_binds = ev_binds'
+                                   , abs_ev_binds = ev_binds
                                    , abs_binds = tc_bind }
 
         ; return (L loc full_bind) } 
@@ -538,7 +528,7 @@ mkGenericInstance clas (hs_ty, binds) = do
     let
        inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
        dfun_id    = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
-       ispec      = mkLocalInstance dfun_id overlap_flag
+        ispec      = mkLocalInstance dfun_id overlap_flag
 
     return (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] False })
 \end{code}