{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Pretty
-- Copyright   :  Copyright (c) 2007 Bertram Felgenhauer
--                          (c) 2008 Benedikt Huber
-- License     :  BSD-style
-- Maintainer  : benedikt.huber@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- This module provides a pretty printer for the parse tree
-- ('Language.C.Syntax.AST').
-----------------------------------------------------------------------------
module Language.C.Pretty (
    -- * Pretty Printing
    Pretty (..),
    -- * Testing
    prettyUsingInclude
) where
import Data.List (isSuffixOf)
import qualified Data.Set as Set
import Text.PrettyPrint.HughesPJ
import Debug.Trace {- for warnings -}
import Prelude hiding ((<>))

import Language.C.Data
import Language.C.Syntax

-- | A class of types which can be pretty printed
class Pretty p where
    -- | pretty print the given value
    pretty     :: p -> Doc
    -- | @prettyPrec prec p@ pretty prints p assuming
    -- that the surrounding context has a precedence of
    -- @prec@
    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

-- pretty print optional chunk
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

-- pretty print when flag is true
ifP :: Bool -> Doc -> Doc
ifP :: Bool -> Doc -> Doc
ifP Bool
flag Doc
doc = if Bool
flag then Doc
doc else Doc
empty

-- pretty print _optional_ list, i.e. [] ~ Nothing and (x:xs) ~ Just (x:xs)
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 a. [a] -> 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)

-- pretty print identifier
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

-- pretty print attribute annotations
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))

-- analogous to showParen
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

-- indent a chunk of code
ii :: Doc -> Doc
ii :: Doc -> Doc
ii = Int -> Doc -> Doc
nest Int
4

-- Pretty instances
instance Pretty CTranslUnit where
    pretty :: CTranslUnit -> Doc
pretty (CTranslUnit [CExternalDeclaration NodeInfo]
edecls NodeInfo
_) = [Doc] -> Doc
vcat ((CExternalDeclaration NodeInfo -> Doc)
-> [CExternalDeclaration NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CExternalDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CExternalDeclaration NodeInfo]
edecls)

-- | Pretty print the given tranlation unit, but replace declarations from header files with @#include@ directives.
--
-- The resulting file may not compile (because of missing @#define@ directives and similar things), but is very useful
-- for testing, as otherwise the pretty printed file will be cluttered with declarations from system headers.
prettyUsingInclude :: CTranslUnit -> Doc
prettyUsingInclude :: CTranslUnit -> Doc
prettyUsingInclude (CTranslUnit [CExternalDeclaration NodeInfo]
edecls NodeInfo
_) =
  Set String -> Doc
forall {a}. Set a -> Doc
includeWarning Set String
headerFiles
    Doc -> Doc -> Doc
$$
  [Doc] -> Doc
vcat ((Either String (CExternalDeclaration NodeInfo) -> Doc)
-> [Either String (CExternalDeclaration NodeInfo)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Doc)
-> (CExternalDeclaration NodeInfo -> Doc)
-> Either String (CExternalDeclaration NodeInfo)
-> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Doc
includeHeader CExternalDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty) [Either String (CExternalDeclaration NodeInfo)]
mappedDecls)
  where
    (Set String
headerFiles,[Either String (CExternalDeclaration NodeInfo)]
mappedDecls) = (CExternalDeclaration NodeInfo
 -> (Set String, [Either String (CExternalDeclaration NodeInfo)])
 -> (Set String, [Either String (CExternalDeclaration NodeInfo)]))
-> (Set String, [Either String (CExternalDeclaration NodeInfo)])
-> [CExternalDeclaration NodeInfo]
-> (Set String, [Either String (CExternalDeclaration NodeInfo)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Either String (CExternalDeclaration NodeInfo)
-> (Set String, [Either String (CExternalDeclaration NodeInfo)])
-> (Set String, [Either String (CExternalDeclaration NodeInfo)])
forall {a} {b}.
Ord a =>
Either a b -> (Set a, [Either a b]) -> (Set a, [Either a b])
addDecl (Either String (CExternalDeclaration NodeInfo)
 -> (Set String, [Either String (CExternalDeclaration NodeInfo)])
 -> (Set String, [Either String (CExternalDeclaration NodeInfo)]))
-> (CExternalDeclaration NodeInfo
    -> Either String (CExternalDeclaration NodeInfo))
-> CExternalDeclaration NodeInfo
-> (Set String, [Either String (CExternalDeclaration NodeInfo)])
-> (Set String, [Either String (CExternalDeclaration NodeInfo)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExternalDeclaration NodeInfo
-> Either String (CExternalDeclaration NodeInfo)
forall {b}. (CNode b, Pos b) => b -> Either String b
tagIncludedDecls) (Set String
forall a. Set a
Set.empty,[]) [CExternalDeclaration NodeInfo]
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. */"

-- TODO: Check need of __extension__
instance Pretty CExtDecl where
    pretty :: CExternalDeclaration NodeInfo -> Doc
pretty (CDeclExt CDeclaration NodeInfo
decl) = CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl Doc -> Doc -> Doc
<> Doc
semi
    pretty (CFDefExt CFunctionDef NodeInfo
fund) = CFunctionDef NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CFunctionDef NodeInfo
fund
    pretty (CAsmExt  CStringLiteral NodeInfo
asmStmt NodeInfo
_) = String -> Doc
text String
"asm" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CStringLiteral NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStringLiteral NodeInfo
asmStmt) Doc -> Doc -> Doc
<> Doc
semi

-- TODO: Check that old-style and new-style aren't mixed
instance Pretty CFunDef where
    pretty :: CFunctionDef NodeInfo -> Doc
pretty (CFunDef [CDeclarationSpecifier NodeInfo]
declspecs CDeclarator NodeInfo
declr [CDeclaration NodeInfo]
decls CStatement NodeInfo
stat NodeInfo
_) =          -- Example:
            [Doc] -> Doc
hsep ((CDeclarationSpecifier NodeInfo -> Doc)
-> [CDeclarationSpecifier NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CDeclarationSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CDeclarationSpecifier NodeInfo]
declspecs)                      -- __attribute__((noreturn)) static long
        Doc -> Doc -> Doc
<+> CDeclarator NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclarator NodeInfo
declr                                     -- foo(b)
        Doc -> Doc -> Doc
$+$ (Doc -> Doc
ii (Doc -> Doc)
-> ([CDeclaration NodeInfo] -> Doc)
-> [CDeclaration NodeInfo]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc)
-> ([CDeclaration NodeInfo] -> [Doc])
-> [CDeclaration NodeInfo]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CDeclaration NodeInfo -> Doc) -> [CDeclaration NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) (Doc -> Doc)
-> (CDeclaration NodeInfo -> Doc) -> CDeclaration NodeInfo -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty)) [CDeclaration NodeInfo]
decls     --     register long b;
        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 CExpression NodeInfo
expr CStatement NodeInfo
stat NodeInfo
_) =
        String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
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 CExpression NodeInfo
expr1 CExpression NodeInfo
expr2 CStatement NodeInfo
stat NodeInfo
_) =
        String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"..."
                    Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
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 (CExpression NodeInfo)
expr NodeInfo
_) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (CExpression NodeInfo -> Doc)
-> Maybe (CExpression NodeInfo) -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe (CExpression NodeInfo)
expr Doc -> Doc -> Doc
<> Doc
semi
    pretty c :: CStatement NodeInfo
c@(CCompound [Ident]
_ [CCompoundBlockItem NodeInfo]
_ NodeInfo
_) = Int -> CStatement NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
0 CStatement NodeInfo
c
    pretty (CIf CExpression NodeInfo
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 (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
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 CExpression NodeInfo
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
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
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 CExpression NodeInfo
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
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
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 CExpression NodeInfo
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
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text String
");"
    pretty (CFor Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
for_init Maybe (CExpression NodeInfo)
cond Maybe (CExpression NodeInfo)
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 (CExpression NodeInfo) -> Doc)
-> (CDeclaration NodeInfo -> Doc)
-> Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
-> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((CExpression NodeInfo -> Doc)
-> Maybe (CExpression NodeInfo) -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty) CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
for_init Doc -> Doc -> Doc
<> Doc
semi
               Doc -> Doc -> Doc
<+> (CExpression NodeInfo -> Doc)
-> Maybe (CExpression NodeInfo) -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe (CExpression NodeInfo)
cond Doc -> Doc -> Doc
<> Doc
semi
               Doc -> Doc -> Doc
<+> (CExpression NodeInfo -> Doc)
-> Maybe (CExpression NodeInfo) -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe (CExpression NodeInfo)
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 CExpression NodeInfo
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 -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
30 CExpression NodeInfo
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 (CExpression NodeInfo)
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 CExpression NodeInfo
e) NodeInfo
_) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
e Doc -> Doc -> Doc
<> Doc
semi
    pretty (CAsm CAssemblyStatement NodeInfo
asmStmt NodeInfo
_) = CAssemblyStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CAssemblyStatement NodeInfo
asmStmt
    prettyPrec :: Int -> CStatement NodeInfo -> Doc
prettyPrec Int
p (CCompound [Ident]
localLabels [CCompoundBlockItem NodeInfo]
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 ((CCompoundBlockItem NodeInfo -> Doc)
-> [CCompoundBlockItem NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CCompoundBlockItem NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CCompoundBlockItem NodeInfo]
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 :: CAssemblyStatement NodeInfo -> Doc
pretty (CAsmStmt Maybe (CTypeQualifier NodeInfo)
tyQual CStringLiteral NodeInfo
expr [CAssemblyOperand NodeInfo]
outOps [CAssemblyOperand NodeInfo]
inOps [CStringLiteral NodeInfo]
clobbers NodeInfo
_) =
        Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"__asm__" Doc -> Doc -> Doc
<+>
             (CTypeQualifier NodeInfo -> Doc)
-> Maybe (CTypeQualifier NodeInfo) -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CTypeQualifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe (CTypeQualifier NodeInfo)
tyQual Doc -> Doc -> Doc
<>
             Doc -> Doc
parens Doc
asmStmt Doc -> Doc -> Doc
<> Doc
semi
      where
        asmStmt :: Doc
asmStmt = CStringLiteral NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStringLiteral NodeInfo
expr Doc -> Doc -> Doc
<+>
                  (if ([CAssemblyOperand NodeInfo] -> Bool)
-> [[CAssemblyOperand NodeInfo]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [CAssemblyOperand NodeInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[CAssemblyOperand NodeInfo]
inOps,[CAssemblyOperand NodeInfo]
outOps] Bool -> Bool -> Bool
&& [CStringLiteral NodeInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CStringLiteral NodeInfo]
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 ((CAssemblyOperand NodeInfo -> Doc)
-> [CAssemblyOperand NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CAssemblyOperand NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CAssemblyOperand NodeInfo]
outOps)) Doc -> Doc -> Doc
<+>
                   String -> Doc
text String
":" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((CAssemblyOperand NodeInfo -> Doc)
-> [CAssemblyOperand NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CAssemblyOperand NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CAssemblyOperand NodeInfo]
inOps)) Doc -> Doc -> Doc
<+>
                   (if [CStringLiteral NodeInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CStringLiteral NodeInfo]
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 ((CStringLiteral NodeInfo -> Doc)
-> [CStringLiteral NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CStringLiteral NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CStringLiteral NodeInfo]
clobbers))

instance Pretty CAsmOperand where
    -- asm_operand :~ [operand-name] "constraint" ( expr )
    pretty :: CAssemblyOperand NodeInfo -> Doc
pretty (CAsmOperand Maybe Ident
mArgName CStringLiteral NodeInfo
cnstr CExpression NodeInfo
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
<+>
        CStringLiteral NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStringLiteral NodeInfo
cnstr Doc -> Doc -> Doc
<+>
        Doc -> Doc
parens (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)

-- TODO: Check need of __extension__
instance Pretty CBlockItem where
    pretty :: CCompoundBlockItem NodeInfo -> Doc
pretty (CBlockStmt CStatement NodeInfo
stat) = CStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
    pretty (CBlockDecl CDeclaration NodeInfo
decl) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl Doc -> Doc -> Doc
<> Doc
semi
    pretty (CNestedFunDef CFunctionDef NodeInfo
fundef) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CFunctionDef NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CFunctionDef NodeInfo
fundef

instance Pretty CDecl where
    -- CAVEAT:
    -- we may not print __attribute__s directly after typespecs,
    -- as this may change the semantics of the declaration.
    -- The parser fixes this, but to avoid hard-to-track code generator
    -- errors, we enforce this invariant on the AST level.
    pretty :: CDeclaration NodeInfo -> Doc
pretty (CDecl [CDeclarationSpecifier NodeInfo]
specs [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
  Maybe (CExpression NodeInfo))]
divs NodeInfo
_) =
        [Doc] -> Doc
hsep ((CDeclarationSpecifier NodeInfo -> Doc)
-> [CDeclarationSpecifier NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CDeclarationSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CDeclarationSpecifier NodeInfo]
checked_specs) Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (((Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
  Maybe (CExpression NodeInfo))
 -> Doc)
-> [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
     Maybe (CExpression NodeInfo))]
-> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
 Maybe (CExpression NodeInfo))
-> Doc
forall {p} {p}.
(Pretty p, Pretty p) =>
(Maybe (CDeclarator NodeInfo), Maybe p, Maybe p) -> Doc
p [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
  Maybe (CExpression NodeInfo))]
divs))
            where
            -- possible hint for AST improvement - (declr, initializer, expr, attrs)
            -- currently there are no sensible attributes for unnamed bitfields though
            p :: (Maybe (CDeclarator NodeInfo), Maybe p, Maybe p) -> Doc
p (Maybe (CDeclarator NodeInfo)
declr, Maybe p
initializer, Maybe p
expr) =
                (CDeclarator NodeInfo -> Doc)
-> Maybe (CDeclarator NodeInfo) -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP (Bool -> Int -> CDeclarator NodeInfo -> Doc
prettyDeclr Bool
False Int
0) Maybe (CDeclarator NodeInfo)
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 (CDeclarator NodeInfo) -> [CAttr]
forall {a}. Maybe (CDeclarator a) -> [CAttribute a]
getAttrs Maybe (CDeclarator NodeInfo)
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 :: [CDeclarationSpecifier NodeInfo]
checked_specs =
                if ((CDeclarationSpecifier NodeInfo, CDeclarationSpecifier NodeInfo)
 -> Bool)
-> [(CDeclarationSpecifier NodeInfo,
     CDeclarationSpecifier NodeInfo)]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CDeclarationSpecifier NodeInfo, CDeclarationSpecifier NodeInfo)
-> Bool
forall {a} {a}.
(CDeclarationSpecifier a, CDeclarationSpecifier a) -> Bool
isAttrAfterSUE  ([CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
-> [(CDeclarationSpecifier NodeInfo,
     CDeclarationSpecifier NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CDeclarationSpecifier NodeInfo]
specs (Int
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. Int -> [a] -> [a]
drop Int
1 [CDeclarationSpecifier NodeInfo]
specs))
                    then String
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
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 ((CDeclarationSpecifier NodeInfo -> Doc)
-> [CDeclarationSpecifier NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CDeclarationSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CDeclarationSpecifier NodeInfo]
specs))
                           [CDeclarationSpecifier NodeInfo]
specs
                    else [CDeclarationSpecifier NodeInfo]
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 CExpression NodeInfo
expr CStringLiteral NodeInfo
str NodeInfo
_) =
      String -> Doc
text String
"_Static_assert" Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma [CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr, CStringLiteral NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStringLiteral NodeInfo
str]))

instance Pretty CDeclSpec where
    pretty :: CDeclarationSpecifier NodeInfo -> Doc
pretty (CStorageSpec CStorageSpecifier NodeInfo
sp) = CStorageSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStorageSpecifier NodeInfo
sp
    pretty (CTypeSpec CTypeSpecifier NodeInfo
sp) = CTypeSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CTypeSpecifier NodeInfo
sp
    pretty (CTypeQual CTypeQualifier NodeInfo
qu) = CTypeQualifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CTypeQualifier NodeInfo
qu
    pretty (CFunSpec CFunctionSpecifier NodeInfo
fs) = CFunctionSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CFunctionSpecifier NodeInfo
fs
    pretty (CAlignSpec CAlignmentSpecifier NodeInfo
sa) = CAlignmentSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CAlignmentSpecifier NodeInfo
sa

instance Pretty CAlignSpec where
    pretty :: CAlignmentSpecifier NodeInfo -> Doc
pretty (CAlignAsType CDeclaration NodeInfo
decl NodeInfo
_) =
        String -> Doc
text String
"_Alignas" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)
    pretty (CAlignAsExpr CExpression NodeInfo
expr NodeInfo
_) =
        String -> Doc
text String
"_Alignas" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)

instance Pretty CStorageSpec where
    pretty :: CStorageSpecifier NodeInfo -> 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 :: CTypeSpecifier NodeInfo -> 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 (CUInt128Type NodeInfo
_)     = String -> Doc
text String
"__uint128"
    pretty (CSUType CStructureUnion NodeInfo
union NodeInfo
_)    = CStructureUnion NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStructureUnion NodeInfo
union
    pretty (CEnumType CEnumeration NodeInfo
enum NodeInfo
_)   = CEnumeration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CEnumeration NodeInfo
enum
    pretty (CTypeDef Ident
ident NodeInfo
_)   = Ident -> Doc
identP Ident
ident
    pretty (CTypeOfExpr CExpression NodeInfo
expr NodeInfo
_) =
        String -> Doc
text String
"typeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)
    pretty (CTypeOfType CDeclaration NodeInfo
decl NodeInfo
_) =
        String -> Doc
text String
"typeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)
    pretty (CAtomicType CDeclaration NodeInfo
decl NodeInfo
_) =
        String -> Doc
text String
"_Atomic" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)

instance Pretty CTypeQual where
    pretty :: CTypeQualifier NodeInfo -> 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 :: CFunctionSpecifier NodeInfo -> Doc
pretty (CInlineQual NodeInfo
_) = String -> Doc
text String
"inline"
    pretty (CNoreturnQual NodeInfo
_) = String -> Doc
text String
"_Noreturn"

instance Pretty CStructUnion where
    pretty :: CStructureUnion NodeInfo -> Doc
pretty (CStruct CStructTag
tag Maybe Ident
ident Maybe [CDeclaration NodeInfo]
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 [CDeclaration NodeInfo]
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 ((CDeclaration NodeInfo -> Doc) -> [CDeclaration NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) (Doc -> Doc)
-> (CDeclaration NodeInfo -> Doc) -> CDeclaration NodeInfo -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty) [CDeclaration NodeInfo]
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 :: CEnumeration NodeInfo -> Doc
pretty (CEnum Maybe Ident
enum_ident Maybe [(Ident, Maybe (CExpression NodeInfo))]
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 (CExpression NodeInfo))]
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 (CExpression NodeInfo)) -> Doc)
-> [(Ident, Maybe (CExpression NodeInfo))] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, Maybe (CExpression NodeInfo)) -> Doc
forall {p}. Pretty p => (Ident, Maybe p) -> Doc
p [(Ident, Maybe (CExpression NodeInfo))]
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

--  Analyze a declarator and return a human-readable description
--   See C99 Spec p 115ff.
-- describeDeclr :: CDeclr -> Doc
-- describeDeclr declr =
--     let declrs = reverse (declrChain declr) in
--     endDescr (foldl descrDeclr undefined declrs)
--
--   where
--   declrChain declr@(CVarDeclr _ _ _ _) = [declr]
--   declrChain declr@(CPtrDeclr _ ideclr _)   = declr : declrChain ideclr
--   declrChain declr@(CArrDeclr ideclr _ _ _) = declr : declrChain ideclr
--   declrChain declr@(CFunDeclr ideclr _ _ _)   = declr : declrChain ideclr
--
--   descrDeclr _ (CVarDeclr ident asm cattrs _) = single False $ \_ ->
--       maybe (text "<anonymous>") identP ident <+>
--       maybeP (\asmname -> parens (text "asm:" <+> pretty asmname)) asm <+>
--       text "is" <+> (if null cattrs then empty else prettyList (map CAttrQual cattrs) <> comma)
--   descrDeclr (pre,isPlural) (CPtrDeclr quals declr _) = single isPlural $ \pluralize ->
--       pre <+> indefArticle isPlural <> prettyList quals <+> pluralize "pointer to" "pointers to"
--   descrDeclr (pre,isPlural) (CArrDeclr declr quals expr _) = plural isPlural $ \pluralize ->
--       pre <+> indefArticle' isPlural <> prettyList quals <+> pluralize "array of" "arrays of"
--   descrDeclr (pre,isPlural) (CFunDeclr declr params cattrs _) = single isPlural $ \pluralize ->
--       pre <+> indefArticle isPlural <> prettyList (map CAttrQual cattrs) <+> pluralize "function returning" "functions returning"
--   endDescr (pre, isPlural) =  pre <+> text (if isPlural then "<typed objects>" else "a <typed object>")
--   single :: Bool -> ( (String -> String -> Doc) -> a ) -> (a, Bool)
--   single isPlural mkDescr = (mkDescr (pluralize isPlural), isPlural)
--   plural :: Bool -> ( (String -> String -> Doc) -> a ) -> (a, Bool)
--   plural isPlural mkDescr = (mkDescr (pluralize isPlural), True)
--   indefArticle isPlural  = text$ if isPlural then "" else "a "
--   indefArticle' isPlural = text$ if isPlural then "" else "an "
--   pluralize isPlural s p = text (if isPlural then p else s)
--   prettyList :: (Pretty a) => [a] -> Doc
--   prettyList = hsep . punctuate comma . map pretty
instance Pretty CDeclr where
    prettyPrec :: Int -> CDeclarator NodeInfo -> Doc
prettyPrec Int
prec CDeclarator NodeInfo
declr = Bool -> Int -> CDeclarator NodeInfo -> Doc
prettyDeclr Bool
True Int
prec CDeclarator NodeInfo
declr

prettyDeclr :: Bool -> Int -> CDeclr -> Doc
prettyDeclr :: Bool -> Int -> CDeclarator NodeInfo -> Doc
prettyDeclr Bool
show_attrs Int
prec (CDeclr Maybe Ident
name [CDerivedDeclarator NodeInfo]
derived_declrs Maybe (CStringLiteral NodeInfo)
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 (CStringLiteral NodeInfo) -> Doc
forall {p}. Pretty p => Maybe p -> Doc
prettyAsmName Maybe (CStringLiteral NodeInfo)
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
    --'*' __attribute__? qualifiers declarator
    ppDeclr Int
p (CPtrDeclr [CTypeQualifier NodeInfo]
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 ((CTypeQualifier NodeInfo -> Doc)
-> [CTypeQualifier NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CTypeQualifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CTypeQualifier NodeInfo]
quals) Doc -> Doc -> Doc
<+> Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr Int
5 [CDerivedDeclarator NodeInfo]
declrs

    -- declarator[ __attribute__? qualifiers expr ]
    ppDeclr Int
p (CArrDeclr [CTypeQualifier NodeInfo]
quals CArraySize NodeInfo
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 ((CTypeQualifier NodeInfo -> Doc)
-> [CTypeQualifier NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CTypeQualifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CTypeQualifier NodeInfo]
quals) Doc -> Doc -> Doc
<+> CArraySize NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CArraySize NodeInfo
size)
    -- declarator ( arguments )
    -- or (__attribute__ declarator) (arguments)
    ppDeclr Int
_ (CFunDeclr Either [Ident] ([CDeclaration NodeInfo], Bool)
params [CAttr]
fun_attrs NodeInfo
_ : [CDerivedDeclarator NodeInfo]
declrs) =
        (if Bool -> Bool
not ([CAttr] -> Bool
forall a. [a] -> 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] ([CDeclaration NodeInfo], Bool) -> Doc
forall {a}. Pretty a => Either [Ident] ([a], Bool) -> Doc
prettyParams Either [Ident] ([CDeclaration NodeInfo], 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 :: CArraySize NodeInfo -> Doc
pretty (CNoArrSize Bool
completeType) = Bool -> Doc -> Doc
ifP Bool
completeType (String -> Doc
text String
"*")
  pretty (CArrSize Bool
staticMod CExpression NodeInfo
expr) = Bool -> Doc -> Doc
ifP Bool
staticMod (String -> Doc
text String
"static") Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr
-- initializer :: { CInit }
-- initializer :- assignment_expression
--              | '{' (designation? initializer)_cs_list '}'
instance Pretty CInit where
    pretty :: CInitializer NodeInfo -> Doc
pretty (CInitExpr CExpression NodeInfo
expr NodeInfo
_) = CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr
    pretty (CInitList CInitializerList NodeInfo
initl NodeInfo
_) =
        String -> Doc
text String
"{" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((([CPartDesignator NodeInfo], CInitializer NodeInfo) -> Doc)
-> CInitializerList NodeInfo -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([CPartDesignator NodeInfo], CInitializer NodeInfo) -> 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

-- designation :- designator_list '='
--             | array_range_designator
-- arr_designator :- '[' constant_expression ']'
-- member_designator :-  '.' identifier
-- arr_range _designator :- '[' constant_expression "..." constant_expression ']'

instance Pretty CDesignator where
    pretty :: CPartDesignator NodeInfo -> Doc
pretty (CArrDesig CExpression NodeInfo
expr NodeInfo
_) = String -> Doc
text String
"[" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
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 CExpression NodeInfo
expr1 CExpression NodeInfo
expr2 NodeInfo
_) =
        String -> Doc
text String
"[" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"..." Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
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 [CExpression NodeInfo]
attrParams NodeInfo
_) = Ident -> Doc
identP Ident
attrName Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
hsep ([Doc] -> Doc)
-> ([CExpression NodeInfo] -> [Doc])
-> [CExpression NodeInfo]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([CExpression NodeInfo] -> [Doc])
-> [CExpression NodeInfo]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CExpression NodeInfo -> Doc) -> [CExpression NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty ([CExpression NodeInfo] -> Doc) -> [CExpression NodeInfo] -> Doc
forall a b. (a -> b) -> a -> b
$ [CExpression NodeInfo]
attrParams)

instance Pretty CExpr where
    prettyPrec :: Int -> CExpression NodeInfo -> Doc
prettyPrec Int
p (CComma [CExpression NodeInfo]
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 ((CExpression NodeInfo -> Doc) -> [CExpression NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
2) [CExpression NodeInfo]
exprs))
    prettyPrec Int
p (CAssign CAssignOp
op CExpression NodeInfo
expr1 CExpression NodeInfo
expr2 NodeInfo
_) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
3 CExpression NodeInfo
expr1 Doc -> Doc -> Doc
<+> CAssignOp -> Doc
forall p. Pretty p => p -> Doc
pretty CAssignOp
op Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
2 CExpression NodeInfo
expr2
    prettyPrec Int
p (CCond CExpression NodeInfo
expr1 Maybe (CExpression NodeInfo)
expr2 CExpression NodeInfo
expr3 NodeInfo
_) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
4 CExpression NodeInfo
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"?" -- NB: assignment only has a higher precedence if cond is on the rhs
           Doc -> Doc -> Doc
<+> (CExpression NodeInfo -> Doc)
-> Maybe (CExpression NodeInfo) -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe (CExpression NodeInfo)
expr2 Doc -> Doc -> Doc
<+> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
4 CExpression NodeInfo
expr3
    prettyPrec Int
p (CBinary CBinaryOp
op CExpression NodeInfo
expr1 CExpression NodeInfo
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 -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
prec CExpression NodeInfo
expr1
                             Doc -> Doc -> Doc
<+> CBinaryOp -> Doc
forall p. Pretty p => p -> Doc
pretty CBinaryOp
op Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) CExpression NodeInfo
expr2
    prettyPrec Int
p (CCast CDeclaration NodeInfo
decl CExpression NodeInfo
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
<> CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl Doc -> Doc -> Doc
<> String -> Doc
text String
")"
                       Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpression NodeInfo
expr
    prettyPrec Int
p (CUnary CUnaryOp
CPostIncOp CExpression NodeInfo
expr NodeInfo
_) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p Int
26 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text String
"++"
    prettyPrec Int
p (CUnary CUnaryOp
CPostDecOp CExpression NodeInfo
expr NodeInfo
_) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p Int
26 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text String
"--"
    prettyPrec Int
p (CUnary CUnaryOp
op expr :: CExpression NodeInfo
expr@(CUnary CUnaryOp
_ CExpression NodeInfo
_ NodeInfo
_) NodeInfo
_) =
        --                             parens aren't necessary, but look nicer imho
        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 -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpression NodeInfo
expr)
    prettyPrec Int
p (CUnary CUnaryOp
op CExpression NodeInfo
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 -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpression NodeInfo
expr
    prettyPrec Int
p (CSizeofExpr CExpression NodeInfo
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 (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)
    prettyPrec Int
p (CSizeofType CDeclaration NodeInfo
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 (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)
    prettyPrec Int
p (CAlignofExpr CExpression NodeInfo
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 (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)
    prettyPrec Int
p (CAlignofType CDeclaration NodeInfo
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 (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)
    prettyPrec Int
p (CComplexReal CExpression NodeInfo
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 -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpression NodeInfo
expr
    prettyPrec Int
p (CComplexImag CExpression NodeInfo
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 -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
25 CExpression NodeInfo
expr
    prettyPrec Int
p (CIndex CExpression NodeInfo
expr1 CExpression NodeInfo
expr2 NodeInfo
_) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p Int
26 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpression NodeInfo
expr1
                       Doc -> Doc -> Doc
<> String -> Doc
text String
"[" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr2 Doc -> Doc -> Doc
<> String -> Doc
text String
"]"
    prettyPrec Int
p (CCall CExpression NodeInfo
expr [CExpression NodeInfo]
args NodeInfo
_) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p Int
30 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
30 CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text String
"("
            Doc -> Doc -> Doc
<> ([Doc] -> Doc
sep ([Doc] -> Doc)
-> ([CExpression NodeInfo] -> [Doc])
-> [CExpression NodeInfo]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([CExpression NodeInfo] -> [Doc])
-> [CExpression NodeInfo]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CExpression NodeInfo -> Doc) -> [CExpression NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty) [CExpression NodeInfo]
args Doc -> Doc -> Doc
<> String -> Doc
text String
")"
    prettyPrec Int
p (CMember CExpression NodeInfo
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 -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec Int
26 CExpression NodeInfo
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 CConstant NodeInfo
constant) = CConstant NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CConstant NodeInfo
constant
    prettyPrec Int
_p (CCompoundLit CDeclaration NodeInfo
decl CInitializerList NodeInfo
initl NodeInfo
_) =
        Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
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) ((([CPartDesignator NodeInfo], CInitializer NodeInfo) -> Doc)
-> CInitializerList NodeInfo -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([CPartDesignator NodeInfo], CInitializer NodeInfo) -> 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
")"

    -- unary_expr :- && ident  {- address of label -}
    prettyPrec Int
_p (CLabAddrExpr Ident
ident NodeInfo
_) = String -> Doc
text String
"&&" Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
ident
    prettyPrec Int
_p (CGenericSelection CExpression NodeInfo
expr [(Maybe (CDeclaration NodeInfo), CExpression NodeInfo)]
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) (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ((Maybe (CDeclaration NodeInfo), CExpression NodeInfo) -> Doc)
-> [(Maybe (CDeclaration NodeInfo), CExpression NodeInfo)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (CDeclaration NodeInfo), CExpression NodeInfo) -> Doc
forall {a} {p}. (Pretty a, Pretty p) => (Maybe a, p) -> Doc
pAssoc [(Maybe (CDeclaration NodeInfo), CExpression NodeInfo)]
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 CBuiltinThing NodeInfo
builtin) = CBuiltinThing NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CBuiltinThing NodeInfo
builtin

instance Pretty CBuiltin where
    pretty :: CBuiltinThing NodeInfo -> Doc
pretty (CBuiltinVaArg CExpression NodeInfo
expr CDeclaration NodeInfo
ty_name NodeInfo
_) =
        String -> Doc
text String
"__builtin_va_arg" Doc -> Doc -> Doc
<+>
        Doc -> Doc
parens (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
ty_name)
    -- The first desig has to be a member field.
    pretty (CBuiltinOffsetOf CDeclaration NodeInfo
ty_name (CMemberDesig Ident
field1 NodeInfo
_ : [CPartDesignator NodeInfo]
desigs) NodeInfo
_) =
        String -> Doc
text String
"__builtin_offsetof" Doc -> Doc -> Doc
<+>
        Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
ty_name Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Ident -> Doc
identP Ident
field1 Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat ((CPartDesignator NodeInfo -> Doc)
-> [CPartDesignator NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CPartDesignator NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CPartDesignator NodeInfo]
desigs) )
    pretty (CBuiltinOffsetOf CDeclaration NodeInfo
_ty_name [CPartDesignator NodeInfo]
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
$ (CPartDesignator NodeInfo -> Doc)
-> [CPartDesignator NodeInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CPartDesignator NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty [CPartDesignator NodeInfo]
otherDesigs)
    pretty (CBuiltinTypesCompatible CDeclaration NodeInfo
ty1 CDeclaration NodeInfo
ty2 NodeInfo
_) =
        String -> Doc
text String
"__builtin_types_compatible_p" Doc -> Doc -> Doc
<+>
        Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
ty1 Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
ty2)
    pretty (CBuiltinConvertVector CExpression NodeInfo
expr CDeclaration NodeInfo
ty NodeInfo
_)  =
        String -> Doc
text String
"__builtin_convertvector" Doc -> Doc -> Doc
<+>
        Doc -> Doc
parens (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
ty)
    pretty (CBuiltinBitCast CDeclaration NodeInfo
ty CExpression NodeInfo
expr NodeInfo
_)  =
        String -> Doc
text String
"__builtin_bit_cast" Doc -> Doc -> Doc
<+>
        Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
ty Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)

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 :: CConstant NodeInfo -> 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 :: CStringLiteral NodeInfo -> Doc
pretty (CStrLit   CString
str NodeInfo
_) = String -> Doc
text (CString -> String
forall a. Show a => a -> String
show CString
str)

-- precedence of C operators
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