    {-# 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 _ = 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 0
      prettyPrec _ = a -> Doc
    forall a. Pretty a => a -> Doc
    pretty

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

    instance Pretty CDecl where
      pretty :: CDecl -> Doc
    pretty (CDecl specs :: [CDeclSpec]
    specs declrs :: [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
    declrs _) =
        [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` 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 sspec :: CStorageSpec
    sspec) = CStorageSpec -> Doc
    forall a. Pretty a => a -> Doc
    pretty CStorageSpec
    sspec
      pretty (CTypeSpec    tspec :: CTypeSpec
    tspec) = CTypeSpec -> Doc
    forall a. Pretty a => a -> Doc
    pretty CTypeSpec
    tspec
      pretty (CTypeQual    qspec :: CTypeQual
    qspec) = CTypeQual -> Doc
    forall a. Pretty a => a -> Doc
    pretty CTypeQual
    qspec

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

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

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

    prettyDeclr :: (Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Doc
    prettyDeclr :: (Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Doc
    prettyDeclr (odeclr :: Maybe CDeclr
    odeclr, oinit :: Maybe CInit
    oinit, oexpr :: 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 "=" 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 ":" 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 oide :: Maybe Ident
    oide                   _) = 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 inds :: [CTypeQual]
    inds declr :: CDeclr
    declr             _) =
        let
          oneLevel :: [a] -> Doc -> Doc
    oneLevel ind :: [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 "*" 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 declr :: CDeclr
    declr _ oexpr :: Maybe CExpr
    oexpr          _) =
        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 declr :: CDeclr
    declr decls :: [CDecl]
    decls isVariadic :: Bool
    isVariadic _) =
        let
          varDoc :: Doc
    varDoc = if Bool
    isVariadic then String -> Doc
    text ", ..." 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 _ = String -> Doc
    text "<<CPretty: CInit not yet implemented!>>"

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

    -- auxilliary 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