{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.C.Pretty where
import Data.Char (isAlphaNum,
isLower)
import Data.Loc
import Data.Maybe (isJust)
#if !(MIN_VERSION_base(4,9,0))
import Data.Monoid (Monoid(..), (<>))
#endif /* !(MIN_VERSION_base(4,9,0)) */
#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import Language.C.Syntax
import Text.PrettyPrint.Mainland
import Text.PrettyPrint.Mainland.Class
pprLoc :: SrcLoc -> Doc -> Doc
pprLoc :: SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc Doc
doc = SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc
data Fixity = Fixity Assoc Int
deriving (Fixity -> Fixity -> Bool
(Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool) -> Eq Fixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
/= :: Fixity -> Fixity -> Bool
Eq, Eq Fixity
Eq Fixity =>
(Fixity -> Fixity -> Ordering)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Fixity)
-> (Fixity -> Fixity -> Fixity)
-> Ord Fixity
Fixity -> Fixity -> Bool
Fixity -> Fixity -> Ordering
Fixity -> Fixity -> Fixity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Fixity -> Fixity -> Ordering
compare :: Fixity -> Fixity -> Ordering
$c< :: Fixity -> Fixity -> Bool
< :: Fixity -> Fixity -> Bool
$c<= :: Fixity -> Fixity -> Bool
<= :: Fixity -> Fixity -> Bool
$c> :: Fixity -> Fixity -> Bool
> :: Fixity -> Fixity -> Bool
$c>= :: Fixity -> Fixity -> Bool
>= :: Fixity -> Fixity -> Bool
$cmax :: Fixity -> Fixity -> Fixity
max :: Fixity -> Fixity -> Fixity
$cmin :: Fixity -> Fixity -> Fixity
min :: Fixity -> Fixity -> Fixity
Ord)
data Assoc = LeftAssoc | RightAssoc | NonAssoc
deriving (Assoc -> Assoc -> Bool
(Assoc -> Assoc -> Bool) -> (Assoc -> Assoc -> Bool) -> Eq Assoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Assoc -> Assoc -> Bool
== :: Assoc -> Assoc -> Bool
$c/= :: Assoc -> Assoc -> Bool
/= :: Assoc -> Assoc -> Bool
Eq, Eq Assoc
Eq Assoc =>
(Assoc -> Assoc -> Ordering)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Assoc)
-> (Assoc -> Assoc -> Assoc)
-> Ord Assoc
Assoc -> Assoc -> Bool
Assoc -> Assoc -> Ordering
Assoc -> Assoc -> Assoc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Assoc -> Assoc -> Ordering
compare :: Assoc -> Assoc -> Ordering
$c< :: Assoc -> Assoc -> Bool
< :: Assoc -> Assoc -> Bool
$c<= :: Assoc -> Assoc -> Bool
<= :: Assoc -> Assoc -> Bool
$c> :: Assoc -> Assoc -> Bool
> :: Assoc -> Assoc -> Bool
$c>= :: Assoc -> Assoc -> Bool
>= :: Assoc -> Assoc -> Bool
$cmax :: Assoc -> Assoc -> Assoc
max :: Assoc -> Assoc -> Assoc
$cmin :: Assoc -> Assoc -> Assoc
min :: Assoc -> Assoc -> Assoc
Ord)
infix_ :: Int -> Fixity
infix_ :: Int -> Fixity
infix_ = Assoc -> Int -> Fixity
Fixity Assoc
NonAssoc
infixl_ :: Int -> Fixity
infixl_ :: Int -> Fixity
infixl_ = Assoc -> Int -> Fixity
Fixity Assoc
LeftAssoc
infixr_ :: Int -> Fixity
infixr_ :: Int -> Fixity
infixr_ = Assoc -> Int -> Fixity
Fixity Assoc
RightAssoc
infixop :: (Pretty a, Pretty b, Pretty op, CFixity op)
=> Int
-> op
-> a
-> b
-> Doc
infixop :: forall a b op.
(Pretty a, Pretty b, Pretty op, CFixity op) =>
Int -> op -> a -> b -> Doc
infixop Int
prec op
op a
l b
r =
Int -> op -> Doc -> Doc
forall a. CFixity a => Int -> a -> Doc -> Doc
parensOp Int
prec op
op (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
leftPrec a
l Doc -> Doc -> Doc
<+> op -> Doc
forall a. Pretty a => a -> Doc
ppr op
op Doc -> Doc -> Doc
<+/> Int -> b -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
rightPrec b
r
where
leftPrec :: Int
leftPrec | Assoc
opAssoc Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
== Assoc
RightAssoc = Int
opPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
| Bool
otherwise = Int
opPrec
rightPrec :: Int
rightPrec | Assoc
opAssoc Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
== Assoc
LeftAssoc = Int
opPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
| Bool
otherwise = Int
opPrec
Fixity Assoc
opAssoc Int
opPrec = op -> Fixity
forall a. CFixity a => a -> Fixity
fixity op
op
prefixop :: (Pretty a, Pretty op, CFixity op)
=> Int
-> op
-> a
-> Doc
prefixop :: forall a op.
(Pretty a, Pretty op, CFixity op) =>
Int -> op -> a -> Doc
prefixop Int
prec op
op a
arg =
Bool -> Doc -> Doc
parensIf (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
opPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
op -> Doc
forall a. Pretty a => a -> Doc
ppr op
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
rightPrec a
arg
where
rightPrec :: Int
rightPrec | Assoc
opAssoc Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
== Assoc
LeftAssoc = Int
opPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
| Bool
otherwise = Int
opPrec
Fixity Assoc
opAssoc Int
opPrec = op -> Fixity
forall a. CFixity a => a -> Fixity
fixity op
op
parensList :: [Doc] -> Doc
parensList :: [Doc] -> Doc
parensList = Doc -> Doc -> Doc -> [Doc] -> Doc
enclosesep Doc
lparen Doc
rparen Doc
comma
bracesList :: [Doc] -> Doc
bracesList :: [Doc] -> Doc
bracesList = Doc -> Doc -> Doc -> [Doc] -> Doc
enclosesep Doc
lbrace Doc
rbrace Doc
comma
bracesSemiList :: [Doc] -> Doc
bracesSemiList :: [Doc] -> Doc
bracesSemiList = Doc -> Doc -> Doc -> [Doc] -> Doc
enclosesep Doc
lbrace Doc
rbrace Doc
semi
angleList :: [Doc] -> Doc
angleList :: [Doc] -> Doc
angleList = Doc -> Doc -> Doc -> [Doc] -> Doc
enclosesep Doc
langle Doc
rangle Doc
comma
embrace :: [Doc] -> Doc
embrace :: [Doc] -> Doc
embrace [] = Doc
lbrace Doc -> Doc -> Doc
<+> Doc
rbrace
embrace [Doc]
ds = Doc
lbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc -> Doc
nest Int
4 (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
stack [Doc]
ds) Doc -> Doc -> Doc
</>
Doc
rbrace
pprAnti :: String -> String -> Doc
pprAnti :: String -> String -> Doc
pprAnti String
anti String
s = Char -> Doc
char Char
'$' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
anti Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
if String -> Bool
isIdentifier String
s then String -> Doc
text String
s else Doc -> Doc
parens (String -> Doc
text String
s)
where
isIdentifier :: String -> Bool
isIdentifier :: String -> Bool
isIdentifier [] = Bool
False
isIdentifier (Char
'_':String
cs) = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isIdChar String
cs
isIdentifier (Char
c:String
cs) = Char -> Bool
isLower Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isIdChar String
cs
isIdChar :: Char -> Bool
isIdChar :: Char -> Bool
isIdChar Char
'_' = Bool
True
isIdChar Char
c = Char -> Bool
isAlphaNum Char
c
class CFixity a where
fixity :: a -> Fixity
parensOp :: Int -> a -> Doc -> Doc
parensOp Int
prec a
op =
Bool -> Doc -> Doc
parensIf (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
opPrec)
where
Fixity Assoc
_ Int
opPrec = a -> Fixity
forall a. CFixity a => a -> Fixity
fixity a
op
commaPrec :: Int
commaPrec :: Int
commaPrec = Int
1
commaPrec1 :: Int
commaPrec1 :: Int
commaPrec1 = Int
commaPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
condPrec :: Int
condPrec :: Int
condPrec = Int
3
condPrec1 :: Int
condPrec1 :: Int
condPrec1 = Int
condPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
unopPrec :: Int
unopPrec :: Int
unopPrec = Int
14
unopPrec1 :: Int
unopPrec1 :: Int
unopPrec1 = Int
unopPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
memberPrec :: Int
memberPrec :: Int
memberPrec = Int
15
memberPrec1 :: Int
memberPrec1 :: Int
memberPrec1 = Int
memberPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
instance CFixity BinOp where
fixity :: BinOp -> Fixity
fixity BinOp
Add = Int -> Fixity
infixl_ Int
12
fixity BinOp
Sub = Int -> Fixity
infixl_ Int
12
fixity BinOp
Mul = Int -> Fixity
infixl_ Int
13
fixity BinOp
Div = Int -> Fixity
infixl_ Int
13
fixity BinOp
Mod = Int -> Fixity
infixl_ Int
13
fixity BinOp
Eq = Int -> Fixity
infixl_ Int
9
fixity BinOp
Ne = Int -> Fixity
infixl_ Int
9
fixity BinOp
Lt = Int -> Fixity
infixl_ Int
10
fixity BinOp
Gt = Int -> Fixity
infixl_ Int
10
fixity BinOp
Le = Int -> Fixity
infixl_ Int
10
fixity BinOp
Ge = Int -> Fixity
infixl_ Int
10
fixity BinOp
Land = Int -> Fixity
infixl_ Int
5
fixity BinOp
Lor = Int -> Fixity
infixl_ Int
4
fixity BinOp
And = Int -> Fixity
infixl_ Int
8
fixity BinOp
Or = Int -> Fixity
infixl_ Int
6
fixity BinOp
Xor = Int -> Fixity
infixl_ Int
7
fixity BinOp
Lsh = Int -> Fixity
infixl_ Int
11
fixity BinOp
Rsh = Int -> Fixity
infixl_ Int
11
parensOp :: Int -> BinOp -> Doc -> Doc
parensOp Int
prec BinOp
op =
BinOp -> Doc -> Doc
go BinOp
op
where
go :: BinOp -> Doc -> Doc
go :: BinOp -> Doc -> Doc
go BinOp
Add | Bool
isBitwiseOp = Doc -> Doc
parens
go BinOp
Sub | Bool
isBitwiseOp = Doc -> Doc
parens
go BinOp
Land | BinOp -> Bool
isOp BinOp
Lor = Doc -> Doc
parens
go BinOp
Lor | BinOp -> Bool
isOp BinOp
Land = Doc -> Doc
parens
go BinOp
And | BinOp -> Bool
isOp BinOp
Or = Doc -> Doc
parens
| BinOp -> Bool
isOp BinOp
Xor = Doc -> Doc
parens
go BinOp
Or | BinOp -> Bool
isOp BinOp
And = Doc -> Doc
parens
| BinOp -> Bool
isOp BinOp
Xor = Doc -> Doc
parens
go BinOp
Xor | BinOp -> Bool
isOp BinOp
And = Doc -> Doc
parens
| BinOp -> Bool
isOp BinOp
Or = Doc -> Doc
parens
go BinOp
_ = Bool -> Doc -> Doc
parensIf (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
opPrec)
isBitwiseOp :: Bool
isBitwiseOp :: Bool
isBitwiseOp = BinOp -> Bool
isOp BinOp
And Bool -> Bool -> Bool
|| BinOp -> Bool
isOp BinOp
Or Bool -> Bool -> Bool
|| BinOp -> Bool
isOp BinOp
Xor
isOp :: BinOp -> Bool
isOp :: BinOp -> Bool
isOp BinOp
op' = Int
prec Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
op'Prec Bool -> Bool -> Bool
|| Int
prec Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
op'Prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
where
Fixity Assoc
_ Int
op'Prec = BinOp -> Fixity
forall a. CFixity a => a -> Fixity
fixity BinOp
op'
Fixity Assoc
_ Int
opPrec = BinOp -> Fixity
forall a. CFixity a => a -> Fixity
fixity BinOp
op
instance CFixity AssignOp where
fixity :: AssignOp -> Fixity
fixity AssignOp
_ = Int -> Fixity
infixr_ Int
2
instance CFixity UnOp where
fixity :: UnOp -> Fixity
fixity UnOp
_ = Int -> Fixity
infixr_ Int
unopPrec
instance Pretty Id where
ppr :: Id -> Doc
ppr (Id String
ident SrcLoc
_) = String -> Doc
text String
ident
ppr (AntiId String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"id" String
v
instance Pretty StringLit where
ppr :: StringLit -> Doc
ppr (StringLit [String]
ss String
_ SrcLoc
_) = [Doc] -> Doc
sep ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
string [String]
ss)
instance Pretty Storage where
ppr :: Storage -> Doc
ppr (Tauto SrcLoc
_) = String -> Doc
text String
"auto"
ppr (Tregister SrcLoc
_) = String -> Doc
text String
"register"
ppr (Tstatic SrcLoc
_) = String -> Doc
text String
"static"
ppr (Textern Maybe StringLit
Nothing SrcLoc
_) = String -> Doc
text String
"extern"
ppr (Textern (Just StringLit
l) SrcLoc
_) = String -> Doc
text String
"extern" Doc -> Doc -> Doc
<+> StringLit -> Doc
forall a. Pretty a => a -> Doc
ppr StringLit
l
ppr (Ttypedef SrcLoc
_) = String -> Doc
text String
"typedef"
ppr (T__block SrcLoc
_) = String -> Doc
text String
"__block"
ppr (TObjC__weak SrcLoc
_) = String -> Doc
text String
"__weak"
ppr (TObjC__strong SrcLoc
_) = String -> Doc
text String
"__strong"
ppr (TObjC__unsafe_unretained SrcLoc
_) = String -> Doc
text String
"__unsafe_unretained"
instance Pretty TypeQual where
ppr :: TypeQual -> Doc
ppr (Tconst SrcLoc
_) = String -> Doc
text String
"const"
ppr (Tvolatile SrcLoc
_) = String -> Doc
text String
"volatile"
ppr (EscTypeQual String
esc SrcLoc
_) = String -> Doc
text String
esc
ppr (AntiTypeQual String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"tyqual" String
v
ppr (AntiTypeQuals String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"tyquals" String
v
ppr (Tinline SrcLoc
_) = String -> Doc
text String
"inline"
ppr (Trestrict SrcLoc
_) = String -> Doc
text String
"restrict"
ppr (TAttr Attr
attr) = [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr
attr]
ppr (T__restrict SrcLoc
_) = String -> Doc
text String
"__restrict"
ppr (TCUDAdevice SrcLoc
_) = String -> Doc
text String
"__device__"
ppr (TCUDAglobal SrcLoc
_) = String -> Doc
text String
"__global__"
ppr (TCUDAhost SrcLoc
_) = String -> Doc
text String
"__host__"
ppr (TCUDAconstant SrcLoc
_) = String -> Doc
text String
"__constant__"
ppr (TCUDAshared SrcLoc
_) = String -> Doc
text String
"__shared__"
ppr (TCUDArestrict SrcLoc
_) = String -> Doc
text String
"__restrict__"
ppr (TCUDAnoinline SrcLoc
_) = String -> Doc
text String
"__noinline__"
ppr (TCLprivate SrcLoc
_) = String -> Doc
text String
"__private"
ppr (TCLlocal SrcLoc
_) = String -> Doc
text String
"__local"
ppr (TCLglobal SrcLoc
_) = String -> Doc
text String
"__global"
ppr (TCLconstant SrcLoc
_) = String -> Doc
text String
"__constant"
ppr (TCLreadonly SrcLoc
_) = String -> Doc
text String
"read_only"
ppr (TCLwriteonly SrcLoc
_) = String -> Doc
text String
"write_only"
ppr (TCLkernel SrcLoc
_) = String -> Doc
text String
"__kernel"
instance Pretty Sign where
ppr :: Sign -> Doc
ppr (Tsigned SrcLoc
_) = String -> Doc
text String
"signed"
ppr (Tunsigned SrcLoc
_) = String -> Doc
text String
"unsigned"
instance Pretty TypeSpec where
ppr :: TypeSpec -> Doc
ppr (Tvoid SrcLoc
_) = String -> Doc
text String
"void"
ppr (Tchar Maybe Sign
sign SrcLoc
_) = Maybe Sign -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Sign
sign Doc -> Doc -> Doc
<+> String -> Doc
text String
"char"
ppr (Tshort Maybe Sign
sign SrcLoc
_) = Maybe Sign -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Sign
sign Doc -> Doc -> Doc
<+> String -> Doc
text String
"short"
ppr (Tint Maybe Sign
sign SrcLoc
_) = Maybe Sign -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Sign
sign Doc -> Doc -> Doc
<+> String -> Doc
text String
"int"
ppr (Tlong Maybe Sign
sign SrcLoc
_) = Maybe Sign -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Sign
sign Doc -> Doc -> Doc
<+> String -> Doc
text String
"long"
ppr (Tlong_long Maybe Sign
sign SrcLoc
_) = Maybe Sign -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Sign
sign Doc -> Doc -> Doc
<+> String -> Doc
text String
"long long"
ppr (Tfloat SrcLoc
_) = String -> Doc
text String
"float"
ppr (Tdouble SrcLoc
_) = String -> Doc
text String
"double"
ppr (Tlong_double SrcLoc
_) = String -> Doc
text String
"long double"
ppr (Tstruct Maybe Id
maybe_ident Maybe [FieldGroup]
maybe_fields [Attr]
attrs SrcLoc
_) =
Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Maybe Id -> Maybe [FieldGroup] -> [Attr] -> Doc
pprStructOrUnion String
"struct" Maybe Id
maybe_ident Maybe [FieldGroup]
maybe_fields [Attr]
attrs
ppr (Tunion Maybe Id
maybe_ident Maybe [FieldGroup]
maybe_fields [Attr]
attrs SrcLoc
_) =
Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Maybe Id -> Maybe [FieldGroup] -> [Attr] -> Doc
pprStructOrUnion String
"union" Maybe Id
maybe_ident Maybe [FieldGroup]
maybe_fields [Attr]
attrs
ppr (Tenum Maybe Id
maybe_ident [CEnum]
cenums [Attr]
attrs SrcLoc
_) =
Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe Id -> [CEnum] -> [Attr] -> Doc
pprEnum Maybe Id
maybe_ident [CEnum]
cenums [Attr]
attrs
ppr (Tnamed Id
ident [Id]
refs SrcLoc
_) =
Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> if [Id] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
refs then Doc
empty else Doc -> Doc
angles ([Doc] -> Doc
commasep ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
forall a. Pretty a => a -> Doc
ppr [Id]
refs))
ppr (T_Bool SrcLoc
_) =
String -> Doc
text String
"_Bool"
ppr (Tfloat_Complex SrcLoc
_) =
String -> Doc
text String
"float" Doc -> Doc -> Doc
<+> String -> Doc
text String
"_Complex"
ppr (Tdouble_Complex SrcLoc
_) =
String -> Doc
text String
"double" Doc -> Doc -> Doc
<+> String -> Doc
text String
"_Complex"
ppr (Tlong_double_Complex SrcLoc
_) =
String -> Doc
text String
"long" Doc -> Doc -> Doc
<+> String -> Doc
text String
"double" Doc -> Doc -> Doc
<+> String -> Doc
text String
"_Complex"
ppr (Tfloat_Imaginary SrcLoc
_) =
String -> Doc
text String
"float" Doc -> Doc -> Doc
<+> String -> Doc
text String
"_Imaginary"
ppr (Tdouble_Imaginary SrcLoc
_) =
String -> Doc
text String
"double" Doc -> Doc -> Doc
<+> String -> Doc
text String
"_Imaginary"
ppr (Tlong_double_Imaginary SrcLoc
_) =
String -> Doc
text String
"long" Doc -> Doc -> Doc
<+> String -> Doc
text String
"double" Doc -> Doc -> Doc
<+> String -> Doc
text String
"_Imaginary"
ppr (TtypeofExp Exp
e SrcLoc
_) =
String -> Doc
text String
"__typeof__" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
14 Exp
e)
ppr (TtypeofType Type
tipe SrcLoc
_) =
String -> Doc
text String
"__typeof__" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
tipe)
ppr (Tva_list SrcLoc
_) =
String -> Doc
text String
"__builtin_va_list"
pprStructOrUnion :: String
-> Maybe Id
-> Maybe [FieldGroup]
-> [Attr]
-> Doc
pprStructOrUnion :: String -> Maybe Id -> Maybe [FieldGroup] -> [Attr] -> Doc
pprStructOrUnion String
ty Maybe Id
maybe_ident Maybe [FieldGroup]
maybe_fields [Attr]
attrs =
String -> Doc
text String
ty Doc -> Doc -> Doc
<+> Maybe Id -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Id
maybe_ident Doc -> Doc -> Doc
<+> Maybe [FieldGroup] -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe [FieldGroup]
maybe_fields Doc -> Doc -> Doc
<+/> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs
pprEnum :: Maybe Id
-> [CEnum]
-> [Attr]
-> Doc
pprEnum :: Maybe Id -> [CEnum] -> [Attr] -> Doc
pprEnum Maybe Id
maybe_ident [CEnum]
cenums [Attr]
attrs =
String -> Doc
text String
"enum" Doc -> Doc -> Doc
<+> Maybe Id -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Id
maybe_ident Doc -> Doc -> Doc
<+> [CEnum] -> Doc
forall a. Pretty a => a -> Doc
ppr [CEnum]
cenums Doc -> Doc -> Doc
<+/> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs
instance Pretty DeclSpec where
ppr :: DeclSpec -> Doc
ppr (DeclSpec [Storage]
storage [TypeQual]
quals TypeSpec
spec SrcLoc
_) =
case (Storage -> Doc) -> [Storage] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Storage -> Doc
forall a. Pretty a => a -> Doc
ppr [Storage]
storage [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (TypeQual -> Doc) -> [TypeQual] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeQual -> Doc
forall a. Pretty a => a -> Doc
ppr [TypeQual]
quals of
[] -> TypeSpec -> Doc
forall a. Pretty a => a -> Doc
ppr TypeSpec
spec
[Doc]
docs -> [Doc] -> Doc
spread [Doc]
docs Doc -> Doc -> Doc
<+/> TypeSpec -> Doc
forall a. Pretty a => a -> Doc
ppr TypeSpec
spec
ppr (AntiDeclSpec String
v SrcLoc
_) =
String -> String -> Doc
pprAnti String
"spec" String
v
ppr (AntiTypeDeclSpec [Storage]
storage [TypeQual]
quals String
v SrcLoc
_) =
[Doc] -> Doc
spread ((Storage -> Doc) -> [Storage] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Storage -> Doc
forall a. Pretty a => a -> Doc
ppr [Storage]
storage [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (TypeQual -> Doc) -> [TypeQual] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeQual -> Doc
forall a. Pretty a => a -> Doc
ppr [TypeQual]
quals) Doc -> Doc -> Doc
<+/>
String -> String -> Doc
pprAnti String
"ty" String
v
instance Pretty ArraySize where
ppr :: ArraySize -> Doc
ppr (ArraySize Bool
True Exp
e SrcLoc
_) = String -> Doc
text String
"static" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
ppr (ArraySize Bool
False Exp
e SrcLoc
_) = Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
ppr (VariableArraySize SrcLoc
_) = String -> Doc
text String
"*"
ppr (NoArraySize SrcLoc
_) = Doc
empty
pprDeclarator :: Maybe Id -> Decl -> Doc
pprDeclarator :: Maybe Id -> Decl -> Doc
pprDeclarator Maybe Id
maybe_ident Decl
declarator =
case Maybe Id
maybe_ident of
Maybe Id
Nothing -> Decl -> Doc -> Doc
pprDecl Decl
declarator Doc
empty
Just Id
ident -> Decl -> Doc -> Doc
pprDecl Decl
declarator (Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident)
where
pprPtr :: Decl -> Doc -> (Decl, Doc)
pprPtr :: Decl -> Doc -> (Decl, Doc)
pprPtr (Ptr [TypeQual]
quals Decl
decl SrcLoc
_) Doc
post =
Decl -> Doc -> (Decl, Doc)
pprPtr Decl
decl (Doc -> (Decl, Doc)) -> Doc -> (Decl, Doc)
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
spread ((TypeQual -> Doc) -> [TypeQual] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeQual -> Doc
forall a. Pretty a => a -> Doc
ppr [TypeQual]
quals) Doc -> Doc -> Doc
<+> Doc
post
pprPtr (BlockPtr [TypeQual]
quals Decl
decl SrcLoc
_) Doc
post =
Decl -> Doc -> (Decl, Doc)
pprPtr Decl
decl (Doc -> (Decl, Doc)) -> Doc -> (Decl, Doc)
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"^" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
spread ((TypeQual -> Doc) -> [TypeQual] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeQual -> Doc
forall a. Pretty a => a -> Doc
ppr [TypeQual]
quals) Doc -> Doc -> Doc
<+> Doc
post
pprPtr Decl
decl Doc
post =
(Decl
decl, Doc
post)
pprDirDecl :: Decl -> Doc -> (Decl, Doc)
pprDirDecl :: Decl -> Doc -> (Decl, Doc)
pprDirDecl (Array [TypeQual]
quals ArraySize
size Decl
decl SrcLoc
_) Doc
pre =
Decl -> Doc -> (Decl, Doc)
pprDirDecl Decl
decl (Doc -> (Decl, Doc)) -> Doc -> (Decl, Doc)
forall a b. (a -> b) -> a -> b
$
Doc
pre Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (Doc -> Doc
align ([Doc] -> Doc
spread ((TypeQual -> Doc) -> [TypeQual] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeQual -> Doc
forall a. Pretty a => a -> Doc
ppr [TypeQual]
quals) Doc -> Doc -> Doc
<+> ArraySize -> Doc
forall a. Pretty a => a -> Doc
ppr ArraySize
size))
pprDirDecl (Proto Decl
decl Params
args SrcLoc
_) Doc
pre =
Decl -> Doc -> (Decl, Doc)
pprDirDecl Decl
decl (Doc -> (Decl, Doc)) -> Doc -> (Decl, Doc)
forall a b. (a -> b) -> a -> b
$
Doc
pre Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Params -> Doc
forall a. Pretty a => a -> Doc
ppr Params
args)
pprDirDecl (OldProto Decl
decl [Id]
args SrcLoc
_) Doc
pre =
Decl -> Doc -> (Decl, Doc)
pprDirDecl Decl
decl (Doc -> (Decl, Doc)) -> Doc -> (Decl, Doc)
forall a b. (a -> b) -> a -> b
$
Doc
pre Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
parensList ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
forall a. Pretty a => a -> Doc
ppr [Id]
args)
pprDirDecl Decl
decl Doc
pre =
(Decl
decl, Doc
pre)
pprDecl :: Decl -> Doc -> Doc
pprDecl :: Decl -> Doc -> Doc
pprDecl Decl
decl Doc
mid =
case Decl
decl' of
DeclRoot {} -> Doc
declDoc
AntiTypeDecl {} -> Doc
declDoc
Decl
_ -> Decl -> Doc -> Doc
pprDecl Decl
decl' (Doc -> Doc
parens Doc
declDoc)
where
(Decl
decl', Doc
declDoc) = (Decl -> Doc -> (Decl, Doc)) -> (Decl, Doc) -> (Decl, Doc)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Decl -> Doc -> (Decl, Doc)
pprPtr (Decl -> Doc -> (Decl, Doc)
pprDirDecl Decl
decl Doc
mid)
instance Pretty Type where
ppr :: Type -> Doc
ppr (Type DeclSpec
spec Decl
decl SrcLoc
_) = DeclSpec -> Doc
forall a. Pretty a => a -> Doc
ppr DeclSpec
spec Doc -> Doc -> Doc
<+> Maybe Id -> Decl -> Doc
pprDeclarator Maybe Id
forall a. Maybe a
Nothing Decl
decl
ppr (AntiType String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"ty" String
v
instance Pretty Designator where
ppr :: Designator -> Doc
ppr (IndexDesignator Exp
e SrcLoc
_) = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
ppr (MemberDesignator Id
ident SrcLoc
_) = Doc
dot Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident
instance Pretty Designation where
ppr :: Designation -> Doc
ppr (Designation [Designator]
ds SrcLoc
_) = (Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) ((Designator -> Doc) -> [Designator] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Designator -> Doc
forall a. Pretty a => a -> Doc
ppr [Designator]
ds)
instance Pretty Initializer where
ppr :: Initializer -> Doc
ppr (ExpInitializer Exp
e SrcLoc
_) = Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
ppr (CompoundInitializer [(Maybe Designation, Initializer)]
inits SrcLoc
_) =
[Doc] -> Doc
bracesList (((Maybe Designation, Initializer) -> Doc)
-> [(Maybe Designation, Initializer)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Designation, Initializer) -> Doc
pprInit [(Maybe Designation, Initializer)]
inits)
where
pprInit :: (Maybe Designation, Initializer) -> Doc
pprInit :: (Maybe Designation, Initializer) -> Doc
pprInit (Maybe Designation
Nothing, Initializer
ini) = Initializer -> Doc
forall a. Pretty a => a -> Doc
ppr Initializer
ini
pprInit (Just Designation
d, Initializer
ini) = Designation -> Doc
forall a. Pretty a => a -> Doc
ppr Designation
d Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<//> Initializer -> Doc
forall a. Pretty a => a -> Doc
ppr Initializer
ini
ppr (AntiInit String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"init" String
v
ppr (AntiInits String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"inits" String
v
instance Pretty Init where
ppr :: Init -> Doc
ppr (Init Id
ident Decl
decl Maybe StringLit
maybe_asmlabel Maybe Initializer
maybe_e [Attr]
attrs SrcLoc
_) =
Maybe Id -> Decl -> Doc
pprDeclarator (Id -> Maybe Id
forall a. a -> Maybe a
Just Id
ident) Decl
decl Doc -> Doc -> Doc
<+/> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs
Doc -> Doc -> Doc
<+> case Maybe StringLit
maybe_asmlabel of
Maybe StringLit
Nothing -> Doc
empty
Just StringLit
l -> String -> Doc
text String
"asm" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (StringLit -> Doc
forall a. Pretty a => a -> Doc
ppr StringLit
l)
Doc -> Doc -> Doc
<+> case Maybe Initializer
maybe_e of
Maybe Initializer
Nothing -> Doc
empty
Just Initializer
e -> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+/> Initializer -> Doc
forall a. Pretty a => a -> Doc
ppr Initializer
e
instance Pretty Typedef where
ppr :: Typedef -> Doc
ppr (Typedef Id
ident Decl
decl [Attr]
attrs SrcLoc
loc) =
Init -> Doc
forall a. Pretty a => a -> Doc
ppr (Id
-> Decl
-> Maybe StringLit
-> Maybe Initializer
-> [Attr]
-> SrcLoc
-> Init
Init Id
ident Decl
decl Maybe StringLit
forall a. Maybe a
Nothing Maybe Initializer
forall a. Maybe a
Nothing [Attr]
attrs SrcLoc
loc)
instance Pretty InitGroup where
ppr :: InitGroup -> Doc
ppr (InitGroup DeclSpec
spec [Attr]
attrs [Init]
inits SrcLoc
_) =
DeclSpec -> Doc
forall a. Pretty a => a -> Doc
ppr DeclSpec
spec Doc -> Doc -> Doc
<+/> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs Doc -> Doc -> Doc
<+> [Doc] -> Doc
commasep ((Init -> Doc) -> [Init] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Init -> Doc
forall a. Pretty a => a -> Doc
ppr [Init]
inits)
ppr (TypedefGroup DeclSpec
spec [Attr]
attrs [Typedef]
typedefs SrcLoc
_) =
String -> Doc
text String
"typedef" Doc -> Doc -> Doc
<+> DeclSpec -> Doc
forall a. Pretty a => a -> Doc
ppr DeclSpec
spec Doc -> Doc -> Doc
<+/> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs Doc -> Doc -> Doc
<+> [Doc] -> Doc
commasep ((Typedef -> Doc) -> [Typedef] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Typedef -> Doc
forall a. Pretty a => a -> Doc
ppr [Typedef]
typedefs)
ppr (AntiDecls String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"decls" String
v
ppr (AntiDecl String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"decl" String
v
pprList :: [InitGroup] -> Doc
pprList [InitGroup]
initgroups =
[Doc] -> Doc
stack ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) ((InitGroup -> Doc) -> [InitGroup] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map InitGroup -> Doc
forall a. Pretty a => a -> Doc
ppr [InitGroup]
initgroups) (Doc -> [Doc]
forall a. a -> [a]
repeat Doc
semi))
instance Pretty Field where
ppr :: Field -> Doc
ppr (Field Maybe Id
maybe_ident Maybe Decl
maybe_decl Maybe Exp
maybe_e SrcLoc
_) =
case Maybe Decl
maybe_decl of
Maybe Decl
Nothing -> Doc
empty
Just Decl
decl -> Maybe Id -> Decl -> Doc
pprDeclarator Maybe Id
maybe_ident Decl
decl
Doc -> Doc -> Doc
<+>
case Maybe Exp
maybe_e of
Maybe Exp
Nothing -> Doc
empty
Just Exp
e -> Doc
colon Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
instance Pretty FieldGroup where
ppr :: FieldGroup -> Doc
ppr (FieldGroup DeclSpec
spec [Field]
fields SrcLoc
_) =
DeclSpec -> Doc
forall a. Pretty a => a -> Doc
ppr DeclSpec
spec Doc -> Doc -> Doc
<+> [Doc] -> Doc
commasep ((Field -> Doc) -> [Field] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Field -> Doc
forall a. Pretty a => a -> Doc
ppr [Field]
fields)
ppr (AntiSdecls String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"sdecls" String
v
ppr (AntiSdecl String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"sdecl" String
v
pprList :: [FieldGroup] -> Doc
pprList [FieldGroup]
fields = [Doc] -> Doc
embrace ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) ((FieldGroup -> Doc) -> [FieldGroup] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldGroup -> Doc
forall a. Pretty a => a -> Doc
ppr [FieldGroup]
fields) (Doc -> [Doc]
forall a. a -> [a]
repeat Doc
semi))
instance Pretty CEnum where
ppr :: CEnum -> Doc
ppr (CEnum Id
ident Maybe Exp
maybe_e SrcLoc
_) =
Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident Doc -> Doc -> Doc
<+>
case Maybe Exp
maybe_e of
Maybe Exp
Nothing -> Doc
empty
Just Exp
e -> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+/> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
ppr (AntiEnums String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"enums" String
v
ppr (AntiEnum String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"enum" String
v
pprList :: [CEnum] -> Doc
pprList [] = Doc
empty
pprList [CEnum]
cenums = [Doc] -> Doc
embrace ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) ((CEnum -> Doc) -> [CEnum] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CEnum -> Doc
forall a. Pretty a => a -> Doc
ppr [CEnum]
cenums) (Doc -> [Doc]
forall a. a -> [a]
repeat Doc
comma))
instance Pretty Attr where
ppr :: Attr -> Doc
ppr (Attr Id
ident [] SrcLoc
_) = Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident
ppr (Attr Id
ident [Exp]
args SrcLoc
_) =
Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commasep ((Exp -> Doc) -> [Exp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Doc
forall a. Pretty a => a -> Doc
ppr [Exp]
args))
ppr (AntiAttr String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"attr" String
v
ppr (AntiAttrs String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"attrs" String
v
pprList :: [Attr] -> Doc
pprList [] = Doc
empty
pprList [Attr]
attrs = String -> Doc
text String
"__attribute__" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Doc
parens (Doc -> Doc
parens ([Doc] -> Doc
commasep ((Attr -> Doc) -> [Attr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attr -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs)))
instance Pretty Param where
ppr :: Param -> Doc
ppr (Param Maybe Id
maybe_ident DeclSpec
spec Decl
decl SrcLoc
_) =
DeclSpec -> Doc
forall a. Pretty a => a -> Doc
ppr DeclSpec
spec Doc -> Doc -> Doc
<+> Maybe Id -> Decl -> Doc
pprDeclarator Maybe Id
maybe_ident Decl
decl
ppr (AntiParams String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"params" String
v
ppr (AntiParam String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"param" String
v
instance Pretty Params where
ppr :: Params -> Doc
ppr (Params [Param]
args Bool
True SrcLoc
_) =
[Doc] -> Doc
commasep ((Param -> Doc) -> [Param] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Param -> Doc
forall a. Pretty a => a -> Doc
ppr [Param]
args [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"..."])
ppr (Params [Param]
args Bool
False SrcLoc
_) =
[Doc] -> Doc
commasep ((Param -> Doc) -> [Param] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Param -> Doc
forall a. Pretty a => a -> Doc
ppr [Param]
args)
instance Pretty Func where
ppr :: Func -> Doc
ppr (Func DeclSpec
spec Id
ident Decl
decl Params
args [BlockItem]
body SrcLoc
loc) =
DeclSpec -> Doc
forall a. Pretty a => a -> Doc
ppr DeclSpec
spec Doc -> Doc -> Doc
<+> Maybe Id -> Decl -> Doc
pprDeclarator (Id -> Maybe Id
forall a. a -> Maybe a
Just Id
ident) (Decl -> Params -> SrcLoc -> Decl
Proto Decl
decl Params
args SrcLoc
loc) Doc -> Doc -> Doc
</> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
body
ppr (OldFunc DeclSpec
spec Id
ident Decl
decl [Id]
args Maybe [InitGroup]
maybe_initgroups [BlockItem]
body SrcLoc
loc) =
DeclSpec -> Doc
forall a. Pretty a => a -> Doc
ppr DeclSpec
spec Doc -> Doc -> Doc
<+> Maybe Id -> Decl -> Doc
pprDeclarator (Id -> Maybe Id
forall a. a -> Maybe a
Just Id
ident) (Decl -> [Id] -> SrcLoc -> Decl
OldProto Decl
decl [Id]
args SrcLoc
loc) Doc -> Doc -> Doc
</>
Maybe [InitGroup] -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe [InitGroup]
maybe_initgroups Doc -> Doc -> Doc
</>
[BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
body
instance Pretty Definition where
ppr :: Definition -> Doc
ppr (FuncDef Func
func SrcLoc
loc) = SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Func -> Doc
forall a. Pretty a => a -> Doc
ppr Func
func
ppr (DecDef InitGroup
initgroup SrcLoc
loc) = SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> InitGroup -> Doc
forall a. Pretty a => a -> Doc
ppr InitGroup
initgroup Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (EscDef String
s SrcLoc
loc) = SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s
ppr (ObjCClassDec [Id]
clss SrcLoc
loc) = SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"@class" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commasep ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
forall a. Pretty a => a -> Doc
ppr [Id]
clss) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (AntiFunc String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"func" String
v
ppr (AntiEsc String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"esc" String
v
ppr (AntiEdecls String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"edecls" String
v
ppr (AntiEdecl String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"edecl" String
v
ppr (ObjCClassIface Id
cident Maybe Id
sident [Id]
refs [ObjCIvarDecl]
ivars [ObjCIfaceDecl]
decls [Attr]
attrs SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
<+> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs Doc -> Doc -> Doc
<+/>
String -> Doc
text String
"@interface" Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
cident Doc -> Doc -> Doc
<+> Doc -> (Id -> Doc) -> Maybe Id -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\Id
ident -> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident) Maybe Id
sident Doc -> Doc -> Doc
<+>
[Id] -> [ObjCIvarDecl] -> [ObjCIfaceDecl] -> Doc
pprIfaceBody [Id]
refs [ObjCIvarDecl]
ivars [ObjCIfaceDecl]
decls
ppr (ObjCCatIface Id
cident Maybe Id
catident [Id]
refs [ObjCIvarDecl]
ivars [ObjCIfaceDecl]
decls SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@interface" Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
cident Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Doc -> (Id -> Doc) -> Maybe Id -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Id -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Id
catident) Doc -> Doc -> Doc
<+> [Id] -> [ObjCIvarDecl] -> [ObjCIfaceDecl] -> Doc
pprIfaceBody [Id]
refs [ObjCIvarDecl]
ivars [ObjCIfaceDecl]
decls
ppr (ObjCProtDec [Id]
prots SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"@protocol" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commasep ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
forall a. Pretty a => a -> Doc
ppr [Id]
prots) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (ObjCProtDef Id
pident [Id]
refs [ObjCIfaceDecl]
decls SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@protocol" Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
pident Doc -> Doc -> Doc
<+> [Id] -> [ObjCIvarDecl] -> [ObjCIfaceDecl] -> Doc
pprIfaceBody [Id]
refs [] [ObjCIfaceDecl]
decls
ppr (ObjCClassImpl Id
cident Maybe Id
sident [ObjCIvarDecl]
ivars [Definition]
defs SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@implementation" Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
cident Doc -> Doc -> Doc
<+> Doc -> (Id -> Doc) -> Maybe Id -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\Id
ident -> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident) Maybe Id
sident Doc -> Doc -> Doc
</>
[Doc] -> Doc
stack ((ObjCIvarDecl -> Doc) -> [ObjCIvarDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCIvarDecl -> Doc
forall a. Pretty a => a -> Doc
ppr [ObjCIvarDecl]
ivars) Doc -> Doc -> Doc
<//>
[Doc] -> Doc
stack ((Definition -> Doc) -> [Definition] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Definition -> Doc
forall a. Pretty a => a -> Doc
ppr [Definition]
defs) Doc -> Doc -> Doc
</>
String -> Doc
text String
"@end"
ppr (ObjCCatImpl Id
cident Id
catident [Definition]
defs SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@implementation" Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
cident Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
catident) Doc -> Doc -> Doc
<//>
[Doc] -> Doc
stack ((Definition -> Doc) -> [Definition] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Definition -> Doc
forall a. Pretty a => a -> Doc
ppr [Definition]
defs) Doc -> Doc -> Doc
</>
String -> Doc
text String
"@end"
ppr (ObjCSynDef [(Id, Maybe Id)]
pivars SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@synthesize" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commasep (((Id, Maybe Id) -> Doc) -> [(Id, Maybe Id)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Id, Maybe Id) -> Doc
forall {a} {a}. (Pretty a, Pretty a) => (a, Maybe a) -> Doc
pprPivar [(Id, Maybe Id)]
pivars) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
where
pprPivar :: (a, Maybe a) -> Doc
pprPivar (a
ident, Maybe a
Nothing) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
ident
pprPivar (a
ident1, Just a
ident2) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
ident1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
ppr a
ident2
ppr (ObjCDynDef [Id]
pivars SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@dynamic" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commasep ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
forall a. Pretty a => a -> Doc
ppr [Id]
pivars) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (ObjCMethDef ObjCMethodProto
proto [BlockItem]
body SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
ObjCMethodProto -> Doc
forall a. Pretty a => a -> Doc
ppr ObjCMethodProto
proto Doc -> Doc -> Doc
</> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
body
ppr (ObjCCompAlias Id
aident Id
cident SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@compatibility_alias" Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
aident Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
cident
ppr (AntiObjCMeth String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"methdef" String
v
ppr (AntiObjCMeths String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"methdefs" String
v
pprList :: [Definition] -> Doc
pprList [Definition]
ds = [Doc] -> Doc
stack ((Definition -> Doc) -> [Definition] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Definition -> Doc
forall a. Pretty a => a -> Doc
ppr [Definition]
ds) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
pprIfaceBody :: [Id] -> [ObjCIvarDecl] -> [ObjCIfaceDecl] -> Doc
pprIfaceBody :: [Id] -> [ObjCIvarDecl] -> [ObjCIfaceDecl] -> Doc
pprIfaceBody [Id]
refs [ObjCIvarDecl]
ivars [ObjCIfaceDecl]
decls =
case [Id]
refs of
[] -> Doc
empty
[Id]
_ -> [Doc] -> Doc
angleList ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
forall a. Pretty a => a -> Doc
ppr [Id]
refs)
Doc -> Doc -> Doc
</> [Doc] -> Doc
stack ((ObjCIvarDecl -> Doc) -> [ObjCIvarDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCIvarDecl -> Doc
forall a. Pretty a => a -> Doc
ppr [ObjCIvarDecl]
ivars)
Doc -> Doc -> Doc
<//> [Doc] -> Doc
stack ((ObjCIfaceDecl -> Doc) -> [ObjCIfaceDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCIfaceDecl -> Doc
forall a. Pretty a => a -> Doc
ppr [ObjCIfaceDecl]
decls)
Doc -> Doc -> Doc
</> String -> Doc
text String
"@end"
instance Pretty Stm where
ppr :: Stm -> Doc
ppr (Label Id
ident [Attr]
attrs Stm
stm SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc -> Doc
indent (-Int
2) (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs) Doc -> Doc -> Doc
</> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
ppr (Case Exp
e Stm
stm SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc -> Doc
indent (-Int
2) (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon) Doc -> Doc -> Doc
</> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
ppr (CaseRange Exp
e1 Exp
e2 Stm
stm SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc -> Doc
indent (-Int
2) (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"..." Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon) Doc -> Doc -> Doc
</> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
ppr (Default Stm
stm SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc -> Doc
indent (-Int
2) (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"default" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon) Doc -> Doc -> Doc
</> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
ppr (Exp Maybe Exp
Nothing SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (Exp (Just Exp
e) SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
hang Int
4 (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (Block [BlockItem]
items SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
items
ppr (If Exp
test Stm
then' Maybe Stm
maybe_else SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
test) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Stm -> Maybe Doc -> Doc
pprThen Stm
then' ((Stm -> Doc) -> Maybe Stm -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stm -> Doc
pprElse Maybe Stm
maybe_else)
where
isIf :: Stm -> Bool
isIf :: Stm -> Bool
isIf If{} = Bool
True
isIf (Comment String
_ Stm
stm SrcLoc
_) = Stm -> Bool
isIf Stm
stm
isIf Stm
_ = Bool
False
pprThen :: Stm -> Maybe Doc -> Doc
pprThen :: Stm -> Maybe Doc -> Doc
pprThen stm :: Stm
stm@(Block {}) Maybe Doc
rest = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm Doc -> Doc -> Doc
<+> Doc -> (Doc -> Doc) -> Maybe Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Doc -> Doc
forall a. a -> a
id Maybe Doc
rest
pprThen Stm
stm Maybe Doc
rest
| Stm -> Bool
isIf Stm
stm = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [Stm -> BlockItem
BlockStm Stm
stm] Doc -> Doc -> Doc
<+> Doc -> (Doc -> Doc) -> Maybe Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Doc -> Doc
forall a. a -> a
id Maybe Doc
rest
pprThen Stm
stm Maybe Doc
Nothing = Int -> Doc -> Doc
nest Int
4 (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm)
pprThen Stm
stm (Just Doc
rest) = Int -> Doc -> Doc
nest Int
4 (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm) Doc -> Doc -> Doc
</> Doc
rest
pprElse :: Stm -> Doc
pprElse :: Stm -> Doc
pprElse Stm
stm =
String -> Doc
text String
"else" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
go Stm
stm
where
go :: Stm -> Doc
go :: Stm -> Doc
go (Block {}) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
go (If {}) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
go Stm
_stm = Int -> Doc -> Doc
nest Int
4 (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm)
ppr (Switch Exp
e Stm
stm SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"switch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
pprBlock Stm
stm
ppr (While Exp
e Stm
stm SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
pprBlock Stm
stm
ppr (DoWhile Stm
stm Exp
e SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"do" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
pprBlock Stm
stm Doc -> Doc -> Doc
<+/> String -> Doc
text String
"while" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (For Either InitGroup (Maybe Exp)
ini Maybe Exp
test Maybe Exp
post Stm
stm SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"for" Doc -> Doc -> Doc
<+>
(Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
semisep) [(InitGroup -> Doc)
-> (Maybe Exp -> Doc) -> Either InitGroup (Maybe Exp) -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either InitGroup -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Either InitGroup (Maybe Exp)
ini, Maybe Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Exp
test, Maybe Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Exp
post] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Stm -> Doc
pprBlock Stm
stm
ppr (Goto Id
ident SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"goto" Doc -> Doc -> Doc
<+> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (Continue SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"continue" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>Doc
semi
ppr (Break SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"break" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (Return Maybe Exp
Nothing SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"return" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (Return (Just Exp
e) SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
4 (String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (Pragma String
pragma SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"#pragma" Doc -> Doc -> Doc
<+> String -> Doc
text String
pragma
ppr (Comment String
com Stm
stm SrcLoc
sloc) =
Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
com Doc -> Doc -> Doc
</> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
ppr (EscStm String
esc SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
esc
ppr (AntiEscStm String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"escstm" String
v
ppr (AntiPragma String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"pragma" String
v
ppr (AntiComment String
v Stm
stm SrcLoc
_) = String -> String -> Doc
pprAnti String
"pragma" String
v Doc -> Doc -> Doc
</> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
ppr (AntiStm String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"stm" String
v
ppr (AntiStms String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"stms" String
v
ppr (Asm Bool
isVolatile [Attr]
_ StringLit
template [AsmOut]
outs [AsmIn]
ins [String]
clobbered SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"__asm__"
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case Bool
isVolatile of
Bool
True -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"__volatile__"
Bool
False -> Doc
empty
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (StringLit -> Doc
forall a. Pretty a => a -> Doc
ppr StringLit
template
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case [AsmOut]
outs of
[] -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
[AsmOut]
_ -> Doc
colon Doc -> Doc -> Doc
<+/> [AsmOut] -> Doc
forall a. Pretty a => a -> Doc
ppr [AsmOut]
outs
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case [AsmIn]
ins of
[] -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
[AsmIn]
_ -> Doc
colon Doc -> Doc -> Doc
<+/> [AsmIn] -> Doc
forall a. Pretty a => a -> Doc
ppr [AsmIn]
ins
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case [String]
clobbered of
[] -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
[String]
_ -> Doc
colon Doc -> Doc -> Doc
<+/> [Doc] -> Doc
commasep ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String]
clobbered)
)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (AsmGoto Bool
isVolatile [Attr]
_ StringLit
template [AsmIn]
ins [String]
clobbered [Id]
labels SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"__asm__"
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case Bool
isVolatile of
Bool
True -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"__volatile__"
Bool
False -> Doc
empty
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (StringLit -> Doc
forall a. Pretty a => a -> Doc
ppr StringLit
template
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case [AsmIn]
ins of
[] -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
[AsmIn]
_ -> Doc
colon Doc -> Doc -> Doc
<+/> [AsmIn] -> Doc
forall a. Pretty a => a -> Doc
ppr [AsmIn]
ins
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case [String]
clobbered of
[] -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
[String]
_ -> Doc
colon Doc -> Doc -> Doc
<+/> [Doc] -> Doc
commasep ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String]
clobbered)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case [String]
clobbered of
[] -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
[String]
_ -> Doc
colon Doc -> Doc -> Doc
<+/> [Doc] -> Doc
commasep ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
forall a. Pretty a => a -> Doc
ppr [Id]
labels)
)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (ObjCTry [BlockItem]
try [ObjCCatch]
catchs Maybe [BlockItem]
finally SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"@try"
Doc -> Doc -> Doc
</> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
try
Doc -> Doc -> Doc
</> [Doc] -> Doc
stack ((ObjCCatch -> Doc) -> [ObjCCatch] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCCatch -> Doc
forall a. Pretty a => a -> Doc
ppr [ObjCCatch]
catchs)
Doc -> Doc -> Doc
</> case Maybe [BlockItem]
finally of
Maybe [BlockItem]
Nothing -> Doc
empty
Just [BlockItem]
block -> String -> Doc
text String
"@finally" Doc -> Doc -> Doc
</> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
block
ppr (ObjCThrow Maybe Exp
e SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"@throw"
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case Maybe Exp
e of
Maybe Exp
Nothing -> Doc
semi
Just Exp
e' -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (ObjCSynchronized Exp
e [BlockItem]
block SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"@synchronized" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e)
Doc -> Doc -> Doc
</> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
block
ppr (ObjCAutoreleasepool [BlockItem]
block SrcLoc
sloc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
sloc
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"@autoreleasepool"
Doc -> Doc -> Doc
</> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
block
pprBlock :: Stm -> Doc
pprBlock :: Stm -> Doc
pprBlock stm :: Stm
stm@(Block {}) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
pprBlock stm :: Stm
stm@(If {}) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [Stm -> BlockItem
BlockStm Stm
stm]
pprBlock Stm
stm = Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
instance Pretty BlockItem where
ppr :: BlockItem -> Doc
ppr (BlockDecl InitGroup
decl) = InitGroup -> Doc
forall a. Pretty a => a -> Doc
ppr InitGroup
decl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (BlockStm Stm
stm) = Stm -> Doc
forall a. Pretty a => a -> Doc
ppr Stm
stm
ppr (AntiBlockItem String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"item" String
v
ppr (AntiBlockItems String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"items" String
v
pprList :: [BlockItem] -> Doc
pprList = [Doc] -> Doc
embrace ([Doc] -> Doc) -> ([BlockItem] -> [Doc]) -> [BlockItem] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockItem] -> [Doc]
loop
where
loop :: [BlockItem] -> [Doc]
loop :: [BlockItem] -> [Doc]
loop [] =
[]
loop [BlockItem
item] =
[BlockItem -> Doc
forall a. Pretty a => a -> Doc
ppr BlockItem
item]
loop (item1 :: BlockItem
item1@(BlockDecl InitGroup
_) : item2 :: BlockItem
item2@(BlockStm Stm
_) : [BlockItem]
items) =
(BlockItem -> Doc
forall a. Pretty a => a -> Doc
ppr BlockItem
item1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [BlockItem] -> [Doc]
loop (BlockItem
item2 BlockItem -> [BlockItem] -> [BlockItem]
forall a. a -> [a] -> [a]
: [BlockItem]
items)
loop (item1 :: BlockItem
item1@(BlockStm Stm
_) : item2 :: BlockItem
item2@(BlockDecl InitGroup
_) : [BlockItem]
items) =
(BlockItem -> Doc
forall a. Pretty a => a -> Doc
ppr BlockItem
item1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [BlockItem] -> [Doc]
loop (BlockItem
item2 BlockItem -> [BlockItem] -> [BlockItem]
forall a. a -> [a] -> [a]
: [BlockItem]
items)
loop (BlockItem
item : [BlockItem]
items) =
BlockItem -> Doc
forall a. Pretty a => a -> Doc
ppr BlockItem
item Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [BlockItem] -> [Doc]
loop [BlockItem]
items
instance Pretty Const where
pprPrec :: Int -> Const -> Doc
pprPrec Int
p (IntConst String
s Signed
_ Integer
i SrcLoc
_) = Bool -> Doc -> Doc
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
s
pprPrec Int
p (LongIntConst String
s Signed
_ Integer
i SrcLoc
_) = Bool -> Doc -> Doc
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
s
pprPrec Int
p (LongLongIntConst String
s Signed
_ Integer
i SrcLoc
_) = Bool -> Doc -> Doc
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
s
pprPrec Int
p (FloatConst String
s Float
r SrcLoc
_) = Bool -> Doc -> Doc
parensIf (Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
s
pprPrec Int
p (DoubleConst String
s Double
r SrcLoc
_) = Bool -> Doc -> Doc
parensIf (Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
s
pprPrec Int
p (LongDoubleConst String
s Double
r SrcLoc
_) = Bool -> Doc -> Doc
parensIf (Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
s
pprPrec Int
_ (CharConst String
s Char
_ SrcLoc
_) = String -> Doc
text String
s
pprPrec Int
_ (StringConst [String]
ss String
_ SrcLoc
_) = [Doc] -> Doc
sep ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
string [String]
ss)
pprPrec Int
_ (AntiConst String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"const" String
v
pprPrec Int
_ (AntiString String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"string" String
v
pprPrec Int
_ (AntiChar String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"char" String
v
pprPrec Int
_ (AntiLongDouble String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"ldouble" String
v
pprPrec Int
_ (AntiDouble String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"double" String
v
pprPrec Int
_ (AntiFloat String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"float" String
v
pprPrec Int
_ (AntiULInt String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"ulint" String
v
pprPrec Int
_ (AntiLInt String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"lint" String
v
pprPrec Int
_ (AntiULLInt String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"ullint" String
v
pprPrec Int
_ (AntiLLInt String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"llint" String
v
pprPrec Int
_ (AntiUInt String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"uint" String
v
pprPrec Int
_ (AntiInt String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"int" String
v
instance Pretty Exp where
pprPrec :: Int -> Exp -> Doc
pprPrec Int
p (Var Id
ident SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Id -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
p Id
ident
pprPrec Int
p (Const Const
k SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Const -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
p Const
k
pprPrec Int
p (BinOp BinOp
op Exp
e1 Exp
e2 SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> BinOp -> Exp -> Exp -> Doc
forall a b op.
(Pretty a, Pretty b, Pretty op, CFixity op) =>
Int -> op -> a -> b -> Doc
infixop Int
p BinOp
op Exp
e1 Exp
e2
pprPrec Int
p (Assign Exp
e1 AssignOp
op Exp
e2 SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> AssignOp -> Exp -> Exp -> Doc
forall a b op.
(Pretty a, Pretty b, Pretty op, CFixity op) =>
Int -> op -> a -> b -> Doc
infixop Int
p AssignOp
op Exp
e1 Exp
e2
pprPrec Int
p (PreInc Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"++" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
unopPrec1 Exp
e
pprPrec Int
p (PostInc Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
unopPrec1 Exp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"++"
pprPrec Int
p (PreDec Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"--" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
unopPrec1 Exp
e
pprPrec Int
p (PostDec Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
unopPrec1 Exp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"--"
pprPrec Int
_ (EscExp String
e SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
e
pprPrec Int
p (AntiEscExp String
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
e
pprPrec Int
p (UnOp op :: UnOp
op@UnOp
Positive Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
UnOp -> Doc
forall a. Pretty a => a -> Doc
ppr UnOp
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
unopPrec1 Exp
e
pprPrec Int
p (UnOp op :: UnOp
op@UnOp
Negate Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
UnOp -> Doc
forall a. Pretty a => a -> Doc
ppr UnOp
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
unopPrec1 Exp
e
pprPrec Int
p (UnOp UnOp
op Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> UnOp -> Exp -> Doc
forall a op.
(Pretty a, Pretty op, CFixity op) =>
Int -> op -> a -> Doc
prefixop Int
p UnOp
op Exp
e
pprPrec Int
p (SizeofExp Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"sizeof" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e)
pprPrec Int
p (SizeofType Type
tipe SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"sizeof" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
tipe)
pprPrec Int
p (Cast Type
tipe Exp
e SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc -> Doc
parens (Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
tipe) Doc -> Doc -> Doc
<+> Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
unopPrec Exp
e
pprPrec Int
p (Cond Exp
test Exp
then' Exp
else' SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
condPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
condPrec1 Exp
test Doc -> Doc -> Doc
<+> String -> Doc
text String
"?" Doc -> Doc -> Doc
<+>
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
condPrec1 Exp
then' Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+>
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
condPrec Exp
else'
pprPrec Int
p (Member Exp
e Id
ident SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
memberPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
memberPrec Exp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
dot Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident
pprPrec Int
p (PtrMember Exp
e Id
ident SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
memberPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
memberPrec Exp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident
pprPrec Int
p (Index Exp
e1 Exp
e2 SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
memberPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
memberPrec Exp
e1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e2)
pprPrec Int
p (FnCall Exp
f [Exp]
args SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
memberPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
memberPrec Exp
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
parensList ((Exp -> Doc) -> [Exp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Doc
forall a. Pretty a => a -> Doc
ppr [Exp]
args)
pprPrec Int
p (Seq Exp
e1 Exp
e2 SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
commaPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
commaPrec Exp
e1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+/> Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
commaPrec1 Exp
e2
pprPrec Int
p (CompoundLit Type
ty [(Maybe Designation, Initializer)]
inits SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
memberPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc -> Doc
parens (Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
ty) Doc -> Doc -> Doc
<+>
Doc -> Doc
braces ([Doc] -> Doc
commasep (((Maybe Designation, Initializer) -> Doc)
-> [(Maybe Designation, Initializer)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Designation, Initializer) -> Doc
pprInit [(Maybe Designation, Initializer)]
inits))
where
pprInit :: (Maybe Designation, Initializer) -> Doc
pprInit :: (Maybe Designation, Initializer) -> Doc
pprInit (Maybe Designation
Nothing, Initializer
ini) = Initializer -> Doc
forall a. Pretty a => a -> Doc
ppr Initializer
ini
pprInit (Just Designation
d, Initializer
ini) = Designation -> Doc
forall a. Pretty a => a -> Doc
ppr Designation
d Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+/> Initializer -> Doc
forall a. Pretty a => a -> Doc
ppr Initializer
ini
pprPrec Int
_ (StmExpr [BlockItem]
blockItems SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
blockItems
pprPrec Int
_ (BuiltinVaArg Exp
e Type
ty SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"__builtin_va_arg(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen
pprPrec Int
_ (BlockLit BlockType
ty [Attr]
attrs [BlockItem]
block SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Char -> Doc
char Char
'^' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> BlockType -> Doc
forall a. Pretty a => a -> Doc
ppr BlockType
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
(if [Attr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attr]
attrs then Doc
empty else Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs) Doc -> Doc -> Doc
<+>
[BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
block
pprPrec Int
p (CudaCall Exp
f ExeConfig
config [Exp]
args SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Bool -> Doc -> Doc
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
memberPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Exp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
memberPrec Exp
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"<<<" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ExeConfig -> Doc
pprConfig ExeConfig
config Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
">>>" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
[Doc] -> Doc
parensList ((Exp -> Doc) -> [Exp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Doc
forall a. Pretty a => a -> Doc
ppr [Exp]
args)
where
pprConfig :: ExeConfig -> Doc
pprConfig :: ExeConfig -> Doc
pprConfig ExeConfig
conf = [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
[Exp -> Doc
forall a. Pretty a => a -> Doc
ppr (ExeConfig -> Exp
exeGridDim ExeConfig
conf), Exp -> Doc
forall a. Pretty a => a -> Doc
ppr (ExeConfig -> Exp
exeBlockDim ExeConfig
conf)] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
(case ExeConfig -> Maybe Exp
exeSharedSize ExeConfig
conf of
Maybe Exp
Nothing -> []
Just Exp
e -> [Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e])
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
(case ExeConfig -> Maybe Exp
exeStream ExeConfig
conf of
Maybe Exp
Nothing -> []
Just Exp
e -> [Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e])
pprPrec Int
_ (ObjCMsg ObjCRecv
recv [ObjCArg]
args [Exp]
varArgs SrcLoc
loc1) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc1 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
ObjCRecv -> Doc
forall a. Pretty a => a -> Doc
ppr ObjCRecv
recv Doc -> Doc -> Doc
<+/>
Int -> Doc -> Doc
nest Int
2 ([ObjCArg] -> Doc
pprMsgArgs [ObjCArg]
args)
where
pprMsgArgs :: [ObjCArg] -> Doc
pprMsgArgs ([ObjCArg (Just Id
sel) Maybe Exp
Nothing SrcLoc
loc]) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
sel
pprMsgArgs [ObjCArg]
_ = [Doc] -> Doc
sep ((ObjCArg -> Doc) -> [ObjCArg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCArg -> Doc
pprMsgArg [ObjCArg]
args) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
[Doc] -> Doc
cat ((Exp -> Doc) -> [Exp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Doc
forall a. Pretty a => a -> Doc
pprVarArg [Exp]
varArgs)
pprMsgArg :: ObjCArg -> Doc
pprMsgArg (ObjCArg (Just Id
sel) (Just Exp
e) SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
sel Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
pprMsgArg (ObjCArg Maybe Id
Nothing (Just Exp
e) SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
colon Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
pprMsgArg (ObjCArg Maybe Id
_ Maybe Exp
Nothing SrcLoc
loc)
= String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"pretty printing 'ObjCArg': missing expression at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Show a => a -> String
show SrcLoc
loc
pprMsgArg (AntiObjCArg String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"kwarg" String
v
pprMsgArg (AntiObjCArgs String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"kwargs" String
v
pprVarArg :: a -> Doc
pprVarArg a
e = Doc
comma Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
ppr a
e
pprPrec Int
_ (ObjCLitConst Maybe UnOp
op Const
c SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Char -> Doc
char Char
'@' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> (UnOp -> Doc) -> Maybe UnOp -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty UnOp -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe UnOp
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Const -> Doc
forall a. Pretty a => a -> Doc
ppr Const
c
pprPrec Int
_ (ObjCLitString [Const]
strs SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
[Doc] -> Doc
spread ((Const -> Doc) -> [Const] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Doc
char Char
'@' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> (Const -> Doc) -> Const -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Doc
forall a. Pretty a => a -> Doc
ppr) [Const]
strs)
pprPrec Int
_ (ObjCLitBool Bool
False SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@NO"
pprPrec Int
_ (ObjCLitBool Bool
True SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@YES"
pprPrec Int
_ (ObjCLitArray [Exp]
es SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Char -> Doc
char Char
'@' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets
([Doc] -> Doc
commasep ((Exp -> Doc) -> [Exp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Doc
forall a. Pretty a => a -> Doc
ppr [Exp]
es))
pprPrec Int
_ (ObjCLitDict [ObjCDictElem]
as SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Char -> Doc
char Char
'@' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
braces
([Doc] -> Doc
commasep ((ObjCDictElem -> Doc) -> [ObjCDictElem] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCDictElem -> Doc
forall a. Pretty a => a -> Doc
ppr [ObjCDictElem]
as))
pprPrec Int
_ (ObjCLitBoxed Exp
e SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Char -> Doc
char Char
'@' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e)
pprPrec Int
_ (ObjCEncode Type
t SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@encode" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
t)
pprPrec Int
_ (ObjCProtocol Id
ident SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@protocol" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident)
pprPrec Int
_ (ObjCSelector String
sel SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@selector" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (String -> Doc
text String
sel)
pprPrec Int
_ (Lambda LambdaIntroducer
captureList Maybe LambdaDeclarator
decl [BlockItem]
blockItems SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
LambdaIntroducer -> Doc
forall a. Pretty a => a -> Doc
ppr LambdaIntroducer
captureList Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Maybe LambdaDeclarator -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe LambdaDeclarator
decl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
[BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
blockItems
pprPrec Int
_ (AntiArgs String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"args" String
v
pprPrec Int
_ (AntiExp String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"var" String
v
instance Pretty LambdaDeclarator where
pprPrec :: Int -> LambdaDeclarator -> Doc
pprPrec Int
_ (LambdaDeclarator Params
params Bool
isMutable Maybe Type
returnType SrcLoc
_) =
Doc -> Doc
parens (Params -> Doc
forall a. Pretty a => a -> Doc
ppr Params
params) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
(if Bool
isMutable then String -> Doc
text String
"mutable" else Doc
empty) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
(if Maybe Type -> Bool
forall a. Maybe a -> Bool
isJust Maybe Type
returnType then String -> Doc
text String
"->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe Type -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Type
returnType else Doc
empty)
instance Pretty LambdaIntroducer where
pprPrec :: Int -> LambdaIntroducer -> Doc
pprPrec Int
_ (LambdaIntroducer [CaptureListEntry]
items SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ((CaptureListEntry -> Doc) -> [CaptureListEntry] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CaptureListEntry -> Doc
forall a. Pretty a => a -> Doc
ppr [CaptureListEntry]
items)
instance Pretty CaptureListEntry where
pprPrec :: Int -> CaptureListEntry -> Doc
pprPrec Int
_ CaptureListEntry
DefaultByValue = Char -> Doc
char Char
'='
pprPrec Int
_ CaptureListEntry
DefaultByReference = Char -> Doc
char Char
'&'
instance Pretty ObjCDictElem where
pprPrec :: Int -> ObjCDictElem -> Doc
pprPrec Int
_ (ObjCDictElem Exp
l Exp
r SrcLoc
_) = Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
l Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
r
pprPrec Int
_ (AntiObjCDictElems String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"dictelems" String
v
instance Pretty BinOp where
ppr :: BinOp -> Doc
ppr BinOp
Add = String -> Doc
text String
"+"
ppr BinOp
Sub = String -> Doc
text String
"-"
ppr BinOp
Mul = String -> Doc
text String
"*"
ppr BinOp
Div = String -> Doc
text String
"/"
ppr BinOp
Mod = String -> Doc
text String
"%"
ppr BinOp
Eq = String -> Doc
text String
"=="
ppr BinOp
Ne = String -> Doc
text String
"!="
ppr BinOp
Lt = String -> Doc
text String
"<"
ppr BinOp
Gt = String -> Doc
text String
">"
ppr BinOp
Le = String -> Doc
text String
"<="
ppr BinOp
Ge = String -> Doc
text String
">="
ppr BinOp
Land = String -> Doc
text String
"&&"
ppr BinOp
Lor = String -> Doc
text String
"||"
ppr BinOp
And = String -> Doc
text String
"&"
ppr BinOp
Or = String -> Doc
text String
"|"
ppr BinOp
Xor = String -> Doc
text String
"^"
ppr BinOp
Lsh = String -> Doc
text String
"<<"
ppr BinOp
Rsh = String -> Doc
text String
">>"
instance Pretty AssignOp where
ppr :: AssignOp -> Doc
ppr AssignOp
JustAssign = String -> Doc
text String
"="
ppr AssignOp
AddAssign = String -> Doc
text String
"+="
ppr AssignOp
SubAssign = String -> Doc
text String
"-="
ppr AssignOp
MulAssign = String -> Doc
text String
"*="
ppr AssignOp
DivAssign = String -> Doc
text String
"/="
ppr AssignOp
ModAssign = String -> Doc
text String
"%="
ppr AssignOp
LshAssign = String -> Doc
text String
"<<="
ppr AssignOp
RshAssign = String -> Doc
text String
">>="
ppr AssignOp
AndAssign = String -> Doc
text String
"&="
ppr AssignOp
XorAssign = String -> Doc
text String
"^="
ppr AssignOp
OrAssign = String -> Doc
text String
"|="
instance Pretty UnOp where
ppr :: UnOp -> Doc
ppr UnOp
AddrOf = String -> Doc
text String
"&"
ppr UnOp
Deref = String -> Doc
text String
"*"
ppr UnOp
Positive = String -> Doc
text String
"+"
ppr UnOp
Negate = String -> Doc
text String
"-"
ppr UnOp
Not = String -> Doc
text String
"~"
ppr UnOp
Lnot = String -> Doc
text String
"!"
instance Pretty AsmOut where
ppr :: AsmOut -> Doc
ppr (AsmOut Maybe Id
Nothing String
constraint Id
ident) =
String -> Doc
text String
constraint Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident)
ppr (AsmOut (Just Id
sym) String
constraint Id
ident) =
Doc -> Doc
brackets (Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
sym) Doc -> Doc -> Doc
<+> String -> Doc
text String
constraint Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident)
pprList :: [AsmOut] -> Doc
pprList [] = Doc
empty
pprList [AsmOut]
outs = [Doc] -> Doc
commasep ((AsmOut -> Doc) -> [AsmOut] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map AsmOut -> Doc
forall a. Pretty a => a -> Doc
ppr [AsmOut]
outs)
instance Pretty AsmIn where
ppr :: AsmIn -> Doc
ppr (AsmIn Maybe Id
Nothing String
constraint Exp
e) =
String -> Doc
text String
constraint Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e)
ppr (AsmIn (Just Id
sym) String
constraint Exp
e) =
Doc -> Doc
brackets (Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
sym) Doc -> Doc -> Doc
<+> String -> Doc
text String
constraint Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e)
pprList :: [AsmIn] -> Doc
pprList [] = Doc
empty
pprList [AsmIn]
ins = [Doc] -> Doc
commasep ((AsmIn -> Doc) -> [AsmIn] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map AsmIn -> Doc
forall a. Pretty a => a -> Doc
ppr [AsmIn]
ins)
instance Pretty BlockType where
ppr :: BlockType -> Doc
ppr (BlockVoid SrcLoc
_loc) = Doc
empty
ppr (BlockParam [Param]
params SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens ([Doc] -> Doc
commasep ((Param -> Doc) -> [Param] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Param -> Doc
forall a. Pretty a => a -> Doc
ppr [Param]
params))
ppr (BlockType Type
ty SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
ty
instance Pretty ObjCIvarDecl where
ppr :: ObjCIvarDecl -> Doc
ppr (ObjCIvarVisi ObjCVisibilitySpec
visi SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ObjCVisibilitySpec -> Doc
forall a. Pretty a => a -> Doc
ppr ObjCVisibilitySpec
visi
ppr (ObjCIvarDecl FieldGroup
field SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FieldGroup -> Doc
forall a. Pretty a => a -> Doc
ppr FieldGroup
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
instance Pretty ObjCVisibilitySpec where
ppr :: ObjCVisibilitySpec -> Doc
ppr (ObjCPrivate SrcLoc
_loc) = String -> Doc
text String
"@private"
ppr (ObjCPublic SrcLoc
_loc) = String -> Doc
text String
"@public"
ppr (ObjCProtected SrcLoc
_loc) = String -> Doc
text String
"@protected"
ppr (ObjCPackage SrcLoc
_loc) = String -> Doc
text String
"@package"
instance Pretty ObjCIfaceDecl where
ppr :: ObjCIfaceDecl -> Doc
ppr (ObjCIfaceProp [ObjCPropAttr]
attrs FieldGroup
field SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"@property"
Doc -> Doc -> Doc
<+> case [ObjCPropAttr]
attrs of
[] -> Doc
empty
[ObjCPropAttr]
_ -> [Doc] -> Doc
parensList ((ObjCPropAttr -> Doc) -> [ObjCPropAttr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCPropAttr -> Doc
forall a. Pretty a => a -> Doc
ppr [ObjCPropAttr]
attrs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FieldGroup -> Doc
forall a. Pretty a => a -> Doc
ppr FieldGroup
field
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (ObjCIfaceReq ObjCMethodReq
req SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ObjCMethodReq -> Doc
forall a. Pretty a => a -> Doc
ppr ObjCMethodReq
req
ppr (ObjCIfaceMeth ObjCMethodProto
proto SrcLoc
_loc) =
ObjCMethodProto -> Doc
forall a. Pretty a => a -> Doc
ppr ObjCMethodProto
proto Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppr (ObjCIfaceDecl InitGroup
decl SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ InitGroup -> Doc
forall a. Pretty a => a -> Doc
ppr InitGroup
decl
ppr (AntiObjCIfaceDecl String
v SrcLoc
_loc) =
String -> String -> Doc
pprAnti String
"ifdecl" String
v
ppr (AntiObjCIfaceDecls String
v SrcLoc
_loc) =
String -> String -> Doc
pprAnti String
"ifdecls" String
v
ppr (AntiObjCProp String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"prop" String
v
ppr (AntiObjCProps String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"props" String
v
instance Pretty ObjCPropAttr where
ppr :: ObjCPropAttr -> Doc
ppr (ObjCGetter Id
ident SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"getter=" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident
ppr (ObjCSetter Id
ident SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"setter=" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
ident Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
ppr (ObjCReadonly SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"readonly"
ppr (ObjCReadwrite SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"readwrite"
ppr (ObjCAssign SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"assign"
ppr (ObjCRetain SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"retain"
ppr (ObjCCopy SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"copy"
ppr (ObjCNonatomic SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"nonatomic"
ppr (ObjCAtomic SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"atomic"
ppr (ObjCStrong SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"strong"
ppr (ObjCWeak SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"weak"
ppr (ObjCUnsafeUnretained SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"unsafe_unretained"
ppr (AntiObjCAttr String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"propattr" String
v
ppr (AntiObjCAttrs String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"propattrs" String
v
instance Pretty ObjCMethodReq where
ppr :: ObjCMethodReq -> Doc
ppr (ObjCRequired SrcLoc
_loc) = String -> Doc
text String
"@required"
ppr (ObjCOptional SrcLoc
_loc) = String -> Doc
text String
"@optional"
instance Pretty ObjCParam where
ppr :: ObjCParam -> Doc
ppr (ObjCParam Maybe Id
sel Maybe Type
ty [Attr]
attrs Maybe Id
arg SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
case (Maybe Id
sel, Maybe Id
arg) of
(Maybe Id
Nothing , Maybe Id
Nothing) -> String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"pretty printing 'ObjCParam': empty " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Show a => a -> String
show SrcLoc
loc
(Just Id
sid, Maybe Id
Nothing) -> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
sid
(Maybe Id
_ , Just Id
pid)
-> Doc -> (Id -> Doc) -> Maybe Id -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Id -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Id
sel Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> (Type -> Doc) -> Maybe Type -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens (Doc -> Doc) -> (Type -> Doc) -> Type -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Doc
forall a. Pretty a => a -> Doc
ppr) Maybe Type
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id -> Doc
forall a. Pretty a => a -> Doc
ppr Id
pid
ppr (AntiObjCParam String
p SrcLoc
_) = String -> String -> Doc
pprAnti String
"methparam" String
p
ppr (AntiObjCParams String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"methparams" String
v
instance Pretty ObjCMethodProto where
ppr :: ObjCMethodProto -> Doc
ppr (ObjCMethodProto Bool
isClassMeth Maybe Type
resTy [Attr]
attrs1 [ObjCParam]
params Bool
vargs [Attr]
attrs2 SrcLoc
loc) =
SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
(if Bool
isClassMeth then Char -> Doc
char Char
'+' else Char -> Doc
char Char
'-') Doc -> Doc -> Doc
<+>
Doc -> (Type -> Doc) -> Maybe Type -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens (Doc -> Doc) -> (Type -> Doc) -> Type -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Doc
forall a. Pretty a => a -> Doc
ppr) Maybe Type
resTy Doc -> Doc -> Doc
<+>
[Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs1 Doc -> Doc -> Doc
<+>
[Doc] -> Doc
spread ((ObjCParam -> Doc) -> [ObjCParam] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCParam -> Doc
forall a. Pretty a => a -> Doc
ppr [ObjCParam]
params) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
(if Bool
vargs then String -> Doc
text String
", ..." else Doc
empty) Doc -> Doc -> Doc
<+>
[Attr] -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs2
ppr (AntiObjCMethodProto String
p SrcLoc
_) = String -> String -> Doc
pprAnti String
"methproto" String
p
instance Pretty ObjCCatch where
ppr :: ObjCCatch -> Doc
ppr (ObjCCatch Maybe Param
Nothing [BlockItem]
block SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@catch (...)" Doc -> Doc -> Doc
<+> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
block
ppr (ObjCCatch (Just Param
param) [BlockItem]
block SrcLoc
loc) =
SrcLoc -> Doc
forall a. Located a => a -> Doc
srcloc SrcLoc
loc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
text String
"@catch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Param -> Doc
forall a. Pretty a => a -> Doc
ppr Param
param) Doc -> Doc -> Doc
<+> [BlockItem] -> Doc
forall a. Pretty a => a -> Doc
ppr [BlockItem]
block
pprList :: [ObjCCatch] -> Doc
pprList = [Doc] -> Doc
stack ([Doc] -> Doc) -> ([ObjCCatch] -> [Doc]) -> [ObjCCatch] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjCCatch -> Doc) -> [ObjCCatch] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ObjCCatch -> Doc
forall a. Pretty a => a -> Doc
ppr
instance Pretty ObjCRecv where
ppr :: ObjCRecv -> Doc
ppr (ObjCRecvSuper SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"super"
ppr (ObjCRecvExp Exp
e SrcLoc
loc) = SrcLoc -> Doc -> Doc
pprLoc SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Exp -> Doc
forall a. Pretty a => a -> Doc
ppr Exp
e
ppr (AntiObjCRecv String
v SrcLoc
_) = String -> String -> Doc
pprAnti String
"recv" String
v