{-# 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 0
    prettyPrec _ = p -> Doc
forall p. Pretty p => p -> Doc
pretty

-- pretty print optional chunk
maybeP :: (p -> Doc) -> Maybe p -> Doc
maybeP :: (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 flag :: Bool
flag doc :: 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 :: ([p] -> Doc) -> [p] -> Doc
mlistP pp :: [p] -> Doc
pp xs :: [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)

-- 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 attrs :: [CAttr]
attrs = String -> Doc
text "__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 prec :: Int
prec prec2 :: Int
prec2 t :: 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 4

-- Pretty instances
instance Pretty CTranslUnit where
    pretty :: CTranslUnit -> Doc
pretty (CTranslUnit edecls :: [CExternalDeclaration NodeInfo]
edecls _) = [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 edecls :: [CExternalDeclaration NodeInfo]
edecls _) =
  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
    (headerFiles :: Set String
headerFiles,mappedDecls :: [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 (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 edecl :: 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 headerRef :: a
headerRef) (headerSet :: Set a
headerSet, ds :: [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 decl :: Either a b
decl (headerSet :: Set a
headerSet,ds :: [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 hFile :: String
hFile = String -> Doc
text "#include" Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes (String -> Doc
text String
hFile)
    isHeaderFile :: String -> Bool
isHeaderFile = (".h" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)
    includeWarning :: Set a -> Doc
includeWarning hs :: Set a
hs | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
hs = Doc
empty
                      | Bool
otherwise = String -> Doc
text "/* 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 decl :: CDeclaration NodeInfo
decl) = CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl Doc -> Doc -> Doc
<> Doc
semi
    pretty (CFDefExt fund :: CFunctionDef NodeInfo
fund) = CFunctionDef NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CFunctionDef NodeInfo
fund
    pretty (CAsmExt  asmStmt :: CStringLiteral NodeInfo
asmStmt _) = String -> Doc
text "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 declspecs :: [CDeclarationSpecifier NodeInfo]
declspecs declr :: CDeclarator NodeInfo
declr decls :: [CDeclaration NodeInfo]
decls stat :: CStatement NodeInfo
stat _) =          -- 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 (-1) CStatement NodeInfo
stat                              -- {  ...
                                                             -- }

instance Pretty CStat where
    pretty :: CStatement NodeInfo -> Doc
pretty (CLabel ident :: Ident
ident stat :: CStatement NodeInfo
stat cattrs :: [CAttr]
cattrs _) = Ident -> Doc
identP Ident
ident Doc -> Doc -> Doc
<> String -> Doc
text ":" 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 expr :: CExpression NodeInfo
expr stat :: CStatement NodeInfo
stat _) =
        String -> Doc
text "case" Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text ":" Doc -> Doc -> Doc
$$ CStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
    pretty (CCases expr1 :: CExpression NodeInfo
expr1 expr2 :: CExpression NodeInfo
expr2 stat :: CStatement NodeInfo
stat _) =
        String -> Doc
text "case" Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text "..."
                    Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr2 Doc -> Doc -> Doc
<> String -> Doc
text ":" Doc -> Doc -> Doc
$$ CStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
    pretty (CDefault stat :: CStatement NodeInfo
stat _) = String -> Doc
text "default:" Doc -> Doc -> Doc
$$ CStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
    pretty (CExpr expr :: Maybe (CExpression NodeInfo)
expr _) = 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 _ _ _) = Int -> CStatement NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 0 CStatement NodeInfo
c
    pretty (CIf expr :: CExpression NodeInfo
expr stat :: CStatement NodeInfo
stat estat :: Maybe (CStatement NodeInfo)
estat _) =
        Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$  String -> Doc
text "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 _ _ _) = Int -> CStatement a -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-1) CStatement a
c
        prettyBody nonCompound :: CStatement a
nonCompound         = Int -> CStatement a -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-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 else_if_expr :: CExpression a
else_if_expr else_if_stat :: CStatement a
else_if_stat else_stat :: Maybe (CStatement a)
else_stat _) =
          String -> Doc
text "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 else_stmt :: CStatement a
else_stmt =
          String -> Doc
text "else"
            Doc -> Doc -> Doc
$+$ CStatement a -> Doc
forall a. Pretty (CStatement a) => CStatement a -> Doc
prettyBody CStatement a
else_stmt

    pretty (CSwitch expr :: CExpression NodeInfo
expr stat :: CStatement NodeInfo
stat _) =
        Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "switch" Doc -> Doc -> Doc
<+> String -> Doc
text "(" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text ")"
               Doc -> Doc -> Doc
$+$ Int -> CStatement NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-1) CStatement NodeInfo
stat
    pretty (CWhile expr :: CExpression NodeInfo
expr stat :: CStatement NodeInfo
stat False _) =
        Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "while" Doc -> Doc -> Doc
<+> String -> Doc
text "(" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text ")"
               Doc -> Doc -> Doc
$+$ Int -> CStatement NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-1) CStatement NodeInfo
stat
    pretty (CWhile expr :: CExpression NodeInfo
expr stat :: CStatement NodeInfo
stat True _) =
        Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "do" Doc -> Doc -> Doc
$+$ Int -> CStatement NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-1) CStatement NodeInfo
stat
               Doc -> Doc -> Doc
$$ String -> Doc
text "while" Doc -> Doc -> Doc
<+> String -> Doc
text "(" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text ");"
    pretty (CFor for_init :: Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
for_init cond :: Maybe (CExpression NodeInfo)
cond step :: Maybe (CExpression NodeInfo)
step stat :: CStatement NodeInfo
stat _) =
        Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "for" Doc -> Doc -> Doc
<+> String -> Doc
text "("
               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 ")" Doc -> Doc -> Doc
$+$ Int -> CStatement NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec (-1) CStatement NodeInfo
stat
    pretty (CGoto ident :: Ident
ident _) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "goto" Doc -> Doc -> Doc
<+> Ident -> Doc
identP Ident
ident Doc -> Doc -> Doc
<> Doc
semi
    pretty (CGotoPtr expr :: CExpression NodeInfo
expr _) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "goto" Doc -> Doc -> Doc
<+> String -> Doc
text "*" Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 30 CExpression NodeInfo
expr Doc -> Doc -> Doc
<> Doc
semi
    pretty (CCont _) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "continue" Doc -> Doc -> Doc
<> Doc
semi
    pretty (CBreak _) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "break" Doc -> Doc -> Doc
<> Doc
semi
    pretty (CReturn Nothing _) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "return" Doc -> Doc -> Doc
<> Doc
semi
    pretty (CReturn (Just e :: CExpression NodeInfo
e) _) = Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "return" Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
e Doc -> Doc -> Doc
<> Doc
semi
    pretty (CAsm asmStmt :: CAssemblyStatement NodeInfo
asmStmt _) = CAssemblyStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CAssemblyStatement NodeInfo
asmStmt
    prettyPrec :: Int -> CStatement NodeInfo -> Doc
prettyPrec p :: Int
p (CCompound localLabels :: [Ident]
localLabels bis :: [CCompoundBlockItem NodeInfo]
bis _) =
        let inner :: Doc
inner = String -> Doc
text "{" 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 "}"
        in  if Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -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 (\l :: Ident
l -> String -> Doc
text "__label__" Doc -> Doc -> Doc
<+> Ident -> Doc
identP Ident
l Doc -> Doc -> Doc
<+> Doc
semi)
    prettyPrec _ p :: 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 tyQual :: Maybe (CTypeQualifier NodeInfo)
tyQual expr :: CStringLiteral NodeInfo
expr outOps :: [CAssemblyOperand NodeInfo]
outOps inOps :: [CAssemblyOperand NodeInfo]
inOps clobbers :: [CStringLiteral NodeInfo]
clobbers _) =
        Doc -> Doc
ii (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "__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 (t :: * -> *) a. Foldable t => t a -> Bool
null [[CAssemblyOperand NodeInfo]
inOps,[CAssemblyOperand NodeInfo]
outOps] Bool -> Bool -> Bool
&& [CStringLiteral NodeInfo] -> 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 ":" 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 ":" 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [CStringLiteral NodeInfo]
clobbers then Doc
empty else Doc
clobs)
        clobs :: Doc
clobs   =  String -> Doc
text ":" 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 mArgName :: Maybe Ident
mArgName cnstr :: CStringLiteral NodeInfo
cnstr expr :: CExpression NodeInfo
expr _) =
        (Ident -> Doc) -> Maybe Ident -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP (\argName :: Ident
argName -> String -> Doc
text "[" Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
argName Doc -> Doc -> Doc
<> String -> Doc
text "]") 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 stat :: CStatement NodeInfo
stat) = CStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat
    pretty (CBlockDecl decl :: 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 fundef :: 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 specs :: [CDeclarationSpecifier NodeInfo]
specs divs :: [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
  Maybe (CExpression NodeInfo))]
divs _) =
        [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 (declr :: Maybe (CDeclarator NodeInfo)
declr, initializer :: Maybe p
initializer, expr :: 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 0) Maybe (CDeclarator NodeInfo)
declr Doc -> Doc -> Doc
<+>
                (p -> Doc) -> Maybe p -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP ((String -> Doc
text ":" 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 "=" 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 ([CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. [a] -> [a]
tail [CDeclarationSpecifier NodeInfo]
specs))
                    then String
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. String -> a -> a
trace
                           ("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 ty :: CTypeSpecifier a
ty,CTypeQual (CAttrQual _)) = CTypeSpecifier a -> Bool
forall a. CTypeSpecifier a -> Bool
isSUEDef CTypeSpecifier a
ty
            isAttrAfterSUE _ = Bool
False
            getAttrs :: Maybe (CDeclarator a) -> [CAttribute a]
getAttrs Nothing = []
            getAttrs (Just (CDeclr _ _ _ cattrs :: [CAttribute a]
cattrs _)) = [CAttribute a]
cattrs
    pretty (CStaticAssert expr :: CExpression NodeInfo
expr str :: CStringLiteral NodeInfo
str _) =
      String -> Doc
text "_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 sp :: CStorageSpecifier NodeInfo
sp) = CStorageSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStorageSpecifier NodeInfo
sp
    pretty (CTypeSpec sp :: CTypeSpecifier NodeInfo
sp) = CTypeSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CTypeSpecifier NodeInfo
sp
    pretty (CTypeQual qu :: CTypeQualifier NodeInfo
qu) = CTypeQualifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CTypeQualifier NodeInfo
qu
    pretty (CFunSpec fs :: CFunctionSpecifier NodeInfo
fs) = CFunctionSpecifier NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CFunctionSpecifier NodeInfo
fs
    pretty (CAlignSpec sa :: 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 decl :: CDeclaration NodeInfo
decl _) =
        String -> Doc
text "_Alignas" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)
    pretty (CAlignAsExpr expr :: CExpression NodeInfo
expr _) =
        String -> Doc
text "_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 _) = String -> Doc
text "auto"
    pretty (CRegister _) = String -> Doc
text "register"
    pretty (CStatic _) = String -> Doc
text "static"
    pretty (CExtern _) = String -> Doc
text "extern"
    pretty (CTypedef _) = String -> Doc
text "typedef"
    pretty (CThread _) = String -> Doc
text "_Thread_local"
    pretty (CClKernel _) = String -> Doc
text "__kernel"
    pretty (CClGlobal _) = String -> Doc
text "__global"
    pretty (CClLocal _)  = String -> Doc
text "__local"

instance Pretty CTypeSpec where
    pretty :: CTypeSpecifier NodeInfo -> Doc
pretty (CVoidType _)        = String -> Doc
text "void"
    pretty (CCharType _)        = String -> Doc
text "char"
    pretty (CShortType _)       = String -> Doc
text "short"
    pretty (CIntType _)         = String -> Doc
text "int"
    pretty (CLongType _)        = String -> Doc
text "long"
    pretty (CFloatType _)       = String -> Doc
text "float"
    pretty (CFloatNType n :: Int
n x :: Bool
x _)  = String -> Doc
text "_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 "x" else Doc
empty) 
    pretty (CDoubleType _)      = String -> Doc
text "double"
    pretty (CSignedType _)      = String -> Doc
text "signed"
    pretty (CUnsigType _)       = String -> Doc
text "unsigned"
    pretty (CBoolType _)        = String -> Doc
text "_Bool"
    pretty (CComplexType _)     = String -> Doc
text "_Complex"
    pretty (CInt128Type _)      = String -> Doc
text "__int128"
    pretty (CSUType union :: CStructureUnion NodeInfo
union _)    = CStructureUnion NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStructureUnion NodeInfo
union
    pretty (CEnumType enum :: CEnumeration NodeInfo
enum _)   = CEnumeration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CEnumeration NodeInfo
enum
    pretty (CTypeDef ident :: Ident
ident _)   = Ident -> Doc
identP Ident
ident
    pretty (CTypeOfExpr expr :: CExpression NodeInfo
expr _) =
        String -> Doc
text "typeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)
    pretty (CTypeOfType decl :: CDeclaration NodeInfo
decl _) =
        String -> Doc
text "typeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)
    pretty (CAtomicType decl :: CDeclaration NodeInfo
decl _) =
        String -> Doc
text "_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 _) = String -> Doc
text "const"
    pretty (CVolatQual _) = String -> Doc
text "volatile"
    pretty (CRestrQual _) = String -> Doc
text "__restrict"
    pretty (CAtomicQual _) = String -> Doc
text "_Atomic"
    pretty (CAttrQual a :: CAttr
a)  = [CAttr] -> Doc
attrlistP [CAttr
a]
    pretty (CNullableQual _) = String -> Doc
text "_Nullable"
    pretty (CNonnullQual _) = String -> Doc
text "_Nonnull"
    pretty (CClRdOnlyQual _) = String -> Doc
text "__read_only"
    pretty (CClWrOnlyQual _) = String -> Doc
text "__write_only"

instance Pretty CFunSpec where
    pretty :: CFunctionSpecifier NodeInfo -> Doc
pretty (CInlineQual _) = String -> Doc
text "inline"
    pretty (CNoreturnQual _) = String -> Doc
text "_Noreturn"

instance Pretty CStructUnion where
    pretty :: CStructureUnion NodeInfo -> Doc
pretty (CStruct tag :: CStructTag
tag ident :: Maybe Ident
ident Nothing cattrs :: [CAttr]
cattrs _) = 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 tag :: CStructTag
tag ident :: Maybe Ident
ident (Just []) cattrs :: [CAttr]
cattrs _) =
        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 "{ }"
    pretty (CStruct tag :: CStructTag
tag ident :: Maybe Ident
ident (Just decls :: [CDeclaration NodeInfo]
decls) cattrs :: [CAttr]
cattrs _) = [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 "{",
        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 "}"]

instance Pretty CStructTag where
    pretty :: CStructTag -> Doc
pretty CStructTag = String -> Doc
text "struct"
    pretty CUnionTag  = String -> Doc
text "union"

instance Pretty CEnum where
    pretty :: CEnumeration NodeInfo -> Doc
pretty (CEnum enum_ident :: Maybe Ident
enum_ident Nothing cattrs :: [CAttr]
cattrs _) = String -> Doc
text "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 enum_ident :: Maybe Ident
enum_ident (Just vals :: [(Ident, Maybe (CExpression NodeInfo))]
vals) cattrs :: [CAttr]
cattrs _) = [Doc] -> Doc
vcat [
        String -> Doc
text "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 "{",
        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 "}"] where
        p :: (Ident, Maybe p) -> Doc
p (ident :: Ident
ident, expr :: 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 "=" 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 prec :: Int
prec declr :: 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 show_attrs :: Bool
show_attrs prec :: Int
prec (CDeclr name :: Maybe Ident
name derived_declrs :: [CDerivedDeclarator NodeInfo]
derived_declrs asmname :: Maybe (CStringLiteral NodeInfo)
asmname cattrs :: [CAttr]
cattrs _) =
    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 _ [] = (Ident -> Doc) -> Maybe Ident -> Doc
forall p. (p -> Doc) -> Maybe p -> Doc
maybeP Ident -> Doc
identP Maybe Ident
name
    --'*' __attribute__? qualifiers declarator
    ppDeclr p :: Int
p (CPtrDeclr quals :: [CTypeQualifier NodeInfo]
quals _ : declrs :: [CDerivedDeclarator NodeInfo]
declrs) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 5 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "*" 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 5 [CDerivedDeclarator NodeInfo]
declrs

    -- declarator[ __attribute__? qualifiers expr ]
    ppDeclr p :: Int
p (CArrDeclr quals :: [CTypeQualifier NodeInfo]
quals size :: CArraySize NodeInfo
size _ : declrs :: [CDerivedDeclarator NodeInfo]
declrs) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 6 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr 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 _ (CFunDeclr params :: Either [Ident] ([CDeclaration NodeInfo], Bool)
params fun_attrs :: [CAttr]
fun_attrs _ : declrs :: [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 5 [CDerivedDeclarator NodeInfo]
declrs) else Int -> [CDerivedDeclarator NodeInfo] -> Doc
ppDeclr 6 [CDerivedDeclarator NodeInfo]
declrs)
        Doc -> Doc -> Doc
<> Doc -> Doc
parens (Either [Ident] ([CDeclaration NodeInfo], Bool) -> Doc
forall p. Pretty p => Either [Ident] ([p], Bool) -> Doc
prettyParams Either [Ident] ([CDeclaration NodeInfo], Bool)
params)
    prettyParams :: Either [Ident] ([p], Bool) -> Doc
prettyParams (Right (decls :: [p]
decls, isVariadic :: Bool
isVariadic)) =
     [Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((p -> Doc) -> [p] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map p -> Doc
forall p. Pretty p => p -> Doc
pretty [p]
decls))
     Doc -> Doc -> Doc
<> (if Bool
isVariadic then String -> Doc
text "," Doc -> Doc -> Doc
<+> String -> Doc
text "..." else Doc
empty)
    prettyParams (Left oldStyleIds :: [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 asm_name_opt :: Maybe p
asm_name_opt
        = Doc -> (p -> Doc) -> Maybe p -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\asm_name :: p
asm_name -> String -> Doc
text "__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 completeType :: Bool
completeType) = Bool -> Doc -> Doc
ifP Bool
completeType (String -> Doc
text "*")
  pretty (CArrSize staticMod :: Bool
staticMod expr :: CExpression NodeInfo
expr) = Bool -> Doc -> Doc
ifP Bool
staticMod (String -> Doc
text "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 expr :: CExpression NodeInfo
expr _) = CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr
    pretty (CInitList initl :: CInitializerList NodeInfo
initl _) =
        String -> Doc
text "{" 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 p. (Pretty p, Pretty p) => ([p], p) -> Doc
p CInitializerList NodeInfo
initl)) Doc -> Doc -> Doc
<+> String -> Doc
text "}" where
        p :: ([p], p) -> Doc
p ([], initializer :: p
initializer)     = p -> Doc
forall p. Pretty p => p -> Doc
pretty p
initializer
        p (desigs :: [p]
desigs, initializer :: p
initializer) = [Doc] -> Doc
hsep ((p -> Doc) -> [p] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map p -> Doc
forall p. Pretty p => p -> Doc
pretty [p]
desigs) Doc -> Doc -> Doc
<+> String -> Doc
text "=" 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 expr :: CExpression NodeInfo
expr _) = String -> Doc
text "[" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text "]"
    pretty (CMemberDesig ident :: Ident
ident _) = String -> Doc
text "." Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
ident
    pretty (CRangeDesig expr1 :: CExpression NodeInfo
expr1 expr2 :: CExpression NodeInfo
expr2 _) =
        String -> Doc
text "[" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text "..." Doc -> Doc -> Doc
<+> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr2 Doc -> Doc -> Doc
<> String -> Doc
text "]"

instance Pretty CAttr where
    pretty :: CAttr -> Doc
pretty (CAttr attrName :: Ident
attrName [] _) = Ident -> Doc
identP Ident
attrName
    pretty (CAttr attrName :: Ident
attrName attrParams :: [CExpression NodeInfo]
attrParams _) = 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 p :: Int
p (CComma exprs :: [CExpression NodeInfo]
exprs _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p (-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 2) [CExpression NodeInfo]
exprs))
    prettyPrec p :: Int
p (CAssign op :: CAssignOp
op expr1 :: CExpression NodeInfo
expr1 expr2 :: CExpression NodeInfo
expr2 _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 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 2 CExpression NodeInfo
expr2
    prettyPrec p :: Int
p (CCond expr1 :: CExpression NodeInfo
expr1 expr2 :: Maybe (CExpression NodeInfo)
expr2 expr3 :: CExpression NodeInfo
expr3 _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 4 CExpression NodeInfo
expr1 Doc -> Doc -> Doc
<+> String -> Doc
text "?" -- 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 ":" Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 4 CExpression NodeInfo
expr3
    prettyPrec p :: Int
p (CBinary op :: CBinaryOp
op expr1 :: CExpression NodeInfo
expr1 expr2 :: CExpression NodeInfo
expr2 _) =
        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
+ 1) CExpression NodeInfo
expr2
    prettyPrec p :: Int
p (CCast decl :: CDeclaration NodeInfo
decl expr :: CExpression NodeInfo
expr _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 25 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(" Doc -> Doc -> Doc
<> CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl Doc -> Doc -> Doc
<> String -> Doc
text ")"
                       Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 25 CExpression NodeInfo
expr
    prettyPrec p :: Int
p (CUnary CPostIncOp expr :: CExpression NodeInfo
expr _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 26 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 26 CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text "++"
    prettyPrec p :: Int
p (CUnary CPostDecOp expr :: CExpression NodeInfo
expr _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 26 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 26 CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text "--"
    prettyPrec p :: Int
p (CUnary op :: CUnaryOp
op expr :: CExpression NodeInfo
expr@(CUnary _ _ _) _) =
        --                             parens aren't necessary, but look nicer imho
        Int -> Int -> Doc -> Doc
parenPrec Int
p 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 25 CExpression NodeInfo
expr)
    prettyPrec p :: Int
p (CUnary op :: CUnaryOp
op expr :: CExpression NodeInfo
expr _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 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 25 CExpression NodeInfo
expr
    prettyPrec p :: Int
p (CSizeofExpr expr :: CExpression NodeInfo
expr _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 25 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "sizeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)
    prettyPrec p :: Int
p (CSizeofType decl :: CDeclaration NodeInfo
decl _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 25 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "sizeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)
    prettyPrec p :: Int
p (CAlignofExpr expr :: CExpression NodeInfo
expr _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 25 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "__alignof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr)
    prettyPrec p :: Int
p (CAlignofType decl :: CDeclaration NodeInfo
decl _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 25 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "__alignof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (CDeclaration NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CDeclaration NodeInfo
decl)
    prettyPrec p :: Int
p (CComplexReal expr :: CExpression NodeInfo
expr _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 25 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "__real" Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 25 CExpression NodeInfo
expr
    prettyPrec p :: Int
p (CComplexImag expr :: CExpression NodeInfo
expr _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 25 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "__imag" Doc -> Doc -> Doc
<+> Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 25 CExpression NodeInfo
expr
    prettyPrec p :: Int
p (CIndex expr1 :: CExpression NodeInfo
expr1 expr2 :: CExpression NodeInfo
expr2 _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 26 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 26 CExpression NodeInfo
expr1
                       Doc -> Doc -> Doc
<> String -> Doc
text "[" Doc -> Doc -> Doc
<> CExpression NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CExpression NodeInfo
expr2 Doc -> Doc -> Doc
<> String -> Doc
text "]"
    prettyPrec p :: Int
p (CCall expr :: CExpression NodeInfo
expr args :: [CExpression NodeInfo]
args _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 30 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 30 CExpression NodeInfo
expr Doc -> Doc -> Doc
<> String -> Doc
text "("
            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 ")"
    prettyPrec p :: Int
p (CMember expr :: CExpression NodeInfo
expr ident :: Ident
ident deref :: Bool
deref _) =
        Int -> Int -> Doc -> Doc
parenPrec Int
p 26 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> CExpression NodeInfo -> Doc
forall p. Pretty p => Int -> p -> Doc
prettyPrec 26 CExpression NodeInfo
expr
                       Doc -> Doc -> Doc
<> String -> Doc
text (if Bool
deref then "->" else ".") Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
ident
    prettyPrec _p :: Int
_p (CVar ident :: Ident
ident _) = Ident -> Doc
identP Ident
ident
    prettyPrec _p :: Int
_p (CConst constant :: CConstant NodeInfo
constant) = CConstant NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CConstant NodeInfo
constant
    prettyPrec _p :: Int
_p (CCompoundLit decl :: CDeclaration NodeInfo
decl initl :: CInitializerList NodeInfo
initl _) =
        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 p. (Pretty p, Pretty p) => ([p], p) -> Doc
p CInitializerList NodeInfo
initl) where
        p :: ([p], p) -> Doc
p ([], initializer :: p
initializer)           = p -> Doc
forall p. Pretty p => p -> Doc
pretty p
initializer
        p (mems :: [p]
mems, initializer :: p
initializer) = [Doc] -> Doc
hcat ((p -> Doc) -> [p] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map p -> Doc
forall p. Pretty p => p -> Doc
pretty [p]
mems) Doc -> Doc -> Doc
<+> String -> Doc
text "=" Doc -> Doc -> Doc
<+> p -> Doc
forall p. Pretty p => p -> Doc
pretty p
initializer

    prettyPrec _p :: Int
_p (CStatExpr stat :: CStatement NodeInfo
stat _) =
        String -> Doc
text "(" Doc -> Doc -> Doc
<> CStatement NodeInfo -> Doc
forall p. Pretty p => p -> Doc
pretty CStatement NodeInfo
stat Doc -> Doc -> Doc
<> String -> Doc
text ")"

    -- unary_expr :- && ident  {- address of label -}
    prettyPrec _p :: Int
_p (CLabAddrExpr ident :: Ident
ident _) = String -> Doc
text "&&" Doc -> Doc -> Doc
<> Ident -> Doc
identP Ident
ident
    prettyPrec _p :: Int
_p (CGenericSelection expr :: CExpression NodeInfo
expr assoc_list :: [(Maybe (CDeclaration NodeInfo), CExpression NodeInfo)]
assoc_list _) =
      String -> Doc
text "_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 p p. (Pretty p, Pretty p) => (Maybe p, p) -> Doc
pAssoc [(Maybe (CDeclaration NodeInfo), CExpression NodeInfo)]
assoc_list)
      where
        pAssoc :: (Maybe p, p) -> Doc
pAssoc (mty :: Maybe p
mty, expr1 :: p
expr1) = Doc -> (p -> Doc) -> Maybe p -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Doc
text "default") p -> Doc
forall p. Pretty p => p -> Doc
pretty Maybe p
mty Doc -> Doc -> Doc
<> String -> Doc
text ":" Doc -> Doc -> Doc
<+> p -> Doc
forall p. Pretty p => p -> Doc
pretty p
expr1
    prettyPrec _p :: Int
_p (CBuiltinExpr builtin :: 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 expr :: CExpression NodeInfo
expr ty_name :: CDeclaration NodeInfo
ty_name _) =
        String -> Doc
text "__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 ty_name :: CDeclaration NodeInfo
ty_name (CMemberDesig field1 :: Ident
field1 _ : desigs :: [CPartDesignator NodeInfo]
desigs) _) =
        String -> Doc
text "__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 _ty_name :: CDeclaration NodeInfo
_ty_name otherDesigs :: [CPartDesignator NodeInfo]
otherDesigs _) =
        String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "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 ty1 :: CDeclaration NodeInfo
ty1 ty2 :: CDeclaration NodeInfo
ty2 _) =
        String -> Doc
text "__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 expr :: CExpression NodeInfo
expr ty :: CDeclaration NodeInfo
ty _)  =
        String -> Doc
text "__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)

instance Pretty CAssignOp where
  pretty :: CAssignOp -> Doc
pretty op :: CAssignOp
op = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case CAssignOp
op of
    CAssignOp -> "="
    CMulAssOp -> "*="
    CDivAssOp -> "/="
    CRmdAssOp -> "%="
    CAddAssOp -> "+="
    CSubAssOp -> "-="
    CShlAssOp -> "<<="
    CShrAssOp -> ">>="
    CAndAssOp -> "&="
    CXorAssOp -> "^="
    COrAssOp  -> "|="

instance Pretty CBinaryOp where
  pretty :: CBinaryOp -> Doc
pretty op :: CBinaryOp
op = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case CBinaryOp
op of
    CMulOp -> "*"
    CDivOp -> "/"
    CRmdOp -> "%"
    CAddOp -> "+"
    CSubOp -> "-"
    CShlOp -> "<<"
    CShrOp -> ">>"
    CLeOp  -> "<"
    CGrOp  -> ">"
    CLeqOp -> "<="
    CGeqOp -> ">="
    CEqOp  -> "=="
    CNeqOp -> "!="
    CAndOp -> "&"
    CXorOp -> "^"
    COrOp  -> "|"
    CLndOp -> "&&"
    CLorOp -> "||"

instance Pretty CUnaryOp where
  pretty :: CUnaryOp -> Doc
pretty op :: CUnaryOp
op = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case CUnaryOp
op of
    CPreIncOp  -> "++"
    CPreDecOp  -> "--"
    CPostIncOp -> "++"
    CPostDecOp -> "--"
    CAdrOp     -> "&"
    CIndOp     -> "*"
    CPlusOp    -> "+"
    CMinOp     -> "-"
    CCompOp    -> "~"
    CNegOp     -> "!"

instance Pretty CConst where
    pretty :: CConstant NodeInfo -> Doc
pretty (CIntConst   int_const :: CInteger
int_const _) = String -> Doc
text (CInteger -> String
forall a. Show a => a -> String
show CInteger
int_const)
    pretty (CCharConst  chr :: CChar
chr _) = String -> Doc
text (CChar -> String
forall a. Show a => a -> String
show CChar
chr)
    pretty (CFloatConst flt :: CFloat
flt _) = String -> Doc
text (CFloat -> String
forall a. Show a => a -> String
show CFloat
flt)
    pretty (CStrConst   str :: CString
str _) = String -> Doc
text (CString -> String
forall a. Show a => a -> String
show CString
str)

instance Pretty CStrLit where
    pretty :: CStringLiteral NodeInfo -> Doc
pretty (CStrLit   str :: CString
str _) = 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 CMulOp = 20
binPrec CDivOp = 20
binPrec CRmdOp = 20
binPrec CAddOp = 19
binPrec CSubOp = 19
binPrec CShlOp = 18
binPrec CShrOp = 18
binPrec CLeOp  = 17
binPrec CGrOp  = 17
binPrec CLeqOp = 17
binPrec CGeqOp = 17
binPrec CEqOp  = 16
binPrec CNeqOp = 16
binPrec CAndOp = 15
binPrec CXorOp = 14
binPrec COrOp  = 13
binPrec CLndOp = 12
binPrec CLorOp = 11