{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
#if __GLASGOW_HASKELL__ <= 708
{-# LANGUAGE OverlappingInstances #-}
#endif
module Language.C.PrintC where
import Prelude
( ($), (.)
, Bool(..), (==), (<)
, Int, Integer, Double, (+), (-), (*)
, String, (++)
, ShowS, showChar, showString
, all, elem, foldr, id, map, null, replicate, shows, span
)
import Data.Char ( Char, isSpace )
import qualified Language.C.AbsC
printTree :: Print a => a -> String
printTree :: forall a. Print a => a -> String
printTree = Doc -> String
render (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0
type Doc = [ShowS] -> [ShowS]
doc :: ShowS -> Doc
doc :: ShowS -> Doc
doc = (:)
render :: Doc -> String
render :: Doc -> String
render Doc
d = Int -> Bool -> [String] -> ShowS
rend Int
0 Bool
False ((ShowS -> String) -> [ShowS] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") ([ShowS] -> [String]) -> [ShowS] -> [String]
forall a b. (a -> b) -> a -> b
$ Doc
d []) String
""
where
rend
:: Int
-> Bool
-> [String]
-> ShowS
rend :: Int -> Bool -> [String] -> ShowS
rend Int
i Bool
p = \case
String
"[" :[String]
ts -> Char -> ShowS
char Char
'[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [String] -> ShowS
rend Int
i Bool
False [String]
ts
String
"(" :[String]
ts -> Char -> ShowS
char Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [String] -> ShowS
rend Int
i Bool
False [String]
ts
String
"{" :[String]
ts -> Int -> Bool -> ShowS
onNewLine Int
i Bool
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> ShowS
new (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [String]
ts
String
"}" : String
";":[String]
ts -> Int -> Bool -> ShowS
onNewLine (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"};" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> ShowS
new (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
ts
String
"}" :[String]
ts -> Int -> Bool -> ShowS
onNewLine (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> ShowS
new (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
ts
[String
";"] -> Char -> ShowS
char Char
';'
String
";" :[String]
ts -> Char -> ShowS
char Char
';' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> ShowS
new Int
i [String]
ts
String
t : ts :: [String]
ts@(String
s:[String]
_) | String -> Bool
closingOrPunctuation String
s
-> ShowS
pending ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [String] -> ShowS
rend Int
i Bool
False [String]
ts
String
t :[String]
ts -> ShowS
pending ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
space String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [String] -> ShowS
rend Int
i Bool
False [String]
ts
[] -> ShowS
forall a. a -> a
id
where
char :: Char -> ShowS
char :: Char -> ShowS
char Char
c = ShowS
pending ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
c
pending :: ShowS
pending :: ShowS
pending = if Bool
p then Int -> ShowS
indent Int
i else ShowS
forall a. a -> a
id
indent :: Int -> ShowS
indent :: Int -> ShowS
indent Int
i = Int -> ShowS -> ShowS
replicateS (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i) (Char -> ShowS
showChar Char
' ')
new :: Int -> [String] -> ShowS
new :: Int -> [String] -> ShowS
new Int
j [String]
ts = Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [String] -> ShowS
rend Int
j Bool
True [String]
ts
onNewLine :: Int -> Bool -> ShowS
onNewLine :: Int -> Bool -> ShowS
onNewLine Int
i Bool
p = (if Bool
p then ShowS
forall a. a -> a
id else Char -> ShowS
showChar Char
'\n') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
i
space :: String -> ShowS
space :: String -> ShowS
space String
t String
s =
case ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
t, String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
spc, String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) of
(Bool
True , Bool
_ , Bool
True ) -> []
(Bool
False, Bool
_ , Bool
True ) -> String
t
(Bool
False, Bool
True, Bool
False) -> String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
(Bool, Bool, Bool)
_ -> String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
where
(String
spc, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
s
closingOrPunctuation :: String -> Bool
closingOrPunctuation :: String -> Bool
closingOrPunctuation [Char
c] = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
closerOrPunct
closingOrPunctuation String
_ = Bool
False
closerOrPunct :: String
closerOrPunct :: String
closerOrPunct = String
")],;"
parenth :: Doc -> Doc
parenth :: Doc -> Doc
parenth Doc
ss = ShowS -> Doc
doc (Char -> ShowS
showChar Char
'(') Doc -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc
ss Doc -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Doc
doc (Char -> ShowS
showChar Char
')')
concatS :: [ShowS] -> ShowS
concatS :: [ShowS] -> ShowS
concatS = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id
concatD :: [Doc] -> Doc
concatD :: [Doc] -> Doc
concatD = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Doc
forall a. a -> a
id
replicateS :: Int -> ShowS -> ShowS
replicateS :: Int -> ShowS -> ShowS
replicateS Int
n ShowS
f = [ShowS] -> ShowS
concatS (Int -> ShowS -> [ShowS]
forall a. Int -> a -> [a]
replicate Int
n ShowS
f)
class Print a where
prt :: Int -> a -> Doc
instance {-# OVERLAPPABLE #-} Print a => Print [a] where
prt :: Int -> [a] -> Doc
prt Int
i = [Doc] -> Doc
concatD ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> a -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
i)
instance Print Char where
prt :: Int -> Char -> Doc
prt Int
_ Char
c = ShowS -> Doc
doc (Char -> ShowS
showChar Char
'\'' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> ShowS
mkEsc Char
'\'' Char
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\'')
instance Print String where
prt :: Int -> String -> Doc
prt Int
_ = String -> Doc
printString
printString :: String -> Doc
printString :: String -> Doc
printString String
s = ShowS -> Doc
doc (Char -> ShowS
showChar Char
'"' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ShowS] -> ShowS
concatS ((Char -> ShowS) -> String -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> ShowS
mkEsc Char
'"') String
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'"')
mkEsc :: Char -> Char -> ShowS
mkEsc :: Char -> Char -> ShowS
mkEsc Char
q = \case
Char
s | Char
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
q -> Char -> ShowS
showChar Char
'\\' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
s
Char
'\\' -> String -> ShowS
showString String
"\\\\"
Char
'\n' -> String -> ShowS
showString String
"\\n"
Char
'\t' -> String -> ShowS
showString String
"\\t"
Char
s -> Char -> ShowS
showChar Char
s
prPrec :: Int -> Int -> Doc -> Doc
prPrec :: Int -> Int -> Doc -> Doc
prPrec Int
i Int
j = if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i then Doc -> Doc
parenth else Doc -> Doc
forall a. a -> a
id
instance Print Integer where
prt :: Int -> Integer -> Doc
prt Int
_ Integer
x = ShowS -> Doc
doc (Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
x)
instance Print Double where
prt :: Int -> Double -> Doc
prt Int
_ Double
x = ShowS -> Doc
doc (Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
x)
instance Print Language.C.AbsC.Identifier where
prt :: Int -> Identifier -> Doc
prt Int
_ (Language.C.AbsC.Identifier String
i) = ShowS -> Doc
doc (ShowS -> Doc) -> ShowS -> Doc
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
i
instance Print Language.C.AbsC.IntegerConstant where
prt :: Int -> IntegerConstant -> Doc
prt Int
_ (Language.C.AbsC.IntegerConstant String
i) = ShowS -> Doc
doc (ShowS -> Doc) -> ShowS -> Doc
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
i
instance Print Language.C.AbsC.TranslationUnit where
prt :: Int -> TranslationUnit -> Doc
prt Int
i = \case
Language.C.AbsC.MkTranslationUnit [ExternalDeclaration]
externaldeclarations -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> [ExternalDeclaration] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [ExternalDeclaration]
externaldeclarations])
instance Print [Language.C.AbsC.ExternalDeclaration] where
prt :: Int -> [ExternalDeclaration] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ [ExternalDeclaration
x] = [Doc] -> Doc
concatD [Int -> ExternalDeclaration -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ExternalDeclaration
x]
prt Int
_ (ExternalDeclaration
x:[ExternalDeclaration]
xs) = [Doc] -> Doc
concatD [Int -> ExternalDeclaration -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ExternalDeclaration
x, Int -> [ExternalDeclaration] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [ExternalDeclaration]
xs]
instance Print Language.C.AbsC.ExternalDeclaration where
prt :: Int -> ExternalDeclaration -> Doc
prt Int
i = \case
Language.C.AbsC.MkExternalDeclarationFunctionDefinition FunctionDefinition
functiondefinition -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> FunctionDefinition -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 FunctionDefinition
functiondefinition])
Language.C.AbsC.MkExternalDeclarationDeclaration Declaration
declaration -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Declaration -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declaration
declaration])
instance Print Language.C.AbsC.FunctionDefinition where
prt :: Int -> FunctionDefinition -> Doc
prt Int
i = \case
Language.C.AbsC.MkFunctionDefinition [DeclarationSpecifier]
declarationspecifiers Declarator
declarator [Declaration]
declarations CompoundStatement
compoundstatement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> [DeclarationSpecifier] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [DeclarationSpecifier]
declarationspecifiers, Int -> Declarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declarator
declarator, Int -> [Declaration] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Declaration]
declarations, Int -> CompoundStatement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 CompoundStatement
compoundstatement])
instance Print Language.C.AbsC.Declaration where
prt :: Int -> Declaration -> Doc
prt Int
i = \case
Language.C.AbsC.MkDeclaration DeclarationSpecifiers
declarationspecifiers InitDeclarationListOpt
initdeclarationlistopt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DeclarationSpecifiers -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclarationSpecifiers
declarationspecifiers, Int -> InitDeclarationListOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 InitDeclarationListOpt
initdeclarationlistopt, ShowS -> Doc
doc (String -> ShowS
showString String
";")])
instance Print [Language.C.AbsC.Declaration] where
prt :: Int -> [Declaration] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ (Declaration
x:[Declaration]
xs) = [Doc] -> Doc
concatD [Int -> Declaration -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declaration
x, Int -> [Declaration] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Declaration]
xs]
instance Print [Language.C.AbsC.DeclarationSpecifier] where
prt :: Int -> [DeclarationSpecifier] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ (DeclarationSpecifier
x:[DeclarationSpecifier]
xs) = [Doc] -> Doc
concatD [Int -> DeclarationSpecifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclarationSpecifier
x, Int -> [DeclarationSpecifier] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [DeclarationSpecifier]
xs]
instance Print Language.C.AbsC.DeclarationSpecifiers where
prt :: Int -> DeclarationSpecifiers -> Doc
prt Int
i = \case
Language.C.AbsC.DeclarationSpecifiers DeclarationSpecifier
declarationspecifier [DeclarationSpecifier]
declarationspecifiers -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DeclarationSpecifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclarationSpecifier
declarationspecifier, Int -> [DeclarationSpecifier] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [DeclarationSpecifier]
declarationspecifiers])
instance Print Language.C.AbsC.DeclarationSpecifier where
prt :: Int -> DeclarationSpecifier -> Doc
prt Int
i = \case
Language.C.AbsC.MkDeclarationSpecifierStorageClass StorageClassSpecifier
storageclassspecifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> StorageClassSpecifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 StorageClassSpecifier
storageclassspecifier])
Language.C.AbsC.MkDeclarationSpecifierTypeSpecifier TypeSpecifier
typespecifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> TypeSpecifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeSpecifier
typespecifier])
Language.C.AbsC.MkDeclarationSpecifierTypeQualifier TypeQualifier
typequalifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> TypeQualifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeQualifier
typequalifier])
instance Print Language.C.AbsC.StorageClassSpecifier where
prt :: Int -> StorageClassSpecifier -> Doc
prt Int
i = \case
StorageClassSpecifier
Language.C.AbsC.MkStorageClassSpecifierAuto -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"auto")])
StorageClassSpecifier
Language.C.AbsC.MkStorageClassSpecifierRegister -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"register")])
StorageClassSpecifier
Language.C.AbsC.MkStorageClassSpecifierStatic -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"static")])
StorageClassSpecifier
Language.C.AbsC.MkStorageClassSpecifierExtern -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"extern")])
StorageClassSpecifier
Language.C.AbsC.MkStorageClassSpecifierTypedef -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"typedef")])
instance Print Language.C.AbsC.TypeSpecifier where
prt :: Int -> TypeSpecifier -> Doc
prt Int
i = \case
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierVoid -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"void")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierChar -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"char")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierShort -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"short")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierInt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"int")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierInt8 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"int8_t")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierInt16 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"int16_t")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierInt32 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"int32_t")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierInt64 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"int64_t")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierUInt8 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"uint8_t")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierUInt16 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"uint16_t")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierUInt32 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"uint32_t")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierUInt64 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"uint64_t")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierLong -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"long")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierFloat -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"float")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierDouble -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"double")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierSigned -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"signed")])
TypeSpecifier
Language.C.AbsC.MkTypeSpecifierUnsigned -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"unsigned")])
Language.C.AbsC.MkTypeSpecifierStructOrUnion StructOrUnionSpecifier
structorunionspecifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> StructOrUnionSpecifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 StructOrUnionSpecifier
structorunionspecifier])
Language.C.AbsC.MkTypeSpecifierEnumSpecifier EnumSpecifier
enumspecifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> EnumSpecifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 EnumSpecifier
enumspecifier])
instance Print Language.C.AbsC.TypeQualifier where
prt :: Int -> TypeQualifier -> Doc
prt Int
i = \case
TypeQualifier
Language.C.AbsC.MkTypeQualifierConst -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"const")])
TypeQualifier
Language.C.AbsC.MkTypeQualifierVolatile -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"volatile")])
instance Print Language.C.AbsC.StructOrUnionSpecifier where
prt :: Int -> StructOrUnionSpecifier -> Doc
prt Int
i = \case
Language.C.AbsC.MkStructOrUnionSpecifierWithFields StructOrUnion
structorunion IdentifierOpt
identifieropt [StructDeclaration]
structdeclarations -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> StructOrUnion -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 StructOrUnion
structorunion, Int -> IdentifierOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 IdentifierOpt
identifieropt, ShowS -> Doc
doc (String -> ShowS
showString String
"{"), Int -> [StructDeclaration] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [StructDeclaration]
structdeclarations, ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
Language.C.AbsC.MkStructOrUnionSpecifierEmpty StructOrUnion
structorunion Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> StructOrUnion -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 StructOrUnion
structorunion, Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
instance Print Language.C.AbsC.StructOrUnion where
prt :: Int -> StructOrUnion -> Doc
prt Int
i = \case
StructOrUnion
Language.C.AbsC.MkStructOrUnionStruct -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"struct")])
StructOrUnion
Language.C.AbsC.MkStructOrUnionUnion -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"union")])
instance Print [Language.C.AbsC.StructDeclaration] where
prt :: Int -> [StructDeclaration] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ [StructDeclaration
x] = [Doc] -> Doc
concatD [Int -> StructDeclaration -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 StructDeclaration
x]
prt Int
_ (StructDeclaration
x:[StructDeclaration]
xs) = [Doc] -> Doc
concatD [Int -> StructDeclaration -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 StructDeclaration
x, Int -> [StructDeclaration] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [StructDeclaration]
xs]
instance Print Language.C.AbsC.InitDeclarationListOpt where
prt :: Int -> InitDeclarationListOpt -> Doc
prt Int
i = \case
InitDeclarationListOpt
Language.C.AbsC.MkInitDeclarationListOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkInitDeclarationListOptJust [InitDeclarator]
initdeclarators -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> [InitDeclarator] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [InitDeclarator]
initdeclarators])
instance Print [Language.C.AbsC.InitDeclarator] where
prt :: Int -> [InitDeclarator] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ [InitDeclarator
x] = [Doc] -> Doc
concatD [Int -> InitDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 InitDeclarator
x]
prt Int
_ (InitDeclarator
x:[InitDeclarator]
xs) = [Doc] -> Doc
concatD [Int -> InitDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 InitDeclarator
x, ShowS -> Doc
doc (String -> ShowS
showString String
","), Int -> [InitDeclarator] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [InitDeclarator]
xs]
instance Print Language.C.AbsC.InitDeclarator where
prt :: Int -> InitDeclarator -> Doc
prt Int
i = \case
Language.C.AbsC.MkInitDeclaratorUninitialized Declarator
declarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Declarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declarator
declarator])
Language.C.AbsC.MkInitDeclaratorInitialized Declarator
declarator Initializer
initializer -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Declarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declarator
declarator, ShowS -> Doc
doc (String -> ShowS
showString String
"="), Int -> Initializer -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Initializer
initializer])
instance Print Language.C.AbsC.StructDeclaration where
prt :: Int -> StructDeclaration -> Doc
prt Int
i = \case
Language.C.AbsC.MkStructDeclaration [SpecifierQualifier]
specifierqualifiers [StructDeclarator]
structdeclarators -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> [SpecifierQualifier] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [SpecifierQualifier]
specifierqualifiers, Int -> [StructDeclarator] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [StructDeclarator]
structdeclarators, ShowS -> Doc
doc (String -> ShowS
showString String
";")])
instance Print [Language.C.AbsC.SpecifierQualifier] where
prt :: Int -> [SpecifierQualifier] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ [SpecifierQualifier
x] = [Doc] -> Doc
concatD [Int -> SpecifierQualifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 SpecifierQualifier
x]
prt Int
_ (SpecifierQualifier
x:[SpecifierQualifier]
xs) = [Doc] -> Doc
concatD [Int -> SpecifierQualifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 SpecifierQualifier
x, Int -> [SpecifierQualifier] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [SpecifierQualifier]
xs]
instance Print Language.C.AbsC.SpecifierQualifier where
prt :: Int -> SpecifierQualifier -> Doc
prt Int
i = \case
Language.C.AbsC.MkSpecifierQualifierTypeSpecifier TypeSpecifier
typespecifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> TypeSpecifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeSpecifier
typespecifier])
Language.C.AbsC.MkSpecifierQualifierTypeQualifier TypeQualifier
typequalifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> TypeQualifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeQualifier
typequalifier])
instance Print [Language.C.AbsC.StructDeclarator] where
prt :: Int -> [StructDeclarator] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ [StructDeclarator
x] = [Doc] -> Doc
concatD [Int -> StructDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 StructDeclarator
x]
prt Int
_ (StructDeclarator
x:[StructDeclarator]
xs) = [Doc] -> Doc
concatD [Int -> StructDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 StructDeclarator
x, ShowS -> Doc
doc (String -> ShowS
showString String
","), Int -> [StructDeclarator] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [StructDeclarator]
xs]
instance Print Language.C.AbsC.StructDeclarator where
prt :: Int -> StructDeclarator -> Doc
prt Int
i = \case
Language.C.AbsC.MkStructDeclaratorDeclarator Declarator
declarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Declarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declarator
declarator])
Language.C.AbsC.MkStructDeclaratorConstant DeclaratorOpt
declaratoropt ConstantExpression
constantexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DeclaratorOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclaratorOpt
declaratoropt, ShowS -> Doc
doc (String -> ShowS
showString String
":"), Int -> ConstantExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ConstantExpression
constantexpression])
instance Print Language.C.AbsC.EnumSpecifier where
prt :: Int -> EnumSpecifier -> Doc
prt Int
i = \case
Language.C.AbsC.MkEnumSpecifierWithCases IdentifierOpt
identifieropt EnumeratorList
enumeratorlist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"enum"), Int -> IdentifierOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 IdentifierOpt
identifieropt, ShowS -> Doc
doc (String -> ShowS
showString String
"{"), Int -> EnumeratorList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 EnumeratorList
enumeratorlist, ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
Language.C.AbsC.MkEnumSpecifierEmpty Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"enum"), Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
instance Print Language.C.AbsC.EnumeratorList where
prt :: Int -> EnumeratorList -> Doc
prt Int
i = \case
Language.C.AbsC.MkEnumeratorList1 Enumerator
enumerator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Enumerator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Enumerator
enumerator])
Language.C.AbsC.MkEnumeratorListN EnumeratorList
enumeratorlist Enumerator
enumerator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> EnumeratorList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 EnumeratorList
enumeratorlist, ShowS -> Doc
doc (String -> ShowS
showString String
","), Int -> Enumerator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Enumerator
enumerator])
instance Print Language.C.AbsC.Enumerator where
prt :: Int -> Enumerator -> Doc
prt Int
i = \case
Language.C.AbsC.MkEnumeratorUninitialized Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
Language.C.AbsC.MkEnumeratorInitialized Identifier
identifier ConstantExpression
constantexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier, ShowS -> Doc
doc (String -> ShowS
showString String
"="), Int -> ConstantExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ConstantExpression
constantexpression])
instance Print Language.C.AbsC.DeclaratorOpt where
prt :: Int -> DeclaratorOpt -> Doc
prt Int
i = \case
DeclaratorOpt
Language.C.AbsC.MkDeclaratorOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkDeclaratorOptJust Declarator
declarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Declarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declarator
declarator])
instance Print Language.C.AbsC.Declarator where
prt :: Int -> Declarator -> Doc
prt Int
i = \case
Language.C.AbsC.MkDeclarator PointerOpt
pointeropt DirectDeclarator
directdeclarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PointerOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PointerOpt
pointeropt, Int -> DirectDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DirectDeclarator
directdeclarator])
instance Print Language.C.AbsC.DirectDeclarator where
prt :: Int -> DirectDeclarator -> Doc
prt Int
i = \case
Language.C.AbsC.MkDirectDeclaratorIdentifier Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
Language.C.AbsC.MkDirectDeclaratorParDeclarator Declarator
declarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> Declarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declarator
declarator, ShowS -> Doc
doc (String -> ShowS
showString String
")")])
Language.C.AbsC.MkDirectDeclaratorConstantExpressionOpt DirectDeclarator
directdeclarator ConstantExpressionOpt
constantexpressionopt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DirectDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DirectDeclarator
directdeclarator, ShowS -> Doc
doc (String -> ShowS
showString String
"["), Int -> ConstantExpressionOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ConstantExpressionOpt
constantexpressionopt, ShowS -> Doc
doc (String -> ShowS
showString String
"]")])
Language.C.AbsC.MkDirectDeclaratorParameterTypeList DirectDeclarator
directdeclarator ParameterTypeList
parametertypelist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DirectDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DirectDeclarator
directdeclarator, ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> ParameterTypeList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ParameterTypeList
parametertypelist, ShowS -> Doc
doc (String -> ShowS
showString String
")")])
Language.C.AbsC.MkDirectDeclaratorIdentifierListOpt DirectDeclarator
directdeclarator IdentifierListOpt
identifierlistopt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DirectDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DirectDeclarator
directdeclarator, ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> IdentifierListOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 IdentifierListOpt
identifierlistopt, ShowS -> Doc
doc (String -> ShowS
showString String
")")])
instance Print Language.C.AbsC.PointerOpt where
prt :: Int -> PointerOpt -> Doc
prt Int
i = \case
PointerOpt
Language.C.AbsC.MkPointerOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkPointerOptJust Pointer
pointer -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Pointer -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Pointer
pointer])
instance Print Language.C.AbsC.Pointer where
prt :: Int -> Pointer -> Doc
prt Int
i = \case
Language.C.AbsC.MkPointer1 TypeQualifierListOpt
typequalifierlistopt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"*"), Int -> TypeQualifierListOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeQualifierListOpt
typequalifierlistopt])
Language.C.AbsC.MkPointerN TypeQualifierListOpt
typequalifierlistopt Pointer
pointer -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"*"), Int -> TypeQualifierListOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeQualifierListOpt
typequalifierlistopt, Int -> Pointer -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Pointer
pointer])
instance Print Language.C.AbsC.TypeQualifierListOpt where
prt :: Int -> TypeQualifierListOpt -> Doc
prt Int
i = \case
TypeQualifierListOpt
Language.C.AbsC.MkTypeQualifierListOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkTypeQualifierListOptJust TypeQualifierList
typequalifierlist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> TypeQualifierList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeQualifierList
typequalifierlist])
instance Print Language.C.AbsC.TypeQualifierList where
prt :: Int -> TypeQualifierList -> Doc
prt Int
i = \case
Language.C.AbsC.MkTypeQualifierList1 TypeQualifier
typequalifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> TypeQualifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeQualifier
typequalifier])
Language.C.AbsC.MkTypeQualifierListN TypeQualifierList
typequalifierlist TypeQualifier
typequalifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> TypeQualifierList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeQualifierList
typequalifierlist, Int -> TypeQualifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeQualifier
typequalifier])
instance Print Language.C.AbsC.ParameterTypeList where
prt :: Int -> ParameterTypeList -> Doc
prt Int
i = \case
Language.C.AbsC.MkParameterTypeList ParameterList
parameterlist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> ParameterList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ParameterList
parameterlist])
Language.C.AbsC.MkParameterTypeListEllipsis ParameterList
parameterlist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> ParameterList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ParameterList
parameterlist, ShowS -> Doc
doc (String -> ShowS
showString String
","), ShowS -> Doc
doc (String -> ShowS
showString String
"...")])
instance Print Language.C.AbsC.ParameterList where
prt :: Int -> ParameterList -> Doc
prt Int
i = \case
Language.C.AbsC.MkParameterList1 ParameterDeclaration
parameterdeclaration -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> ParameterDeclaration -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ParameterDeclaration
parameterdeclaration])
Language.C.AbsC.MkParameterListN ParameterList
parameterlist ParameterDeclaration
parameterdeclaration -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> ParameterList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ParameterList
parameterlist, ShowS -> Doc
doc (String -> ShowS
showString String
","), Int -> ParameterDeclaration -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ParameterDeclaration
parameterdeclaration])
instance Print Language.C.AbsC.ParameterDeclaration where
prt :: Int -> ParameterDeclaration -> Doc
prt Int
i = \case
Language.C.AbsC.MkParameterDeclarationDeclarator DeclarationSpecifiers
declarationspecifiers Declarator
declarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DeclarationSpecifiers -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclarationSpecifiers
declarationspecifiers, Int -> Declarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Declarator
declarator])
Language.C.AbsC.MkParameterDeclarationAbstractDeclaratorOpt DeclarationSpecifiers
declarationspecifiers AbstractDeclaratorOpt
abstractdeclaratoropt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DeclarationSpecifiers -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclarationSpecifiers
declarationspecifiers, Int -> AbstractDeclaratorOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 AbstractDeclaratorOpt
abstractdeclaratoropt])
instance Print Language.C.AbsC.IdentifierListOpt where
prt :: Int -> IdentifierListOpt -> Doc
prt Int
i = \case
IdentifierListOpt
Language.C.AbsC.MkIdentifierListOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkIdentifierListOptJust IdentifierList
identifierlist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> IdentifierList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 IdentifierList
identifierlist])
instance Print Language.C.AbsC.IdentifierList where
prt :: Int -> IdentifierList -> Doc
prt Int
i = \case
Language.C.AbsC.MkIdentifierList1 Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
Language.C.AbsC.MkIdentifierListN IdentifierList
identifierlist Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> IdentifierList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 IdentifierList
identifierlist, ShowS -> Doc
doc (String -> ShowS
showString String
","), Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
instance Print Language.C.AbsC.Initializer where
prt :: Int -> Initializer -> Doc
prt Int
i = \case
Language.C.AbsC.MkInitializerAssignment Expression
expression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression])
Language.C.AbsC.MkInitializerIniutializerList InitializerList
initializerlist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"{"), Int -> InitializerList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 InitializerList
initializerlist, ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
Language.C.AbsC.MkInitializerIniutializerListC InitializerList
initializerlist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"{"), Int -> InitializerList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 InitializerList
initializerlist, ShowS -> Doc
doc (String -> ShowS
showString String
","), ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
instance Print Language.C.AbsC.InitializerList where
prt :: Int -> InitializerList -> Doc
prt Int
i = \case
Language.C.AbsC.MkInitializerList1 Initializer
initializer -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Initializer -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Initializer
initializer])
Language.C.AbsC.MkInitializerListN InitializerList
initializerlist Initializer
initializer -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> InitializerList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 InitializerList
initializerlist, ShowS -> Doc
doc (String -> ShowS
showString String
","), Int -> Initializer -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Initializer
initializer])
instance Print Language.C.AbsC.TypeName where
prt :: Int -> TypeName -> Doc
prt Int
i = \case
Language.C.AbsC.MkTypeName [SpecifierQualifier]
specifierqualifiers AbstractDeclaratorOpt
abstractdeclaratoropt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> [SpecifierQualifier] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [SpecifierQualifier]
specifierqualifiers, Int -> AbstractDeclaratorOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 AbstractDeclaratorOpt
abstractdeclaratoropt])
instance Print Language.C.AbsC.AbstractDeclaratorOpt where
prt :: Int -> AbstractDeclaratorOpt -> Doc
prt Int
i = \case
AbstractDeclaratorOpt
Language.C.AbsC.MkAbstractDeclaratorOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkAbstractDeclaratorOptJust AbstractDeclarator
abstractdeclarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> AbstractDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 AbstractDeclarator
abstractdeclarator])
instance Print Language.C.AbsC.AbstractDeclarator where
prt :: Int -> AbstractDeclarator -> Doc
prt Int
i = \case
Language.C.AbsC.MkAbstractDeclaratorPointer Pointer
pointer -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Pointer -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Pointer
pointer])
Language.C.AbsC.MkAbstractDeclaratorDirect PointerOpt
pointeropt DirectAbstractDeclarator
directabstractdeclarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PointerOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PointerOpt
pointeropt, Int -> DirectAbstractDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DirectAbstractDeclarator
directabstractdeclarator])
instance Print Language.C.AbsC.DirectAbstractDeclaratorOpt where
prt :: Int -> DirectAbstractDeclaratorOpt -> Doc
prt Int
i = \case
DirectAbstractDeclaratorOpt
Language.C.AbsC.MkDirectAbstractDeclaratorOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkDirectAbstractDeclaratorOptJust DirectAbstractDeclarator
directabstractdeclarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DirectAbstractDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DirectAbstractDeclarator
directabstractdeclarator])
instance Print Language.C.AbsC.DirectAbstractDeclarator where
prt :: Int -> DirectAbstractDeclarator -> Doc
prt Int
i = \case
Language.C.AbsC.MkDirectAbstractDeclaratorPar AbstractDeclarator
abstractdeclarator -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> AbstractDeclarator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 AbstractDeclarator
abstractdeclarator, ShowS -> Doc
doc (String -> ShowS
showString String
")")])
Language.C.AbsC.MkDirectAbstractDeclaratorConstantExpressionOpt DirectAbstractDeclaratorOpt
directabstractdeclaratoropt ConstantExpressionOpt
constantexpressionopt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DirectAbstractDeclaratorOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DirectAbstractDeclaratorOpt
directabstractdeclaratoropt, ShowS -> Doc
doc (String -> ShowS
showString String
"["), Int -> ConstantExpressionOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ConstantExpressionOpt
constantexpressionopt, ShowS -> Doc
doc (String -> ShowS
showString String
"]")])
Language.C.AbsC.MkDirectAbstractDeclaratorParameterTypeList DirectAbstractDeclaratorOpt
directabstractdeclaratoropt ParameterTypeList
parametertypelist -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DirectAbstractDeclaratorOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DirectAbstractDeclaratorOpt
directabstractdeclaratoropt, ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> ParameterTypeList -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ParameterTypeList
parametertypelist, ShowS -> Doc
doc (String -> ShowS
showString String
")")])
instance Print Language.C.AbsC.Statement where
prt :: Int -> Statement -> Doc
prt Int
i = \case
Language.C.AbsC.MkStatementLabeled LabeledStatement
labeledstatement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> LabeledStatement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 LabeledStatement
labeledstatement])
Language.C.AbsC.MkStatementExpression ExpressionStatement
expressionstatement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> ExpressionStatement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ExpressionStatement
expressionstatement])
Language.C.AbsC.MkStatementCompound CompoundStatement
compoundstatement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> CompoundStatement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 CompoundStatement
compoundstatement])
Language.C.AbsC.MkStatementSelection SelectionStatement
selectionstatement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> SelectionStatement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 SelectionStatement
selectionstatement])
Language.C.AbsC.MkStatementIteration IterationStatement
iterationstatement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> IterationStatement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 IterationStatement
iterationstatement])
Language.C.AbsC.MkStatementJump JumpStatement
jumpstatement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> JumpStatement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 JumpStatement
jumpstatement])
instance Print Language.C.AbsC.LabeledStatement where
prt :: Int -> LabeledStatement -> Doc
prt Int
i = \case
Language.C.AbsC.MkLabeledStatementIdentifier Identifier
identifier Statement
statement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier, ShowS -> Doc
doc (String -> ShowS
showString String
":"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement])
Language.C.AbsC.MkLabeledStatementCase ConstantExpression
constantexpression Statement
statement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"case"), Int -> ConstantExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ConstantExpression
constantexpression, ShowS -> Doc
doc (String -> ShowS
showString String
":"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement])
Language.C.AbsC.MkLabeledStatementDefault Statement
statement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"default"), ShowS -> Doc
doc (String -> ShowS
showString String
":"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement])
instance Print Language.C.AbsC.ExpressionStatement where
prt :: Int -> ExpressionStatement -> Doc
prt Int
i = \case
Language.C.AbsC.MkExpressionStatement ExpressionOpt
expressionopt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> ExpressionOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ExpressionOpt
expressionopt, ShowS -> Doc
doc (String -> ShowS
showString String
";")])
instance Print Language.C.AbsC.CompoundStatement where
prt :: Int -> CompoundStatement -> Doc
prt Int
i = \case
Language.C.AbsC.MkCompoundStatement [Declaration]
declarations [Statement]
statements -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"{"), Int -> [Declaration] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Declaration]
declarations, Int -> [Statement] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Statement]
statements, ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
instance Print [Language.C.AbsC.Statement] where
prt :: Int -> [Statement] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ (Statement
x:[Statement]
xs) = [Doc] -> Doc
concatD [Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
x, Int -> [Statement] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Statement]
xs]
instance Print Language.C.AbsC.SelectionStatement where
prt :: Int -> SelectionStatement -> Doc
prt Int
i = \case
Language.C.AbsC.MkSelectionStatementIfThen Expression
expression Statement
statement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"if"), ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression, ShowS -> Doc
doc (String -> ShowS
showString String
")"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement])
Language.C.AbsC.MkSelectionStatementIfThenElse Expression
expression Statement
statement1 Statement
statement2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"if"), ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression, ShowS -> Doc
doc (String -> ShowS
showString String
")"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement1, ShowS -> Doc
doc (String -> ShowS
showString String
"else"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement2])
Language.C.AbsC.MkSelectionStatementSwitch Expression
expression Statement
statement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"switch"), ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression, ShowS -> Doc
doc (String -> ShowS
showString String
")"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement])
instance Print Language.C.AbsC.IterationStatement where
prt :: Int -> IterationStatement -> Doc
prt Int
i = \case
Language.C.AbsC.MkIterationStatementWhile Expression
expression Statement
statement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"while"), ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression, ShowS -> Doc
doc (String -> ShowS
showString String
")"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement])
Language.C.AbsC.MkIterationStatementDo Statement
statement Expression
expression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"do"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement, ShowS -> Doc
doc (String -> ShowS
showString String
"while"), ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression, ShowS -> Doc
doc (String -> ShowS
showString String
")"), ShowS -> Doc
doc (String -> ShowS
showString String
";")])
Language.C.AbsC.MkIterationStatementFor ExpressionOpt
expressionopt1 ExpressionOpt
expressionopt2 ExpressionOpt
expressionopt3 Statement
statement -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"for"), ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> ExpressionOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ExpressionOpt
expressionopt1, ShowS -> Doc
doc (String -> ShowS
showString String
";"), Int -> ExpressionOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ExpressionOpt
expressionopt2, ShowS -> Doc
doc (String -> ShowS
showString String
";"), Int -> ExpressionOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ExpressionOpt
expressionopt3, ShowS -> Doc
doc (String -> ShowS
showString String
")"), Int -> Statement -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Statement
statement])
instance Print Language.C.AbsC.JumpStatement where
prt :: Int -> JumpStatement -> Doc
prt Int
i = \case
Language.C.AbsC.MkJumpStatementGoto Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"goto"), Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier, ShowS -> Doc
doc (String -> ShowS
showString String
";")])
JumpStatement
Language.C.AbsC.MkJumpStatementContinue -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"continue"), ShowS -> Doc
doc (String -> ShowS
showString String
";")])
JumpStatement
Language.C.AbsC.MkJumpStatementBreak -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"break"), ShowS -> Doc
doc (String -> ShowS
showString String
";")])
Language.C.AbsC.MkJumpStatementReturn ExpressionOpt
expressionopt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"return"), Int -> ExpressionOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ExpressionOpt
expressionopt, ShowS -> Doc
doc (String -> ShowS
showString String
";")])
instance Print Language.C.AbsC.ExpressionOpt where
prt :: Int -> ExpressionOpt -> Doc
prt Int
i = \case
ExpressionOpt
Language.C.AbsC.MkExpressionOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkExpressionOptJust Expression
expression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression])
instance Print Language.C.AbsC.Expression where
prt :: Int -> Expression -> Doc
prt Int
i = \case
Language.C.AbsC.Expression12 CastExpression
castexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
12 ([Doc] -> Doc
concatD [Int -> CastExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 CastExpression
castexpression])
Language.C.AbsC.Expression11 Expression
expression1 MultOp
multop Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
11 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
11 Expression
expression1, Int -> MultOp -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 MultOp
multop, Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
12 Expression
expression2])
Language.C.AbsC.Expression10 Expression
expression1 AddOp
addop Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
10 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
10 Expression
expression1, Int -> AddOp -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 AddOp
addop, Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
11 Expression
expression2])
Language.C.AbsC.Expression9 Expression
expression1 ShiftOp
shiftop Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
9 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
9 Expression
expression1, Int -> ShiftOp -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ShiftOp
shiftop, Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
10 Expression
expression2])
Language.C.AbsC.Expression8 Expression
expression1 RelOp
relop Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
8 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
8 Expression
expression1, Int -> RelOp -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 RelOp
relop, Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
9 Expression
expression2])
Language.C.AbsC.Expression7 Expression
expression1 EqOp
eqop Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
7 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
7 Expression
expression1, Int -> EqOp -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 EqOp
eqop, Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
8 Expression
expression2])
Language.C.AbsC.Expression6 Expression
expression1 Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
6 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
6 Expression
expression1, ShowS -> Doc
doc (String -> ShowS
showString String
"^"), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
7 Expression
expression2])
Language.C.AbsC.Expression5 Expression
expression1 Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
5 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
5 Expression
expression1, ShowS -> Doc
doc (String -> ShowS
showString String
"|"), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
6 Expression
expression2])
Language.C.AbsC.Expression4 Expression
expression1 Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
4 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
4 Expression
expression1, ShowS -> Doc
doc (String -> ShowS
showString String
"&&"), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
5 Expression
expression2])
Language.C.AbsC.Expression3 Expression
expression1 Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
3 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
3 Expression
expression1, ShowS -> Doc
doc (String -> ShowS
showString String
"||"), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
4 Expression
expression2])
Language.C.AbsC.Expression2 Expression
expression1 Expression
expression2 Expression
expression3 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
2 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
3 Expression
expression1, ShowS -> Doc
doc (String -> ShowS
showString String
"?"), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression2, ShowS -> Doc
doc (String -> ShowS
showString String
":"), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
2 Expression
expression3])
Language.C.AbsC.Expression1 UnaryExpression
unaryexpression AssignmentOperator
assignmentoperator Expression
expression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
1 ([Doc] -> Doc
concatD [Int -> UnaryExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 UnaryExpression
unaryexpression, Int -> AssignmentOperator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 AssignmentOperator
assignmentoperator, Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
2 Expression
expression])
Language.C.AbsC.Expression Expression
expression1 Expression
expression2 -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression1, ShowS -> Doc
doc (String -> ShowS
showString String
","), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
1 Expression
expression2])
instance Print [Language.C.AbsC.Expression] where
prt :: Int -> [Expression] -> Doc
prt Int
_ [] = [Doc] -> Doc
concatD []
prt Int
_ [Expression
x] = [Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
1 Expression
x]
prt Int
_ (Expression
x:[Expression]
xs) = [Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
1 Expression
x, ShowS -> Doc
doc (String -> ShowS
showString String
","), Int -> [Expression] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
1 [Expression]
xs]
instance Print Language.C.AbsC.AssignmentOperator where
prt :: Int -> AssignmentOperator -> Doc
prt Int
i = \case
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorAssign -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorTimes -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"*=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorDiv -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"/=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorMod -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"%=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorPlus -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"+=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorMinus -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"-=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorShiftL -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"<<=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorShiftR -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
">>=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorAnd -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"&=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorXOr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"^=")])
AssignmentOperator
Language.C.AbsC.MkAssignmentOperatorOr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"|=")])
instance Print Language.C.AbsC.ConstantExpressionOpt where
prt :: Int -> ConstantExpressionOpt -> Doc
prt Int
i = \case
ConstantExpressionOpt
Language.C.AbsC.MkConditionalExpressionNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkConditionalExpressionJust ConstantExpression
constantexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> ConstantExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ConstantExpression
constantexpression])
instance Print Language.C.AbsC.ConstantExpression where
prt :: Int -> ConstantExpression -> Doc
prt Int
i = \case
Language.C.AbsC.MkConstantExpression Expression
expression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
2 Expression
expression])
instance Print Language.C.AbsC.EqOp where
prt :: Int -> EqOp -> Doc
prt Int
i = \case
EqOp
Language.C.AbsC.EqOpEq -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"==")])
EqOp
Language.C.AbsC.EqOpNeq -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"!=")])
instance Print Language.C.AbsC.RelOp where
prt :: Int -> RelOp -> Doc
prt Int
i = \case
RelOp
Language.C.AbsC.RelOpLT -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"<")])
RelOp
Language.C.AbsC.RelOpGT -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
">")])
RelOp
Language.C.AbsC.RelOpLE -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"<=")])
RelOp
Language.C.AbsC.RelOpGE -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
">=")])
instance Print Language.C.AbsC.ShiftOp where
prt :: Int -> ShiftOp -> Doc
prt Int
i = \case
ShiftOp
Language.C.AbsC.ShiftOpLeft -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"<<")])
ShiftOp
Language.C.AbsC.ShiftOpRight -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
">>")])
instance Print Language.C.AbsC.AddOp where
prt :: Int -> AddOp -> Doc
prt Int
i = \case
AddOp
Language.C.AbsC.AddOpPlus -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"+")])
AddOp
Language.C.AbsC.AddOpMinus -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"-")])
instance Print Language.C.AbsC.MultOp where
prt :: Int -> MultOp -> Doc
prt Int
i = \case
MultOp
Language.C.AbsC.MultOpTimes -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"*")])
MultOp
Language.C.AbsC.MultOpDiv -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"/")])
MultOp
Language.C.AbsC.MultOpMod -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"%")])
instance Print Language.C.AbsC.CastExpression where
prt :: Int -> CastExpression -> Doc
prt Int
i = \case
Language.C.AbsC.MkCastExpression1 UnaryExpression
unaryexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> UnaryExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 UnaryExpression
unaryexpression])
Language.C.AbsC.MkCastExpressionN TypeName
typename CastExpression
castexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> TypeName -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeName
typename, ShowS -> Doc
doc (String -> ShowS
showString String
")"), Int -> CastExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 CastExpression
castexpression])
instance Print Language.C.AbsC.UnaryExpression where
prt :: Int -> UnaryExpression -> Doc
prt Int
i = \case
Language.C.AbsC.MkUnaryExpressionPostfix PostfixExpression
postfixexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PostfixExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PostfixExpression
postfixexpression])
Language.C.AbsC.MkUnaryExpressionPlus2 UnaryExpression
unaryexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"++"), Int -> UnaryExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 UnaryExpression
unaryexpression])
Language.C.AbsC.MkUnaryExpressionMinus2 UnaryExpression
unaryexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"--"), Int -> UnaryExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 UnaryExpression
unaryexpression])
Language.C.AbsC.MkUnaryExpressionUnaryOp UnaryOperator
unaryoperator CastExpression
castexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> UnaryOperator -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 UnaryOperator
unaryoperator, Int -> CastExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 CastExpression
castexpression])
Language.C.AbsC.MkUnaryExpressionSizeof1 UnaryExpression
unaryexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"sizeof"), Int -> UnaryExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 UnaryExpression
unaryexpression])
Language.C.AbsC.MkUnaryExpressionSizeofPar TypeName
typename -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"sizeof"), ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> TypeName -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 TypeName
typename, ShowS -> Doc
doc (String -> ShowS
showString String
")")])
instance Print Language.C.AbsC.UnaryOperator where
prt :: Int -> UnaryOperator -> Doc
prt Int
i = \case
UnaryOperator
Language.C.AbsC.MkUnaryOperatorAnd -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"&")])
UnaryOperator
Language.C.AbsC.MkUnaryOperatorTimes -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"*")])
UnaryOperator
Language.C.AbsC.MkUnaryOperatorPlus -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"+")])
UnaryOperator
Language.C.AbsC.MkUnaryOperatorMinus -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"-")])
UnaryOperator
Language.C.AbsC.MkUnaryOperatorTilde -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"~")])
UnaryOperator
Language.C.AbsC.MkUnaryOperatorBang -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"!")])
instance Print Language.C.AbsC.PostfixExpression where
prt :: Int -> PostfixExpression -> Doc
prt Int
i = \case
Language.C.AbsC.MkPostfixExpression1 PrimaryExpression
primaryexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PrimaryExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PrimaryExpression
primaryexpression])
Language.C.AbsC.MkPostfixExpressionBrackets PostfixExpression
postfixexpression Expression
expression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PostfixExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PostfixExpression
postfixexpression, ShowS -> Doc
doc (String -> ShowS
showString String
"["), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression, ShowS -> Doc
doc (String -> ShowS
showString String
"]")])
Language.C.AbsC.MkPostfixExpressionArgumentExpressionListOpt PostfixExpression
postfixexpression ArgumentExpressionListOpt
argumentexpressionlistopt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PostfixExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PostfixExpression
postfixexpression, ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> ArgumentExpressionListOpt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 ArgumentExpressionListOpt
argumentexpressionlistopt, ShowS -> Doc
doc (String -> ShowS
showString String
")")])
Language.C.AbsC.MkPostfixExpressionDot PostfixExpression
postfixexpression Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PostfixExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PostfixExpression
postfixexpression, ShowS -> Doc
doc (String -> ShowS
showString String
"."), Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
Language.C.AbsC.MkPostfixExpressionArrow PostfixExpression
postfixexpression Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PostfixExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PostfixExpression
postfixexpression, ShowS -> Doc
doc (String -> ShowS
showString String
"->"), Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
Language.C.AbsC.MkPostfixExpressionPlus2 PostfixExpression
postfixexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PostfixExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PostfixExpression
postfixexpression, ShowS -> Doc
doc (String -> ShowS
showString String
"++")])
Language.C.AbsC.MkPostfixExpressionMinus2 PostfixExpression
postfixexpression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PostfixExpression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PostfixExpression
postfixexpression, ShowS -> Doc
doc (String -> ShowS
showString String
"--")])
instance Print Language.C.AbsC.PrimaryExpression where
prt :: Int -> PrimaryExpression -> Doc
prt Int
i = \case
Language.C.AbsC.MkPrimaryExpressionIdentifier Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
Language.C.AbsC.MkPrimaryExpressionConstant Constant
constant -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Constant -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Constant
constant])
Language.C.AbsC.MkPrimaryExpressionString String
str -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [String -> Doc
printString String
str])
Language.C.AbsC.MkPrimaryExpressionParExpression Expression
expression -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"("), Int -> Expression -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expression
expression, ShowS -> Doc
doc (String -> ShowS
showString String
")")])
instance Print Language.C.AbsC.ArgumentExpressionListOpt where
prt :: Int -> ArgumentExpressionListOpt -> Doc
prt Int
i = \case
ArgumentExpressionListOpt
Language.C.AbsC.MkArgumentExpressionListOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkArgumentExpressionListOptJust [Expression]
expressions -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> [Expression] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
1 [Expression]
expressions])
instance Print Language.C.AbsC.Constant where
prt :: Int -> Constant -> Doc
prt Int
i = \case
Language.C.AbsC.MkConstantInteger IntegerConstant
integerconstant -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> IntegerConstant -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 IntegerConstant
integerconstant])
Language.C.AbsC.MkConstantCharacter CharacterConstant
characterconstant -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> CharacterConstant -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 CharacterConstant
characterconstant])
Language.C.AbsC.MkConstantFloating FloatingConstant
floatingconstant -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> FloatingConstant -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 FloatingConstant
floatingconstant])
instance Print Language.C.AbsC.IdentifierOpt where
prt :: Int -> IdentifierOpt -> Doc
prt Int
i = \case
IdentifierOpt
Language.C.AbsC.MkIdentifierOptNothing -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [])
Language.C.AbsC.MkIdentifierOptJust Identifier
identifier -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Identifier -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Identifier
identifier])
instance Print Language.C.AbsC.CharacterConstant where
prt :: Int -> CharacterConstant -> Doc
prt Int
i = \case
Language.C.AbsC.MkCharacterConstant Char
c -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Char -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Char
c])
instance Print Language.C.AbsC.FloatingConstant where
prt :: Int -> FloatingConstant -> Doc
prt Int
i = \case
Language.C.AbsC.MkFloatingConstant Double
d -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Double -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Double
d])