- hPutStr if_hdl "\n__declarations__\n" >>
- hPutStr if_hdl (ppShow 100 (ppAboves [
- ppAboves (map ppSemid sorted_classes),
- ppAboves (map ppSemid sorted_tycons),
- ppAboves (map ppSemid sorted_vals)]))
--}
+ if null exported_insts then
+ return ()
+ else
+ hPutStr if_hdl "\n__instances__\n" >>
+ hPutStr if_hdl (ppShow 100 (ppAboves (map pp_inst sorted_insts)))
+ where
+ is_exported_inst (InstInfo clas _ ty _ _ _ _ _ from_here _ _ _)
+ = from_here -- && ...
+
+ -------
+ lt_inst (InstInfo clas1 _ ty1 _ _ _ _ _ _ _ _ _)
+ (InstInfo clas2 _ ty2 _ _ _ _ _ _ _ _ _)
+ = let
+ tycon1 = fst (getAppTyCon ty1)
+ tycon2 = fst (getAppTyCon ty2)
+ in
+ case (origName clas1 `cmp` origName clas2) of
+ LT_ -> True
+ GT_ -> False
+ EQ_ -> origName tycon1 < origName tycon2
+
+ -------
+ pp_inst (InstInfo clas tvs ty theta _ _ _ _ _ _ _ _)
+ = ppBeside (ppPStr SLIT("instance "))
+ (pprType PprInterface (mkSigmaTy tvs theta (mkDictTy clas ty)))