{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module      :  Language.C.Pretty
-- Copyright   :  (c) 2006-2011 Harvard University
--                (c) 2011-2013 Geoffrey Mainland
--             :  (c) 2013-2016 Drexel University
-- License     :  BSD-style
-- Maintainer  :  mainland@drexel.edu

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

-- | Pretty print infix binary operators
infixop :: (Pretty a, Pretty b, Pretty op, CFixity op)
        => Int -- ^ precedence of context
        -> op  -- ^ operator
        -> a   -- ^ left argument
        -> b   -- ^ right argument
        -> 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

-- | Pretty print prefix unary operators
prefixop :: (Pretty a, Pretty op, CFixity op)
         => Int -- ^ precedence of context
         -> op  -- ^ operator
         -> a   -- ^ argument
         -> 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

--
-- Fixities are taken from Table 2-1 in Section 2.12 of K&R (2nd ed.)
--
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

        -- Return 'True' if we are potentially an immediate subterm of the
        -- binary operator op'. We make this determination based of the value of
        -- @prec@.
        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

    -- When printing leading + and - operators, we print the argument at
    -- precedence 'unopPrec1' to ensure we get parentheses in cases like
    -- @-(-42)@. The same holds for @++@ and @--@ above.
    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