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