- lookup_fn = mk_lookup_tyvar_fn sty vs
-
- pp_data_or_new = case data_or_new of
- DataType -> ppPStr SLIT("data")
- NewType -> ppPStr SLIT("newtype")
-
- yes_we_print_condecls
- = unabstract
- && not (null cons) -- we know what they are
- && (case (getExportFlag n) of
- ExportAbs -> False
- other -> True)
-
- yes_we_print_pragma_condecls
- = not yes_we_print_condecls
- && not opt_OmitInterfacePragmas
- && not (null cons)
- && not (maybeToBool (maybePurelyLocalTyCon this_tycon))
- {- && not (any (dataConMentionsNonPreludeTyCon this_tycon) cons) -}
-
- yes_we_print_pragma_specs
- = not (null specs)
-
- pp_unabstract_condecls
- = if yes_we_print_condecls
- then ppCat [ppSP, ppEquals, pp_condecls]
- else ppNil
-
- pp_pragma_condecls
- = if yes_we_print_pragma_condecls
- then pp_condecls
- else ppNil
-
- pp_pragma_specs
- = if yes_we_print_pragma_specs
- then pp_specs
- else ppNil
-
- pp_pragma
- = if (yes_we_print_pragma_condecls || yes_we_print_pragma_specs)
- then ppCat [ppStr "\t{-# GHC_PRAGMA", pp_pragma_condecls, pp_pragma_specs, ppStr "#-}"]
- else ppNil
-
- pp_condecls
- = let
- (c:cs) = cons
- in
- ppCat ((ppr_con c) : (map ppr_next_con cs))
- where
- ppr_con con
- = let
- (_, _, con_arg_tys, _) = dataConSig con
- in
- ppCat [pprNonOp PprForUser con, -- the data con's name...
- ppIntersperse ppSP (map (ppr_ty sty lookup_fn tYCON_PREC) con_arg_tys)]
-
- ppr_next_con con = ppCat [ppChar '|', ppr_con con]
-
- pp_specs
- = ppBesides [ppPStr SLIT("_SPECIALIZE_ "), pp_the_list [
- ppCat [ppLbrack, ppInterleave ppComma (map pp_maybe ty_maybes), ppRbrack]
- | ty_maybes <- specs ]]
-
- pp_the_list [p] = p
- pp_the_list (p:ps) = ppAbove (ppBeside p ppComma) (pp_the_list ps)
-
- pp_maybe Nothing = pp_NONE
- pp_maybe (Just ty) = pprParendGenType sty ty
-
- pp_NONE = ppPStr SLIT("_N_")
-
-pprTyCon PprInterface (TupleTyCon a) specs
- = ASSERT (null specs)
- ppCat [ ppStr "{- Tuple", ppInt a, ppStr "-}" ]
-
-pprTyCon PprInterface (PrimTyCon k n a kind_fn) specs
- = ASSERT (null specs)
- ppCat [ ppStr "{- data", ppr PprForUser n, ppStr " *built-in* -}" ]