- keyword | isNewTyCon tycon = SLIT("newtype")
- | otherwise = SLIT("data")
-
- tyvars = tyConTyVars tycon
-
- ppr_con data_con
- | null field_labels
- = ASSERT( tycon == tycon1 && tyvars == tyvars1 )
- hsep [ ppr_ex ex_tyvars ex_theta,
- ppr name,
- hsep (map ppr_arg_ty (strict_marks `zip` arg_tys))
- ]
-
- | otherwise
- = hsep [ ppr_ex ex_tyvars ex_theta,
- ppr name,
- braces $ hsep $ punctuate comma (map ppr_field (strict_marks `zip` field_labels))
- ]
- where
- (tyvars1, theta1, ex_tyvars, ex_theta, arg_tys, tycon1) = dataConSig data_con
- field_labels = dataConFieldLabels data_con
- strict_marks = dataConStrictMarks data_con
- name = getName data_con
-
- ppr_ex [] ex_theta = ASSERT( null ex_theta ) empty
- ppr_ex ex_tvs ex_theta = ptext SLIT("__forall") <+> brackets (pprTyVarBndrs ex_tvs)
- <+> pprIfaceClasses ex_theta <+> ptext SLIT("=>")
-
- ppr_arg_ty (strict_mark, ty) = ppr_strict_mark strict_mark <> pprParendType ty
-
- ppr_strict_mark NotMarkedStrict = empty
- ppr_strict_mark (MarkedUnboxed _ _) = ptext SLIT("! ! ")
- ppr_strict_mark MarkedStrict = ptext SLIT("! ")
-
- ppr_field (strict_mark, field_label)
- = hsep [ ppr (fieldLabelName field_label),
- dcolon,
- ppr_strict_mark strict_mark <> pprParendType (fieldLabelType field_label)
- ]
-
-ifaceTyCon tycon
- = pprPanic "pprIfaceTyDecl" (ppr tycon)
-
-ifaceClass clas
- = hsep [ptext SLIT("class"),
- ppr_decl_class_context sc_theta,
- ppr clas, -- Print the name
- pprTyVarBndrs clas_tyvars,
- pprFundeps clas_fds,
- pp_ops,
- semi
- ]
- where
- (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
-
- pp_ops | null op_stuff = empty
- | otherwise = hsep [ptext SLIT("where"),
- braces (hsep (punctuate semi (map ppr_classop op_stuff)))
- ]
-
- ppr_classop (sel_id, dm_id, explicit_dm)
- = ASSERT( sel_tyvars == clas_tyvars)
- hsep [ppr (getOccName sel_id),
- if explicit_dm then equals else empty,
- dcolon,
- 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 = pprIfaceTheta theta <+> ptext SLIT(" =>")
-
-ppr_decl_class_context :: ClassContext -> SDoc
-ppr_decl_class_context [] = empty
-ppr_decl_class_context ctxt = pprIfaceClasses ctxt <+> ptext SLIT(" =>")
-
-pprIfaceTheta :: ThetaType -> SDoc -- Use braces rather than parens in interface files
-pprIfaceTheta [] = empty
-pprIfaceTheta theta = braces (hsep (punctuate comma [pprIfacePred p | p <- theta]))
-
--- ZZ - not sure who uses this - i.e. whether IParams really show up or not
--- (it's not used to print normal value signatures)
-pprIfacePred :: PredType -> SDoc
-pprIfacePred (Class clas tys) = pprConstraint clas tys
-pprIfacePred (IParam n ty) = char '?' <> ppr n <+> ptext SLIT("::") <+> ppr ty
-
-pprIfaceClasses :: ClassContext -> SDoc
-pprIfaceClasses [] = empty
-pprIfaceClasses theta = braces (hsep (punctuate comma [pprConstraint c tys | (c,tys) <- theta]))
-\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 :: AvailInfo -> SDoc
-upp_avail (Avail name) = pprOccName (getOccName name)
-upp_avail (AvailTC name []) = empty
-upp_avail (AvailTC name ns) = hcat [pprOccName (getOccName name), bang, upp_export ns']
- where
- bang | name `elem` ns = empty
- | otherwise = char '|'
- ns' = filter (/= name) ns
-
-upp_export :: [Name] -> SDoc
-upp_export [] = empty
-upp_export names = braces (hsep (map (pprOccName . getOccName) names))
-
-upp_fixity :: (Name, Fixity) -> SDoc
-upp_fixity (name, fixity) = hsep [ptext SLIT("0"), ppr fixity, ppr name, semi]
- -- Dummy version number!
-
-ppr_unqual_name :: NamedThing a => a -> SDoc -- Just its occurrence name
-ppr_unqual_name name = pprOccName (getOccName name)
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Comparisons}
-%* *
-%************************************************************************
-
-
-The various sorts above simply prevent unnecessary "wobbling" when
-things change that don't have to. We therefore compare lexically, not
-by unique
-
-\begin{code}
-lt_avail :: AvailInfo -> AvailInfo -> Bool