-upp_avail NotAvailable = uppNil
-upp_avail (Avail name ns) = uppBesides [upp_module mod, uppSP,
- upp_occname occ, uppSP,
- upp_export ns]
- where
- (mod,occ) = modAndOcc name
-
-upp_export [] = uppNil
-upp_export names = uppBesides [uppStr "(",
- uppIntersperse uppSP (map (upp_occname . getOccName) names),
- uppStr ")"]
-
-upp_fixity (occ, Fixity prec dir, prov) = uppBesides [upp_dir dir, uppSP,
- uppInt prec, uppSP,
- upp_occname occ, uppSemi]
-upp_dir InfixR = uppStr "infixr"
-upp_dir InfixL = uppStr "infixl"
-upp_dir InfixN = uppStr "infix"
-
-ppr_unqual_name :: NamedThing a => a -> Unpretty -- Just its occurrence name
-ppr_unqual_name name = upp_occname (getOccName name)
+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 tycon
+upp_class clas = ifaceClass clas
+\end{code}
+
+
+\begin{code}
+ifaceTyCon :: TyCon -> SDoc
+ifaceTyCon tycon
+ | isSynTyCon tycon
+ = hsep [ ptext SLIT("type"),
+ ppr (getName tycon),
+ pprTyVarBndrs tyvars,
+ ptext SLIT("="),
+ ppr ty,
+ semi
+ ]
+ where
+ (tyvars, ty) = getSynTyConDefn tycon
+
+ifaceTyCon tycon
+ | isAlgTyCon tycon
+ = hsep [ ptext keyword,
+ ppr_decl_context (tyConTheta tycon),
+ ppr (getName tycon),
+ pprTyVarBndrs (tyConTyVars tycon),
+ ptext SLIT("="),
+ hsep (punctuate (ptext SLIT(" | ")) (map ppr_con (tyConDataCons tycon))),
+ semi
+ ]
+ where
+ keyword | isNewTyCon tycon = SLIT("newtype")
+ | otherwise = SLIT("data")
+
+ ppr_con data_con
+ | null field_labels
+ = hsep [ ppr name,
+ hsep (map ppr_arg_ty (strict_marks `zip` arg_tys))
+ ]
+
+ | otherwise
+ = hsep [ ppr 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 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 (fieldLabelName field_label),
+ ptext SLIT("::"),
+ ppr_strict_mark strict_mark <> pprParendType (fieldLabelType field_label)
+ ]
+
+ifaceTyCon tycon
+ = pprPanic "pprIfaceTyDecl" (ppr tycon)
+
+ifaceClass clas
+ = hsep [ptext SLIT("class"),
+ ppr_decl_context sc_theta,
+ ppr clas, -- Print the name
+ pprTyVarBndrs clas_tyvars,
+ pp_ops,
+ semi
+ ]
+ where
+ (clas_tyvars, sc_theta, _, sel_ids, defms) = classBigSig clas
+
+ pp_ops | null sel_ids = empty
+ | otherwise = hsep [ptext SLIT("where"),
+ braces (hsep (punctuate semi (zipWith ppr_classop sel_ids defms)))
+ ]
+
+ ppr_classop sel_id maybe_defm
+ = ASSERT( sel_tyvars == clas_tyvars)
+ hsep [ppr (getOccName sel_id),
+ if maybeToBool maybe_defm then equals else empty,
+ ptext SLIT("::"),
+ ppr op_ty
+ ]
+ where
+ (sel_tyvars, _, op_ty) = splitSigmaTy (idType sel_id)
+
+ppr_decl_context :: ThetaType -> SDoc
+ppr_decl_context [] = empty
+ppr_decl_context theta
+ = braces (hsep (punctuate comma (map (ppr_dict) theta)))
+ <>
+ ptext SLIT(" =>")
+ where
+ ppr_dict (clas,tys) = ppr clas <+> hsep (map pprParendType tys)
+\end{code}