- returnM (InstInfo { iDFunId = dfun, iBinds = VanillaInst rn_meth_binds [] },
- aux_binds)
-
-gen_list :: [(Unique, FixityEnv -> TyCon -> (LHsBinds RdrName, LHsBinds RdrName))]
-gen_list = [(eqClassKey, no_aux_binds (ignore_fix_env gen_Eq_binds))
- ,(ordClassKey, no_aux_binds (ignore_fix_env gen_Ord_binds))
- ,(enumClassKey, no_aux_binds (ignore_fix_env gen_Enum_binds))
- ,(boundedClassKey, no_aux_binds (ignore_fix_env gen_Bounded_binds))
- ,(ixClassKey, no_aux_binds (ignore_fix_env gen_Ix_binds))
- ,(typeableClassKey,no_aux_binds (ignore_fix_env gen_Typeable_binds))
- ,(showClassKey, no_aux_binds gen_Show_binds)
- ,(readClassKey, no_aux_binds gen_Read_binds)
- ,(dataClassKey, gen_Data_binds)
- ]
-
- -- no_aux_binds is used for generators that don't
- -- need to produce any auxiliary bindings
-no_aux_binds f fix_env tc = (f fix_env tc, emptyBag)
-ignore_fix_env f fix_env tc = f tc
+ ; return (InstInfo { iSpec = spec,
+ iBinds = VanillaInst rn_meth_binds [] },
+ aux_binds)
+ }
+
+genDerivBinds clas fix_env tycon
+ | className clas `elem` typeableClassNames
+ = (gen_Typeable_binds tycon, emptyLHsBinds)
+
+ | otherwise
+ = case assocMaybe gen_list (getUnique clas) of
+ Just gen_fn -> gen_fn fix_env tycon
+ Nothing -> pprPanic "genDerivBinds: bad derived class" (ppr clas)
+ where
+ gen_list :: [(Unique, FixityEnv -> TyCon -> (LHsBinds RdrName, LHsBinds RdrName))]
+ gen_list = [(eqClassKey, no_aux_binds (ignore_fix_env gen_Eq_binds))
+ ,(ordClassKey, no_aux_binds (ignore_fix_env gen_Ord_binds))
+ ,(enumClassKey, no_aux_binds (ignore_fix_env gen_Enum_binds))
+ ,(boundedClassKey, no_aux_binds (ignore_fix_env gen_Bounded_binds))
+ ,(ixClassKey, no_aux_binds (ignore_fix_env gen_Ix_binds))
+ ,(typeableClassKey,no_aux_binds (ignore_fix_env gen_Typeable_binds))
+ ,(showClassKey, no_aux_binds gen_Show_binds)
+ ,(readClassKey, no_aux_binds gen_Read_binds)
+ ,(dataClassKey, gen_Data_binds)
+ ]
+
+ -- no_aux_binds is used for generators that don't
+ -- need to produce any auxiliary bindings
+ no_aux_binds f fix_env tc = (f fix_env tc, emptyLHsBinds)
+ ignore_fix_env f fix_env tc = f tc