{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
module Language.C.Pretty (
Pretty (..),
prettyUsingInclude
) where
import Data.List (isSuffixOf)
import qualified Data.Set as Set
import Text.PrettyPrint.HughesPJ
import Debug.Trace
import Prelude hiding ((<>))
import Language.C.Data
import Language.C.Syntax
class Pretty p where
pretty :: p -> Doc
prettyPrec :: Int -> p -> Doc
pretty = forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
0
prettyPrec Int
_ = forall p. Pretty p => p -> Doc
pretty
maybeP :: (p -> Doc) -> Maybe p -> Doc
maybeP :: forall p. (p -> Doc) -> Maybe p -> Doc
maybeP = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty
ifP :: Bool -> Doc -> Doc
ifP :: Bool -> Doc -> Doc
ifP Bool
flag Doc
doc = if Bool
flag then Doc
doc else Doc
empty
mlistP :: ([p] -> Doc) -> [p] -> Doc
mlistP :: forall p. ([p] -> Doc) -> [p] -> Doc
mlistP [p] -> Doc
pp [p]
xs = forall p. (p -> Doc) -> Maybe p -> Doc
maybeP [p] -> Doc
pp (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [p]
xs then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [p]
xs)
identP :: Ident -> Doc
identP :: Ident -> Doc
identP = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> String
identToString
attrlistP :: [CAttr] -> Doc
attrlistP :: [CAttr] -> Doc
attrlistP [] = Doc
empty
attrlistP [CAttr]
attrs = String -> Doc
text String
"__attribute__" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc -> Doc
parens ([Doc] -> Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [CAttr]
attrs))
parenPrec :: Int -> Int -> Doc -> Doc
parenPrec :: Int -> Int -> Doc -> Doc
parenPrec Int
prec Int
prec2 Doc
t = if Int
prec forall a. Ord a => a -> a -> Bool
<= Int
prec2 then Doc
t else Doc -> Doc
parens Doc
t
ii :: Doc -> Doc
ii :: Doc -> Doc
ii = Int -> Doc -> Doc
nest Int
4
instance Pretty CTranslUnit where
pretty :: CTranslUnit -> Doc
pretty (CTranslUnit [CExtDecl]
edecls NodeInfo
_) = [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CExtDecl]
edecls)
prettyUsingInclude :: CTranslUnit -> Doc
prettyUsingInclude :: CTranslUnit -> Doc
prettyUsingInclude (CTranslUnit [CExtDecl]
edecls NodeInfo
_) =
forall {a}. Set a -> Doc
includeWarning Set String
headerFiles
Doc -> Doc -> Doc
$$
[Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Doc
includeHeader forall p. Pretty p => p -> Doc
pretty) [Either String CExtDecl]
mappedDecls)
where
(Set String
headerFiles,[Either String CExtDecl]
mappedDecls) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {a} {b}.
Ord a =>
Either a b -> (Set a, [Either a b]) -> (Set a, [Either a b])
addDecl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. (CNode b, Pos b) => b -> Either String b
tagIncludedDecls) (forall a. Set a
Set.empty,[]) [CExtDecl]
edecls
tagIncludedDecls :: b -> Either String b
tagIncludedDecls b
edecl | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
isHeaderFile (forall a. CNode a => a -> Maybe String
fileOfNode b
edecl) = forall a b. a -> Either a b
Left ((Position -> String
posFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pos a => a -> Position
posOf) b
edecl)
| Bool
otherwise = forall a b. b -> Either a b
Right b
edecl
addDecl :: Either a b -> (Set a, [Either a b]) -> (Set a, [Either a b])
addDecl decl :: Either a b
decl@(Left a
headerRef) (Set a
headerSet, [Either a b]
ds)
| forall a. Ord a => a -> Set a -> Bool
Set.member a
headerRef Set a
headerSet = (Set a
headerSet, [Either a b]
ds)
| Bool
otherwise = (forall a. Ord a => a -> Set a -> Set a
Set.insert a
headerRef Set a
headerSet, Either a b
decl forall a. a -> [a] -> [a]
: [Either a b]
ds)
addDecl Either a b
decl (Set a
headerSet,[Either a b]
ds) = (Set a
headerSet, Either a b
decl forall a. a -> [a] -> [a]
: [Either a b]
ds)
includeHeader :: String -> Doc
includeHeader String
hFile = String -> Doc
text String
"#include" Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes (String -> Doc
text String
hFile)
isHeaderFile :: String -> Bool
isHeaderFile = (String
".h" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)
includeWarning :: Set a -> Doc
includeWarning Set a
hs | forall a. Set a -> Bool
Set.null Set a
hs = Doc
empty
| Bool
otherwise = String -> Doc
text String
"/* Warning: The #include directives in this file aren't necessarily correct. */"
instance Pretty CExtDecl where
pretty :: CExtDecl -> Doc
pretty (CDeclExt CDecl
decl) = forall p. Pretty p => p -> Doc
pretty CDecl
decl Doc -> Doc -> Doc
<> Doc
semi
pretty (CFDefExt CFunDef
fund) = forall p. Pretty p => p -> Doc
pretty CFunDef
fund
pretty (CAsmExt CStrLit
asmStmt NodeInfo
_) = String -> Doc
text String
"asm" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CStrLit
asmStmt) Doc -> Doc -> Doc
<> Doc
semi
instance Pretty CFunDef where
pretty :: CFunDef -> Doc
pretty (CFunDef [CDeclSpec]
declspecs CDeclr
declr [CDecl]
decls CStatement NodeInfo
stat NodeInfo
_) =
[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CDeclSpec]
declspecs)
Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CDeclr
declr
Doc -> Doc -> Doc
$+$ (Doc -> Doc
ii forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Pretty p => p -> Doc
pretty)) [CDecl]
decls
Doc -> Doc -> Doc
$$ forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) CStatement NodeInfo
stat
instance Pretty CStat where
pretty :: CStatement NodeInfo -> Doc
pretty (CLabel Ident
ident CStatement NodeInfo
stat [CAttr]
cattrs NodeInfo
_) = Ident -> Doc
identP Ident
ident Doc -> Doc -> Doc
<> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
$$ forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
pretty (CCase CExpr
expr CStatement NodeInfo
stat NodeInfo
_) =
String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
":" Doc -> Doc -> Doc
$$ forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
pretty (CCases CExpr
expr1 CExpr
expr2 CStatement NodeInfo
stat NodeInfo
_) =
String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CExpr
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"..."
Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CExpr
expr2 Doc -> Doc -> Doc
<> String -> Doc
text String
":" Doc -> Doc -> Doc
$$ forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
pretty (CDefault CStatement NodeInfo
stat NodeInfo
_) = String -> Doc
text String
"default:" Doc -> Doc -> Doc
$$ forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
pretty (CExpr Maybe CExpr
expr NodeInfo
_) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ forall p. (p -> Doc) -> Maybe p -> Doc
maybeP forall p. Pretty p => p -> Doc
pretty Maybe CExpr
expr Doc -> Doc -> Doc
<> Doc
semi
pretty c :: CStatement NodeInfo
c@(CCompound [Ident]
_ [CBlockItem]
_ NodeInfo
_) = forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
0 CStatement NodeInfo
c
pretty (CIf CExpr
expr CStatement NodeInfo
stat Maybe (CStatement NodeInfo)
estat NodeInfo
_) =
Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpr
expr)
Doc -> Doc -> Doc
$+$ forall {a}. Pretty (CStatement a) => CStatement a -> Doc
prettyBody CStatement NodeInfo
stat
Doc -> Doc -> Doc
$$ forall p. (p -> Doc) -> Maybe p -> Doc
maybeP forall {a}.
(Pretty (CExpression a), Pretty (CStatement a)) =>
CStatement a -> Doc
prettyElse Maybe (CStatement NodeInfo)
estat
where
prettyBody :: CStatement a -> Doc
prettyBody c :: CStatement a
c@(CCompound [Ident]
_ [CCompoundBlockItem a]
_ a
_) = forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) CStatement a
c
prettyBody CStatement a
nonCompound = forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) (forall a. [Ident] -> [CCompoundBlockItem a] -> a -> CStatement a
CCompound [] [forall a. CStatement a -> CCompoundBlockItem a
CBlockStmt CStatement a
nonCompound] forall a. HasCallStack => a
undefined)
prettyElse :: CStatement a -> Doc
prettyElse (CIf CExpression a
else_if_expr CStatement a
else_if_stat Maybe (CStatement a)
else_stat a
_) =
String -> Doc
text String
"else if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpression a
else_if_expr)
Doc -> Doc -> Doc
$+$ forall {a}. Pretty (CStatement a) => CStatement a -> Doc
prettyBody CStatement a
else_if_stat
Doc -> Doc -> Doc
$$ forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CStatement a -> Doc
prettyElse Maybe (CStatement a)
else_stat
prettyElse CStatement a
else_stmt =
String -> Doc
text String
"else"
Doc -> Doc -> Doc
$+$ forall {a}. Pretty (CStatement a) => CStatement a -> Doc
prettyBody CStatement a
else_stmt
pretty (CSwitch CExpr
expr CStatement NodeInfo
stat NodeInfo
_) =
Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"switch" Doc -> Doc -> Doc
<+> String -> Doc
text String
"(" Doc -> Doc -> Doc
<> forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
")"
Doc -> Doc -> Doc
$+$ forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) CStatement NodeInfo
stat
pretty (CWhile CExpr
expr CStatement NodeInfo
stat Bool
False NodeInfo
_) =
Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> String -> Doc
text String
"(" Doc -> Doc -> Doc
<> forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
")"
Doc -> Doc -> Doc
$+$ forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) CStatement NodeInfo
stat
pretty (CWhile CExpr
expr CStatement NodeInfo
stat Bool
True NodeInfo
_) =
Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"do" Doc -> Doc -> Doc
$+$ forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) CStatement NodeInfo
stat
Doc -> Doc -> Doc
$$ String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> String -> Doc
text String
"(" Doc -> Doc -> Doc
<> forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
");"
pretty (CFor Either (Maybe CExpr) CDecl
for_init Maybe CExpr
cond Maybe CExpr
step CStatement NodeInfo
stat NodeInfo
_) =
Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"for" Doc -> Doc -> Doc
<+> String -> Doc
text String
"("
Doc -> Doc -> Doc
<> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall p. (p -> Doc) -> Maybe p -> Doc
maybeP forall p. Pretty p => p -> Doc
pretty) forall p. Pretty p => p -> Doc
pretty Either (Maybe CExpr) CDecl
for_init Doc -> Doc -> Doc
<> Doc
semi
Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP forall p. Pretty p => p -> Doc
pretty Maybe CExpr
cond Doc -> Doc -> Doc
<> Doc
semi
Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP forall p. Pretty p => p -> Doc
pretty Maybe CExpr
step Doc -> Doc -> Doc
<> String -> Doc
text String
")" Doc -> Doc -> Doc
$+$ forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) CStatement NodeInfo
stat
pretty (CGoto Ident
ident NodeInfo
_) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"goto" Doc -> Doc -> Doc
<+> Ident -> Doc
identP Ident
ident Doc -> Doc -> Doc
<> Doc
semi
pretty (CGotoPtr CExpr
expr NodeInfo
_) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"goto" Doc -> Doc -> Doc
<+> String -> Doc
text String
"*" Doc -> Doc -> Doc
<+> forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
30 CExpr
expr Doc -> Doc -> Doc
<> Doc
semi
pretty (CCont NodeInfo
_) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"continue" Doc -> Doc -> Doc
<> Doc
semi
pretty (CBreak NodeInfo
_) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"break" Doc -> Doc -> Doc
<> Doc
semi
pretty (CReturn Maybe CExpr
Nothing NodeInfo
_) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"return" Doc -> Doc -> Doc
<> Doc
semi
pretty (CReturn (Just CExpr
e) NodeInfo
_) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CExpr
e Doc -> Doc -> Doc
<> Doc
semi
pretty (CAsm CAsmStmt
asmStmt NodeInfo
_) = forall p. Pretty p => p -> Doc
pretty CAsmStmt
asmStmt
prettyPrec :: Int -> CStatement NodeInfo -> Doc
prettyPrec Int
p (CCompound [Ident]
localLabels [CBlockItem]
bis NodeInfo
_) =
let inner :: Doc
inner = String -> Doc
text String
"{" Doc -> Doc -> Doc
$+$ forall p. ([p] -> Doc) -> [p] -> Doc
mlistP [Ident] -> Doc
ppLblDecls [Ident]
localLabels Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CBlockItem]
bis) Doc -> Doc -> Doc
$$ String -> Doc
text String
"}"
in if Int
p forall a. Eq a => a -> a -> Bool
== -Int
1 then Doc
inner else Doc -> Doc
ii Doc
inner
where ppLblDecls :: [Ident] -> Doc
ppLblDecls = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Ident
l -> String -> Doc
text String
"__label__" Doc -> Doc -> Doc
<+> Ident -> Doc
identP Ident
l Doc -> Doc -> Doc
<+> Doc
semi)
prettyPrec Int
_ CStatement NodeInfo
p = forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
p
instance Pretty CAsmStmt where
pretty :: CAsmStmt -> Doc
pretty (CAsmStmt Maybe CTypeQual
tyQual CStrLit
expr [CAsmOperand]
outOps [CAsmOperand]
inOps [CStrLit]
clobbers NodeInfo
_) =
Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__asm__" Doc -> Doc -> Doc
<+>
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP forall p. Pretty p => p -> Doc
pretty Maybe CTypeQual
tyQual Doc -> Doc -> Doc
<>
Doc -> Doc
parens Doc
asmStmt Doc -> Doc -> Doc
<> Doc
semi
where
asmStmt :: Doc
asmStmt = forall p. Pretty p => p -> Doc
pretty CStrLit
expr Doc -> Doc -> Doc
<+>
(if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[CAsmOperand]
inOps,[CAsmOperand]
outOps] Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CStrLit]
clobbers then Doc
empty else Doc
ops)
ops :: Doc
ops = String -> Doc
text String
":" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CAsmOperand]
outOps)) Doc -> Doc -> Doc
<+>
String -> Doc
text String
":" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CAsmOperand]
inOps)) Doc -> Doc -> Doc
<+>
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CStrLit]
clobbers then Doc
empty else Doc
clobs)
clobs :: Doc
clobs = String -> Doc
text String
":" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CStrLit]
clobbers))
instance Pretty CAsmOperand where
pretty :: CAsmOperand -> Doc
pretty (CAsmOperand Maybe Ident
mArgName CStrLit
cnstr CExpr
expr NodeInfo
_) =
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP (\Ident
argName -> String -> Doc
text String
"[" Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
argName Doc -> Doc -> Doc
<> String -> Doc
text String
"]") Maybe Ident
mArgName Doc -> Doc -> Doc
<+>
forall p. Pretty p => p -> Doc
pretty CStrLit
cnstr Doc -> Doc -> Doc
<+>
Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpr
expr)
instance Pretty CBlockItem where
pretty :: CBlockItem -> Doc
pretty (CBlockStmt CStatement NodeInfo
stat) = forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
pretty (CBlockDecl CDecl
decl) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => p -> Doc
pretty CDecl
decl Doc -> Doc -> Doc
<> Doc
semi
pretty (CNestedFunDef CFunDef
fundef) = Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => p -> Doc
pretty CFunDef
fundef
instance Pretty CDecl where
pretty :: CDecl -> Doc
pretty (CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
divs NodeInfo
_) =
[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CDeclSpec]
checked_specs) Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall {p} {p}.
(Pretty p, Pretty p) =>
(Maybe CDeclr, Maybe p, Maybe p) -> Doc
p [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
divs))
where
p :: (Maybe CDeclr, Maybe p, Maybe p) -> Doc
p (Maybe CDeclr
declr, Maybe p
initializer, Maybe p
expr) =
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP (Bool -> Int -> CDeclr -> Doc
prettyDeclr Bool
False Int
0) Maybe CDeclr
declr Doc -> Doc -> Doc
<+>
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP ((String -> Doc
text String
":" Doc -> Doc -> Doc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Pretty p => p -> Doc
pretty) Maybe p
expr Doc -> Doc -> Doc
<+>
[CAttr] -> Doc
attrlistP (forall {a}. Maybe (CDeclarator a) -> [CAttribute a]
getAttrs Maybe CDeclr
declr) Doc -> Doc -> Doc
<+>
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP ((String -> Doc
text String
"=" Doc -> Doc -> Doc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Pretty p => p -> Doc
pretty) Maybe p
initializer
checked_specs :: [CDeclSpec]
checked_specs =
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {a} {a}.
(CDeclarationSpecifier a, CDeclarationSpecifier a) -> Bool
isAttrAfterSUE (forall a b. [a] -> [b] -> [(a, b)]
zip [CDeclSpec]
specs (forall a. [a] -> [a]
tail [CDeclSpec]
specs))
then forall a. String -> a -> a
trace
(String
"Warning: AST Invariant violated: __attribute__ specifier following struct/union/enum:" forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CDeclSpec]
specs))
[CDeclSpec]
specs
else [CDeclSpec]
specs
isAttrAfterSUE :: (CDeclarationSpecifier a, CDeclarationSpecifier a) -> Bool
isAttrAfterSUE (CTypeSpec CTypeSpecifier a
ty,CTypeQual (CAttrQual CAttribute a
_)) = forall a. CTypeSpecifier a -> Bool
isSUEDef CTypeSpecifier a
ty
isAttrAfterSUE (CDeclarationSpecifier a, CDeclarationSpecifier a)
_ = Bool
False
getAttrs :: Maybe (CDeclarator a) -> [CAttribute a]
getAttrs Maybe (CDeclarator a)
Nothing = []
getAttrs (Just (CDeclr Maybe Ident
_ [CDerivedDeclarator a]
_ Maybe (CStringLiteral a)
_ [CAttribute a]
cattrs a
_)) = [CAttribute a]
cattrs
pretty (CStaticAssert CExpr
expr CStrLit
str NodeInfo
_) =
String -> Doc
text String
"_Static_assert" Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma [forall p. Pretty p => p -> Doc
pretty CExpr
expr, forall p. Pretty p => p -> Doc
pretty CStrLit
str]))
instance Pretty CDeclSpec where
pretty :: CDeclSpec -> Doc
pretty (CStorageSpec CStorageSpec
sp) = forall p. Pretty p => p -> Doc
pretty CStorageSpec
sp
pretty (CTypeSpec CTypeSpec
sp) = forall p. Pretty p => p -> Doc
pretty CTypeSpec
sp
pretty (CTypeQual CTypeQual
qu) = forall p. Pretty p => p -> Doc
pretty CTypeQual
qu
pretty (CFunSpec CFunSpec
fs) = forall p. Pretty p => p -> Doc
pretty CFunSpec
fs
pretty (CAlignSpec CAlignSpec
sa) = forall p. Pretty p => p -> Doc
pretty CAlignSpec
sa
instance Pretty CAlignSpec where
pretty :: CAlignSpec -> Doc
pretty (CAlignAsType CDecl
decl NodeInfo
_) =
String -> Doc
text String
"_Alignas" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CDecl
decl)
pretty (CAlignAsExpr CExpr
expr NodeInfo
_) =
String -> Doc
text String
"_Alignas" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpr
expr)
instance Pretty CStorageSpec where
pretty :: CStorageSpec -> Doc
pretty (CAuto NodeInfo
_) = String -> Doc
text String
"auto"
pretty (CRegister NodeInfo
_) = String -> Doc
text String
"register"
pretty (CStatic NodeInfo
_) = String -> Doc
text String
"static"
pretty (CExtern NodeInfo
_) = String -> Doc
text String
"extern"
pretty (CTypedef NodeInfo
_) = String -> Doc
text String
"typedef"
pretty (CThread NodeInfo
_) = String -> Doc
text String
"_Thread_local"
pretty (CClKernel NodeInfo
_) = String -> Doc
text String
"__kernel"
pretty (CClGlobal NodeInfo
_) = String -> Doc
text String
"__global"
pretty (CClLocal NodeInfo
_) = String -> Doc
text String
"__local"
instance Pretty CTypeSpec where
pretty :: CTypeSpec -> Doc
pretty (CVoidType NodeInfo
_) = String -> Doc
text String
"void"
pretty (CCharType NodeInfo
_) = String -> Doc
text String
"char"
pretty (CShortType NodeInfo
_) = String -> Doc
text String
"short"
pretty (CIntType NodeInfo
_) = String -> Doc
text String
"int"
pretty (CLongType NodeInfo
_) = String -> Doc
text String
"long"
pretty (CFloatType NodeInfo
_) = String -> Doc
text String
"float"
pretty (CFloatNType Int
n Bool
x NodeInfo
_) = String -> Doc
text String
"_Float" Doc -> Doc -> Doc
<> String -> Doc
text (forall a. Show a => a -> String
show Int
n) Doc -> Doc -> Doc
<>
(if Bool
x then String -> Doc
text String
"x" else Doc
empty)
pretty (CDoubleType NodeInfo
_) = String -> Doc
text String
"double"
pretty (CSignedType NodeInfo
_) = String -> Doc
text String
"signed"
pretty (CUnsigType NodeInfo
_) = String -> Doc
text String
"unsigned"
pretty (CBoolType NodeInfo
_) = String -> Doc
text String
"_Bool"
pretty (CComplexType NodeInfo
_) = String -> Doc
text String
"_Complex"
pretty (CInt128Type NodeInfo
_) = String -> Doc
text String
"__int128"
pretty (CUInt128Type NodeInfo
_) = String -> Doc
text String
"__uint128"
pretty (CSUType CStructUnion
union NodeInfo
_) = forall p. Pretty p => p -> Doc
pretty CStructUnion
union
pretty (CEnumType CEnum
enum NodeInfo
_) = forall p. Pretty p => p -> Doc
pretty CEnum
enum
pretty (CTypeDef Ident
ident NodeInfo
_) = Ident -> Doc
identP Ident
ident
pretty (CTypeOfExpr CExpr
expr NodeInfo
_) =
String -> Doc
text String
"typeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpr
expr)
pretty (CTypeOfType CDecl
decl NodeInfo
_) =
String -> Doc
text String
"typeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CDecl
decl)
pretty (CAtomicType CDecl
decl NodeInfo
_) =
String -> Doc
text String
"_Atomic" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CDecl
decl)
instance Pretty CTypeQual where
pretty :: CTypeQual -> Doc
pretty (CConstQual NodeInfo
_) = String -> Doc
text String
"const"
pretty (CVolatQual NodeInfo
_) = String -> Doc
text String
"volatile"
pretty (CRestrQual NodeInfo
_) = String -> Doc
text String
"__restrict"
pretty (CAtomicQual NodeInfo
_) = String -> Doc
text String
"_Atomic"
pretty (CAttrQual CAttr
a) = [CAttr] -> Doc
attrlistP [CAttr
a]
pretty (CNullableQual NodeInfo
_) = String -> Doc
text String
"_Nullable"
pretty (CNonnullQual NodeInfo
_) = String -> Doc
text String
"_Nonnull"
pretty (CClRdOnlyQual NodeInfo
_) = String -> Doc
text String
"__read_only"
pretty (CClWrOnlyQual NodeInfo
_) = String -> Doc
text String
"__write_only"
instance Pretty CFunSpec where
pretty :: CFunSpec -> Doc
pretty (CInlineQual NodeInfo
_) = String -> Doc
text String
"inline"
pretty (CNoreturnQual NodeInfo
_) = String -> Doc
text String
"_Noreturn"
instance Pretty CStructUnion where
pretty :: CStructUnion -> Doc
pretty (CStruct CStructTag
tag Maybe Ident
ident Maybe [CDecl]
Nothing [CAttr]
cattrs NodeInfo
_) = forall p. Pretty p => p -> Doc
pretty CStructTag
tag Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP Ident -> Doc
identP Maybe Ident
ident
pretty (CStruct CStructTag
tag Maybe Ident
ident (Just []) [CAttr]
cattrs NodeInfo
_) =
forall p. Pretty p => p -> Doc
pretty CStructTag
tag Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP Ident -> Doc
identP Maybe Ident
ident Doc -> Doc -> Doc
<+> String -> Doc
text String
"{ }"
pretty (CStruct CStructTag
tag Maybe Ident
ident (Just [CDecl]
decls) [CAttr]
cattrs NodeInfo
_) = [Doc] -> Doc
vcat [
forall p. Pretty p => p -> Doc
pretty CStructTag
tag Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP Ident -> Doc
identP Maybe Ident
ident Doc -> Doc -> Doc
<+> String -> Doc
text String
"{",
Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep (forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Pretty p => p -> Doc
pretty) [CDecl]
decls),
String -> Doc
text String
"}"]
instance Pretty CStructTag where
pretty :: CStructTag -> Doc
pretty CStructTag
CStructTag = String -> Doc
text String
"struct"
pretty CStructTag
CUnionTag = String -> Doc
text String
"union"
instance Pretty CEnum where
pretty :: CEnum -> Doc
pretty (CEnum Maybe Ident
enum_ident Maybe [(Ident, Maybe CExpr)]
Nothing [CAttr]
cattrs NodeInfo
_) = String -> Doc
text String
"enum" Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP Ident -> Doc
identP Maybe Ident
enum_ident
pretty (CEnum Maybe Ident
enum_ident (Just [(Ident, Maybe CExpr)]
vals) [CAttr]
cattrs NodeInfo
_) = [Doc] -> Doc
vcat [
String -> Doc
text String
"enum" Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP Ident -> Doc
identP Maybe Ident
enum_ident Doc -> Doc -> Doc
<+> String -> Doc
text String
"{",
Doc -> Doc
ii forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall {p}. Pretty p => (Ident, Maybe p) -> Doc
p [(Ident, Maybe CExpr)]
vals)),
String -> Doc
text String
"}"] where
p :: (Ident, Maybe p) -> Doc
p (Ident
ident, Maybe p
expr) = Ident -> Doc
identP Ident
ident Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP ((String -> Doc
text String
"=" Doc -> Doc -> Doc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Pretty p => p -> Doc
pretty) Maybe p
expr
instance Pretty CDeclr where
prettyPrec :: Int -> CDeclr -> Doc
prettyPrec Int
prec CDeclr
declr = Bool -> Int -> CDeclr -> Doc
prettyDeclr Bool
True Int
prec CDeclr
declr
prettyDeclr :: Bool -> Int -> CDeclr -> Doc
prettyDeclr :: Bool -> Int -> CDeclr -> Doc
prettyDeclr Bool
show_attrs Int
prec (CDeclr Maybe Ident
name [CDerivedDeclarator NodeInfo]
derived_declrs Maybe CStrLit
asmname [CAttr]
cattrs NodeInfo
_) =
Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr Int
prec (forall a. [a] -> [a]
reverse [CDerivedDeclarator NodeInfo]
derived_declrs) Doc -> Doc -> Doc
<+> forall {p}. Pretty p => Maybe p -> Doc
prettyAsmName Maybe CStrLit
asmname Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
ifP Bool
show_attrs ([CAttr] -> Doc
attrlistP [CAttr]
cattrs)
where
ppDeclr :: Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr Int
_ [] = forall p. (p -> Doc) -> Maybe p -> Doc
maybeP Ident -> Doc
identP Maybe Ident
name
ppDeclr Int
p (CPtrDeclr [CTypeQual]
quals NodeInfo
_ : [CDerivedDeclarator NodeInfo]
declrs) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
5 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"*" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CTypeQual]
quals) Doc -> Doc -> Doc
<+> Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr Int
5 [CDerivedDeclarator NodeInfo]
declrs
ppDeclr Int
p (CArrDeclr [CTypeQual]
quals CArrSize
size NodeInfo
_ : [CDerivedDeclarator NodeInfo]
declrs) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
6 forall a b. (a -> b) -> a -> b
$ Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr Int
6 [CDerivedDeclarator NodeInfo]
declrs Doc -> Doc -> Doc
<> Doc -> Doc
brackets ([Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CTypeQual]
quals) Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CArrSize
size)
ppDeclr Int
_ (CFunDeclr Either [Ident] ([CDecl], Bool)
params [CAttr]
fun_attrs NodeInfo
_ : [CDerivedDeclarator NodeInfo]
declrs) =
(if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CAttr]
fun_attrs) then Doc -> Doc
parens ([CAttr] -> Doc
attrlistP [CAttr]
fun_attrs Doc -> Doc -> Doc
<+> Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr Int
5 [CDerivedDeclarator NodeInfo]
declrs) else Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr Int
6 [CDerivedDeclarator NodeInfo]
declrs)
Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall {a}. Pretty a => Either [Ident] ([a], Bool) -> Doc
prettyParams Either [Ident] ([CDecl], Bool)
params)
prettyParams :: Either [Ident] ([a], Bool) -> Doc
prettyParams (Right ([a]
decls, Bool
isVariadic)) =
[Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [a]
decls))
Doc -> Doc -> Doc
<> (if Bool
isVariadic then String -> Doc
text String
"," Doc -> Doc -> Doc
<+> String -> Doc
text String
"..." else Doc
empty)
prettyParams (Left [Ident]
oldStyleIds) =
[Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
identP [Ident]
oldStyleIds))
prettyAsmName :: Maybe p -> Doc
prettyAsmName Maybe p
asm_name_opt
= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\p
asm_name -> String -> Doc
text String
"__asm__" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty p
asm_name)) Maybe p
asm_name_opt
instance Pretty CArrSize where
pretty :: CArrSize -> Doc
pretty (CNoArrSize Bool
completeType) = Bool -> Doc -> Doc
ifP Bool
completeType (String -> Doc
text String
"*")
pretty (CArrSize Bool
staticMod CExpr
expr) = Bool -> Doc -> Doc
ifP Bool
staticMod (String -> Doc
text String
"static") Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CExpr
expr
instance Pretty CInit where
pretty :: CInit -> Doc
pretty (CInitExpr CExpr
expr NodeInfo
_) = forall p. Pretty p => p -> Doc
pretty CExpr
expr
pretty (CInitList CInitializerList NodeInfo
initl NodeInfo
_) =
String -> Doc
text String
"{" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall {p} {a}. (Pretty p, Pretty a) => ([a], p) -> Doc
p CInitializerList NodeInfo
initl)) Doc -> Doc -> Doc
<+> String -> Doc
text String
"}" where
p :: ([a], p) -> Doc
p ([], p
initializer) = forall p. Pretty p => p -> Doc
pretty p
initializer
p ([a]
desigs, p
initializer) = [Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [a]
desigs) Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty p
initializer
instance Pretty CDesignator where
pretty :: CDesignator -> Doc
pretty (CArrDesig CExpr
expr NodeInfo
_) = String -> Doc
text String
"[" Doc -> Doc -> Doc
<> forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
"]"
pretty (CMemberDesig Ident
ident NodeInfo
_) = String -> Doc
text String
"." Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
ident
pretty (CRangeDesig CExpr
expr1 CExpr
expr2 NodeInfo
_) =
String -> Doc
text String
"[" Doc -> Doc -> Doc
<> forall p. Pretty p => p -> Doc
pretty CExpr
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"..." Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CExpr
expr2 Doc -> Doc -> Doc
<> String -> Doc
text String
"]"
instance Pretty CAttr where
pretty :: CAttr -> Doc
pretty (CAttr Ident
attrName [] NodeInfo
_) = Ident -> Doc
identP Ident
attrName
pretty (CAttr Ident
attrName [CExpr]
attrParams NodeInfo
_) = Ident -> Doc
identP Ident
attrName Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [CExpr]
attrParams)
instance Pretty CExpr where
prettyPrec :: Int -> CExpr -> Doc
prettyPrec Int
p (CComma [CExpr]
exprs NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p (-Int
1) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
2) [CExpr]
exprs))
prettyPrec Int
p (CAssign CAssignOp
op CExpr
expr1 CExpr
expr2 NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
3 CExpr
expr1 Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CAssignOp
op Doc -> Doc -> Doc
<+> forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
2 CExpr
expr2
prettyPrec Int
p (CCond CExpr
expr1 Maybe CExpr
expr2 CExpr
expr3 NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
4 CExpr
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"?"
Doc -> Doc -> Doc
<+> forall p. (p -> Doc) -> Maybe p -> Doc
maybeP forall p. Pretty p => p -> Doc
pretty Maybe CExpr
expr2 Doc -> Doc -> Doc
<+> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
4 CExpr
expr3
prettyPrec Int
p (CBinary CBinaryOp
op CExpr
expr1 CExpr
expr2 NodeInfo
_) =
let prec :: Int
prec = CBinaryOp -> Int
binPrec CBinaryOp
op
in Int -> Int -> Doc -> Doc
parenPrec Int
p Int
prec forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
prec CExpr
expr1
Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CBinaryOp
op Doc -> Doc -> Doc
<+> forall p. Pretty p => Int -> p -> Doc
prettyPrec (Int
prec forall a. Num a => a -> a -> a
+ Int
1) CExpr
expr2
prettyPrec Int
p (CCast CDecl
decl CExpr
expr NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> forall p. Pretty p => p -> Doc
pretty CDecl
decl Doc -> Doc -> Doc
<> String -> Doc
text String
")"
Doc -> Doc -> Doc
<+> forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpr
expr
prettyPrec Int
p (CUnary CUnaryOp
CPostIncOp CExpr
expr NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
26 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
"++"
prettyPrec Int
p (CUnary CUnaryOp
CPostDecOp CExpr
expr NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
26 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
"--"
prettyPrec Int
p (CUnary CUnaryOp
op expr :: CExpr
expr@(CUnary CUnaryOp
_ CExpr
_ NodeInfo
_) NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => p -> Doc
pretty CUnaryOp
op Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpr
expr)
prettyPrec Int
p (CUnary CUnaryOp
op CExpr
expr NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => p -> Doc
pretty CUnaryOp
op Doc -> Doc -> Doc
<> forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpr
expr
prettyPrec Int
p (CSizeofExpr CExpr
expr NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"sizeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpr
expr)
prettyPrec Int
p (CSizeofType CDecl
decl NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"sizeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CDecl
decl)
prettyPrec Int
p (CAlignofExpr CExpr
expr NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__alignof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpr
expr)
prettyPrec Int
p (CAlignofType CDecl
decl NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__alignof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CDecl
decl)
prettyPrec Int
p (CComplexReal CExpr
expr NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__real" Doc -> Doc -> Doc
<+> forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpr
expr
prettyPrec Int
p (CComplexImag CExpr
expr NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
25 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__imag" Doc -> Doc -> Doc
<+> forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpr
expr
prettyPrec Int
p (CIndex CExpr
expr1 CExpr
expr2 NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
26 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpr
expr1
Doc -> Doc -> Doc
<> String -> Doc
text String
"[" Doc -> Doc -> Doc
<> forall p. Pretty p => p -> Doc
pretty CExpr
expr2 Doc -> Doc -> Doc
<> String -> Doc
text String
"]"
prettyPrec Int
p (CCall CExpr
expr [CExpr]
args NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
30 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
30 CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
"("
Doc -> Doc -> Doc
<> ([Doc] -> Doc
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty) [CExpr]
args Doc -> Doc -> Doc
<> String -> Doc
text String
")"
prettyPrec Int
p (CMember CExpr
expr Ident
ident Bool
deref NodeInfo
_) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
26 forall a b. (a -> b) -> a -> b
$ forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpr
expr
Doc -> Doc -> Doc
<> String -> Doc
text (if Bool
deref then String
"->" else String
".") Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
ident
prettyPrec Int
_p (CVar Ident
ident NodeInfo
_) = Ident -> Doc
identP Ident
ident
prettyPrec Int
_p (CConst CConst
constant) = forall p. Pretty p => p -> Doc
pretty CConst
constant
prettyPrec Int
_p (CCompoundLit CDecl
decl CInitializerList NodeInfo
initl NodeInfo
_) =
Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CDecl
decl) Doc -> Doc -> Doc
<+> (Doc -> Doc
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma) (forall a b. (a -> b) -> [a] -> [b]
map forall {p} {a}. (Pretty p, Pretty a) => ([a], p) -> Doc
p CInitializerList NodeInfo
initl) where
p :: ([a], p) -> Doc
p ([], p
initializer) = forall p. Pretty p => p -> Doc
pretty p
initializer
p ([a]
mems, p
initializer) = [Doc] -> Doc
hcat (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [a]
mems) Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty p
initializer
prettyPrec Int
_p (CStatExpr CStatement NodeInfo
stat NodeInfo
_) =
String -> Doc
text String
"(" Doc -> Doc -> Doc
<> forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat Doc -> Doc -> Doc
<> String -> Doc
text String
")"
prettyPrec Int
_p (CLabAddrExpr Ident
ident NodeInfo
_) = String -> Doc
text String
"&&" Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
ident
prettyPrec Int
_p (CGenericSelection CExpr
expr [(Maybe CDecl, CExpr)]
assoc_list NodeInfo
_) =
String -> Doc
text String
"_Generic" Doc -> Doc -> Doc
<> (Doc -> Doc
parensforall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> Doc
hsepforall b c a. (b -> c) -> (a -> b) -> a -> c
.Doc -> [Doc] -> [Doc]
punctuate Doc
comma) (forall p. Pretty p => p -> Doc
pretty CExpr
expr forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a} {p}. (Pretty a, Pretty p) => (Maybe a, p) -> Doc
pAssoc [(Maybe CDecl, CExpr)]
assoc_list)
where
pAssoc :: (Maybe a, p) -> Doc
pAssoc (Maybe a
mty, p
expr1) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Doc
text String
"default") forall p. Pretty p => p -> Doc
pretty Maybe a
mty Doc -> Doc -> Doc
<> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty p
expr1
prettyPrec Int
_p (CBuiltinExpr CBuiltin
builtin) = forall p. Pretty p => p -> Doc
pretty CBuiltin
builtin
instance Pretty CBuiltin where
pretty :: CBuiltin -> Doc
pretty (CBuiltinVaArg CExpr
expr CDecl
ty_name NodeInfo
_) =
String -> Doc
text String
"__builtin_va_arg" Doc -> Doc -> Doc
<+>
Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CDecl
ty_name)
pretty (CBuiltinOffsetOf CDecl
ty_name (CMemberDesig Ident
field1 NodeInfo
_ : [CDesignator]
desigs) NodeInfo
_) =
String -> Doc
text String
"__builtin_offsetof" Doc -> Doc -> Doc
<+>
Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CDecl
ty_name Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Ident -> Doc
identP Ident
field1 Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat (forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CDesignator]
desigs) )
pretty (CBuiltinOffsetOf CDecl
_ty_name [CDesignator]
otherDesigs NodeInfo
_) =
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Inconsistent AST: Cannot interpret designators in offsetOf: " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show ([Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall p. Pretty p => p -> Doc
pretty [CDesignator]
otherDesigs)
pretty (CBuiltinTypesCompatible CDecl
ty1 CDecl
ty2 NodeInfo
_) =
String -> Doc
text String
"__builtin_types_compatible_p" Doc -> Doc -> Doc
<+>
Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CDecl
ty1 Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CDecl
ty2)
pretty (CBuiltinConvertVector CExpr
expr CDecl
ty NodeInfo
_) =
String -> Doc
text String
"__builtin_convertvector" Doc -> Doc -> Doc
<+>
Doc -> Doc
parens (forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> forall p. Pretty p => p -> Doc
pretty CDecl
ty)
instance Pretty CAssignOp where
pretty :: CAssignOp -> Doc
pretty CAssignOp
op = String -> Doc
text forall a b. (a -> b) -> a -> b
$ case CAssignOp
op of
CAssignOp
CAssignOp -> String
"="
CAssignOp
CMulAssOp -> String
"*="
CAssignOp
CDivAssOp -> String
"/="
CAssignOp
CRmdAssOp -> String
"%="
CAssignOp
CAddAssOp -> String
"+="
CAssignOp
CSubAssOp -> String
"-="
CAssignOp
CShlAssOp -> String
"<<="
CAssignOp
CShrAssOp -> String
">>="
CAssignOp
CAndAssOp -> String
"&="
CAssignOp
CXorAssOp -> String
"^="
CAssignOp
COrAssOp -> String
"|="
instance Pretty CBinaryOp where
pretty :: CBinaryOp -> Doc
pretty CBinaryOp
op = String -> Doc
text forall a b. (a -> b) -> a -> b
$ case CBinaryOp
op of
CBinaryOp
CMulOp -> String
"*"
CBinaryOp
CDivOp -> String
"/"
CBinaryOp
CRmdOp -> String
"%"
CBinaryOp
CAddOp -> String
"+"
CBinaryOp
CSubOp -> String
"-"
CBinaryOp
CShlOp -> String
"<<"
CBinaryOp
CShrOp -> String
">>"
CBinaryOp
CLeOp -> String
"<"
CBinaryOp
CGrOp -> String
">"
CBinaryOp
CLeqOp -> String
"<="
CBinaryOp
CGeqOp -> String
">="
CBinaryOp
CEqOp -> String
"=="
CBinaryOp
CNeqOp -> String
"!="
CBinaryOp
CAndOp -> String
"&"
CBinaryOp
CXorOp -> String
"^"
CBinaryOp
COrOp -> String
"|"
CBinaryOp
CLndOp -> String
"&&"
CBinaryOp
CLorOp -> String
"||"
instance Pretty CUnaryOp where
pretty :: CUnaryOp -> Doc
pretty CUnaryOp
op = String -> Doc
text forall a b. (a -> b) -> a -> b
$ case CUnaryOp
op of
CUnaryOp
CPreIncOp -> String
"++"
CUnaryOp
CPreDecOp -> String
"--"
CUnaryOp
CPostIncOp -> String
"++"
CUnaryOp
CPostDecOp -> String
"--"
CUnaryOp
CAdrOp -> String
"&"
CUnaryOp
CIndOp -> String
"*"
CUnaryOp
CPlusOp -> String
"+"
CUnaryOp
CMinOp -> String
"-"
CUnaryOp
CCompOp -> String
"~"
CUnaryOp
CNegOp -> String
"!"
instance Pretty CConst where
pretty :: CConst -> Doc
pretty (CIntConst CInteger
int_const NodeInfo
_) = String -> Doc
text (forall a. Show a => a -> String
show CInteger
int_const)
pretty (CCharConst CChar
chr NodeInfo
_) = String -> Doc
text (forall a. Show a => a -> String
show CChar
chr)
pretty (CFloatConst CFloat
flt NodeInfo
_) = String -> Doc
text (forall a. Show a => a -> String
show CFloat
flt)
pretty (CStrConst CString
str NodeInfo
_) = String -> Doc
text (forall a. Show a => a -> String
show CString
str)
instance Pretty CStrLit where
pretty :: CStrLit -> Doc
pretty (CStrLit CString
str NodeInfo
_) = String -> Doc
text (forall a. Show a => a -> String
show CString
str)
binPrec :: CBinaryOp -> Int
binPrec :: CBinaryOp -> Int
binPrec CBinaryOp
CMulOp = Int
20
binPrec CBinaryOp
CDivOp = Int
20
binPrec CBinaryOp
CRmdOp = Int
20
binPrec CBinaryOp
CAddOp = Int
19
binPrec CBinaryOp
CSubOp = Int
19
binPrec CBinaryOp
CShlOp = Int
18
binPrec CBinaryOp
CShrOp = Int
18
binPrec CBinaryOp
CLeOp = Int
17
binPrec CBinaryOp
CGrOp = Int
17
binPrec CBinaryOp
CLeqOp = Int
17
binPrec CBinaryOp
CGeqOp = Int
17
binPrec CBinaryOp
CEqOp = Int
16
binPrec CBinaryOp
CNeqOp = Int
16
binPrec CBinaryOp
CAndOp = Int
15
binPrec CBinaryOp
CXorOp = Int
14
binPrec CBinaryOp
COrOp = Int
13
binPrec CBinaryOp
CLndOp = Int
12
binPrec CBinaryOp
CLorOp = Int
11