X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcClassDcl.lhs;h=542ce20a603240e0a04d215db7a31192d245396a;hp=839a5a276b999810597512b152e4e000d22d707d;hb=a3bab0506498db41853543558c52a4fda0d183af;hpb=62f76a3cbced691b60f511fb83547a5d62653252 diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs index 839a5a2..542ce20 100644 --- 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}