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