{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# OPTIONS -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Analysis.Debug
-- Copyright   :  (c) 2008 Benedikt Huber
-- License     :  BSD-style
-- Maintainer  :  benedikt.huber@gmail.com
-- Stability   :  prototype
-- Portability :  ghc
--
-- Pretty printing the semantic analysis representation.
-- This is currently only intended for debugging purposes.
-----------------------------------------------------------------------------
module Language.C.Analysis.Debug (
globalDeclStats,
prettyAssocs, prettyAssocsWith,
-- and many pretty instances
)
where
import Language.C.Analysis.SemRep
import Language.C.Analysis.Export
import Language.C.Analysis.DefTable
import Language.C.Analysis.NameSpaceMap

import Language.C.Data
import Language.C.Pretty

import Prelude hiding ((<>))
import Text.PrettyPrint.HughesPJ
import Data.Map (Map) ; import qualified Data.Map as Map

prettyAssocs :: (Pretty k, Pretty v) => String -> [(k,v)] -> Doc
prettyAssocs :: String -> [(k, v)] -> Doc
prettyAssocs label :: String
label = String -> (k -> Doc) -> (v -> Doc) -> [(k, v)] -> Doc
forall k v. String -> (k -> Doc) -> (v -> Doc) -> [(k, v)] -> Doc
prettyAssocsWith String
label k -> Doc
forall p. Pretty p => p -> Doc
pretty v -> Doc
forall p. Pretty p => p -> Doc
pretty
prettyAssocsWith :: String -> (k -> Doc) -> (v -> Doc) -> [(k,v)] -> Doc
prettyAssocsWith :: String -> (k -> Doc) -> (v -> Doc) -> [(k, v)] -> Doc
prettyAssocsWith label :: String
label prettyKey :: k -> Doc
prettyKey prettyVal :: v -> Doc
prettyVal theMap :: [(k, v)]
theMap =
    String -> Doc
text String
label Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest 8 ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((k, v) -> Doc) -> [(k, v)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> Doc
prettyEntry [(k, v)]
theMap)
    where
    prettyEntry :: (k, v) -> Doc
prettyEntry (k :: k
k,v :: v
v) = k -> Doc
prettyKey k
k Doc -> Doc -> Doc
<+> String -> Doc
text " ~> " Doc -> Doc -> Doc
<+> v -> Doc
prettyVal v
v

instance Pretty DefTable where
    pretty :: DefTable -> Doc
pretty dt :: DefTable
dt = String -> Doc
text "DefTable" Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest 4 ([Doc] -> Doc
vcat [Doc]
defMaps)
        where
        defMaps :: [Doc]
defMaps = [ String -> (DefTable -> NameSpaceMap Ident IdentEntry) -> Doc
forall k v.
(Pretty k, Pretty v, Ord k) =>
String -> (DefTable -> NameSpaceMap k v) -> Doc
prettyNSMap "idents" DefTable -> NameSpaceMap Ident IdentEntry
identDecls
                  , String -> (DefTable -> NameSpaceMap SUERef TagEntry) -> Doc
forall k v.
(Pretty k, Pretty v, Ord k) =>
String -> (DefTable -> NameSpaceMap k v) -> Doc
prettyNSMap "tags" DefTable -> NameSpaceMap SUERef TagEntry
tagDecls
                  , String -> (DefTable -> NameSpaceMap Ident Ident) -> Doc
forall k v.
(Pretty k, Pretty v, Ord k) =>
String -> (DefTable -> NameSpaceMap k v) -> Doc
prettyNSMap "labels" DefTable -> NameSpaceMap Ident Ident
labelDefs
                  , String -> (DefTable -> NameSpaceMap Ident MemberDecl) -> Doc
forall k v.
(Pretty k, Pretty v, Ord k) =>
String -> (DefTable -> NameSpaceMap k v) -> Doc
prettyNSMap "members" DefTable -> NameSpaceMap Ident MemberDecl
memberDecls
                  ]
        prettyNSMap :: String -> (DefTable -> NameSpaceMap k v) -> Doc
prettyNSMap label :: String
label f :: DefTable -> NameSpaceMap k v
f = String -> [(k, v)] -> Doc
forall k v. (Pretty k, Pretty v) => String -> [(k, v)] -> Doc
prettyAssocs String
label ([(k, v)] -> Doc)
-> (NameSpaceMap k v -> [(k, v)]) -> NameSpaceMap k v -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaceMap k v -> [(k, v)]
forall k a. Ord k => NameSpaceMap k a -> [(k, a)]
nsMapToList (NameSpaceMap k v -> Doc) -> NameSpaceMap k v -> Doc
forall a b. (a -> b) -> a -> b
$ DefTable -> NameSpaceMap k v
f DefTable
dt

instance Pretty GlobalDecls where
    pretty :: GlobalDecls -> Doc
pretty gd :: GlobalDecls
gd = String -> Doc
text "Global Declarations" Doc -> Doc -> Doc
$$ (Int -> Doc -> Doc
nest 4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
declMaps)
        where
        declMaps :: [Doc]
declMaps = [ String -> Map Ident Enumerator -> Doc
forall t k. (Pretty t, Pretty k) => String -> Map k t -> Doc
prettyMap "enumerators" Map Ident Enumerator
theEnums, String -> Map Ident Decl -> Doc
forall t k. (Pretty t, Pretty k) => String -> Map k t -> Doc
prettyMap "declarations" Map Ident Decl
theDecls,
                     String -> Map Ident ObjDef -> Doc
forall t k. (Pretty t, Pretty k) => String -> Map k t -> Doc
prettyMap "objects" Map Ident ObjDef
theObjs,  String -> Map Ident FunDef -> Doc
forall t k. (Pretty t, Pretty k) => String -> Map k t -> Doc
prettyMap "functions" Map Ident FunDef
theFuns,
                     String -> Map SUERef TagDef -> Doc
forall t k. (Pretty t, Pretty k) => String -> Map k t -> Doc
prettyMap "tags"    (Map SUERef TagDef -> Doc) -> Map SUERef TagDef -> Doc
forall a b. (a -> b) -> a -> b
$ GlobalDecls -> Map SUERef TagDef
gTags GlobalDecls
gd,  String -> Map Ident TypeDef -> Doc
forall t k. (Pretty t, Pretty k) => String -> Map k t -> Doc
prettyMap "typeDefs"  (Map Ident TypeDef -> Doc) -> Map Ident TypeDef -> Doc
forall a b. (a -> b) -> a -> b
$ GlobalDecls -> Map Ident TypeDef
gTypeDefs GlobalDecls
gd ]
        prettyMap :: (Pretty t, Pretty k) => String -> Map k t -> Doc
        prettyMap :: String -> Map k t -> Doc
prettyMap label :: String
label = String -> [(k, t)] -> Doc
forall k v. (Pretty k, Pretty v) => String -> [(k, v)] -> Doc
prettyAssocs String
label ([(k, t)] -> Doc) -> (Map k t -> [(k, t)]) -> Map k t -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k t -> [(k, t)]
forall k a. Map k a -> [(k, a)]
Map.assocs
        (theDecls :: Map Ident Decl
theDecls, (theEnums :: Map Ident Enumerator
theEnums, theObjs :: Map Ident ObjDef
theObjs, theFuns :: Map Ident FunDef
theFuns)) = Bool
-> Map Ident IdentDecl
-> (Map Ident Decl,
    (Map Ident Enumerator, Map Ident ObjDef, Map Ident FunDef))
splitIdentDecls Bool
False (GlobalDecls -> Map Ident IdentDecl
gObjs GlobalDecls
gd)

globalDeclStats :: (FilePath -> Bool) -> GlobalDecls -> [(String,Int)]
globalDeclStats :: (String -> Bool) -> GlobalDecls -> [(String, Int)]
globalDeclStats file_filter :: String -> Bool
file_filter gmap :: GlobalDecls
gmap =
    [ ("Enumeration Constants",Map Ident Enumerator -> Int
forall k a. Map k a -> Int
Map.size Map Ident Enumerator
enumerators),
      ("Total Object/Function Declarations",Map Ident Decl -> Int
forall k a. Map k a -> Int
Map.size Map Ident Decl
all_decls),
      ("Object definitions", Map Ident ObjDef -> Int
forall k a. Map k a -> Int
Map.size Map Ident ObjDef
objDefs),
      ("Function Definitions", Map Ident FunDef -> Int
forall k a. Map k a -> Int
Map.size Map Ident FunDef
funDefs),
      ("Tag definitions", Map SUERef TagDef -> Int
forall k a. Map k a -> Int
Map.size Map SUERef TagDef
tagDefs),
      ("TypeDefs", Map Ident TypeDef -> Int
forall k a. Map k a -> Int
Map.size Map Ident TypeDef
typeDefs)
    ]
    where
    gmap' :: GlobalDecls
gmap' = (DeclEvent -> Bool) -> GlobalDecls -> GlobalDecls
filterGlobalDecls DeclEvent -> Bool
forall n. CNode n => n -> Bool
filterFile GlobalDecls
gmap
    (all_decls :: Map Ident Decl
all_decls,(enumerators :: Map Ident Enumerator
enumerators,objDefs :: Map Ident ObjDef
objDefs,funDefs :: Map Ident FunDef
funDefs)) = Bool
-> Map Ident IdentDecl
-> (Map Ident Decl,
    (Map Ident Enumerator, Map Ident ObjDef, Map Ident FunDef))
splitIdentDecls Bool
True (GlobalDecls -> Map Ident IdentDecl
gObjs GlobalDecls
gmap')
    (tagDefs :: Map SUERef TagDef
tagDefs,typeDefs :: Map Ident TypeDef
typeDefs) = (GlobalDecls -> Map SUERef TagDef
gTags GlobalDecls
gmap', GlobalDecls -> Map Ident TypeDef
gTypeDefs GlobalDecls
gmap')
    filterFile :: (CNode n) => n -> Bool
    filterFile :: n -> Bool
filterFile = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True String -> Bool
file_filter (Maybe String -> Bool) -> (n -> Maybe String) -> n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo -> Maybe String
forall a. CNode a => a -> Maybe String
fileOfNode (NodeInfo -> Maybe String) -> (n -> NodeInfo) -> n -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo

instance (Pretty a, Pretty b) => Pretty (Either a b) where
    pretty :: Either a b -> Doc
pretty = (a -> Doc) -> (b -> Doc) -> Either a b -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Doc
forall p. Pretty p => p -> Doc
pretty b -> Doc
forall p. Pretty p => p -> Doc
pretty
instance Pretty TagFwdDecl where
    pretty :: TagFwdDecl -> Doc
pretty (CompDecl ct :: CompTypeRef
ct) = CompTypeRef -> Doc
forall p. Pretty p => p -> Doc
pretty CompTypeRef
ct
    pretty (EnumDecl et :: EnumTypeRef
et) = EnumTypeRef -> Doc
forall p. Pretty p => p -> Doc
pretty EnumTypeRef
et
instance Pretty CompTyKind where
    pretty :: CompTyKind -> Doc
pretty StructTag = String -> Doc
text "struct"
    pretty UnionTag = String -> Doc
text "union"
instance Pretty CompTypeRef where
    pretty :: CompTypeRef -> Doc
pretty (CompTypeRef sue :: SUERef
sue kind :: CompTyKind
kind _) = CompTyKind -> Doc
forall p. Pretty p => p -> Doc
pretty CompTyKind
kind Doc -> Doc -> Doc
<+> SUERef -> Doc
forall p. Pretty p => p -> Doc
pretty SUERef
sue
instance Pretty EnumTypeRef where
    pretty :: EnumTypeRef -> Doc
pretty (EnumTypeRef sue :: SUERef
sue _ ) = String -> Doc
text "enum" Doc -> Doc -> Doc
<+> SUERef -> Doc
forall p. Pretty p => p -> Doc
pretty SUERef
sue
instance Pretty Ident where
    pretty :: Ident -> Doc
pretty = String -> Doc
text (String -> Doc) -> (Ident -> String) -> Ident -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> String
identToString
instance Pretty SUERef where
    pretty :: SUERef -> Doc
pretty (AnonymousRef name :: Name
name) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Name -> Int
nameId Name
name)
    pretty (NamedRef ident :: Ident
ident) = Ident -> Doc
forall p. Pretty p => p -> Doc
pretty Ident
ident
instance Pretty TagDef where
    pretty :: TagDef -> Doc
pretty (CompDef compty :: CompType
compty) = CompType -> Doc
forall p. Pretty p => p -> Doc
pretty CompType
compty
    pretty (EnumDef enumty :: EnumType
enumty) = EnumType -> Doc
forall p. Pretty p => p -> Doc
pretty EnumType
enumty
instance Pretty IdentDecl where
    pretty :: IdentDecl -> Doc
pretty (Declaration decl :: Decl
decl) = Decl -> Doc
forall p. Pretty p => p -> Doc
pretty Decl
decl
    pretty (ObjectDef odef :: ObjDef
odef) = ObjDef -> Doc
forall p. Pretty p => p -> Doc
pretty ObjDef
odef
    pretty (FunctionDef fdef :: FunDef
fdef) = FunDef -> Doc
forall p. Pretty p => p -> Doc
pretty FunDef
fdef
    pretty (EnumeratorDef enumerator :: Enumerator
enumerator) = Enumerator -> Doc
forall p. Pretty p => p -> Doc
pretty Enumerator
enumerator
instance Pretty Decl where
    pretty :: Decl -> Doc
pretty (Decl vardecl :: VarDecl
vardecl _) =
        String -> Doc
text "declaration" Doc -> Doc -> Doc
<+>
        VarDecl -> Doc
forall p. Pretty p => p -> Doc
pretty VarDecl
vardecl
instance Pretty TypeDef where
    pretty :: TypeDef -> Doc
pretty (TypeDef ident :: Ident
ident ty :: Type
ty attrs :: Attributes
attrs _) =
        String -> Doc
text "typedef" Doc -> Doc -> Doc
<+> Ident -> Doc
forall p. Pretty p => p -> Doc
pretty Ident
ident Doc -> Doc -> Doc
<+> String -> Doc
text "as"  Doc -> Doc -> Doc
<+>
        Attributes -> Doc
forall p. Pretty p => p -> Doc
pretty Attributes
attrs Doc -> Doc -> Doc
<+> Type -> Doc
forall p. Pretty p => p -> Doc
pretty Type
ty
instance Pretty ObjDef where
    pretty :: ObjDef -> Doc
pretty (ObjDef vardecl :: VarDecl
vardecl init_opt :: Maybe Initializer
init_opt _) =
        String -> Doc
text "object" Doc -> Doc -> Doc
<+>
        VarDecl -> Doc
forall p. Pretty p => p -> Doc
pretty VarDecl
vardecl Doc -> Doc -> Doc
<+> Doc -> (Initializer -> Doc) -> Maybe Initializer -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (((String -> Doc
text "=") Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (Initializer -> Doc) -> Initializer -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Initializer -> Doc
forall p. Pretty p => p -> Doc
pretty) Maybe Initializer
init_opt
instance Pretty FunDef where
    pretty :: FunDef -> Doc
pretty (FunDef vardecl :: VarDecl
vardecl _stmt :: Stmt
_stmt _) =
        String -> Doc
text "function" Doc -> Doc -> Doc
<+>
        VarDecl -> Doc
forall p. Pretty p => p -> Doc
pretty VarDecl
vardecl
instance Pretty VarDecl where
    pretty :: VarDecl -> Doc
pretty (VarDecl name :: VarName
name attrs :: DeclAttrs
attrs ty :: Type
ty) =
        (([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text " |")) [VarName -> Doc
forall p. Pretty p => p -> Doc
pretty VarName
name, DeclAttrs -> Doc
forall p. Pretty p => p -> Doc
pretty DeclAttrs
attrs, Type -> Doc
forall p. Pretty p => p -> Doc
pretty Type
ty])
instance Pretty ParamDecl where
    pretty :: ParamDecl -> Doc
pretty (ParamDecl (VarDecl name :: VarName
name declattrs :: DeclAttrs
declattrs ty :: Type
ty) _) =
        DeclAttrs -> Doc
forall p. Pretty p => p -> Doc
pretty DeclAttrs
declattrs Doc -> Doc -> Doc
<+> VarName -> Doc
forall p. Pretty p => p -> Doc
pretty VarName
name Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> Type -> Doc
forall p. Pretty p => p -> Doc
pretty Type
ty
    pretty (AbstractParamDecl (VarDecl name :: VarName
name declattrs :: DeclAttrs
declattrs ty :: Type
ty) _) =
        String -> Doc
text "abstract" Doc -> Doc -> Doc
<+> DeclAttrs -> Doc
forall p. Pretty p => p -> Doc
pretty DeclAttrs
declattrs Doc -> Doc -> Doc
<+> VarName -> Doc
forall p. Pretty p => p -> Doc
pretty VarName
name Doc -> Doc -> Doc
<+>
             String -> Doc
text "::" Doc -> Doc -> Doc
<+> Type -> Doc
forall p. Pretty p => p -> Doc
pretty Type
ty
instance Pretty DeclAttrs where
    pretty :: DeclAttrs -> Doc
pretty (DeclAttrs fun_attrs :: FunctionAttrs
fun_attrs storage :: Storage
storage attrs :: Attributes
attrs) =
        [Doc] -> Doc
hsep [ FunctionAttrs -> Doc
forall p. Pretty p => p -> Doc
pretty FunctionAttrs
fun_attrs, Storage -> Doc
forall p. Pretty p => p -> Doc
pretty Storage
storage, Attributes -> Doc
forall p. Pretty p => p -> Doc
pretty Attributes
attrs]

instance Pretty Type where
  pretty :: Type -> Doc
pretty ty :: Type
ty = CDecl -> Doc
forall p. Pretty p => p -> Doc
pretty (Type -> CDecl
exportTypeDecl Type
ty)
instance Pretty TypeQuals where
    pretty :: TypeQuals -> Doc
pretty tyQuals :: TypeQuals
tyQuals = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((String, TypeQuals -> Bool) -> Doc)
-> [(String, TypeQuals -> Bool)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String, TypeQuals -> Bool) -> Doc
showAttr [ ("const",TypeQuals -> Bool
constant),("volatile",TypeQuals -> Bool
volatile),("restrict",TypeQuals -> Bool
restrict) ]
        where showAttr :: (String, TypeQuals -> Bool) -> Doc
showAttr (str :: String
str,select :: TypeQuals -> Bool
select) | TypeQuals -> Bool
select TypeQuals
tyQuals = String -> Doc
text String
str
                                    | Bool
otherwise      = Doc
empty

instance Pretty CompType where
    pretty :: CompType -> Doc
pretty (CompType sue_ref :: SUERef
sue_ref tag :: CompTyKind
tag members :: [MemberDecl]
members attrs :: Attributes
attrs _node :: NodeInfo
_node) =
        (String -> Doc
text(String -> Doc) -> (CompTyKind -> String) -> CompTyKind -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CompTyKind -> String
forall a. Show a => a -> String
show) CompTyKind
tag Doc -> Doc -> Doc
<+> SUERef -> Doc
forall p. Pretty p => p -> Doc
pretty SUERef
sue_ref Doc -> Doc -> Doc
<+>
        Doc -> Doc
braces ([MemberDecl] -> Doc
forall a. Pretty a => [a] -> Doc
terminateSemi [MemberDecl]
members) Doc -> Doc -> Doc
<+>
        Attributes -> Doc
forall p. Pretty p => p -> Doc
pretty Attributes
attrs

instance Pretty MemberDecl where
    pretty :: MemberDecl -> Doc
pretty (MemberDecl (VarDecl name :: VarName
name declattrs :: DeclAttrs
declattrs ty :: Type
ty) bitfield :: Maybe Expr
bitfield _) =
        DeclAttrs -> Doc
forall p. Pretty p => p -> Doc
pretty DeclAttrs
declattrs Doc -> Doc -> Doc
<+> VarName -> Doc
forall p. Pretty p => p -> Doc
pretty VarName
name Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> Type -> Doc
forall p. Pretty p => p -> Doc
pretty Type
ty Doc -> Doc -> Doc
<+>
        (Doc -> (Expr -> Doc) -> Maybe Expr -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\bf :: Expr
bf -> String -> Doc
text ":" Doc -> Doc -> Doc
<+> Expr -> Doc
forall p. Pretty p => p -> Doc
pretty Expr
bf) Maybe Expr
bitfield)
    pretty (AnonBitField ty :: Type
ty bitfield_sz :: Expr
bitfield_sz _) =
        Type -> Doc
forall p. Pretty p => p -> Doc
pretty Type
ty Doc -> Doc -> Doc
<+> String -> Doc
text ":" Doc -> Doc -> Doc
<+> Expr -> Doc
forall p. Pretty p => p -> Doc
pretty Expr
bitfield_sz

instance Pretty EnumType where
    pretty :: EnumType -> Doc
pretty (EnumType sue_ref :: SUERef
sue_ref enumerators :: [Enumerator]
enumerators attrs :: Attributes
attrs _) =
      String -> Doc
text "enum" Doc -> Doc -> Doc
<+> SUERef -> Doc
forall p. Pretty p => p -> Doc
pretty SUERef
sue_ref Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
terminateSemi_ ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Enumerator -> Doc) -> [Enumerator] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Enumerator -> Doc
prettyEnr [Enumerator]
enumerators) Doc -> Doc -> Doc
<+> Attributes -> Doc
forall p. Pretty p => p -> Doc
pretty Attributes
attrs
      where
      prettyEnr :: Enumerator -> Doc
prettyEnr (Enumerator ident :: Ident
ident expr :: Expr
expr _enumty :: EnumType
_enumty _) = Ident -> Doc
forall p. Pretty p => p -> Doc
pretty Ident
ident Doc -> Doc -> Doc
<+> String -> Doc
text " = " Doc -> Doc -> Doc
<+> Expr -> Doc
forall p. Pretty p => p -> Doc
pretty Expr
expr

instance Pretty Enumerator where
    pretty :: Enumerator -> Doc
pretty (Enumerator ident :: Ident
ident expr :: Expr
expr enumty :: EnumType
enumty _) = String -> Doc
text "<" Doc -> Doc -> Doc
<> String -> Doc
text "econst" Doc -> Doc -> Doc
<+> SUERef -> Doc
forall p. Pretty p => p -> Doc
pretty (EnumType -> SUERef
forall a. HasSUERef a => a -> SUERef
sueRef EnumType
enumty) Doc -> Doc -> Doc
<> String -> Doc
text ">" Doc -> Doc -> Doc
<+>
                                              Ident -> Doc
forall p. Pretty p => p -> Doc
pretty Ident
ident Doc -> Doc -> Doc
<+> String -> Doc
text " = " Doc -> Doc -> Doc
<+> Expr -> Doc
forall p. Pretty p => p -> Doc
pretty Expr
expr

instance Pretty FunctionAttrs where
    pretty :: FunctionAttrs -> Doc
pretty fattrs :: FunctionAttrs
fattrs = [Doc] -> Doc
hsep [(FunctionAttrs -> Bool) -> String -> Doc
pIf FunctionAttrs -> Bool
isInline "inline", (FunctionAttrs -> Bool) -> String -> Doc
pIf FunctionAttrs -> Bool
isNoreturn "_Noreturn"]
      where
        pIf :: (FunctionAttrs -> Bool) -> String -> Doc
pIf isMatch :: FunctionAttrs -> Bool
isMatch txt :: String
txt = if FunctionAttrs -> Bool
isMatch FunctionAttrs
fattrs then String -> Doc
text String
txt else Doc
empty

instance Pretty Storage where
    pretty :: Storage -> Doc
pretty NoStorage = Doc
empty
    pretty (Auto reg :: Bool
reg) = String -> Doc
text(String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if Bool
reg then "auto/register" else "auto"
    pretty (Static linkage :: Linkage
linkage thread_local :: Bool
thread_local) =
        ([Doc] -> Doc
hcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text "/") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ String -> Doc
text "static",Linkage -> Doc
forall p. Pretty p => p -> Doc
pretty Linkage
linkage ])
        Doc -> Doc -> Doc
<+> (if Bool
thread_local then String -> Doc
text ", __thread" else Doc
empty)
    pretty (FunLinkage linkage :: Linkage
linkage) = String -> Doc
text "function/" Doc -> Doc -> Doc
<> Linkage -> Doc
forall p. Pretty p => p -> Doc
pretty Linkage
linkage
instance Pretty Linkage where
    pretty :: Linkage -> Doc
pretty InternalLinkage = String -> Doc
text "internal"
    pretty ExternalLinkage = String -> Doc
text "external"
    pretty NoLinkage       = String -> Doc
text "local"
instance Pretty VarName where
    pretty :: VarName -> Doc
pretty NoName = String -> Doc
text "<anonymous>"
    pretty (VarName ident :: Ident
ident asmname_opt :: Maybe AsmName
asmname_opt) = Ident -> Doc
forall p. Pretty p => p -> Doc
pretty Ident
ident Doc -> Doc -> Doc
<+> (Doc -> (AsmName -> Doc) -> Maybe AsmName -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty AsmName -> Doc
forall p. Pretty p => p -> Doc
pAsmName Maybe AsmName
asmname_opt)
        where pAsmName :: p -> Doc
pAsmName asmname :: p
asmname = String -> Doc
text "" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (String -> Doc
text "asmname" Doc -> Doc -> Doc
<+> p -> Doc
forall p. Pretty p => p -> Doc
pretty p
asmname)
instance Pretty Attributes where
    pretty :: Attributes -> Doc
pretty = Attributes -> Doc
forall a. Pretty a => [a] -> Doc
joinComma
instance Pretty Attr where
    pretty :: Attr -> Doc
pretty (Attr ident :: Ident
ident es :: [Expr]
es _) = Ident -> Doc
forall p. Pretty p => p -> Doc
pretty Ident
ident Doc -> Doc -> Doc
<+> (if [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr]
es then Doc
empty else String -> Doc
text "(...)")

joinComma :: (Pretty a) => [a] -> Doc
joinComma :: [a] -> Doc
joinComma = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall p. Pretty p => p -> Doc
pretty
terminateSemi :: (Pretty a) => [a] -> Doc
terminateSemi :: [a] -> Doc
terminateSemi = [Doc] -> Doc
terminateSemi_ ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall p. Pretty p => p -> Doc
pretty
terminateSemi_ :: [Doc] -> Doc
terminateSemi_ :: [Doc] -> Doc
terminateSemi_ = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
<> Doc
semi)