{-# LANGUAGE CPP #-}
module CPretty (
) where
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif
import Idents (Ident, identToLexeme)
import Text.PrettyPrint.HughesPJ
import CAST
instance Show CDecl where
showsPrec _ = showString . render . pretty
class Pretty a where
pretty :: a -> Doc
prettyPrec :: Int -> a -> Doc
pretty = prettyPrec 0
prettyPrec _ = pretty
instance Pretty CDecl where
pretty (CDecl specs declrs _) =
hsep (map pretty specs) `hang` 2 $
hsep (punctuate comma (map prettyDeclr declrs)) <> semi
instance Pretty CDeclSpec where
pretty (CStorageSpec sspec) = pretty sspec
pretty (CTypeSpec tspec) = pretty tspec
pretty (CTypeQual qspec) = pretty qspec
instance Pretty CStorageSpec where
pretty (CAuto _) = text "auto"
pretty (CRegister _) = text "register"
pretty (CStatic _) = text "static"
pretty (CExtern _) = text "extern"
pretty (CTypedef _) = text "typedef"
instance Pretty CTypeSpec where
pretty (CVoidType _) = text "void"
pretty (CCharType _) = text "char"
pretty (CShortType _) = text "short"
pretty (CIntType _) = text "int"
pretty (CLongType _) = text "long"
pretty (CFloatType _) = text "float"
pretty (CFloat128Type _) = text "__float128"
pretty (CDoubleType _) = text "double"
pretty (CSignedType _) = text "signed"
pretty (CUnsigType _) = text "unsigned"
pretty (CSUType struct _) = text "<<CPretty: CSUType not yet implemented!>>"
pretty (CEnumType enum _) = text "<<CPretty: CEnumType not yet implemented!>>"
pretty (CTypeDef ide _) = ident ide
instance Pretty CTypeQual where
pretty (CConstQual _) = text "const"
pretty (CVolatQual _) = text "volatile"
pretty (CRestrQual _) = text "restrict"
prettyDeclr :: (Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Doc
prettyDeclr (odeclr, oinit, oexpr) =
maybe empty pretty odeclr
<+> maybe empty ((text "=" <+>) . pretty) oinit
<+> maybe empty ((text ":" <+>) . pretty) oexpr
instance Pretty CDeclr where
pretty (CVarDeclr oide _) = maybe empty ident oide
pretty (CPtrDeclr inds declr _) =
let
oneLevel ind = parens . (hsep (map pretty ind) <+>) . (text "*" <>)
in
oneLevel inds (pretty declr)
pretty (CArrDeclr declr _ oexpr _) =
pretty declr <> brackets (maybe empty pretty oexpr)
pretty (CFunDeclr declr decls isVariadic _) =
let
varDoc = if isVariadic then text ", ..." else empty
in
pretty declr
<+> parens (hsep (punctuate comma (map pretty decls)) <> varDoc)
instance Pretty CInit where
pretty _ = text "<<CPretty: CInit not yet implemented!>>"
instance Pretty CExpr where
pretty _ = text "<<CPretty: CExpr not yet implemented!>>"
ident :: Ident -> Doc
ident = text . identToLexeme