+ 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 ->
+ mapAndUnzip3M (do_one inst_loc) op_items `thenM` \ (meth_ids, meth_binds, rhs_insts) ->
+
+ tcSimplifyCheck
+ (ptext SLIT("newtype derived instance"))
+ inst_tyvars' avail_insts rhs_insts `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, _)
+ = -- The binding is like "op @ NewTy = op @ RepTy"
+ -- Make the *binder*, like in mkMethodBind
+ tcInstClassOp inst_loc sel_id inst_tys' `thenM` \ meth_inst ->
+
+ -- Make the *occurrence on the rhs*
+ tcInstClassOp inst_loc sel_id rep_tys' `thenM` \ rhs_inst ->
+ let
+ meth_id = instToId meth_inst
+ in
+ return (meth_id, VarMonoBind meth_id (HsVar (instToId rhs_inst)), rhs_inst)
+
+ -- Instantiate rep_tys with the relevant type variables
+ rep_tys' = map (substTy subst) rep_tys
+ subst = mkTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars')
+\end{code}
+
+Note: [Superclass loops]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+We have to be very, very careful when generating superclasses, lest we
+accidentally build a loop. Here's an example:
+
+ class S a
+
+ class S a => C a where { opc :: a -> a }
+ class S b => D b where { opd :: b -> b }
+
+ instance C Int where
+ opc = opd
+
+ instance D Int where
+ opd = opc
+
+From (instance C Int) we get the constraint set {ds1:S Int, dd:D Int}
+Simplifying, we may well get:
+ $dfCInt = :C ds1 (opd dd)
+ dd = $dfDInt
+ ds1 = $p1 dd
+Notice that we spot that we can extract ds1 from dd.
+
+Alas! Alack! We can do the same for (instance D Int):
+
+ $dfDInt = :D ds2 (opc dc)
+ dc = $dfCInt
+ ds2 = $p1 dc
+
+And now we've defined the superclass in terms of itself.
+
+
+Solution: treat the superclass context separately, and simplify it
+all the way down to nothing on its own. Don't toss any 'free' parts
+out to be simplified together with other bits of context.
+Hence the tcSimplifyTop below.
+
+At a more basic level, don't include this_dict in the context wrt
+which we simplify sc_dicts, else sc_dicts get bound by just selecting
+from this_dict!!
+
+\begin{code}
+tcSuperClasses inst_tyvars' dfun_arg_dicts sc_dicts
+ = addErrCtxt superClassCtxt $
+ getLIE (tcSimplifyCheck doc inst_tyvars'
+ dfun_arg_dicts
+ sc_dicts) `thenM` \ (sc_binds1, sc_lie) ->
+
+ -- It's possible that the superclass stuff might have done unification
+ checkSigTyVars inst_tyvars' `thenM` \ zonked_inst_tyvars ->
+
+ -- We must simplify this all the way down
+ -- lest we build superclass loops
+ -- See Note [Superclass loops] above
+ tcSimplifyTop sc_lie `thenM` \ sc_binds2 ->
+
+ returnM (zonked_inst_tyvars, sc_binds1, sc_binds2)
+
+ where
+ doc = ptext SLIT("instance declaration superclass context")