module Language.C99.Pretty where

import Language.C99.AST

import Text.PrettyPrint
import Prelude hiding ((<>))


-- Binary operator
bin :: (Pretty a, Pretty b) => a -> String -> b -> Doc
bin :: a -> String -> b -> Doc
bin a
x String
op b
y = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x Doc -> Doc -> Doc
<+> String -> Doc
text String
op Doc -> Doc -> Doc
<+> b -> Doc
forall a. Pretty a => a -> Doc
pretty b
y

class Pretty a where
  pretty :: a -> Doc

instance Pretty a => Pretty (Maybe a) where
  pretty :: Maybe a -> Doc
pretty (Just a
x) = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x
  pretty Maybe a
Nothing  = Doc
empty

{- IDENTIFIERS -}
{- 6.4.2.1 -}
instance Pretty Ident where
  pretty :: Ident -> Doc
pretty (IdentBase           IdentNonDigit
idn) = IdentNonDigit -> Doc
forall a. Pretty a => a -> Doc
pretty IdentNonDigit
idn
  pretty (IdentConsNonDigit Ident
i IdentNonDigit
idn) = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i Doc -> Doc -> Doc
<> IdentNonDigit -> Doc
forall a. Pretty a => a -> Doc
pretty IdentNonDigit
idn
  pretty (IdentCons         Ident
i Digit
d  ) = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i Doc -> Doc -> Doc
<> Digit -> Doc
forall a. Pretty a => a -> Doc
pretty Digit
d

instance Pretty IdentNonDigit where
  pretty :: IdentNonDigit -> Doc
pretty (IdentNonDigit     NonDigit
nd ) = NonDigit -> Doc
forall a. Pretty a => a -> Doc
pretty NonDigit
nd
  pretty (IdentNonDigitUniv UnivCharName
ucn) = UnivCharName -> Doc
forall a. Pretty a => a -> Doc
pretty UnivCharName
ucn

instance Pretty NonDigit where
  pretty :: NonDigit -> Doc
pretty NonDigit
c = case NonDigit
c of
    NonDigit
NDUnderscore -> Char -> Doc
char Char
'_'
    NonDigit
NDa -> Char -> Doc
char Char
'a' ;      NonDigit
NDA -> Char -> Doc
char Char
'A'
    NonDigit
NDb -> Char -> Doc
char Char
'b' ;      NonDigit
NDB -> Char -> Doc
char Char
'B'
    NonDigit
NDc -> Char -> Doc
char Char
'c' ;      NonDigit
NDC -> Char -> Doc
char Char
'C'
    NonDigit
NDd -> Char -> Doc
char Char
'd' ;      NonDigit
NDD -> Char -> Doc
char Char
'D'
    NonDigit
NDe -> Char -> Doc
char Char
'e' ;      NonDigit
NDE -> Char -> Doc
char Char
'E'
    NonDigit
NDf -> Char -> Doc
char Char
'f' ;      NonDigit
NDF -> Char -> Doc
char Char
'F'
    NonDigit
NDg -> Char -> Doc
char Char
'g' ;      NonDigit
NDG -> Char -> Doc
char Char
'G'
    NonDigit
NDh -> Char -> Doc
char Char
'h' ;      NonDigit
NDH -> Char -> Doc
char Char
'H'
    NonDigit
NDi -> Char -> Doc
char Char
'i' ;      NonDigit
NDI -> Char -> Doc
char Char
'I'
    NonDigit
NDj -> Char -> Doc
char Char
'j' ;      NonDigit
NDJ -> Char -> Doc
char Char
'J'
    NonDigit
NDk -> Char -> Doc
char Char
'k' ;      NonDigit
NDK -> Char -> Doc
char Char
'K'
    NonDigit
NDl -> Char -> Doc
char Char
'l' ;      NonDigit
NDL -> Char -> Doc
char Char
'L'
    NonDigit
NDm -> Char -> Doc
char Char
'm' ;      NonDigit
NDM -> Char -> Doc
char Char
'M'
    NonDigit
NDn -> Char -> Doc
char Char
'n' ;      NonDigit
NDN -> Char -> Doc
char Char
'N'
    NonDigit
NDo -> Char -> Doc
char Char
'o' ;      NonDigit
NDO -> Char -> Doc
char Char
'O'
    NonDigit
NDp -> Char -> Doc
char Char
'p' ;      NonDigit
NDP -> Char -> Doc
char Char
'P'
    NonDigit
NDq -> Char -> Doc
char Char
'q' ;      NonDigit
NDQ -> Char -> Doc
char Char
'Q'
    NonDigit
NDr -> Char -> Doc
char Char
'r' ;      NonDigit
NDR -> Char -> Doc
char Char
'R'
    NonDigit
NDs -> Char -> Doc
char Char
's' ;      NonDigit
NDS -> Char -> Doc
char Char
'S'
    NonDigit
NDt -> Char -> Doc
char Char
't' ;      NonDigit
NDT -> Char -> Doc
char Char
'T'
    NonDigit
NDu -> Char -> Doc
char Char
'u' ;      NonDigit
NDU -> Char -> Doc
char Char
'U'
    NonDigit
NDv -> Char -> Doc
char Char
'v' ;      NonDigit
NDV -> Char -> Doc
char Char
'V'
    NonDigit
NDw -> Char -> Doc
char Char
'w' ;      NonDigit
NDW -> Char -> Doc
char Char
'W'
    NonDigit
NDx -> Char -> Doc
char Char
'x' ;      NonDigit
NDX -> Char -> Doc
char Char
'X'
    NonDigit
NDy -> Char -> Doc
char Char
'y' ;      NonDigit
NDY -> Char -> Doc
char Char
'Y'
    NonDigit
NDz -> Char -> Doc
char Char
'z' ;      NonDigit
NDZ -> Char -> Doc
char Char
'Z'

instance Pretty Digit where
  pretty :: Digit -> Doc
pretty Digit
c = case Digit
c of
    Digit
DZero  -> Int -> Doc
int Int
0
    Digit
DOne   -> Int -> Doc
int Int
1
    Digit
DTwo   -> Int -> Doc
int Int
2
    Digit
DThree -> Int -> Doc
int Int
3
    Digit
DFour  -> Int -> Doc
int Int
4
    Digit
DFive  -> Int -> Doc
int Int
5
    Digit
DSix   -> Int -> Doc
int Int
6
    Digit
DSeven -> Int -> Doc
int Int
7
    Digit
DEight -> Int -> Doc
int Int
8
    Digit
DNine  -> Int -> Doc
int Int
9


{- UNIVERSAL CHARACTER NAMES -}
{- 6.4.3 -}
instance Pretty UnivCharName where
  pretty :: UnivCharName -> Doc
pretty (UnivCharName1 HexQuad
hq     ) = String -> Doc
text String
"\\u" Doc -> Doc -> Doc
<> HexQuad -> Doc
forall a. Pretty a => a -> Doc
pretty HexQuad
hq
  pretty (UnivCharName2 HexQuad
hq1 HexQuad
hq2) = String -> Doc
text String
"\\U" Doc -> Doc -> Doc
<> HexQuad -> Doc
forall a. Pretty a => a -> Doc
pretty HexQuad
hq1 Doc -> Doc -> Doc
<> HexQuad -> Doc
forall a. Pretty a => a -> Doc
pretty HexQuad
hq2

instance Pretty HexQuad where
  pretty :: HexQuad -> Doc
pretty (HexQuad HexDigit
hd1 HexDigit
hd2 HexDigit
hd3 HexDigit
hd4) =  HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
hd1 Doc -> Doc -> Doc
<> HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
hd2
                                   Doc -> Doc -> Doc
<> HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
hd3 Doc -> Doc -> Doc
<> HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
hd4


{- CONSTANTS -}
{- 6.4.4 -}
instance Pretty Const where
  pretty :: Const -> Doc
pretty (ConstInt   IntConst
ic) = IntConst -> Doc
forall a. Pretty a => a -> Doc
pretty IntConst
ic
  pretty (ConstFloat FloatConst
fc) = FloatConst -> Doc
forall a. Pretty a => a -> Doc
pretty FloatConst
fc
  pretty (ConstEnum  EnumConst
ec) = EnumConst -> Doc
forall a. Pretty a => a -> Doc
pretty EnumConst
ec
  pretty (ConstChar  CharConst
cc) = CharConst -> Doc
forall a. Pretty a => a -> Doc
pretty CharConst
cc

{- 6.4.4.1 -}
instance Pretty IntConst where
  pretty :: IntConst -> Doc
pretty (IntDec DecConst
dc Maybe IntSuffix
mis) = DecConst -> Doc
forall a. Pretty a => a -> Doc
pretty DecConst
dc Doc -> Doc -> Doc
<> Maybe IntSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe IntSuffix
mis
  pretty (IntOc  OcConst
oc Maybe IntSuffix
mis) = OcConst -> Doc
forall a. Pretty a => a -> Doc
pretty OcConst
oc Doc -> Doc -> Doc
<> Maybe IntSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe IntSuffix
mis
  pretty (IntHex HexConst
hc Maybe IntSuffix
mis) = HexConst -> Doc
forall a. Pretty a => a -> Doc
pretty HexConst
hc Doc -> Doc -> Doc
<> Maybe IntSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe IntSuffix
mis

instance Pretty DecConst where
  pretty :: DecConst -> Doc
pretty (DecBase    NonZeroDigit
nzd) = NonZeroDigit -> Doc
forall a. Pretty a => a -> Doc
pretty NonZeroDigit
nzd
  pretty (DecCons DecConst
dc Digit
d  ) = DecConst -> Doc
forall a. Pretty a => a -> Doc
pretty DecConst
dc Doc -> Doc -> Doc
<> Digit -> Doc
forall a. Pretty a => a -> Doc
pretty Digit
d

instance Pretty OcConst where
  pretty :: OcConst -> Doc
pretty OcConst
Oc0            = Int -> Doc
int Int
0
  pretty (OcCons OcConst
oc OcDigit
od) = OcConst -> Doc
forall a. Pretty a => a -> Doc
pretty OcConst
oc Doc -> Doc -> Doc
<> OcDigit -> Doc
forall a. Pretty a => a -> Doc
pretty OcDigit
od

instance Pretty HexConst where
  pretty :: HexConst -> Doc
pretty (HexBase HexPrefix
prefix HexDigit
digit) = HexPrefix -> Doc
forall a. Pretty a => a -> Doc
pretty HexPrefix
prefix Doc -> Doc -> Doc
<> HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
digit
  pretty (HexCons HexConst
hexes HexDigit
digit)  = HexConst -> Doc
forall a. Pretty a => a -> Doc
pretty HexConst
hexes Doc -> Doc -> Doc
<> HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
digit

instance Pretty HexPrefix where
  pretty :: HexPrefix -> Doc
pretty HexPrefix
OX = String -> Doc
text String
"0x"

instance Pretty NonZeroDigit where
  pretty :: NonZeroDigit -> Doc
pretty NonZeroDigit
d = case NonZeroDigit
d of
    NonZeroDigit
NZOne   -> Int -> Doc
int Int
1
    NonZeroDigit
NZTwo   -> Int -> Doc
int Int
2
    NonZeroDigit
NZThree -> Int -> Doc
int Int
3
    NonZeroDigit
NZFour  -> Int -> Doc
int Int
4
    NonZeroDigit
NZFive  -> Int -> Doc
int Int
5
    NonZeroDigit
NZSix   -> Int -> Doc
int Int
6
    NonZeroDigit
NZSeven -> Int -> Doc
int Int
7
    NonZeroDigit
NZEight -> Int -> Doc
int Int
8
    NonZeroDigit
NZNine  -> Int -> Doc
int Int
9

instance Pretty OcDigit where
  pretty :: OcDigit -> Doc
pretty OcDigit
d = case OcDigit
d of
    OcDigit
OcZero  -> String -> Doc
text String
"0"
    OcDigit
OcOne   -> String -> Doc
text String
"1"
    OcDigit
OcTwo   -> String -> Doc
text String
"2"
    OcDigit
OcThree -> String -> Doc
text String
"3"
    OcDigit
OcFour  -> String -> Doc
text String
"4"
    OcDigit
OcFive  -> String -> Doc
text String
"5"
    OcDigit
OcSix   -> String -> Doc
text String
"6"
    OcDigit
OcSeven -> String -> Doc
text String
"7"

instance Pretty HexDigit where
  pretty :: HexDigit -> Doc
pretty HexDigit
HexZero  = String -> Doc
text String
"0"
  pretty HexDigit
HexOne   = String -> Doc
text String
"1"
  pretty HexDigit
HexTwo   = String -> Doc
text String
"2"
  pretty HexDigit
HexThree = String -> Doc
text String
"3"
  pretty HexDigit
HexFour  = String -> Doc
text String
"4"
  pretty HexDigit
HexFive  = String -> Doc
text String
"5"
  pretty HexDigit
HexSix   = String -> Doc
text String
"6"
  pretty HexDigit
HexSeven = String -> Doc
text String
"7"
  pretty HexDigit
HexEight = String -> Doc
text String
"8"
  pretty HexDigit
HexNine  = String -> Doc
text String
"9"
  pretty HexDigit
HexA     = String -> Doc
text String
"A"
  pretty HexDigit
HexB     = String -> Doc
text String
"B"
  pretty HexDigit
HexC     = String -> Doc
text String
"C"
  pretty HexDigit
HexD     = String -> Doc
text String
"D"
  pretty HexDigit
HexE     = String -> Doc
text String
"E"
  pretty HexDigit
HexF     = String -> Doc
text String
"F"

instance Pretty IntSuffix where
  pretty :: IntSuffix -> Doc
pretty (IntSuffixUnsignedLong     UnsignedSuffix
u  Maybe LongSuffix
ml) = UnsignedSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty UnsignedSuffix
u  Doc -> Doc -> Doc
<> Maybe LongSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe LongSuffix
ml
  pretty (IntSuffixUnsignedLongLong UnsignedSuffix
u  LongLongSuffix
ll) = UnsignedSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty UnsignedSuffix
u  Doc -> Doc -> Doc
<> LongLongSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty LongLongSuffix
ll
  pretty (IntSuffixLong             LongSuffix
l  Maybe UnsignedSuffix
mu) = LongSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty LongSuffix
l  Doc -> Doc -> Doc
<> Maybe UnsignedSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe UnsignedSuffix
mu
  pretty (IntSuffixLongLong         LongLongSuffix
ll Maybe UnsignedSuffix
mu) = LongLongSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty LongLongSuffix
ll Doc -> Doc -> Doc
<> Maybe UnsignedSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe UnsignedSuffix
mu

instance Pretty UnsignedSuffix where
  pretty :: UnsignedSuffix -> Doc
pretty UnsignedSuffix
U = Char -> Doc
char Char
'U'

instance Pretty LongSuffix     where
  pretty :: LongSuffix -> Doc
pretty LongSuffix
L = Char -> Doc
char Char
'L'

instance Pretty LongLongSuffix where
  pretty :: LongLongSuffix -> Doc
pretty LongLongSuffix
rL = String -> Doc
text String
"LL"

{- 6.4.4.2 -}
instance Pretty FloatConst where
  pretty :: FloatConst -> Doc
pretty (FloatDec DecFloatConst
dfc) = DecFloatConst -> Doc
forall a. Pretty a => a -> Doc
pretty DecFloatConst
dfc
  pretty (FloatHex HexFloatConst
hfc) = HexFloatConst -> Doc
forall a. Pretty a => a -> Doc
pretty HexFloatConst
hfc

instance Pretty DecFloatConst where
  pretty :: DecFloatConst -> Doc
pretty (DecFloatFrac   FracConst
fc Maybe ExpPart
me Maybe FloatSuffix
mfs) = FracConst -> Doc
forall a. Pretty a => a -> Doc
pretty FracConst
fc Doc -> Doc -> Doc
<> Maybe ExpPart -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe ExpPart
me Doc -> Doc -> Doc
<> Maybe FloatSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe FloatSuffix
mfs
  pretty (DecFloatDigits DigitSeq
ds ExpPart
ep Maybe FloatSuffix
mfs) = DigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty DigitSeq
ds Doc -> Doc -> Doc
<> ExpPart -> Doc
forall a. Pretty a => a -> Doc
pretty ExpPart
ep Doc -> Doc -> Doc
<> Maybe FloatSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe FloatSuffix
mfs

instance Pretty HexFloatConst where
  pretty :: HexFloatConst -> Doc
pretty (HexFloatFrac   HexPrefix
hp HexFracConst
hfc BinExpPart
bep Maybe FloatSuffix
mfs) =
    HexPrefix -> Doc
forall a. Pretty a => a -> Doc
pretty HexPrefix
hp Doc -> Doc -> Doc
<> HexFracConst -> Doc
forall a. Pretty a => a -> Doc
pretty HexFracConst
hfc Doc -> Doc -> Doc
<> BinExpPart -> Doc
forall a. Pretty a => a -> Doc
pretty BinExpPart
bep Doc -> Doc -> Doc
<> Maybe FloatSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe FloatSuffix
mfs
  pretty (HexFloatDigits HexPrefix
hp HexDigitSeq
hds BinExpPart
bep Maybe FloatSuffix
mfs) =
    HexPrefix -> Doc
forall a. Pretty a => a -> Doc
pretty HexPrefix
hp Doc -> Doc -> Doc
<> HexDigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigitSeq
hds Doc -> Doc -> Doc
<> BinExpPart -> Doc
forall a. Pretty a => a -> Doc
pretty BinExpPart
bep Doc -> Doc -> Doc
<> Maybe FloatSuffix -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe FloatSuffix
mfs

instance Pretty FracConst where
  pretty :: FracConst -> Doc
pretty (FracZero Maybe DigitSeq
mds DigitSeq
ds) = Maybe DigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DigitSeq
mds Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> DigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty DigitSeq
ds
  pretty (Frac         DigitSeq
ds) = DigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty DigitSeq
ds Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.'

instance Pretty ExpPart where
  pretty :: ExpPart -> Doc
pretty (E Maybe Sign
ms DigitSeq
ds) = Char -> Doc
char Char
'e' Doc -> Doc -> Doc
<> Maybe Sign -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Sign
ms Doc -> Doc -> Doc
<> DigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty DigitSeq
ds

instance Pretty Sign where
  pretty :: Sign -> Doc
pretty Sign
SPlus  = Char -> Doc
char Char
'+'
  pretty Sign
SMinus = Char -> Doc
char Char
'-'

instance Pretty DigitSeq where
  pretty :: DigitSeq -> Doc
pretty (DigitBase    Digit
d) = Digit -> Doc
forall a. Pretty a => a -> Doc
pretty Digit
d
  pretty (DigitCons DigitSeq
ds Digit
d) = DigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty DigitSeq
ds Doc -> Doc -> Doc
<> Digit -> Doc
forall a. Pretty a => a -> Doc
pretty Digit
d

instance Pretty HexFracConst where
  pretty :: HexFracConst -> Doc
pretty (HexFracZero Maybe HexDigitSeq
mhds HexDigitSeq
hds) = Maybe HexDigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe HexDigitSeq
mhds Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> HexDigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigitSeq
hds
  pretty (HexFrac          HexDigitSeq
hds) = HexDigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigitSeq
hds Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.'

instance Pretty BinExpPart where
  pretty :: BinExpPart -> Doc
pretty (P Maybe Sign
ms DigitSeq
ds) = Char -> Doc
char Char
'p' Doc -> Doc -> Doc
<> Maybe Sign -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Sign
ms Doc -> Doc -> Doc
<> DigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty DigitSeq
ds

instance Pretty HexDigitSeq where
  pretty :: HexDigitSeq -> Doc
pretty (HexDigitBase     HexDigit
hd) = HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
hd
  pretty (HexDigitCons HexDigitSeq
hds HexDigit
hd) = HexDigitSeq -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigitSeq
hds Doc -> Doc -> Doc
<> HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
hd

instance Pretty FloatSuffix where
  pretty :: FloatSuffix -> Doc
pretty FloatSuffix
FF = Char -> Doc
char Char
'f'
  pretty FloatSuffix
FL = Char -> Doc
char Char
'l'

{- 6.4.4.3 -}
instance Pretty EnumConst where
  pretty :: EnumConst -> Doc
pretty (Enum Ident
i) = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i

{- 6.4.4.4 -}
instance Pretty CharConst where
  pretty :: CharConst -> Doc
pretty (Char CCharSeq
charSeq)  = Doc -> Doc
quotes (CCharSeq -> Doc
forall a. Pretty a => a -> Doc
pretty CCharSeq
charSeq)
  pretty (CharL CCharSeq
charSeq) = Char -> Doc
char Char
'L' Doc -> Doc -> Doc
<> Doc -> Doc
quotes (CCharSeq -> Doc
forall a. Pretty a => a -> Doc
pretty CCharSeq
charSeq)

instance Pretty CCharSeq where
  pretty :: CCharSeq -> Doc
pretty (CCharBase CChar
cchar)      = CChar -> Doc
forall a. Pretty a => a -> Doc
pretty CChar
cchar
  pretty (CCharCons CCharSeq
cseq CChar
cchar) = CCharSeq -> Doc
forall a. Pretty a => a -> Doc
pretty CCharSeq
cseq Doc -> Doc -> Doc
<> CChar -> Doc
forall a. Pretty a => a -> Doc
pretty CChar
cchar

instance Pretty CChar where
  pretty :: CChar -> Doc
pretty (CChar Char
ch)        = Char -> Doc
char Char
ch
  pretty (CCharEsc EscSeq
escSeq) = EscSeq -> Doc
forall a. Pretty a => a -> Doc
pretty EscSeq
escSeq

instance Pretty EscSeq where
  pretty :: EscSeq -> Doc
pretty (EscSimple SimpleEscSeq
se) = SimpleEscSeq -> Doc
forall a. Pretty a => a -> Doc
pretty SimpleEscSeq
se

instance Pretty SimpleEscSeq where
  pretty :: SimpleEscSeq -> Doc
pretty SimpleEscSeq
esc = case SimpleEscSeq
esc of
    SimpleEscSeq
SEQuote     -> String -> Doc
text String
"\\\'"
    SimpleEscSeq
SEDQuote    -> String -> Doc
text String
"\\\""
    SimpleEscSeq
SEQuestion  -> String -> Doc
text String
"\\?"
    SimpleEscSeq
SEBackSlash -> String -> Doc
text String
"\\\\"
    SimpleEscSeq
SEa         -> String -> Doc
text String
"\\a"
    SimpleEscSeq
SEb         -> String -> Doc
text String
"\\b"
    SimpleEscSeq
SEf         -> String -> Doc
text String
"\\f"
    SimpleEscSeq
SEn         -> String -> Doc
text String
"\\n"
    SimpleEscSeq
SEr         -> String -> Doc
text String
"\\r"
    SimpleEscSeq
SEt         -> String -> Doc
text String
"\\t"
    SimpleEscSeq
SEv         -> String -> Doc
text String
"\\v"

instance Pretty OcEscSeq where
  pretty :: OcEscSeq -> Doc
pretty (OcEsc1 OcDigit
od) = Char -> Doc
char Char
'\\' Doc -> Doc -> Doc
<> OcDigit -> Doc
forall a. Pretty a => a -> Doc
pretty OcDigit
od
  pretty (OcEsc2 OcDigit
od1 OcDigit
od2) = Char -> Doc
char Char
'\\' Doc -> Doc -> Doc
<> OcDigit -> Doc
forall a. Pretty a => a -> Doc
pretty OcDigit
od1 Doc -> Doc -> Doc
<> OcDigit -> Doc
forall a. Pretty a => a -> Doc
pretty OcDigit
od2
  pretty (OcEsc3 OcDigit
od1 OcDigit
od2 OcDigit
od3) = Char -> Doc
char Char
'\\' Doc -> Doc -> Doc
<> OcDigit -> Doc
forall a. Pretty a => a -> Doc
pretty OcDigit
od1 Doc -> Doc -> Doc
<> OcDigit -> Doc
forall a. Pretty a => a -> Doc
pretty OcDigit
od2 Doc -> Doc -> Doc
<> OcDigit -> Doc
forall a. Pretty a => a -> Doc
pretty OcDigit
od3

instance Pretty HexEscSeq where
  pretty :: HexEscSeq -> Doc
pretty (HexEscBase HexDigit
hd) = String -> Doc
text String
"\\x" Doc -> Doc -> Doc
<> HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
hd
  pretty (HexEscCons HexEscSeq
hs HexDigit
hd) = HexEscSeq -> Doc
forall a. Pretty a => a -> Doc
pretty HexEscSeq
hs Doc -> Doc -> Doc
<> HexDigit -> Doc
forall a. Pretty a => a -> Doc
pretty HexDigit
hd

{- STRING LITERALS -}
{- 6.4.5 -}
instance Pretty StringLit where
  pretty :: StringLit -> Doc
pretty (StringLit  Maybe SCharSeq
mcs) =             Doc -> Doc
doubleQuotes (Maybe SCharSeq -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe SCharSeq
mcs)
  pretty (StringLitL Maybe SCharSeq
mcs) = Char -> Doc
char Char
'L' Doc -> Doc -> Doc
<> Doc -> Doc
doubleQuotes (Maybe SCharSeq -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe SCharSeq
mcs)

instance Pretty SCharSeq where
  pretty :: SCharSeq -> Doc
pretty (SCharBase SChar
sc    ) = SChar -> Doc
forall a. Pretty a => a -> Doc
pretty SChar
sc
  pretty (SCharCons SCharSeq
scs SChar
sc) = SCharSeq -> Doc
forall a. Pretty a => a -> Doc
pretty SCharSeq
scs Doc -> Doc -> Doc
<> SChar -> Doc
forall a. Pretty a => a -> Doc
pretty SChar
sc

instance Pretty SChar where
  pretty :: SChar -> Doc
pretty (SChar    Char
c ) = Char -> Doc
char Char
c
  pretty (SCharEsc EscSeq
es) = EscSeq -> Doc
forall a. Pretty a => a -> Doc
pretty EscSeq
es


{- EXPRESSIONS -}
{- 6.5.1 -}
instance Pretty PrimExpr where
  pretty :: PrimExpr -> Doc
pretty (PrimIdent  Ident
i ) = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i
  pretty (PrimConst  Const
c ) = Const -> Doc
forall a. Pretty a => a -> Doc
pretty Const
c
  pretty (PrimString StringLit
sl) = StringLit -> Doc
forall a. Pretty a => a -> Doc
pretty StringLit
sl
  pretty (PrimExpr   Expr
e ) = Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
e)

{- 6.5.2 -}
instance Pretty PostfixExpr where
  pretty :: PostfixExpr -> Doc
pretty (PostfixPrim     PrimExpr
pe     ) = PrimExpr -> Doc
forall a. Pretty a => a -> Doc
pretty PrimExpr
pe
  pretty (PostfixIndex    PostfixExpr
pe Expr
e   ) = PostfixExpr -> Doc
forall a. Pretty a => a -> Doc
pretty PostfixExpr
pe Doc -> Doc -> Doc
<> Doc -> Doc
brackets (Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
e)
  pretty (PostfixFunction PostfixExpr
pe Maybe ArgExprList
mael) = PostfixExpr -> Doc
forall a. Pretty a => a -> Doc
pretty PostfixExpr
pe Doc -> Doc -> Doc
<> Doc -> Doc
parens (Maybe ArgExprList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe ArgExprList
mael)
  pretty (PostfixDot      PostfixExpr
pe Ident
i   ) = PostfixExpr -> Doc
forall a. Pretty a => a -> Doc
pretty PostfixExpr
pe Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i
  pretty (PostfixArrow    PostfixExpr
pe Ident
i   ) = PostfixExpr -> Doc
forall a. Pretty a => a -> Doc
pretty PostfixExpr
pe Doc -> Doc -> Doc
<> String -> Doc
text String
"->" Doc -> Doc -> Doc
<> Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i
  pretty (PostfixInc      PostfixExpr
pe     ) = PostfixExpr -> Doc
forall a. Pretty a => a -> Doc
pretty PostfixExpr
pe Doc -> Doc -> Doc
<> String -> Doc
text String
"++"
  pretty (PostfixDec      PostfixExpr
pe     ) = PostfixExpr -> Doc
forall a. Pretty a => a -> Doc
pretty PostfixExpr
pe Doc -> Doc -> Doc
<> String -> Doc
text String
"--"
  pretty (PostfixInits    TypeName
tn InitList
il  ) = Doc -> Doc
parens (TypeName -> Doc
forall a. Pretty a => a -> Doc
pretty TypeName
tn) Doc -> Doc -> Doc
<> Doc -> Doc
braces (InitList -> Doc
forall a. Pretty a => a -> Doc
pretty InitList
il)

instance Pretty ArgExprList where
  pretty :: ArgExprList -> Doc
pretty (ArgExprListBase     AssignExpr
ae) = AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae
  pretty (ArgExprListCons ArgExprList
ael AssignExpr
ae) = ArgExprList -> Doc
forall a. Pretty a => a -> Doc
pretty ArgExprList
ael Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae

{- 6.5.3 -}
instance Pretty UnaryExpr where
  pretty :: UnaryExpr -> Doc
pretty (UnaryPostfix  PostfixExpr
pe   ) = PostfixExpr -> Doc
forall a. Pretty a => a -> Doc
pretty PostfixExpr
pe
  pretty (UnaryInc      UnaryExpr
ue   ) = String -> Doc
text String
"++" Doc -> Doc -> Doc
<> UnaryExpr -> Doc
forall a. Pretty a => a -> Doc
pretty UnaryExpr
ue
  pretty (UnaryDec      UnaryExpr
ue   ) = String -> Doc
text String
"--" Doc -> Doc -> Doc
<> UnaryExpr -> Doc
forall a. Pretty a => a -> Doc
pretty UnaryExpr
ue
  pretty (UnaryOp       UnaryOp
op CastExpr
ce) = UnaryOp -> Doc
forall a. Pretty a => a -> Doc
pretty UnaryOp
op Doc -> Doc -> Doc
<> CastExpr -> Doc
forall a. Pretty a => a -> Doc
pretty CastExpr
ce
  pretty (UnarySizeExpr UnaryExpr
ue   ) = String -> Doc
text String
"sizeof" Doc -> Doc -> Doc
<+> UnaryExpr -> Doc
forall a. Pretty a => a -> Doc
pretty UnaryExpr
ue
  pretty (UnarySizeType TypeName
tn   ) = String -> Doc
text String
"sizeof" Doc -> Doc -> Doc
<> Doc -> Doc
parens (TypeName -> Doc
forall a. Pretty a => a -> Doc
pretty TypeName
tn)

instance Pretty UnaryOp where
  pretty :: UnaryOp -> Doc
pretty UnaryOp
op = case UnaryOp
op of
    UnaryOp
UORef   -> Char -> Doc
char Char
'&'
    UnaryOp
UODeref -> Char -> Doc
char Char
'*'
    UnaryOp
UOPlus  -> Char -> Doc
char Char
'+'
    UnaryOp
UOMin   -> Char -> Doc
char Char
'-'
    UnaryOp
UOBNot  -> Char -> Doc
char Char
'~'
    UnaryOp
UONot   -> Char -> Doc
char Char
'!'

{- 6.5.4 -}
instance Pretty CastExpr where
  pretty :: CastExpr -> Doc
pretty (CastUnary UnaryExpr
ue) = UnaryExpr -> Doc
forall a. Pretty a => a -> Doc
pretty UnaryExpr
ue
  pretty (Cast TypeName
tn CastExpr
ce)   = Doc -> Doc
parens (TypeName -> Doc
forall a. Pretty a => a -> Doc
pretty TypeName
tn) Doc -> Doc -> Doc
<> CastExpr -> Doc
forall a. Pretty a => a -> Doc
pretty CastExpr
ce

{- 6.5.5 -}
instance Pretty MultExpr where
  pretty :: MultExpr -> Doc
pretty (MultCast    CastExpr
ce) = CastExpr -> Doc
forall a. Pretty a => a -> Doc
pretty CastExpr
ce
  pretty (MultMult MultExpr
me CastExpr
ce) = MultExpr -> String -> CastExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin MultExpr
me String
"*" CastExpr
ce
  pretty (MultDiv  MultExpr
me CastExpr
ce) = MultExpr -> String -> CastExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin MultExpr
me String
"/" CastExpr
ce
  pretty (MultMod  MultExpr
me CastExpr
ce) = MultExpr -> String -> CastExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin MultExpr
me String
"%" CastExpr
ce

{- 6.5.6 -}
instance Pretty AddExpr where
  pretty :: AddExpr -> Doc
pretty (AddMult    MultExpr
me) = MultExpr -> Doc
forall a. Pretty a => a -> Doc
pretty MultExpr
me
  pretty (AddPlus AddExpr
ae MultExpr
me) = AddExpr -> String -> MultExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin AddExpr
ae String
"+" MultExpr
me
  pretty (AddMin  AddExpr
ae MultExpr
me) = AddExpr -> String -> MultExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin AddExpr
ae String
"-" MultExpr
me

{- 6.5.7 -}
instance Pretty ShiftExpr where
  pretty :: ShiftExpr -> Doc
pretty (ShiftAdd         AddExpr
add) = AddExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AddExpr
add
  pretty (ShiftLeft  ShiftExpr
shift AddExpr
add) = ShiftExpr -> String -> AddExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin ShiftExpr
shift String
"<<" AddExpr
add
  pretty (ShiftRight ShiftExpr
shift AddExpr
add) = ShiftExpr -> String -> AddExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin ShiftExpr
shift String
">>" AddExpr
add

{- 6.5.8 -}
instance Pretty RelExpr where
  pretty :: RelExpr -> Doc
pretty (RelShift     ShiftExpr
shift) = ShiftExpr -> Doc
forall a. Pretty a => a -> Doc
pretty ShiftExpr
shift
  pretty (RelLT    RelExpr
rel ShiftExpr
shift) = RelExpr -> String -> ShiftExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin RelExpr
rel String
"<"  ShiftExpr
shift
  pretty (RelGT    RelExpr
rel ShiftExpr
shift) = RelExpr -> String -> ShiftExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin RelExpr
rel String
">"  ShiftExpr
shift
  pretty (RelLE    RelExpr
rel ShiftExpr
shift) = RelExpr -> String -> ShiftExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin RelExpr
rel String
"<=" ShiftExpr
shift
  pretty (RelGE    RelExpr
rel ShiftExpr
shift) = RelExpr -> String -> ShiftExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin RelExpr
rel String
">=" ShiftExpr
shift

{- 6.5.9 -}
instance Pretty EqExpr where
  pretty :: EqExpr -> Doc
pretty (EqRel    RelExpr
rel) = RelExpr -> Doc
forall a. Pretty a => a -> Doc
pretty RelExpr
rel
  pretty (EqEq  EqExpr
eq RelExpr
rel) = EqExpr -> String -> RelExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin EqExpr
eq String
"==" RelExpr
rel
  pretty (EqNEq EqExpr
eq RelExpr
rel) = EqExpr -> String -> RelExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin EqExpr
eq String
"!=" RelExpr
rel

{- 6.5.10 -}
instance Pretty AndExpr where
  pretty :: AndExpr -> Doc
pretty (AndEq     EqExpr
eq) = EqExpr -> Doc
forall a. Pretty a => a -> Doc
pretty EqExpr
eq
  pretty (And   AndExpr
and EqExpr
eq) = AndExpr -> String -> EqExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin AndExpr
and String
"&" EqExpr
eq

{- 6.5.11 -}
instance Pretty XOrExpr where
  pretty :: XOrExpr -> Doc
pretty (XOrAnd     AndExpr
and) = AndExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AndExpr
and
  pretty (XOr    XOrExpr
xor AndExpr
and) = XOrExpr -> String -> AndExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin XOrExpr
xor String
"^" AndExpr
and

{- 6.5.12 -}
instance Pretty OrExpr where
  pretty :: OrExpr -> Doc
pretty (OrXOr    XOrExpr
xor) = XOrExpr -> Doc
forall a. Pretty a => a -> Doc
pretty XOrExpr
xor
  pretty (Or    OrExpr
or XOrExpr
xor) = OrExpr -> String -> XOrExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin OrExpr
or String
"|" XOrExpr
xor

{- 6.5.13 -}
instance Pretty LAndExpr where
  pretty :: LAndExpr -> Doc
pretty (LAndOr     OrExpr
or) = OrExpr -> Doc
forall a. Pretty a => a -> Doc
pretty OrExpr
or
  pretty (LAnd   LAndExpr
and OrExpr
or) = LAndExpr -> String -> OrExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin LAndExpr
and String
"&&" OrExpr
or

{- 6.5.14 -}
instance Pretty LOrExpr where
  pretty :: LOrExpr -> Doc
pretty (LOrAnd    LAndExpr
and) = LAndExpr -> Doc
forall a. Pretty a => a -> Doc
pretty LAndExpr
and
  pretty (LOr    LOrExpr
or LAndExpr
and) = LOrExpr -> String -> LAndExpr -> Doc
forall a b. (Pretty a, Pretty b) => a -> String -> b -> Doc
bin LOrExpr
or String
"||" LAndExpr
and

{- 6.5.15 -}
instance Pretty CondExpr where
  pretty :: CondExpr -> Doc
pretty (CondLOr LOrExpr
le     ) = LOrExpr -> Doc
forall a. Pretty a => a -> Doc
pretty LOrExpr
le
  pretty (Cond    LOrExpr
le Expr
e CondExpr
ce) = LOrExpr -> Doc
forall a. Pretty a => a -> Doc
pretty LOrExpr
le Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
e Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> CondExpr -> Doc
forall a. Pretty a => a -> Doc
pretty CondExpr
ce

{- 6.5.16 -}
instance Pretty AssignExpr where
  pretty :: AssignExpr -> Doc
pretty (AssignCond CondExpr
ce)   = CondExpr -> Doc
forall a. Pretty a => a -> Doc
pretty CondExpr
ce
  pretty (Assign UnaryExpr
ue AssignOp
op AssignExpr
ae) = UnaryExpr -> Doc
forall a. Pretty a => a -> Doc
pretty UnaryExpr
ue Doc -> Doc -> Doc
<+> AssignOp -> Doc
forall a. Pretty a => a -> Doc
pretty AssignOp
op Doc -> Doc -> Doc
<+> AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae

instance Pretty AssignOp where
  pretty :: AssignOp -> Doc
pretty AssignOp
op = case AssignOp
op of
    AssignOp
AEq     -> String -> Doc
text String
"="
    AssignOp
ATimes  -> String -> Doc
text String
"*="
    AssignOp
ADiv    -> String -> Doc
text String
"/="
    AssignOp
AMod    -> String -> Doc
text String
"%="
    AssignOp
AAdd    -> String -> Doc
text String
"+="
    AssignOp
ASub    -> String -> Doc
text String
"-="
    AssignOp
AShiftL -> String -> Doc
text String
"<<="
    AssignOp
AShiftR -> String -> Doc
text String
">>="
    AssignOp
AAnd    -> String -> Doc
text String
"&="
    AssignOp
AXOr    -> String -> Doc
text String
"^="
    AssignOp
AOr     -> String -> Doc
text String
"|="

{- 6.5.17 -}
instance Pretty Expr where
  pretty :: Expr -> Doc
pretty (ExprAssign   AssignExpr
ae) = AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae
  pretty (Expr       Expr
e AssignExpr
ae) = Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
e Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae

{- 6.6 -}
instance Pretty ConstExpr where
  pretty :: ConstExpr -> Doc
pretty (Const CondExpr
ce) = CondExpr -> Doc
forall a. Pretty a => a -> Doc
pretty CondExpr
ce


{- DECLARATIONS -}
{- 6.7 -}
instance Pretty Decln where
  pretty :: Decln -> Doc
pretty (Decln DeclnSpecs
ds Maybe InitDeclrList
midl) = DeclnSpecs -> Doc
forall a. Pretty a => a -> Doc
pretty DeclnSpecs
ds Doc -> Doc -> Doc
<+> Maybe InitDeclrList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe InitDeclrList
midl

instance Pretty DeclnSpecs where
  pretty :: DeclnSpecs -> Doc
pretty (DeclnSpecsStorage StorageClassSpec
scs Maybe DeclnSpecs
mds) = StorageClassSpec -> Doc
forall a. Pretty a => a -> Doc
pretty StorageClassSpec
scs Doc -> Doc -> Doc
<+> Maybe DeclnSpecs -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DeclnSpecs
mds
  pretty (DeclnSpecsType    TypeSpec
ts  Maybe DeclnSpecs
mds) = TypeSpec -> Doc
forall a. Pretty a => a -> Doc
pretty TypeSpec
ts  Doc -> Doc -> Doc
<+> Maybe DeclnSpecs -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DeclnSpecs
mds
  pretty (DeclnSpecsQual    TypeQual
tq  Maybe DeclnSpecs
mds) = TypeQual -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQual
tq  Doc -> Doc -> Doc
<+> Maybe DeclnSpecs -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DeclnSpecs
mds
  pretty (DeclnSpecsFun     FunSpec
fs  Maybe DeclnSpecs
mds) = FunSpec -> Doc
forall a. Pretty a => a -> Doc
pretty FunSpec
fs  Doc -> Doc -> Doc
<+> Maybe DeclnSpecs -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DeclnSpecs
mds

instance Pretty InitDeclrList where
  pretty :: InitDeclrList -> Doc
pretty (InitDeclrBase     InitDeclr
id) = InitDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty InitDeclr
id
  pretty (InitDeclrCons InitDeclrList
idl InitDeclr
id) = InitDeclrList -> Doc
forall a. Pretty a => a -> Doc
pretty InitDeclrList
idl Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> InitDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty InitDeclr
id

instance Pretty InitDeclr where
  pretty :: InitDeclr -> Doc
pretty (InitDeclr      Declr
d  ) = Declr -> Doc
forall a. Pretty a => a -> Doc
pretty Declr
d
  pretty (InitDeclrInitr Declr
d Init
i) = Declr -> Doc
forall a. Pretty a => a -> Doc
pretty Declr
d Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Init -> Doc
forall a. Pretty a => a -> Doc
pretty Init
i

{- 6.7.1 -}
instance Pretty StorageClassSpec where
  pretty :: StorageClassSpec -> Doc
pretty StorageClassSpec
c = case StorageClassSpec
c of
    StorageClassSpec
STypedef  -> String -> Doc
text String
"typedef"
    StorageClassSpec
SExtern   -> String -> Doc
text String
"extern"
    StorageClassSpec
SStatic   -> String -> Doc
text String
"static"
    StorageClassSpec
SAuto     -> String -> Doc
text String
"auto"
    StorageClassSpec
SRegister -> String -> Doc
text String
"register"

{- 6.7.2 -}
instance Pretty TypeSpec where
  pretty :: TypeSpec -> Doc
pretty TypeSpec
ty = case TypeSpec
ty of
    TypeSpec
TVoid               -> String -> Doc
text String
"void"
    TypeSpec
TChar               -> String -> Doc
text String
"char"
    TypeSpec
TShort              -> String -> Doc
text String
"short"
    TypeSpec
TInt                -> String -> Doc
text String
"int"
    TypeSpec
TLong               -> String -> Doc
text String
"long"
    TypeSpec
TFloat              -> String -> Doc
text String
"float"
    TypeSpec
TDouble             -> String -> Doc
text String
"double"
    TypeSpec
TSigned             -> String -> Doc
text String
"signed"
    TypeSpec
TUnsigned           -> String -> Doc
text String
"unsigned"
    TypeSpec
TBool               -> String -> Doc
text String
"_Bool"
    TypeSpec
TComplex            -> String -> Doc
text String
"_Complex"
    TStructOrUnion StructOrUnionSpec
sous -> StructOrUnionSpec -> Doc
forall a. Pretty a => a -> Doc
pretty StructOrUnionSpec
sous
    TEnum          EnumSpec
es   -> EnumSpec -> Doc
forall a. Pretty a => a -> Doc
pretty EnumSpec
es
    TTypedef       TypedefName
tn   -> TypedefName -> Doc
forall a. Pretty a => a -> Doc
pretty TypedefName
tn

{- 6.7.2.1 -}
instance Pretty StructOrUnionSpec where
  pretty :: StructOrUnionSpec -> Doc
pretty (StructOrUnionDecln     StructOrUnion
sou Maybe Ident
mi StructDeclnList
sdl) =
    [Doc] -> Doc
vcat [StructOrUnion -> Doc
forall a. Pretty a => a -> Doc
pretty StructOrUnion
sou Doc -> Doc -> Doc
<+> Maybe Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Ident
mi, Doc
lbrace, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ StructDeclnList -> Doc
forall a. Pretty a => a -> Doc
pretty StructDeclnList
sdl, Doc
rbrace]
  pretty (StructOrUnionForwDecln StructOrUnion
sou Ident
i     ) =
    StructOrUnion -> Doc
forall a. Pretty a => a -> Doc
pretty StructOrUnion
sou Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i

instance Pretty StructOrUnion where
  pretty :: StructOrUnion -> Doc
pretty StructOrUnion
Struct = String -> Doc
text String
"struct"
  pretty StructOrUnion
Union  = String -> Doc
text String
"union"

instance Pretty StructDeclnList where
  pretty :: StructDeclnList -> Doc
pretty (StructDeclnBase StructDecln
sd    ) = StructDecln -> Doc
forall a. Pretty a => a -> Doc
pretty StructDecln
sd
  pretty (StructDeclnCons StructDeclnList
sdl StructDecln
sd) = StructDeclnList -> Doc
forall a. Pretty a => a -> Doc
pretty StructDeclnList
sdl Doc -> Doc -> Doc
$+$ StructDecln -> Doc
forall a. Pretty a => a -> Doc
pretty StructDecln
sd

instance Pretty StructDecln where
  pretty :: StructDecln -> Doc
pretty (StructDecln SpecQualList
sql StructDeclrList
sdl) = SpecQualList -> Doc
forall a. Pretty a => a -> Doc
pretty SpecQualList
sql Doc -> Doc -> Doc
<+> StructDeclrList -> Doc
forall a. Pretty a => a -> Doc
pretty StructDeclrList
sdl Doc -> Doc -> Doc
<> Char -> Doc
char Char
';'

instance Pretty SpecQualList where
  pretty :: SpecQualList -> Doc
pretty (SpecQualType TypeSpec
ts Maybe SpecQualList
msql) = TypeSpec -> Doc
forall a. Pretty a => a -> Doc
pretty TypeSpec
ts Doc -> Doc -> Doc
<+> Maybe SpecQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe SpecQualList
msql
  pretty (SpecQualQual TypeQual
tq Maybe SpecQualList
msql) = TypeQual -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQual
tq Doc -> Doc -> Doc
<+> Maybe SpecQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe SpecQualList
msql

instance Pretty StructDeclrList where
  pretty :: StructDeclrList -> Doc
pretty (StructDeclrBase     StructDeclr
sd) = StructDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty StructDeclr
sd
  pretty (StructDeclrCons StructDeclrList
sdl StructDeclr
sd) = StructDeclrList -> Doc
forall a. Pretty a => a -> Doc
pretty StructDeclrList
sdl Doc -> Doc -> Doc
<+> Char -> Doc
char Char
',' Doc -> Doc -> Doc
<+> StructDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty StructDeclr
sd

instance Pretty StructDeclr where
  pretty :: StructDeclr -> Doc
pretty (StructDeclr    Declr
d    ) = Declr -> Doc
forall a. Pretty a => a -> Doc
pretty Declr
d
  pretty (StructDeclrBit Maybe Declr
md ConstExpr
ce) = Maybe Declr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Declr
md Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> ConstExpr -> Doc
forall a. Pretty a => a -> Doc
pretty ConstExpr
ce

{- 6.7.2.2 -}
instance Pretty EnumSpec where
  pretty :: EnumSpec -> Doc
pretty (EnumSpec Maybe Ident
mident EnumrList
enumrlist) = String -> Doc
text String
"enum" Doc -> Doc -> Doc
<+> Maybe Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Ident
mident Doc -> Doc -> Doc
<+> Doc -> Doc
braces (EnumrList -> Doc
forall a. Pretty a => a -> Doc
pretty EnumrList
enumrlist)
  pretty (EnumSpecForw Ident
ident)        = String -> Doc
text String
"enum" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
ident

instance Pretty EnumrList where
  pretty :: EnumrList -> Doc
pretty (EnumrBase Enumr
enumr)    = Enumr -> Doc
forall a. Pretty a => a -> Doc
pretty Enumr
enumr
  pretty (EnumrCons EnumrList
el Enumr
enumr) = EnumrList -> Doc
forall a. Pretty a => a -> Doc
pretty EnumrList
el Doc -> Doc -> Doc
<+> Char -> Doc
char Char
',' Doc -> Doc -> Doc
<+> Enumr -> Doc
forall a. Pretty a => a -> Doc
pretty Enumr
enumr

instance Pretty Enumr where
  pretty :: Enumr -> Doc
pretty (Enumr (Enum Ident
ident))          = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
ident
  pretty (EnumrInit (Enum Ident
ident) ConstExpr
expr) = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
ident Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> ConstExpr -> Doc
forall a. Pretty a => a -> Doc
pretty ConstExpr
expr

{- 6.7.3 -}
instance Pretty TypeQual where
  pretty :: TypeQual -> Doc
pretty TypeQual
q = case TypeQual
q of
    TypeQual
QConst    -> String -> Doc
text String
"const"
    TypeQual
QRestrict -> String -> Doc
text String
"restrict"
    TypeQual
QVolatile -> String -> Doc
text String
"volatile"

{- 6.7.4 -}
instance Pretty FunSpec where
  pretty :: FunSpec -> Doc
pretty FunSpec
SpecInline = String -> Doc
text String
"inline"

{- 6.7.5 -}
instance Pretty Declr where
  pretty :: Declr -> Doc
pretty (Declr Maybe Ptr
mptr DirectDeclr
dd) = Maybe Ptr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Ptr
mptr Doc -> Doc -> Doc
<+> DirectDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty DirectDeclr
dd

instance Pretty DirectDeclr where
  pretty :: DirectDeclr -> Doc
pretty (DirectDeclrIdent  Ident
i        ) = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i
  pretty (DirectDeclrDeclr  Declr
d        ) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Declr -> Doc
forall a. Pretty a => a -> Doc
pretty Declr
d
  pretty (DirectDeclrArray1 DirectDeclr
d Maybe TypeQualList
mtl Maybe AssignExpr
mae) = DirectDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty DirectDeclr
d Doc -> Doc -> Doc
<> Doc -> Doc
brackets (Maybe TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TypeQualList
mtl Doc -> Doc -> Doc
<+> Maybe AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe AssignExpr
mae)
  pretty (DirectDeclrArray2 DirectDeclr
d Maybe TypeQualList
mtl AssignExpr
ae ) = DirectDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty DirectDeclr
d Doc -> Doc -> Doc
<> Doc -> Doc
brackets (String -> Doc
text String
"static" Doc -> Doc -> Doc
<+> Maybe TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TypeQualList
mtl Doc -> Doc -> Doc
<+> AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae)
  pretty (DirectDeclrArray3 DirectDeclr
d TypeQualList
tl  AssignExpr
ae ) = DirectDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty DirectDeclr
d Doc -> Doc -> Doc
<> Doc -> Doc
brackets (TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQualList
tl Doc -> Doc -> Doc
<+> String -> Doc
text String
"static" Doc -> Doc -> Doc
<+> AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae)
  pretty (DirectDeclrArray4 DirectDeclr
d Maybe TypeQualList
mtl    ) = DirectDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty DirectDeclr
d Doc -> Doc -> Doc
<> Doc -> Doc
brackets (Maybe TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TypeQualList
mtl Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'*')
  pretty (DirectDeclrFun1   DirectDeclr
d ParamTypeList
ptl    ) = DirectDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty DirectDeclr
d Doc -> Doc -> Doc
<> Doc -> Doc
parens (ParamTypeList -> Doc
forall a. Pretty a => a -> Doc
pretty ParamTypeList
ptl)
  pretty (DirectDeclrFun2   DirectDeclr
d Maybe IdentList
mil    ) = DirectDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty DirectDeclr
d Doc -> Doc -> Doc
<> Doc -> Doc
parens (Maybe IdentList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe IdentList
mil)

instance Pretty Ptr where
  pretty :: Ptr -> Doc
pretty (PtrBase Maybe TypeQualList
mtql  ) = Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<> Maybe TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TypeQualList
mtql
  pretty (PtrCons Maybe TypeQualList
mtql Ptr
p) = Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<> Maybe TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TypeQualList
mtql Doc -> Doc -> Doc
<> Ptr -> Doc
forall a. Pretty a => a -> Doc
pretty Ptr
p

instance Pretty TypeQualList where
  pretty :: TypeQualList -> Doc
pretty (TypeQualBase TypeQual
tq)     = TypeQual -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQual
tq
  pretty (TypeQualCons TypeQualList
tql TypeQual
tq) = TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQualList
tql Doc -> Doc -> Doc
<+> TypeQual -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQual
tq

instance Pretty ParamTypeList where
  pretty :: ParamTypeList -> Doc
pretty (ParamTypeList    ParamList
tq) = ParamList -> Doc
forall a. Pretty a => a -> Doc
pretty ParamList
tq
  pretty (ParamTypeListVar ParamList
tq) = ParamList -> Doc
forall a. Pretty a => a -> Doc
pretty ParamList
tq Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> String -> Doc
text String
"..."

instance Pretty ParamList where
  pretty :: ParamList -> Doc
pretty (ParamBase    ParamDecln
pd) = ParamDecln -> Doc
forall a. Pretty a => a -> Doc
pretty ParamDecln
pd
  pretty (ParamCons ParamList
pl ParamDecln
pd) = ParamList -> Doc
forall a. Pretty a => a -> Doc
pretty ParamList
pl Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> ParamDecln -> Doc
forall a. Pretty a => a -> Doc
pretty ParamDecln
pd

instance Pretty ParamDecln where
  pretty :: ParamDecln -> Doc
pretty (ParamDecln         DeclnSpecs
ds Declr
d   ) = DeclnSpecs -> Doc
forall a. Pretty a => a -> Doc
pretty DeclnSpecs
ds Doc -> Doc -> Doc
<+> Declr -> Doc
forall a. Pretty a => a -> Doc
pretty Declr
d
  pretty (ParamDeclnAbstract DeclnSpecs
ds Maybe DirectAbstractDeclr
mdad) = DeclnSpecs -> Doc
forall a. Pretty a => a -> Doc
pretty DeclnSpecs
ds Doc -> Doc -> Doc
<+> Maybe DirectAbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DirectAbstractDeclr
mdad

instance Pretty IdentList where
  pretty :: IdentList -> Doc
pretty (IdentListBase Ident
ident) = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
ident
  pretty (IdentListCons IdentList
idl Ident
ident) = IdentList -> Doc
forall a. Pretty a => a -> Doc
pretty IdentList
idl Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
ident

{- 6.7.6 -}
instance Pretty TypeName where
  pretty :: TypeName -> Doc
pretty (TypeName SpecQualList
sql Maybe AbstractDeclr
mdar) = SpecQualList -> Doc
forall a. Pretty a => a -> Doc
pretty SpecQualList
sql Doc -> Doc -> Doc
<+> Maybe AbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe AbstractDeclr
mdar

instance Pretty AbstractDeclr where
  pretty :: AbstractDeclr -> Doc
pretty (AbstractDeclr       Ptr
ptr    ) = Ptr -> Doc
forall a. Pretty a => a -> Doc
pretty Ptr
ptr
  pretty (AbstractDeclrDirect Maybe Ptr
mptr DirectAbstractDeclr
ad) = Maybe Ptr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Ptr
mptr Doc -> Doc -> Doc
<> DirectAbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty DirectAbstractDeclr
ad

instance Pretty DirectAbstractDeclr where
  pretty :: DirectAbstractDeclr -> Doc
pretty (DirectAbstractDeclr AbstractDeclr
dad) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ AbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty AbstractDeclr
dad
  pretty (DirectAbstractDeclrArray1 Maybe DirectAbstractDeclr
mdad Maybe TypeQualList
mtql Maybe AssignExpr
mae)
    = Maybe DirectAbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DirectAbstractDeclr
mdad Doc -> Doc -> Doc
<> Doc -> Doc
brackets (Maybe TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TypeQualList
mtql Doc -> Doc -> Doc
<> Maybe AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe AssignExpr
mae)
  pretty (DirectAbstractDeclrArray2 Maybe DirectAbstractDeclr
mdad Maybe TypeQualList
mtql AssignExpr
ae)
    = Maybe DirectAbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DirectAbstractDeclr
mdad Doc -> Doc -> Doc
<> Doc -> Doc
brackets (String -> Doc
text String
"static" Doc -> Doc -> Doc
<+> Maybe TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TypeQualList
mtql Doc -> Doc -> Doc
<> AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae)
  pretty (DirectAbstractDeclrArray3 Maybe DirectAbstractDeclr
mdad TypeQualList
tql AssignExpr
ae)
    = Maybe DirectAbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DirectAbstractDeclr
mdad Doc -> Doc -> Doc
<> Doc -> Doc
brackets (TypeQualList -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQualList
tql Doc -> Doc -> Doc
<+> String -> Doc
text String
"static" Doc -> Doc -> Doc
<+> AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae)
  pretty (DirectAbstractDeclrArray4 Maybe DirectAbstractDeclr
mdad) = Maybe DirectAbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DirectAbstractDeclr
mdad Doc -> Doc -> Doc
<> Doc -> Doc
brackets (Char -> Doc
char Char
'*')
  pretty (DirectAbstractDeclrFun Maybe DirectAbstractDeclr
mdad Maybe ParamTypeList
mptl) = Maybe DirectAbstractDeclr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DirectAbstractDeclr
mdad Doc -> Doc -> Doc
<> Doc -> Doc
parens (Maybe ParamTypeList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe ParamTypeList
mptl)

{- 6.7.7 -}
instance Pretty TypedefName where
  pretty :: TypedefName -> Doc
pretty (TypedefName Ident
i) = Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i

{- 6.7.8 -}
instance Pretty Init where
  pretty :: Init -> Doc
pretty (InitExpr AssignExpr
ae) = AssignExpr -> Doc
forall a. Pretty a => a -> Doc
pretty AssignExpr
ae
  pretty (InitList InitList
il) = Doc -> Doc
braces (InitList -> Doc
forall a. Pretty a => a -> Doc
pretty InitList
il)

instance Pretty InitList where
  pretty :: InitList -> Doc
pretty (InitBase    Maybe Design
md Init
i) =                        Maybe Design -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Design
md Doc -> Doc -> Doc
<+> Init -> Doc
forall a. Pretty a => a -> Doc
pretty Init
i
  pretty (InitCons InitList
il Maybe Design
md Init
i) = InitList -> Doc
forall a. Pretty a => a -> Doc
pretty InitList
il Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Maybe Design -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Design
md Doc -> Doc -> Doc
<+> Init -> Doc
forall a. Pretty a => a -> Doc
pretty Init
i

instance Pretty Design where
  pretty :: Design -> Doc
pretty (Design DesigrList
dl) = DesigrList -> Doc
forall a. Pretty a => a -> Doc
pretty DesigrList
dl Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'='

instance Pretty DesigrList where
  pretty :: DesigrList -> Doc
pretty (DesigrBase    Desigr
d) = Desigr -> Doc
forall a. Pretty a => a -> Doc
pretty Desigr
d
  pretty (DesigrCons DesigrList
dl Desigr
d) = DesigrList -> Doc
forall a. Pretty a => a -> Doc
pretty DesigrList
dl Doc -> Doc -> Doc
<+> Desigr -> Doc
forall a. Pretty a => a -> Doc
pretty Desigr
d

instance Pretty Desigr where
  pretty :: Desigr -> Doc
pretty (DesigrConst ConstExpr
ce) = Doc -> Doc
brackets (ConstExpr -> Doc
forall a. Pretty a => a -> Doc
pretty ConstExpr
ce)
  pretty (DesigrIdent Ident
i ) = Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i

{- STATEMENTS -}
{- 6.8 -}
instance Pretty Stmt where
  pretty :: Stmt -> Doc
pretty (StmtLabeled  LabeledStmt
ls) = LabeledStmt -> Doc
forall a. Pretty a => a -> Doc
pretty LabeledStmt
ls
  pretty (StmtCompound CompoundStmt
cs) = Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
braces (CompoundStmt -> Doc
forall a. Pretty a => a -> Doc
pretty CompoundStmt
cs)
  pretty (StmtExpr     ExprStmt
es) = ExprStmt -> Doc
forall a. Pretty a => a -> Doc
pretty ExprStmt
es
  pretty (StmtSelect   SelectStmt
ss) = SelectStmt -> Doc
forall a. Pretty a => a -> Doc
pretty SelectStmt
ss
  pretty (StmtIter     IterStmt
is) = IterStmt -> Doc
forall a. Pretty a => a -> Doc
pretty IterStmt
is
  pretty (StmtJump     JumpStmt
js) = JumpStmt -> Doc
forall a. Pretty a => a -> Doc
pretty JumpStmt
js

{- 6.8.1 -}
instance Pretty LabeledStmt where
  pretty :: LabeledStmt -> Doc
pretty (LabeledIdent Ident
i  Stmt
s) =                 Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i  Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s
  pretty (LabeledCase  ConstExpr
ce Stmt
s) = String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> ConstExpr -> Doc
forall a. Pretty a => a -> Doc
pretty ConstExpr
ce Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s
  pretty (LabeledDefault  Stmt
s) = String -> Doc
text String
"default"            Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s

{- 6.8.2 -}
instance Pretty CompoundStmt where
  pretty :: CompoundStmt -> Doc
pretty (Compound Maybe BlockItemList
Nothing) = Doc
empty
  pretty (Compound Maybe BlockItemList
mbil   ) = Maybe BlockItemList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe BlockItemList
mbil

instance Pretty BlockItemList where
  pretty :: BlockItemList -> Doc
pretty (BlockItemBase     BlockItem
bi) = BlockItem -> Doc
forall a. Pretty a => a -> Doc
pretty BlockItem
bi
  pretty (BlockItemCons BlockItemList
bil BlockItem
bi) = BlockItemList -> Doc
forall a. Pretty a => a -> Doc
pretty BlockItemList
bil Doc -> Doc -> Doc
$$ BlockItem -> Doc
forall a. Pretty a => a -> Doc
pretty BlockItem
bi

instance Pretty BlockItem where
  pretty :: BlockItem -> Doc
pretty (BlockItemDecln Decln
d) = Decln -> Doc
forall a. Pretty a => a -> Doc
pretty Decln
d Doc -> Doc -> Doc
<> Doc
semi
  pretty (BlockItemStmt  Stmt
s) = Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s Doc -> Doc -> Doc
<> Doc
semi

{- 6.8.3 -}
instance Pretty ExprStmt where
  pretty :: ExprStmt -> Doc
pretty (ExprStmt Maybe Expr
Nothing) = Doc
empty
  pretty (ExprStmt Maybe Expr
me)      = Maybe Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Expr
me

{- 6.8.4 -}
instance Pretty SelectStmt where
  pretty :: SelectStmt -> Doc
pretty (SelectIf Expr
c Stmt
s) = [Doc] -> Doc
vcat [ String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
c) Doc -> Doc -> Doc
<+> Doc
lbrace
                               , Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s
                               , Doc
rbrace
                               ]
  pretty (SelectIfElse Expr
c Stmt
s1 Stmt
s2) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
c) Doc -> Doc -> Doc
<+> Doc
lbrace
         , Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s1
         , Doc
rbrace Doc -> Doc -> Doc
<+> String -> Doc
text String
"else" Doc -> Doc -> Doc
<+> Doc
lbrace
         , Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s2
         , Doc
rbrace
         ]
  pretty (SelectSwitch Expr
c Stmt
s) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"switch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
c) Doc -> Doc -> Doc
<+> Doc
lbrace
         , Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s
         , Doc
rbrace
         ]

{- 6.8.5 -}
instance Pretty IterStmt where
  pretty :: IterStmt -> Doc
pretty (IterWhile Expr
c Stmt
s) = String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
c) Doc -> Doc -> Doc
<+> Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s
  pretty (IterDo    Stmt
s Expr
c) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"do" Doc -> Doc -> Doc
<+> Doc
lbrace
         , Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s
         , Doc
rbrace Doc -> Doc -> Doc
<+> String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Expr
c)
         ]
  pretty (IterForUpdate Maybe Expr
me1 Maybe Expr
me2 Maybe Expr
me3 Stmt
s) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"for" Doc -> Doc -> Doc
<+> Doc -> Doc
parens ( Maybe Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Expr
me1 Doc -> Doc -> Doc
<> Doc
semi Doc -> Doc -> Doc
<+>
                                   Maybe Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Expr
me2 Doc -> Doc -> Doc
<> Doc
semi Doc -> Doc -> Doc
<+>
                                   Maybe Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Expr
me3 ) Doc -> Doc -> Doc
<+> Doc
lbrace
         , Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s
         , Doc
rbrace
         ]
  pretty (IterFor Decln
d Maybe Expr
me1 Maybe Expr
me2 Stmt
s) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"for" Doc -> Doc -> Doc
<+> Doc -> Doc
parens ( Decln -> Doc
forall a. Pretty a => a -> Doc
pretty Decln
d Doc -> Doc -> Doc
<+> Maybe Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Expr
me1 Doc -> Doc -> Doc
<> Doc
semi
                            Doc -> Doc -> Doc
<+> Maybe Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Expr
me2 ) Doc -> Doc -> Doc
<+> Doc
lbrace
         , Stmt -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt
s
         , Doc
rbrace
         ]

{- 6.8.6 -}
instance Pretty JumpStmt where
  pretty :: JumpStmt -> Doc
pretty (JumpGoto Ident
i)    = String -> Doc
text String
"goto" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. Pretty a => a -> Doc
pretty Ident
i
  pretty JumpStmt
JumpContinue    = String -> Doc
text String
"continue"
  pretty JumpStmt
JumpBreak       = String -> Doc
text String
"break"
  pretty (JumpReturn Maybe Expr
me) = String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> Maybe Expr -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Expr
me


{- EXTERNAL DEFINITIONS -}
{- 6.9 -}
instance Pretty TransUnit where
  pretty :: TransUnit -> Doc
pretty TransUnit
tu = [Doc] -> Doc
vcat [TransUnit -> Doc
pretty' TransUnit
tu, String -> Doc
text String
""]
    where
      pretty' :: TransUnit -> Doc
pretty' (TransUnitBase    ExtDecln
ed) = ExtDecln -> Doc
forall a. Pretty a => a -> Doc
pretty ExtDecln
ed
      pretty' (TransUnitCons TransUnit
tu ExtDecln
ed) = case ExtDecln
ed of
        ExtFun FunDef
_ -> [Doc] -> Doc
vcat [TransUnit -> Doc
pretty' TransUnit
tu, String -> Doc
text String
"", ExtDecln -> Doc
forall a. Pretty a => a -> Doc
pretty ExtDecln
ed]
        ExtDecln
_        -> [Doc] -> Doc
vcat [TransUnit -> Doc
pretty' TransUnit
tu, ExtDecln -> Doc
forall a. Pretty a => a -> Doc
pretty ExtDecln
ed]

instance Pretty ExtDecln where
  pretty :: ExtDecln -> Doc
pretty (ExtFun FunDef
fd)  = FunDef -> Doc
forall a. Pretty a => a -> Doc
pretty FunDef
fd
  pretty (ExtDecln Decln
d) = Decln -> Doc
forall a. Pretty a => a -> Doc
pretty Decln
d Doc -> Doc -> Doc
<> Doc
semi

{- 6.9.1 -}
instance Pretty FunDef where
  pretty :: FunDef -> Doc
pretty (FunDef DeclnSpecs
ds Declr
d Maybe DeclnList
mdl (Compound Maybe BlockItemList
Nothing)) = DeclnSpecs -> Declr -> Maybe DeclnList -> Doc
fheader DeclnSpecs
ds Declr
d Maybe DeclnList
mdl Doc -> Doc -> Doc
<> Doc
semi
  pretty (FunDef DeclnSpecs
ds Declr
d Maybe DeclnList
mdl CompoundStmt
cs) =
    [Doc] -> Doc
vcat [ DeclnSpecs -> Declr -> Maybe DeclnList -> Doc
fheader DeclnSpecs
ds Declr
d Maybe DeclnList
mdl Doc -> Doc -> Doc
<+> Doc
lbrace
         , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CompoundStmt -> Doc
forall a. Pretty a => a -> Doc
pretty CompoundStmt
cs
         , Doc
rbrace
         ]

instance Pretty DeclnList where
  pretty :: DeclnList -> Doc
pretty (DeclnBase    Decln
d) = Decln -> Doc
forall a. Pretty a => a -> Doc
pretty Decln
d
  pretty (DeclnCons DeclnList
dl Decln
d) = DeclnList -> Doc
forall a. Pretty a => a -> Doc
pretty DeclnList
dl Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Decln -> Doc
forall a. Pretty a => a -> Doc
pretty Decln
d


fheader :: DeclnSpecs -> Declr -> Maybe DeclnList -> Doc
fheader :: DeclnSpecs -> Declr -> Maybe DeclnList -> Doc
fheader DeclnSpecs
ds Declr
d Maybe DeclnList
mdl = DeclnSpecs -> Doc
forall a. Pretty a => a -> Doc
pretty DeclnSpecs
ds Doc -> Doc -> Doc
<+> Declr -> Doc
forall a. Pretty a => a -> Doc
pretty Declr
d Doc -> Doc -> Doc
<+> Maybe DeclnList -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe DeclnList
mdl