-ppr_tycon tycon
- = --pprTrace "ppr_tycon:" (ppr PprDebug tycon) $
- ppr_tc (initNmbr (nmbrTyCon tycon))
-
-------------------------
-ppr_tc (PrimTyCon _ n _)
- = ppCat [ ppStr "{- data", ppr_name n, ppStr " *built-in* -}" ]
-
-ppr_tc FunTyCon
- = ppCat [ ppStr "{- data", ppr_name FunTyCon, ppStr " *built-in* -}" ]
-
-ppr_tc (TupleTyCon _ n _)
- = ppCat [ ppStr "{- ", ppr_name n, ppStr "-}" ]
-
-ppr_tc (SynTyCon _ n _ _ tvs expand)
- = let
- pp_tyvars = map ppr_tyvar tvs
- in
- ppBesides [ppPStr SLIT("type "), ppr_name n, ppSP, ppIntersperse ppSP pp_tyvars,
- ppPStr SLIT(" = "), ppr_ty expand, ppSemi]
-
-ppr_tc this_tycon@(DataTyCon u n k tvs ctxt cons derivings data_or_new)
- = ppHang (ppCat [pp_data_or_new,
- ppr_context ctxt,
- ppr_name n,
- ppIntersperse ppSP (map ppr_tyvar tvs)])
- 2
- (ppBeside pp_unabstract_condecls ppSemi)
- -- NB: we do not print deriving info in interfaces
- where
- pp_data_or_new = case data_or_new of
- DataType -> ppPStr SLIT("data")
- NewType -> ppPStr SLIT("newtype")
-
- ppr_context [] = ppNil
- ppr_context [(c,t)] = ppCat [ppr_name c, ppr_ty t, ppStr "=>"]
- ppr_context cs
- = ppBesides[ppLparen,
- ppInterleave ppComma [ppCat [ppr_name c, ppr_ty t] | (c,t) <- cs],
- ppRparen, ppStr " =>"]
-
- yes_we_print_condecls
- = case (getExportFlag n) of
- ExportAbs -> False
- other -> True
-
- pp_unabstract_condecls
- = if yes_we_print_condecls
- then ppCat [ppEquals, pp_condecls]
- else ppNil
-
- pp_condecls
- = let
- (c:cs) = cons
- in
- ppSep ((ppr_con c) : (map ppr_next_con cs))
-
- ppr_next_con con = ppCat [ppChar '|', ppr_con con]
-
- ppr_con con
- = let
- (_, _, con_arg_tys, _) = dataConSig con
- labels = dataConFieldLabels con -- none if not a record
- strict_marks = dataConStrictMarks con
- in
- ppCat [ppr_unq_name con, ppr_fields labels strict_marks con_arg_tys]
-
- ppr_fields labels strict_marks con_arg_tys
- = if null labels then -- not a record thingy
- ppIntersperse ppSP (zipWithEqual ppr_bang_ty strict_marks con_arg_tys)
- else
- ppCat [ ppChar '{',
- ppInterleave ppComma (zipWith3Equal ppr_field labels strict_marks con_arg_tys),
- ppChar '}' ]
-
- ppr_bang_ty b t
- = ppBeside (case b of { MarkedStrict -> ppChar '!'; _ -> ppNil })
- (pprParendType PprInterface t)
-
- ppr_field l b t
- = ppBesides [ppr_unq_name l, ppPStr SLIT(" :: "),
- case b of { MarkedStrict -> ppChar '!'; _ -> ppNil },
- ppr_ty t]