+---------------
+tcInstanceMethodBody :: SkolemInfo -> Class -> [TcTyVar] -> [Inst]
+ -> TcThetaType -> [TcType]
+ -> Maybe (Inst, LHsBind Id) -> Id
+ -> Name -- The local method name
+ -> TcSigFun -> TcPragFun -> LHsBind Name
+ -> TcM (Id, LHsBinds Id)
+tcInstanceMethodBody rigid_info clas tyvars dfun_dicts theta inst_tys
+ mb_this_bind sel_id local_meth_name
+ sig_fn prag_fn bind@(L loc _)
+ = do { let (sel_tyvars,sel_rho) = tcSplitForAllTys (idType sel_id)
+ rho_ty = ASSERT( length sel_tyvars == length inst_tys )
+ substTyWith sel_tyvars inst_tys sel_rho
+
+ (first_pred, local_meth_ty) = tcSplitPredFunTy_maybe rho_ty
+ `orElse` pprPanic "tcInstanceMethod" (ppr sel_id)
+
+ local_meth_id = mkLocalId local_meth_name local_meth_ty
+ meth_ty = mkSigmaTy tyvars theta local_meth_ty
+ sel_name = idName sel_id
+
+ -- The first predicate should be of form (C a b)
+ -- where C is the class in question
+ ; MASSERT( case getClassPredTys_maybe first_pred of
+ { Just (clas1, _tys) -> clas == clas1 ; Nothing -> False } )
+
+ -- 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
+ ; ((tc_bind, _), lie) <- getLIE $
+ tcExtendIdEnv [local_meth_id] $
+ tcPolyBinds TopLevel sig_fn prag_fn
+ NonRecursive NonRecursive
+ (unitBag bind)
+
+ ; meth_id <- case rigid_info of
+ ClsSkol _ -> do { dm_name <- lookupTopBndrRn (mkDefMethRdrName sel_name)
+ ; return (mkDefaultMethodId dm_name meth_ty) }
+ _other -> do { meth_name <- newLocalName sel_name
+ ; return (mkLocalId meth_name meth_ty) }
+
+ ; let (avails, this_dict_bind)
+ = case mb_this_bind of
+ Nothing -> (dfun_dicts, emptyBag)
+ Just (this, bind) -> (this : dfun_dicts, unitBag bind)
+
+ ; inst_loc <- getInstLoc (SigOrigin rigid_info)
+ ; lie_binds <- tcSimplifyCheck inst_loc tyvars avails lie
+
+ ; let full_bind = L loc $
+ AbsBinds tyvars dfun_lam_vars
+ [(tyvars, meth_id, local_meth_id, [])]
+ (this_dict_bind `unionBags` lie_binds
+ `unionBags` tc_bind)
+
+ dfun_lam_vars = map instToVar dfun_dicts -- Includes equalities
+
+ ; return (meth_id, unitBag full_bind) }
+\end{code}