+ dfun_id = mkDictFunId dfun_name clas tyvars inst_tys theta
+ in
+ returnTc [InstInfo { iLocal = is_local, iDFunId = dfun_id,
+ iBinds = binds, iPrags = uprags }]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Extracting generic instance declaration from class declarations}
+%* *
+%************************************************************************
+
+@getGenericInstances@ extracts the generic instance declarations from a class
+declaration. For exmaple
+
+ class C a where
+ op :: a -> a
+
+ op{ x+y } (Inl v) = ...
+ op{ x+y } (Inr v) = ...
+ op{ x*y } (v :*: w) = ...
+ op{ 1 } Unit = ...
+
+gives rise to the instance declarations
+
+ instance C (x+y) where
+ op (Inl v) = ...
+ op (Inr v) = ...
+
+ instance C (x*y) where
+ op (v :*: w) = ...
+
+ instance C 1 where
+ op Unit = ...
+
+
+\begin{code}
+getGenericInstances :: Module -> [RenamedTyClDecl] -> TcM [InstInfo]
+getGenericInstances mod class_decls
+ = mapTc (get_generics mod) class_decls `thenTc` \ gen_inst_infos ->
+ let
+ gen_inst_info = concat gen_inst_infos
+ in
+ getDOptsTc `thenTc` \ dflags ->
+ ioToTc (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
+ (vcat (map pprInstInfo gen_inst_info)))
+ `thenNF_Tc_`
+ returnTc gen_inst_info
+
+get_generics mod decl@(ClassDecl context class_name tyvar_names
+ fundeps class_sigs def_methods
+ name_list loc)
+ | null groups
+ = returnTc [] -- The comon case:
+ -- no generic default methods, or
+ -- its an imported class decl (=> has no methods at all)
+
+ | otherwise -- A local class decl with generic default methods
+ = recoverNF_Tc (returnNF_Tc []) $
+ tcAddDeclCtxt decl $
+ tcLookupClass class_name `thenTc` \ clas ->
+
+ -- Make an InstInfo out of each group
+ mapTc (mkGenericInstance mod clas loc) groups `thenTc` \ inst_infos ->
+
+ -- Check that there is only one InstInfo for each type constructor
+ -- The main way this can fail is if you write
+ -- f {| a+b |} ... = ...
+ -- f {| x+y |} ... = ...
+ -- Then at this point we'll have an InstInfo for each
+ let
+ tc_inst_infos :: [(TyCon, InstInfo)]
+ tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
+
+ bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
+ length group > 1]
+ get_uniq (tc,_) = getUnique tc
+ in
+ mapTc (addErrTc . dupGenericInsts) bad_groups `thenTc_`