- if null gen_inst_info then
- returnM []
- else
- getDOpts `thenM` \ dflags ->
- ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
- (vcat (map pprInstInfo gen_inst_info)))
- `thenM_`
- returnM gen_inst_info
-
-get_generics decl@(ClassDecl {tcdMeths = Nothing})
- = returnM [] -- Imported class decls
-
-get_generics decl@(ClassDecl {tcdName = class_name, tcdMeths = Just def_methods, tcdLoc = loc})
- | null groups
- = returnM [] -- The comon case: no generic default methods
-
- | otherwise -- A source class decl with generic default methods
- = recoverM (returnM []) $
- tcAddDeclCtxt decl $
- tcLookupClass class_name `thenM` \ clas ->
-
- -- Make an InstInfo out of each group
- mappM (mkGenericInstance clas loc) groups `thenM` \ 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,
- group `lengthExceeds` 1]
- get_uniq (tc,_) = getUnique tc
- in
- mappM (addErrTc . dupGenericInsts) bad_groups `thenM_`
-
- -- Check that there is an InstInfo for each generic type constructor
- let
- missing = genericTyCons `minusList` [tc | (tc,_) <- tc_inst_infos]
- in
- checkTc (null missing) (missingGenericInstances missing) `thenM_`
-
- returnM inst_infos
-
- where
- -- Group the declarations by type pattern
- groups :: [(RenamedHsType, RenamedMonoBinds)]
- groups = assocElts (getGenericBinds def_methods)
-
-
----------------------------------
-getGenericBinds :: RenamedMonoBinds -> Assoc RenamedHsType RenamedMonoBinds
- -- Takes a group of method bindings, finds the generic ones, and returns
- -- them in finite map indexed by the type parameter in the definition.