+ tcHsSigType poly_ty `thenTc` \ poly_ty' ->
+ let
+ (tyvars, theta, clas, inst_tys) = splitDFunTy poly_ty'
+ in
+
+ (case maybe_dfun_name of
+ Nothing -> -- A source-file instance declaration
+
+ -- Check for respectable instance type, and context
+ -- but only do this for non-imported instance decls.
+ -- Imported ones should have been checked already, and may indeed
+ -- contain something illegal in normal Haskell, notably
+ -- instance CCallable [Char]
+
+ getDOptsTc `thenTc` \ dflags ->
+ scrutiniseInstanceHead dflags clas inst_tys `thenNF_Tc_`
+ mapNF_Tc (scrutiniseInstanceConstraint dflags) theta `thenNF_Tc_`
+
+ -- Make the dfun id and return it
+ newDFunName clas inst_tys src_loc `thenNF_Tc` \ dfun_name ->
+ returnNF_Tc (True, dfun_name)
+
+ Just dfun_name -> -- An interface-file instance declaration
+ -- Make the dfun id
+ returnNF_Tc (False, dfun_name)
+ ) `thenNF_Tc` \ (is_local, dfun_name) ->
+
+ let
+ 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 :: [RenamedTyClDecl] -> TcM [InstInfo]
+getGenericInstances class_decls
+ = mapTc get_generics 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 decl@(ClassDecl {tcdMeths = Nothing})
+ = returnTc [] -- Imported class decls
+
+get_generics decl@(ClassDecl {tcdName = class_name, tcdMeths = Just def_methods, tcdLoc = loc})
+ | null groups
+ = returnTc [] -- The comon case: no generic default methods
+
+ | 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 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_`
+
+ -- Check that there is an InstInfo for each generic type constructor