{-# 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 = Int -> p -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
0
prettyPrec Int
_ = p -> Doc
forall p. Pretty p => p -> Doc
pretty
maybeP :: (p -> Doc) -> Maybe p -> Doc
maybeP :: forall p. (p -> Doc) -> Maybe p -> Doc
maybeP = Doc -> (p -> Doc) -> Maybe p -> Doc
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 = ([p] -> Doc) -> Maybe [p] -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP [p] -> Doc
pp (if [p] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [p]
xs then Maybe [p]
forall a. Maybe a
Nothing else [p] -> Maybe [p]
forall a. a -> Maybe a
Just [p]
xs)
identP :: Ident -> Doc
identP :: Ident -> Doc
identP = String -> Doc
text (String -> Doc) -> (Ident -> String) -> Ident -> Doc
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 ([Doc] -> Doc) -> ([CAttr] -> [Doc]) -> [CAttr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([CAttr] -> [Doc]) -> [CAttr] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CAttr -> Doc) -> [CAttr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CAttr -> Doc
forall p. Pretty p => p -> Doc
pretty ([CAttr] -> Doc) -> [CAttr] -> Doc
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 Int -> Int -> Bool
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 ((CExtDecl -> Doc) -> [CExtDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CExtDecl -> Doc
forall p. Pretty p => p -> Doc
pretty [CExtDecl]
edecls)
prettyUsingInclude :: CTranslUnit -> Doc
prettyUsingInclude :: CTranslUnit -> Doc
prettyUsingInclude (CTranslUnit [CExtDecl]
edecls NodeInfo
_) =
Set String -> Doc
forall {a}. Set a -> Doc
includeWarning Set String
headerFiles
Doc -> Doc -> Doc
$$
[Doc] -> Doc
vcat ((Either String CExtDecl -> Doc)
-> [Either String CExtDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Doc)
-> (CExtDecl -> Doc) -> Either String CExtDecl -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Doc
includeHeader CExtDecl -> Doc
forall p. Pretty p => p -> Doc
pretty) [Either String CExtDecl]
mappedDecls)
where
(Set String
headerFiles,[Either String CExtDecl]
mappedDecls) = (CExtDecl
-> (Set String, [Either String CExtDecl])
-> (Set String, [Either String CExtDecl]))
-> (Set String, [Either String CExtDecl])
-> [CExtDecl]
-> (Set String, [Either String CExtDecl])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Either String CExtDecl
-> (Set String, [Either String CExtDecl])
-> (Set String, [Either String CExtDecl])
forall {a} {b}.
Ord a =>
Either a b -> (Set a, [Either a b]) -> (Set a, [Either a b])
addDecl (Either String CExtDecl
-> (Set String, [Either String CExtDecl])
-> (Set String, [Either String CExtDecl]))
-> (CExtDecl -> Either String CExtDecl)
-> CExtDecl
-> (Set String, [Either String CExtDecl])
-> (Set String, [Either String CExtDecl])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExtDecl -> Either String CExtDecl
forall {b}. (CNode b, Pos b) => b -> Either String b
tagIncludedDecls) (Set String
forall a. Set a
Set.empty,[]) [CExtDecl]
edecls
tagIncludedDecls :: b -> Either String b
tagIncludedDecls b
edecl | Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
isHeaderFile (b -> Maybe String
forall a. CNode a => a -> Maybe String
fileOfNode b
edecl) = String -> Either String b
forall a b. a -> Either a b
Left ((Position -> String
posFile (Position -> String) -> (b -> Position) -> b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Position
forall a. Pos a => a -> Position
posOf) b
edecl)
| Bool
otherwise = b -> Either String b
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)
| a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
headerRef Set a
headerSet = (Set a
headerSet, [Either a b]
ds)
| Bool
otherwise = (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
headerRef Set a
headerSet, Either a b
decl Either a b -> [Either a b] -> [Either a b]
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 Either a b -> [Either a b] -> [Either a b]
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" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)
includeWarning :: Set a -> Doc
includeWarning Set a
hs | Set a -> Bool
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) = CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty CDecl
decl Doc -> Doc -> Doc
<> Doc
semi
pretty (CFDefExt CFunDef
fund) = CFunDef -> Doc
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 (CStrLit -> Doc
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 ((CDeclSpec -> Doc) -> [CDeclSpec] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CDeclSpec -> Doc
forall p. Pretty p => p -> Doc
pretty [CDeclSpec]
declspecs)
Doc -> Doc -> Doc
<+> CDeclr -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclr
declr
Doc -> Doc -> Doc
$+$ (Doc -> Doc
ii (Doc -> Doc) -> ([CDecl] -> Doc) -> [CDecl] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([CDecl] -> [Doc]) -> [CDecl] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CDecl -> Doc) -> [CDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) (Doc -> Doc) -> (CDecl -> Doc) -> CDecl -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty)) [CDecl]
decls
Doc -> Doc -> Doc
$$ Int -> CStatement NodeInfo -> 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
$$ CStatement NodeInfo -> 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
<+> CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
":" Doc -> Doc -> Doc
$$ CStatement NodeInfo -> 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
<+> CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"..."
Doc -> Doc -> Doc
<+> CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr2 Doc -> Doc -> Doc
<> String -> Doc
text String
":" Doc -> Doc -> Doc
$$ CStatement NodeInfo -> 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
$$ CStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
pretty (CExpr Maybe CExpr
expr NodeInfo
_) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (CExpr -> Doc) -> Maybe CExpr -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe CExpr
expr Doc -> Doc -> Doc
<> Doc
semi
pretty c :: CStatement NodeInfo
c@(CCompound [Ident]
_ [CBlockItem]
_ NodeInfo
_) = Int -> CStatement NodeInfo -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr)
Doc -> Doc -> Doc
$+$ CStatement NodeInfo -> Doc
forall {a}. Pretty (CStatement a) => CStatement a -> Doc
prettyBody CStatement NodeInfo
stat
Doc -> Doc -> Doc
$$ (CStatement NodeInfo -> Doc) -> Maybe (CStatement NodeInfo) -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CStatement NodeInfo -> Doc
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
_) = Int -> CStatement a -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) CStatement a
c
prettyBody CStatement a
nonCompound = Int -> CStatement a -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) ([Ident] -> [CCompoundBlockItem a] -> a -> CStatement a
forall a. [Ident] -> [CCompoundBlockItem a] -> a -> CStatement a
CCompound [] [CStatement a -> CCompoundBlockItem a
forall a. CStatement a -> CCompoundBlockItem a
CBlockStmt CStatement a
nonCompound] a
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 (CExpression a -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression a
else_if_expr)
Doc -> Doc -> Doc
$+$ CStatement a -> Doc
forall {a}. Pretty (CStatement a) => CStatement a -> Doc
prettyBody CStatement a
else_if_stat
Doc -> Doc -> Doc
$$ (CStatement a -> Doc) -> Maybe (CStatement a) -> 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
$+$ CStatement a -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"switch" Doc -> Doc -> Doc
<+> String -> Doc
text String
"(" Doc -> Doc -> Doc
<> CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
")"
Doc -> Doc -> Doc
$+$ Int -> CStatement NodeInfo -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> String -> Doc
text String
"(" Doc -> Doc -> Doc
<> CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> String -> Doc
text String
")"
Doc -> Doc -> Doc
$+$ Int -> CStatement NodeInfo -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"do" Doc -> Doc -> Doc
$+$ Int -> CStatement NodeInfo -> 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
<> CExpr -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"for" Doc -> Doc -> Doc
<+> String -> Doc
text String
"("
Doc -> Doc -> Doc
<> (Maybe CExpr -> Doc)
-> (CDecl -> Doc) -> Either (Maybe CExpr) CDecl -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((CExpr -> Doc) -> Maybe CExpr -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty) CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty Either (Maybe CExpr) CDecl
for_init Doc -> Doc -> Doc
<> Doc
semi
Doc -> Doc -> Doc
<+> (CExpr -> Doc) -> Maybe CExpr -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe CExpr
cond Doc -> Doc -> Doc
<> Doc
semi
Doc -> Doc -> Doc
<+> (CExpr -> Doc) -> Maybe CExpr -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe CExpr
step Doc -> Doc -> Doc
<> String -> Doc
text String
")" Doc -> Doc -> Doc
$+$ Int -> CStatement NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-Int
1) CStatement NodeInfo
stat
pretty (CGoto Ident
ident NodeInfo
_) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"goto" Doc -> Doc -> Doc
<+> String -> Doc
text String
"*" Doc -> Doc -> Doc
<+> Int -> CExpr -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
30 CExpr
expr Doc -> Doc -> Doc
<> Doc
semi
pretty (CCont NodeInfo
_) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"continue" Doc -> Doc -> Doc
<> Doc
semi
pretty (CBreak NodeInfo
_) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
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 (Doc -> Doc) -> Doc -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
e Doc -> Doc -> Doc
<> Doc
semi
pretty (CAsm CAsmStmt
asmStmt NodeInfo
_) = CAsmStmt -> Doc
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
$+$ ([Ident] -> Doc) -> [Ident] -> Doc
forall p. ([p] -> Doc) -> [p] -> Doc
mlistP [Ident] -> Doc
ppLblDecls [Ident]
localLabels Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat ((CBlockItem -> Doc) -> [CBlockItem] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CBlockItem -> Doc
forall p. Pretty p => p -> Doc
pretty [CBlockItem]
bis) Doc -> Doc -> Doc
$$ String -> Doc
text String
"}"
in if Int
p Int -> Int -> Bool
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 ([Doc] -> Doc) -> ([Ident] -> [Doc]) -> [Ident] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> Doc) -> [Ident] -> [Doc]
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 = CStatement NodeInfo -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__asm__" Doc -> Doc -> Doc
<+>
(CTypeQual -> Doc) -> Maybe CTypeQual -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CTypeQual -> Doc
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 = CStrLit -> Doc
forall p. Pretty p => p -> Doc
pretty CStrLit
expr Doc -> Doc -> Doc
<+>
(if ([CAsmOperand] -> Bool) -> [[CAsmOperand]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [CAsmOperand] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[CAsmOperand]
inOps,[CAsmOperand]
outOps] Bool -> Bool -> Bool
&& [CStrLit] -> 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 ((CAsmOperand -> Doc) -> [CAsmOperand] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CAsmOperand -> Doc
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 ((CAsmOperand -> Doc) -> [CAsmOperand] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CAsmOperand -> Doc
forall p. Pretty p => p -> Doc
pretty [CAsmOperand]
inOps)) Doc -> Doc -> Doc
<+>
(if [CStrLit] -> Bool
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 ((CStrLit -> Doc) -> [CStrLit] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CStrLit -> Doc
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
_) =
(Ident -> Doc) -> Maybe Ident -> Doc
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
<+>
CStrLit -> Doc
forall p. Pretty p => p -> Doc
pretty CStrLit
cnstr Doc -> Doc -> Doc
<+>
Doc -> Doc
parens (CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr)
instance Pretty CBlockItem where
pretty :: CBlockItem -> Doc
pretty (CBlockStmt CStatement NodeInfo
stat) = CStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
pretty (CBlockDecl CDecl
decl) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty CDecl
decl Doc -> Doc -> Doc
<> Doc
semi
pretty (CNestedFunDef CFunDef
fundef) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CFunDef -> Doc
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 ((CDeclSpec -> Doc) -> [CDeclSpec] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CDeclSpec -> Doc
forall p. Pretty p => p -> Doc
pretty [CDeclSpec]
checked_specs) Doc -> Doc -> Doc
<+> [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
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) =
(CDeclr -> Doc) -> Maybe CDeclr -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP (Bool -> Int -> CDeclr -> Doc
prettyDeclr Bool
False Int
0) Maybe CDeclr
declr Doc -> Doc -> Doc
<+>
(p -> Doc) -> Maybe p -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP ((String -> Doc
text String
":" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (p -> Doc) -> p -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Doc
forall p. Pretty p => p -> Doc
pretty) Maybe p
expr Doc -> Doc -> Doc
<+>
[CAttr] -> Doc
attrlistP (Maybe CDeclr -> [CAttr]
forall {a}. Maybe (CDeclarator a) -> [CAttribute a]
getAttrs Maybe CDeclr
declr) Doc -> Doc -> Doc
<+>
(p -> Doc) -> Maybe p -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP ((String -> Doc
text String
"=" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (p -> Doc) -> p -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Doc
forall p. Pretty p => p -> Doc
pretty) Maybe p
initializer
checked_specs :: [CDeclSpec]
checked_specs =
if ((CDeclSpec, CDeclSpec) -> Bool)
-> [(CDeclSpec, CDeclSpec)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CDeclSpec, CDeclSpec) -> Bool
forall {a} {a}.
(CDeclarationSpecifier a, CDeclarationSpecifier a) -> Bool
isAttrAfterSUE ([CDeclSpec] -> [CDeclSpec] -> [(CDeclSpec, CDeclSpec)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CDeclSpec]
specs ([CDeclSpec] -> [CDeclSpec]
forall a. [a] -> [a]
tail [CDeclSpec]
specs))
then String -> [CDeclSpec] -> [CDeclSpec]
forall a. String -> a -> a
trace
(String
"Warning: AST Invariant violated: __attribute__ specifier following struct/union/enum:" String -> String -> String
forall a. [a] -> [a] -> [a]
++
[Doc] -> String
forall a. Show a => a -> String
show ((CDeclSpec -> Doc) -> [CDeclSpec] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CDeclSpec -> Doc
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
_)) = CTypeSpecifier a -> Bool
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 [CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr, CStrLit -> Doc
forall p. Pretty p => p -> Doc
pretty CStrLit
str]))
instance Pretty CDeclSpec where
pretty :: CDeclSpec -> Doc
pretty (CStorageSpec CStorageSpec
sp) = CStorageSpec -> Doc
forall p. Pretty p => p -> Doc
pretty CStorageSpec
sp
pretty (CTypeSpec CTypeSpec
sp) = CTypeSpec -> Doc
forall p. Pretty p => p -> Doc
pretty CTypeSpec
sp
pretty (CTypeQual CTypeQual
qu) = CTypeQual -> Doc
forall p. Pretty p => p -> Doc
pretty CTypeQual
qu
pretty (CFunSpec CFunSpec
fs) = CFunSpec -> Doc
forall p. Pretty p => p -> Doc
pretty CFunSpec
fs
pretty (CAlignSpec CAlignSpec
sa) = CAlignSpec -> Doc
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 (CDecl -> Doc
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 (CExpr -> Doc
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 (Int -> String
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 (CSUType CStructUnion
union NodeInfo
_) = CStructUnion -> Doc
forall p. Pretty p => p -> Doc
pretty CStructUnion
union
pretty (CEnumType CEnum
enum NodeInfo
_) = CEnum -> Doc
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 (CExpr -> Doc
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 (CDecl -> Doc
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 (CDecl -> Doc
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
_) = CStructTag -> Doc
forall p. Pretty p => p -> Doc
pretty CStructTag
tag Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
<+> (Ident -> Doc) -> Maybe Ident -> 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
_) =
CStructTag -> Doc
forall p. Pretty p => p -> Doc
pretty CStructTag
tag Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
<+> (Ident -> Doc) -> Maybe Ident -> 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 [
CStructTag -> Doc
forall p. Pretty p => p -> Doc
pretty CStructTag
tag Doc -> Doc -> Doc
<+> [CAttr] -> Doc
attrlistP [CAttr]
cattrs Doc -> Doc -> Doc
<+> (Ident -> Doc) -> Maybe Ident -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ((CDecl -> Doc) -> [CDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) (Doc -> Doc) -> (CDecl -> Doc) -> CDecl -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDecl -> Doc
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
<+> (Ident -> Doc) -> Maybe Ident -> 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
<+> (Ident -> Doc) -> Maybe Ident -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (((Ident, Maybe CExpr) -> Doc) -> [(Ident, Maybe CExpr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, Maybe CExpr) -> Doc
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
<+> (p -> Doc) -> Maybe p -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP ((String -> Doc
text String
"=" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (p -> Doc) -> p -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Doc
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 ([CDerivedDeclarator NodeInfo] -> [CDerivedDeclarator NodeInfo]
forall a. [a] -> [a]
reverse [CDerivedDeclarator NodeInfo]
derived_declrs) Doc -> Doc -> Doc
<+> Maybe CStrLit -> 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
_ [] = (Ident -> Doc) -> Maybe Ident -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"*" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((CTypeQual -> Doc) -> [CTypeQual] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CTypeQual -> Doc
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 (Doc -> Doc) -> Doc -> Doc
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 ((CTypeQual -> Doc) -> [CTypeQual] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CTypeQual -> Doc
forall p. Pretty p => p -> Doc
pretty [CTypeQual]
quals) Doc -> Doc -> Doc
<+> CArrSize -> 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 ([CAttr] -> Bool
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 (Either [Ident] ([CDecl], Bool) -> Doc
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 ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
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 ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
identP [Ident]
oldStyleIds))
prettyAsmName :: Maybe p -> Doc
prettyAsmName Maybe p
asm_name_opt
= Doc -> (p -> Doc) -> Maybe p -> Doc
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 (p -> Doc
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
<+> CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr
instance Pretty CInit where
pretty :: CInit -> Doc
pretty (CInitExpr CExpr
expr NodeInfo
_) = CExpr -> Doc
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 ((([CDesignator], CInit) -> Doc)
-> CInitializerList NodeInfo -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([CDesignator], CInit) -> Doc
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) = p -> Doc
forall p. Pretty p => p -> Doc
pretty p
initializer
p ([a]
desigs, p
initializer) = [Doc] -> Doc
hsep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall p. Pretty p => p -> Doc
pretty [a]
desigs) Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> p -> 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
<> CExpr -> 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
<> CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"..." Doc -> Doc -> Doc
<+> CExpr -> 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 ([Doc] -> Doc) -> ([CExpr] -> [Doc]) -> [CExpr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([CExpr] -> [Doc]) -> [CExpr] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CExpr -> Doc) -> [CExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty ([CExpr] -> Doc) -> [CExpr] -> Doc
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) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((CExpr -> Doc) -> [CExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CExpr -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpr -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
3 CExpr
expr1 Doc -> Doc -> Doc
<+> CAssignOp -> Doc
forall p. Pretty p => p -> Doc
pretty CAssignOp
op Doc -> Doc -> Doc
<+> Int -> CExpr -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpr -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
4 CExpr
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"?"
Doc -> Doc -> Doc
<+> (CExpr -> Doc) -> Maybe CExpr -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe CExpr
expr2 Doc -> Doc -> Doc
<+> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> Int -> CExpr -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpr -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
prec CExpr
expr1
Doc -> Doc -> Doc
<+> CBinaryOp -> Doc
forall p. Pretty p => p -> Doc
pretty CBinaryOp
op Doc -> Doc -> Doc
<+> Int -> CExpr -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (Int
prec Int -> Int -> Int
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty CDecl
decl Doc -> Doc -> Doc
<> String -> Doc
text String
")"
Doc -> Doc -> Doc
<+> Int -> CExpr -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpr -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpr -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CUnaryOp -> Doc
forall p. Pretty p => p -> Doc
pretty CUnaryOp
op Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Int -> CExpr -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CUnaryOp -> Doc
forall p. Pretty p => p -> Doc
pretty CUnaryOp
op Doc -> Doc -> Doc
<> Int -> CExpr -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"sizeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CExpr -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"sizeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDecl -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__alignof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CExpr -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__alignof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDecl -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__real" Doc -> Doc -> Doc
<+> Int -> CExpr -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__imag" Doc -> Doc -> Doc
<+> Int -> CExpr -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpr -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpr
expr1
Doc -> Doc -> Doc
<> String -> Doc
text String
"[" Doc -> Doc -> Doc
<> CExpr -> 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpr -> Doc
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 ([Doc] -> Doc) -> ([CExpr] -> [Doc]) -> [CExpr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([CExpr] -> [Doc]) -> [CExpr] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CExpr -> Doc) -> [CExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CExpr -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpr -> Doc
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) = CConst -> Doc
forall p. Pretty p => p -> Doc
pretty CConst
constant
prettyPrec Int
_p (CCompoundLit CDecl
decl CInitializerList NodeInfo
initl NodeInfo
_) =
Doc -> Doc
parens (CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty CDecl
decl) Doc -> Doc -> Doc
<+> (Doc -> Doc
braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma) ((([CDesignator], CInit) -> Doc)
-> CInitializerList NodeInfo -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([CDesignator], CInit) -> Doc
forall {p} {a}. (Pretty p, Pretty a) => ([a], p) -> Doc
p CInitializerList NodeInfo
initl) where
p :: ([a], p) -> Doc
p ([], p
initializer) = p -> Doc
forall p. Pretty p => p -> Doc
pretty p
initializer
p ([a]
mems, p
initializer) = [Doc] -> Doc
hcat ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall p. Pretty p => p -> Doc
pretty [a]
mems) Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> p -> 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
<> CStatement NodeInfo -> 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
parens(Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> Doc
hsep([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Doc -> [Doc] -> [Doc]
punctuate Doc
comma) (CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ((Maybe CDecl, CExpr) -> Doc) -> [(Maybe CDecl, CExpr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe CDecl, CExpr) -> Doc
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) = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Doc
text String
"default") a -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe a
mty Doc -> Doc -> Doc
<> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> p -> Doc
forall p. Pretty p => p -> Doc
pretty p
expr1
prettyPrec Int
_p (CBuiltinExpr CBuiltin
builtin) = CBuiltin -> Doc
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 (CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> CDecl -> 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 (CDecl -> Doc
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 ((CDesignator -> Doc) -> [CDesignator] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CDesignator -> Doc
forall p. Pretty p => p -> Doc
pretty [CDesignator]
desigs) )
pretty (CBuiltinOffsetOf CDecl
_ty_name [CDesignator]
otherDesigs NodeInfo
_) =
String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Inconsistent AST: Cannot interpret designators in offsetOf: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Doc -> String
forall a. Show a => a -> String
show ([Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CDesignator -> Doc) -> [CDesignator] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CDesignator -> Doc
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 (CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty CDecl
ty1 Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> CDecl -> 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 (CExpr -> Doc
forall p. Pretty p => p -> Doc
pretty CExpr
expr Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty CDecl
ty)
instance Pretty CAssignOp where
pretty :: CAssignOp -> Doc
pretty CAssignOp
op = String -> Doc
text (String -> Doc) -> String -> Doc
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 (String -> Doc) -> String -> Doc
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 (String -> Doc) -> String -> Doc
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 (CInteger -> String
forall a. Show a => a -> String
show CInteger
int_const)
pretty (CCharConst CChar
chr NodeInfo
_) = String -> Doc
text (CChar -> String
forall a. Show a => a -> String
show CChar
chr)
pretty (CFloatConst CFloat
flt NodeInfo
_) = String -> Doc
text (CFloat -> String
forall a. Show a => a -> String
show CFloat
flt)
pretty (CStrConst CString
str NodeInfo
_) = String -> Doc
text (CString -> String
forall a. Show a => a -> String
show CString
str)
instance Pretty CStrLit where
pretty :: CStrLit -> Doc
pretty (CStrLit CString
str NodeInfo
_) = String -> Doc
text (CString -> String
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