+ifaceTyCons hdl tycons = hPutCol hdl upp_tycon (sortLt (<) (filter (for_iface_name . getName) tycons ))
+ifaceClasses hdl classes = hPutCol hdl upp_class (sortLt (<) (filter (for_iface_name . getName) classes))
+
+for_iface_name name = isLocallyDefined name &&
+ not (isWiredInName name)
+
+upp_tycon tycon = ifaceTyCon PprInterface tycon
+upp_class clas = ifaceClass PprInterface clas
+\end{code}
+
+
+\begin{code}
+ifaceTyCon :: PprStyle -> TyCon -> Doc
+ifaceTyCon sty tycon
+ = case tycon of
+ DataTyCon uniq name kind tyvars theta data_cons deriv new_or_data
+ -> hsep [ ptext (keyword new_or_data),
+ ppr_decl_context sty theta,
+ ppr sty name,
+ hsep (map (pprTyVarBndr sty) tyvars),
+ ptext SLIT("="),
+ hsep (punctuate (ptext SLIT(" | ")) (map ppr_con data_cons)),
+ semi
+ ]
+
+ SynTyCon uniq name kind arity tyvars ty
+ -> hsep [ ptext SLIT("type"),
+ ppr sty name,
+ hsep (map (pprTyVarBndr sty) tyvars),
+ ptext SLIT("="),
+ ppr sty ty,
+ semi
+ ]
+ other -> pprPanic "pprIfaceTyDecl" (ppr PprDebug tycon)
+ where
+ keyword NewType = SLIT("newtype")
+ keyword DataType = SLIT("data")
+
+ ppr_con data_con
+ | null field_labels
+ = hsep [ ppr sty name,
+ hsep (map ppr_arg_ty (strict_marks `zip` arg_tys))
+ ]
+
+ | otherwise
+ = hsep [ ppr sty name,
+ braces $ hsep $ punctuate comma (map ppr_field (strict_marks `zip` field_labels))
+ ]
+ where
+ field_labels = dataConFieldLabels data_con
+ arg_tys = dataConRawArgTys data_con
+ strict_marks = dataConStrictMarks data_con
+ name = getName data_con
+
+ ppr_arg_ty (strict_mark, ty) = ppr_strict_mark strict_mark <> pprParendType sty ty
+
+ ppr_strict_mark NotMarkedStrict = empty
+ ppr_strict_mark MarkedStrict = ptext SLIT("! ")
+ -- The extra space helps the lexical analyser that lexes
+ -- interface files; it doesn't make the rigid operator/identifier
+ -- distinction, so "!a" is a valid identifier so far as it is concerned
+
+ ppr_field (strict_mark, field_label)
+ = hsep [ ppr sty (fieldLabelName field_label),
+ ptext SLIT("::"),
+ ppr_strict_mark strict_mark <> pprParendType sty (fieldLabelType field_label)
+ ]
+
+ifaceClass sty clas
+ = hsep [ptext SLIT("class"),
+ ppr_decl_context sty theta,
+ ppr sty clas, -- Print the name
+ pprTyVarBndr sty tyvar,
+ pp_ops,
+ semi
+ ]
+ where
+ (tyvar, super_classes, ops) = classSig clas
+ theta = super_classes `zip` repeat (mkTyVarTy tyvar)
+
+ pp_ops | null ops = empty
+ | otherwise = hsep [ptext SLIT("where"),
+ braces (hsep (punctuate semi (map ppr_classop ops)))
+ ]
+
+ ppr_classop op = hsep [ppr sty (getOccName op),
+ ptext SLIT("::"),
+ ppr sty (classOpLocalType op)
+ ]
+
+ppr_decl_context :: PprStyle -> [(Class,Type)] -> Doc
+ppr_decl_context sty [] = empty
+ppr_decl_context sty theta
+ = braces (hsep (punctuate comma (map (ppr_dict) theta)))
+ <>
+ ptext SLIT(" =>")
+ where
+ ppr_dict (clas,ty) = hsep [ppr sty clas, ppr sty ty]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Random small things}
+%* *
+%************************************************************************
+
+When printing export lists, we print like this:
+ Avail f f
+ AvailTC C [C, x, y] C(x,y)
+ AvailTC C [x, y] C!(x,y) -- Exporting x, y but not C
+
+\begin{code}
+upp_avail NotAvailable = empty
+upp_avail (Avail name) = upp_occname (getOccName name)
+upp_avail (AvailTC name []) = empty
+upp_avail (AvailTC name ns) = hcat [upp_occname (getOccName name), bang, upp_export ns']
+ where
+ bang | name `elem` ns = empty
+ | otherwise = char '!'
+ ns' = filter (/= name) ns
+
+upp_export [] = empty
+upp_export names = hcat [char '(',
+ hsep (map (upp_occname . getOccName) names),
+ char ')']
+
+upp_fixity (occ, (Fixity prec dir, prov)) = hcat [upp_dir dir, space,
+ int prec, space,
+ upp_occname occ, semi]
+upp_dir InfixR = ptext SLIT("infixr")
+upp_dir InfixL = ptext SLIT("infixl")
+upp_dir InfixN = ptext SLIT("infix")
+
+ppr_unqual_name :: NamedThing a => a -> Doc -- Just its occurrence name