+
+
+tcMethods clas inst_tyvars inst_tyvars' dfun_theta' inst_tys'
+ avail_insts op_items (VanillaInst monobinds uprags)
+ = -- Check that all the method bindings come from this class
+ let
+ sel_names = [idName sel_id | (sel_id, _) <- op_items]
+ bad_bndrs = collectMonoBinders monobinds `minusList` sel_names
+ in
+ mappM (addErrTc . badMethodErr clas) bad_bndrs `thenM_`
+
+ -- Make the method bindings
+ mapAndUnzipM do_one op_items `thenM` \ (meth_ids, meth_binds_s) ->
+
+ returnM (meth_ids, andMonoBindList meth_binds_s)
+
+ where
+ xtve = inst_tyvars `zip` inst_tyvars'
+ do_one op_item
+ = mkMethodBind InstanceDeclOrigin clas
+ inst_tys' monobinds op_item `thenM` \ (meth_inst, meth_info) ->
+ tcMethodBind xtve inst_tyvars' dfun_theta'
+ avail_insts uprags meth_info `thenM` \ meth_bind ->
+ -- Could add meth_insts to avail_insts, but not worth the bother
+ returnM (instToId meth_inst, meth_bind)
+
+-- Derived newtype instances
+tcMethods clas inst_tyvars inst_tyvars' dfun_theta' inst_tys'
+ avail_insts op_items (NewTypeDerived rep_tys)
+ = getInstLoc InstanceDeclOrigin `thenM` \ inst_loc ->
+ getLIE (mapAndUnzipM (do_one inst_loc) op_items) `thenM` \ ((meth_ids, meth_binds), lie) ->
+
+ tcSimplifyCheck
+ (ptext SLIT("newtype derived instance"))
+ inst_tyvars' avail_insts lie `thenM` \ lie_binds ->
+
+ -- I don't think we have to do the checkSigTyVars thing
+
+ returnM (meth_ids, lie_binds `AndMonoBinds` andMonoBindList meth_binds)
+
+ where
+ do_one inst_loc (sel_id, _)
+ = newMethodAtLoc inst_loc sel_id inst_tys' `thenM` \ meth_inst ->
+ -- Like in mkMethodBind
+ newMethod InstanceDeclOrigin sel_id rep_tys' `thenM` \ rhs_id ->
+ -- The binding is like "op @ NewTy = op @ RepTy"
+ let
+ meth_id = instToId meth_inst
+ in
+ return (meth_id, VarMonoBind meth_id (HsVar rhs_id))
+
+ -- Instantiate rep_tys with the relevant type variables
+ rep_tys' = map (substTy subst) rep_tys
+ subst = mkTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars')