    {-# LANGUAGE CPP #-}
    --  C->Haskell Compiler: pretty printing of C abstract syntax
    --
    --  Author : Manuel M T Chakravarty
    --  Created: 25 August 1
    --
    --  Version $Revision: 1.3 $ from $Date: 2005/06/22 16:01:21 $
    --
    --  Copyright (c) [2001..2004] Manuel M T Chakravarty
    --
    --  This file is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  This file is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    --  GNU General Public License for more details.
    --
    --- DESCRIPTION ---------------------------------------------------------------
    --
    --  Pretty printing support for abstract C trees.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --- TODO ----------------------------------------------------------------------
    --
    --  * So far, only covers a small fraction of the abstract tree definition
    --

    module CPretty (
      -- we are just providing instances to the class `Pretty'
    ) where

    #if MIN_VERSION_base(4,11,0)
    import Prelude hiding ((<>))
    #endif
    import Idents (Ident, identToLexeme)
    import Text.PrettyPrint.HughesPJ

    import CAST

    -- pretty printing of AST nodes
    -- ----------------------------

    instance Show CDecl where
      showsPrec :: Int -> CDecl -> ShowS
    showsPrec Int
    _ = String -> ShowS
    showString (String -> ShowS) -> (CDecl -> String) -> CDecl -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> String
    render (Doc -> String) -> (CDecl -> Doc) -> CDecl -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty

    -- overloaded pretty-printing function (EXPORTED)
    --
    class Pretty a where
      pretty     :: a -> Doc
      prettyPrec :: Int -> a -> Doc

      pretty       = Int -> a -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    0
      prettyPrec Int
    _ = a -> Doc
    forall a. Pretty a => a -> Doc
    pretty

    -- actual structure tree traversals
    -- --------------------------------

    instance Pretty CDecl where
      pretty :: CDecl -> Doc
    pretty (CDecl [CDeclSpec]
    specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
    declrs Attrs
    _) =
        [Doc] -> Doc
    hsep ((CDeclSpec -> Doc) -> [CDeclSpec] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map CDeclSpec -> Doc
    forall a. Pretty a => a -> Doc
    pretty [CDeclSpec]
    specs) Doc -> Int -> Doc -> Doc
    `hang` Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
          [Doc] -> Doc
    hsep (Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma (((Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Doc)
    -> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Doc
    prettyDeclr [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
    declrs)) Doc -> Doc -> Doc
    <> Doc
    semi

    instance Pretty CDeclSpec where
      pretty :: CDeclSpec -> Doc
    pretty (CStorageSpec CStorageSpec
    sspec) = CStorageSpec -> Doc
    forall a. Pretty a => a -> Doc
    pretty CStorageSpec
    sspec
      pretty (CTypeSpec    CTypeSpec
    tspec) = CTypeSpec -> Doc
    forall a. Pretty a => a -> Doc
    pretty CTypeSpec
    tspec
      pretty (CTypeQual    CTypeQual
    qspec) = CTypeQual -> Doc
    forall a. Pretty a => a -> Doc
    pretty CTypeQual
    qspec

    instance Pretty CStorageSpec where
      pretty :: CStorageSpec -> Doc
    pretty (CAuto     Attrs
    _) = String -> Doc
    text String
    "auto"
      pretty (CRegister Attrs
    _) = String -> Doc
    text String
    "register"
      pretty (CStatic   Attrs
    _) = String -> Doc
    text String
    "static"
      pretty (CExtern   Attrs
    _) = String -> Doc
    text String
    "extern"
      pretty (CTypedef  Attrs
    _) = String -> Doc
    text String
    "typedef"

    instance Pretty CTypeSpec where
      pretty :: CTypeSpec -> Doc
    pretty (CVoidType      Attrs
    _) = String -> Doc
    text String
    "void"
      pretty (CCharType      Attrs
    _) = String -> Doc
    text String
    "char"
      pretty (CShortType     Attrs
    _) = String -> Doc
    text String
    "short"
      pretty (CIntType       Attrs
    _) = String -> Doc
    text String
    "int"
      pretty (CLongType      Attrs
    _) = String -> Doc
    text String
    "long"
      pretty (CFloatType     Attrs
    _) = String -> Doc
    text String
    "float"
      pretty (CFloat128Type  Attrs
    _) = String -> Doc
    text String
    "__float128"
      pretty (CDoubleType    Attrs
    _) = String -> Doc
    text String
    "double"
      pretty (CSignedType    Attrs
    _) = String -> Doc
    text String
    "signed"
      pretty (CUnsigType     Attrs
    _) = String -> Doc
    text String
    "unsigned"
      pretty (CSUType CStructUnion
    struct Attrs
    _) = String -> Doc
    text String
    "<<CPretty: CSUType not yet implemented!>>"
      pretty (CEnumType CEnum
    enum Attrs
    _) = String -> Doc
    text String
    "<<CPretty: CEnumType not yet implemented!>>"
      pretty (CTypeDef Ident
    ide   Attrs
    _) = Ident -> Doc
    ident Ident
    ide

    instance Pretty CTypeQual where
      pretty :: CTypeQual -> Doc
    pretty (CConstQual Attrs
    _) = String -> Doc
    text String
    "const"
      pretty (CVolatQual Attrs
    _) = String -> Doc
    text String
    "volatile"
      pretty (CRestrQual Attrs
    _) = String -> Doc
    text String
    "restrict"

    prettyDeclr :: (Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Doc
    prettyDeclr :: (Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Doc
    prettyDeclr (Maybe CDeclr
    odeclr, Maybe CInit
    oinit, Maybe CExpr
    oexpr) =
          Doc -> (CDeclr -> Doc) -> Maybe CDeclr -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty CDeclr -> Doc
    forall a. Pretty a => a -> Doc
    pretty Maybe CDeclr
    odeclr
      Doc -> Doc -> Doc
    <+> Doc -> (CInit -> Doc) -> Maybe CInit -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty ((String -> Doc
    text String
    "=" Doc -> Doc -> Doc
    <+>) (Doc -> Doc) -> (CInit -> Doc) -> CInit -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CInit -> Doc
    forall a. Pretty a => a -> Doc
    pretty) Maybe CInit
    oinit
      Doc -> Doc -> Doc
    <+> Doc -> (CExpr -> Doc) -> Maybe CExpr -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty ((String -> Doc
    text String
    ":" Doc -> Doc -> Doc
    <+>) (Doc -> Doc) -> (CExpr -> Doc) -> CExpr -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CExpr -> Doc
    forall a. Pretty a => a -> Doc
    pretty) Maybe CExpr
    oexpr

    instance Pretty CDeclr where
      pretty :: CDeclr -> Doc
    pretty (CVarDeclr Maybe Ident
    oide                   Attrs
    _) = Doc -> (Ident -> Doc) -> Maybe Ident -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty Ident -> Doc
    ident Maybe Ident
    oide
      pretty (CPtrDeclr [CTypeQual]
    inds CDeclr
    declr             Attrs
    _) =
        let
          oneLevel :: [a] -> Doc -> Doc
    oneLevel [a]
    ind = Doc -> Doc
    parens (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Doc] -> Doc
    hsep ((a -> Doc) -> [a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Doc
    forall a. Pretty a => a -> Doc
    pretty [a]
    ind) Doc -> Doc -> Doc
    <+>) (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Doc
    text String
    "*" Doc -> Doc -> Doc
    <>)
        in
        [CTypeQual] -> Doc -> Doc
    forall {a}. Pretty a => [a] -> Doc -> Doc
    oneLevel [CTypeQual]
    inds (CDeclr -> Doc
    forall a. Pretty a => a -> Doc
    pretty CDeclr
    declr)
      pretty (CArrDeclr CDeclr
    declr [CTypeQual]
    _ Maybe CExpr
    oexpr          Attrs
    _) =
        CDeclr -> Doc
    forall a. Pretty a => a -> Doc
    pretty CDeclr
    declr Doc -> Doc -> Doc
    <> Doc -> Doc
    brackets (Doc -> (CExpr -> Doc) -> Maybe CExpr -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty CExpr -> Doc
    forall a. Pretty a => a -> Doc
    pretty Maybe CExpr
    oexpr)
      pretty (CFunDeclr CDeclr
    declr [CDecl]
    decls Bool
    isVariadic Attrs
    _) =
        let
          varDoc :: Doc
    varDoc = if Bool
    isVariadic then String -> Doc
    text String
    ", ..." else Doc
    empty
        in
        CDeclr -> Doc
    forall a. Pretty a => a -> Doc
    pretty CDeclr
    declr
        Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens ([Doc] -> Doc
    hsep (Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma ((CDecl -> Doc) -> [CDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map CDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [CDecl]
    decls)) Doc -> Doc -> Doc
    <> Doc
    varDoc)

    instance Pretty CInit where
      pretty :: CInit -> Doc
    pretty CInit
    _ = String -> Doc
    text String
    "<<CPretty: CInit not yet implemented!>>"

    instance Pretty CExpr where
      pretty :: CExpr -> Doc
    pretty CExpr
    _ = String -> Doc
    text String
    "<<CPretty: CExpr not yet implemented!>>"

    -- auxiliary functions
    -- --------------------

    ident :: Ident -> Doc
    ident :: Ident -> Doc
    ident  = String -> Doc
    text (String -> Doc) -> (Ident -> String) -> Ident -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> String
    identToLexeme