{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}

-- |
-- Module      :  Text.LLVM.PP
-- Copyright   :  Trevor Elliott 2011-2016
-- License     :  BSD3
--
-- Maintainer  :  awesomelyawesome@gmail.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- This is the pretty-printer for llvm assembly versions 3.6 and lower.
--
module Text.LLVM.PP where

import Text.LLVM.AST
import Text.LLVM.Triple.AST (TargetTriple)
import Text.LLVM.Triple.Print (printTriple)

import Control.Applicative ((<|>))
import Data.Bits ( shiftR, (.&.) )
import Data.Char (isAlphaNum,isAscii,isDigit,isPrint,ord,toUpper)
import Data.List (intersperse)
import qualified Data.Map as Map
import Data.Maybe (catMaybes,fromMaybe,isJust)
import GHC.Float (castDoubleToWord64, castFloatToWord32)
import Numeric (showHex)
import Text.PrettyPrint.HughesPJ
import Data.Int
import Prelude hiding ((<>))


-- Pretty-printer Config -------------------------------------------------------


-- | The value used to specify the LLVM major version.  The LLVM text format
-- (i.e. assembly code) changes with different versions of LLVM, so this value is
-- used to select the version the output should be generated for.
--
-- At the current time, changes primarily occur when the LLVM major version
-- changes, and this is expected to be the case going forward, so it is
-- sufficient to reference the LLVM version by the single major version number.
-- There is one exception and one possible future exception to this approach:
--
--  1. During LLVM v3, there were changes in 3.5, 3.6, 3.7, and 3.8.  There are
--     explicit @ppLLVMnn@ function entry points for those versions, but in the
--     event that a numerical value is needed, we note the serendipitous fact
--     that prior to LLVM 4, there are exactly 4 versions we need to
--     differentiate and can therefore assign the values of 0, 1, 2, and 3 to
--     those versions (and we have no intention of supporting any other pre-4.0
--     versions at this point).
--
--  2. If at some future date, there are text format changes associated with a
--     minor version, then the LLVM version designation here will need to be
--     enhanced and made more sophisticated.  At the present time, the likelihood
--     of that is small enough that the current simple implementation is a
--     benefit over a more complex mechanism that might not be needed.
--
type LLVMVer = Int

-- | Helpers for specifying the LLVM versions prior to v4
llvmV3_5, llvmV3_6, llvmV3_7, llvmV3_8 :: LLVMVer
llvmV3_5 :: LLVMVer
llvmV3_5 = LLVMVer
0
llvmV3_6 :: LLVMVer
llvmV3_6 = LLVMVer
1
llvmV3_7 :: LLVMVer
llvmV3_7 = LLVMVer
2
llvmV3_8 :: LLVMVer
llvmV3_8 = LLVMVer
3

-- | This value should be updated when support is added for new LLVM versions;
-- this is used for defaulting and otherwise reporting the maximum LLVM version
-- known to be supported.
llvmVlatest :: LLVMVer
llvmVlatest :: LLVMVer
llvmVlatest = LLVMVer
17


-- | The differences between various versions of the llvm textual AST.
newtype Config = Config { Config -> LLVMVer
cfgVer :: LLVMVer }

withConfig :: Config -> ((?config :: Config) => a) -> a
withConfig :: forall a. Config -> ((?config::Config) => a) -> a
withConfig Config
cfg (?config::Config) => a
body = let ?config = ?config::Config
Config
cfg in a
(?config::Config) => a
body


ppLLVM :: LLVMVer -> ((?config :: Config) => a) -> a
ppLLVM :: forall a. LLVMVer -> ((?config::Config) => a) -> a
ppLLVM LLVMVer
llvmver = Config -> ((?config::Config) => a) -> a
forall a. Config -> ((?config::Config) => a) -> a
withConfig Config { cfgVer :: LLVMVer
cfgVer = LLVMVer
llvmver }

ppLLVM35, ppLLVM36, ppLLVM37, ppLLVM38 :: ((?config :: Config) => a) -> a

ppLLVM35 :: forall a. ((?config::Config) => a) -> a
ppLLVM35 = Config -> ((?config::Config) => a) -> a
forall a. Config -> ((?config::Config) => a) -> a
withConfig Config { cfgVer :: LLVMVer
cfgVer = LLVMVer
llvmV3_5 }
ppLLVM36 :: forall a. ((?config::Config) => a) -> a
ppLLVM36 = Config -> ((?config::Config) => a) -> a
forall a. Config -> ((?config::Config) => a) -> a
withConfig Config { cfgVer :: LLVMVer
cfgVer = LLVMVer
llvmV3_6 }
ppLLVM37 :: forall a. ((?config::Config) => a) -> a
ppLLVM37 = Config -> ((?config::Config) => a) -> a
forall a. Config -> ((?config::Config) => a) -> a
withConfig Config { cfgVer :: LLVMVer
cfgVer = LLVMVer
llvmV3_7 }
ppLLVM38 :: forall a. ((?config::Config) => a) -> a
ppLLVM38 = Config -> ((?config::Config) => a) -> a
forall a. Config -> ((?config::Config) => a) -> a
withConfig Config { cfgVer :: LLVMVer
cfgVer = LLVMVer
llvmV3_8 }

llvmVer :: (?config :: Config) => LLVMVer
llvmVer :: (?config::Config) => LLVMVer
llvmVer = Config -> LLVMVer
cfgVer ?config::Config
Config
?config

llvmVerToString :: LLVMVer -> String
llvmVerToString :: LLVMVer -> [Char]
llvmVerToString LLVMVer
0 = [Char]
"3.5"
llvmVerToString LLVMVer
1 = [Char]
"3.6"
llvmVerToString LLVMVer
2 = [Char]
"3.7"
llvmVerToString LLVMVer
3 = [Char]
"3.8"
llvmVerToString LLVMVer
n
  | LLVMVer
n LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
4    = LLVMVer -> [Char]
forall a. Show a => a -> [Char]
show LLVMVer
n
  | Bool
otherwise = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid LLVMVer: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LLVMVer -> [Char]
forall a. Show a => a -> [Char]
show LLVMVer
n

-- | This is a helper function for when a list of parameters is gated by a
-- condition (usually the llvmVer value).
when' :: Monoid a => Bool -> a -> a
when' :: forall a. Monoid a => Bool -> a -> a
when' Bool
c a
l = if Bool
c then a
l else a
forall a. Monoid a => a
mempty


-- | This type encapsulates the ability to convert an object into Doc
-- format. Using this abstraction allows for a consolidated representation of the
-- declaration.  Most pretty-printing for LLVM elements will have a @'Fmt' a@
-- function signature for that element.
type Fmt a = (?config :: Config) => a -> Doc


-- | The LLVMPretty class has instances for most AST elements.  It allows the
-- conversion of an AST element (and its sub-elements) into a Doc assembly format
-- by simply using the 'llvmPP' method rather than needing to explicitly invoke
-- the specific pretty-printing function for that element.
class LLVMPretty a where llvmPP :: Fmt a

instance LLVMPretty Module where llvmPP :: Fmt Module
llvmPP = Fmt Module
Module -> Doc
ppModule
instance LLVMPretty Symbol where llvmPP :: Fmt Symbol
llvmPP = Fmt Symbol
Symbol -> Doc
ppSymbol
instance LLVMPretty Ident  where llvmPP :: Fmt Ident
llvmPP = Fmt Ident
Ident -> Doc
ppIdent


-- Modules ---------------------------------------------------------------------

ppModule :: Fmt Module
ppModule :: Fmt Module
ppModule Module
m = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($+$) Doc
empty
  ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt (Maybe [Char])
Maybe [Char] -> Doc
ppSourceName (Module -> Maybe [Char]
modSourceName Module
m)
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Fmt TargetTriple
TargetTriple -> Doc
ppTargetTriple (Module -> TargetTriple
modTriple Module
m)
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Fmt DataLayout
DataLayout -> Doc
ppDataLayout (Module -> DataLayout
modDataLayout Module
m)
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Fmt InlineAsm
InlineAsm -> Doc
ppInlineAsm  (Module -> InlineAsm
modInlineAsm Module
m)
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (TypeDecl -> Doc) -> [TypeDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt TypeDecl
TypeDecl -> Doc
ppTypeDecl    (Module -> [TypeDecl]
modTypes Module
m)
           , (Global -> Doc) -> [Global] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Global
Global -> Doc
ppGlobal      (Module -> [Global]
modGlobals Module
m)
           , (GlobalAlias -> Doc) -> [GlobalAlias] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt GlobalAlias
GlobalAlias -> Doc
ppGlobalAlias (Module -> [GlobalAlias]
modAliases Module
m)
           , (Declare -> Doc) -> [Declare] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Declare
Declare -> Doc
ppDeclare     (Module -> [Declare]
modDeclares Module
m)
           , (Define -> Doc) -> [Define] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Define
Define -> Doc
ppDefine      (Module -> [Define]
modDefines Module
m)
           , (NamedMd -> Doc) -> [NamedMd] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt NamedMd
NamedMd -> Doc
ppNamedMd     (Module -> [NamedMd]
modNamedMd Module
m)
           , (UnnamedMd -> Doc) -> [UnnamedMd] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt UnnamedMd
UnnamedMd -> Doc
ppUnnamedMd   (Module -> [UnnamedMd]
modUnnamedMd Module
m)
           , (([Char], SelectionKind) -> Doc)
-> [([Char], SelectionKind)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt ([Char], SelectionKind)
([Char], SelectionKind) -> Doc
ppComdat      (Map [Char] SelectionKind -> [([Char], SelectionKind)]
forall k a. Map k a -> [(k, a)]
Map.toList (Module -> Map [Char] SelectionKind
modComdat Module
m))
           ]


-- Source filename -------------------------------------------------------------

ppSourceName :: Fmt (Maybe String)
ppSourceName :: Fmt (Maybe [Char])
ppSourceName Maybe [Char]
Nothing   = Doc
empty
ppSourceName (Just [Char]
sn) = Doc
"source_filename" Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Char] -> Doc
text [Char]
sn)

-- Metadata --------------------------------------------------------------------

ppNamedMd :: Fmt NamedMd
ppNamedMd :: Fmt NamedMd
ppNamedMd NamedMd
nm =
  [Doc] -> Doc
sep [ Fmt Doc
Doc -> Doc
ppMetadata ([Char] -> Doc
text (NamedMd -> [Char]
nmName NamedMd
nm)) Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'='
      , Fmt Doc
Doc -> Doc
ppMetadata (Doc -> Doc
braces (Fmt [Doc]
[Doc] -> Doc
commas ((LLVMVer -> Doc) -> [LLVMVer] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt Doc
Doc -> Doc
ppMetadata (Doc -> Doc) -> (LLVMVer -> Doc) -> LLVMVer -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LLVMVer -> Doc
int) (NamedMd -> [LLVMVer]
nmValues NamedMd
nm)))) ]

ppUnnamedMd :: Fmt UnnamedMd
ppUnnamedMd :: Fmt UnnamedMd
ppUnnamedMd UnnamedMd
um =
  [Doc] -> Doc
sep [ Fmt Doc
Doc -> Doc
ppMetadata (LLVMVer -> Doc
int (UnnamedMd -> LLVMVer
umIndex UnnamedMd
um)) Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'='
      , Doc
distinct Doc -> Doc -> Doc
<+> Fmt ValMd
ValMd -> Doc
ppValMd (UnnamedMd -> ValMd
umValues UnnamedMd
um) ]
  where
  distinct :: Doc
distinct | UnnamedMd -> Bool
umDistinct UnnamedMd
um = Doc
"distinct"
           | Bool
otherwise     = Doc
empty


-- Aliases ---------------------------------------------------------------------

ppGlobalAlias :: Fmt GlobalAlias
ppGlobalAlias :: Fmt GlobalAlias
ppGlobalAlias GlobalAlias
g = Fmt Symbol
Symbol -> Doc
ppSymbol (GlobalAlias -> Symbol
aliasName GlobalAlias
g)
              Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'='
              Doc -> Doc -> Doc
<+> Fmt Linkage -> Fmt (Maybe Linkage)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Linkage
Linkage -> Doc
ppLinkage (GlobalAlias -> Maybe Linkage
aliasLinkage GlobalAlias
g)
              Doc -> Doc -> Doc
<+> Fmt Visibility -> Fmt (Maybe Visibility)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Visibility
Visibility -> Doc
ppVisibility (GlobalAlias -> Maybe Visibility
aliasVisibility GlobalAlias
g)
              Doc -> Doc -> Doc
<+> Doc
body
  where
  val :: Value
val  = GlobalAlias -> Value
aliasTarget GlobalAlias
g
  body :: Doc
body = case Value
val of
    ValSymbol Symbol
_sym -> Fmt Type
Type -> Doc
ppType (GlobalAlias -> Type
aliasType GlobalAlias
g) Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppValue Value
val
    Value
_              -> Fmt Value
Value -> Doc
ppValue Value
val


-- Target triple ---------------------------------------------------------------

-- | Pretty print a 'TargetTriple'
ppTargetTriple :: Fmt TargetTriple
ppTargetTriple :: Fmt TargetTriple
ppTargetTriple TargetTriple
triple = Doc
"target" Doc -> Doc -> Doc
<+> Doc
"triple" Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'='
    Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Char] -> Doc
text (TargetTriple -> [Char]
printTriple TargetTriple
triple))

-- Data Layout -----------------------------------------------------------------

-- | Pretty print a data layout specification.
ppDataLayout :: Fmt DataLayout
ppDataLayout :: Fmt DataLayout
ppDataLayout [] = Doc
empty
ppDataLayout DataLayout
ls = Doc
"target" Doc -> Doc -> Doc
<+> Doc
"datalayout" Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'='
    Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
'-') ((LayoutSpec -> Doc) -> DataLayout -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt LayoutSpec
LayoutSpec -> Doc
ppLayoutSpec DataLayout
ls)))

-- | Pretty print a single layout specification.
ppLayoutSpec :: Fmt LayoutSpec
ppLayoutSpec :: Fmt LayoutSpec
ppLayoutSpec LayoutSpec
ls =
  case LayoutSpec
ls of
    LayoutSpec
BigEndian                 -> Char -> Doc
char Char
'E'
    LayoutSpec
LittleEndian              -> Char -> Doc
char Char
'e'
    PointerSize LLVMVer
0 LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref -> Char -> Doc
char Char
'p' Doc -> Doc -> Doc
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<> LLVMVer -> LLVMVer -> Fmt (Maybe LLVMVer)
ppLayoutBody LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref
    PointerSize LLVMVer
n LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref -> Char -> Doc
char Char
'p' Doc -> Doc -> Doc
<> LLVMVer -> Doc
int LLVMVer
n Doc -> Doc -> Doc
<> Char -> Doc
char Char
':'
                                          Doc -> Doc -> Doc
<> LLVMVer -> LLVMVer -> Fmt (Maybe LLVMVer)
ppLayoutBody LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref
    IntegerSize   LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref -> Char -> Doc
char Char
'i' Doc -> Doc -> Doc
<> LLVMVer -> LLVMVer -> Fmt (Maybe LLVMVer)
ppLayoutBody LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref
    VectorSize    LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref -> Char -> Doc
char Char
'v' Doc -> Doc -> Doc
<> LLVMVer -> LLVMVer -> Fmt (Maybe LLVMVer)
ppLayoutBody LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref
    FloatSize     LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref -> Char -> Doc
char Char
'f' Doc -> Doc -> Doc
<> LLVMVer -> LLVMVer -> Fmt (Maybe LLVMVer)
ppLayoutBody LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref
    StackObjSize  LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref -> Char -> Doc
char Char
's' Doc -> Doc -> Doc
<> LLVMVer -> LLVMVer -> Fmt (Maybe LLVMVer)
ppLayoutBody LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref
    AggregateSize LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref -> Char -> Doc
char Char
'a' Doc -> Doc -> Doc
<> LLVMVer -> LLVMVer -> Fmt (Maybe LLVMVer)
ppLayoutBody LLVMVer
sz LLVMVer
abi Maybe LLVMVer
pref
    NativeIntSize [LLVMVer]
szs         ->
      Char -> Doc
char Char
'n' Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
':') ((LLVMVer -> Doc) -> [LLVMVer] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map LLVMVer -> Doc
int [LLVMVer]
szs))
    StackAlign LLVMVer
a              -> Char -> Doc
char Char
'S' Doc -> Doc -> Doc
<> LLVMVer -> Doc
int LLVMVer
a
    Mangling Mangling
m                -> Char -> Doc
char Char
'm' Doc -> Doc -> Doc
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<> Fmt Mangling
Mangling -> Doc
ppMangling Mangling
m

-- | Pretty-print the common case for data layout specifications.
ppLayoutBody :: Int -> Int -> Fmt (Maybe Int)
ppLayoutBody :: LLVMVer -> LLVMVer -> Fmt (Maybe LLVMVer)
ppLayoutBody LLVMVer
size LLVMVer
abi Maybe LLVMVer
mb = LLVMVer -> Doc
int LLVMVer
size Doc -> Doc -> Doc
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<> LLVMVer -> Doc
int LLVMVer
abi Doc -> Doc -> Doc
<> Doc
pref
  where
  pref :: Doc
pref = case Maybe LLVMVer
mb of
    Maybe LLVMVer
Nothing -> Doc
empty
    Just LLVMVer
p  -> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<> LLVMVer -> Doc
int LLVMVer
p

ppMangling :: Fmt Mangling
ppMangling :: Fmt Mangling
ppMangling Mangling
ElfMangling         = Char -> Doc
char Char
'e'
ppMangling Mangling
MipsMangling        = Char -> Doc
char Char
'm'
ppMangling Mangling
MachOMangling       = Char -> Doc
char Char
'o'
ppMangling Mangling
WindowsCoffMangling = Char -> Doc
char Char
'w'


-- Inline Assembly -------------------------------------------------------------

-- | Pretty-print the inline assembly block.
ppInlineAsm :: Fmt InlineAsm
ppInlineAsm :: Fmt InlineAsm
ppInlineAsm  = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($+$) Doc
empty ([Doc] -> Doc) -> (InlineAsm -> [Doc]) -> InlineAsm -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Doc) -> InlineAsm -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
ppLine
  where
  ppLine :: [Char] -> Doc
ppLine [Char]
l = Doc
"module asm" Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Char] -> Doc
text [Char]
l)


-- Identifiers -----------------------------------------------------------------

ppIdent :: Fmt Ident
ppIdent :: Fmt Ident
ppIdent (Ident [Char]
n)
  | [Char] -> Bool
validIdentifier [Char]
n = Char -> Doc
char Char
'%' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
n
  | Bool
otherwise         = Char -> Doc
char Char
'%' Doc -> Doc -> Doc
<> Fmt [Char]
[Char] -> Doc
ppStringLiteral [Char]
n

-- | According to the LLVM Language Reference Manual, the regular
-- expression for LLVM identifiers is "[-a-zA-Z$._][-a-zA-Z$._0-9]".
-- Identifiers may also be strings of one or more decimal digits.
validIdentifier :: String -> Bool
validIdentifier :: [Char] -> Bool
validIdentifier [] = Bool
False
validIdentifier s :: [Char]
s@(Char
c0 : [Char]
cs)
  | Char -> Bool
isDigit Char
c0 = (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
cs
  | Bool
otherwise  = (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isIdentChar [Char]
s
  where
  isIdentChar :: Char -> Bool
  isIdentChar :: Char -> Bool
isIdentChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"-$._" :: [Char])


-- Symbols ---------------------------------------------------------------------

ppSymbol :: Fmt Symbol
ppSymbol :: Fmt Symbol
ppSymbol (Symbol [Char]
n)
  | [Char] -> Bool
validIdentifier [Char]
n = Char -> Doc
char Char
'@' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
n
  | Bool
otherwise         = Char -> Doc
char Char
'@' Doc -> Doc -> Doc
<> Fmt [Char]
[Char] -> Doc
ppStringLiteral [Char]
n


-- Types -----------------------------------------------------------------------

ppPrimType :: Fmt PrimType
ppPrimType :: Fmt PrimType
ppPrimType PrimType
Label          = Doc
"label"
ppPrimType PrimType
Void           = Doc
"void"
ppPrimType (Integer Word32
i)    = Char -> Doc
char Char
'i' Doc -> Doc -> Doc
<> Integer -> Doc
integer (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
i)
ppPrimType (FloatType FloatType
ft) = Fmt FloatType
FloatType -> Doc
ppFloatType FloatType
ft
ppPrimType PrimType
X86mmx         = Doc
"x86mmx"
ppPrimType PrimType
Metadata       = Doc
"metadata"

ppFloatType :: Fmt FloatType
ppFloatType :: Fmt FloatType
ppFloatType FloatType
Half      = Doc
"half"
ppFloatType FloatType
Float     = Doc
"float"
ppFloatType FloatType
Double    = Doc
"double"
ppFloatType FloatType
Fp128     = Doc
"fp128"
ppFloatType FloatType
X86_fp80  = Doc
"x86_fp80"
ppFloatType FloatType
PPC_fp128 = Doc
"ppc_fp128"

ppType :: Fmt Type
ppType :: Fmt Type
ppType (PrimType PrimType
pt)     = Fmt PrimType
PrimType -> Doc
ppPrimType PrimType
pt
ppType (Alias Ident
i)         = Fmt Ident
Ident -> Doc
ppIdent Ident
i
ppType (Array Word64
len Type
ty)    = Doc -> Doc
brackets (Word64 -> Doc
forall i. Integral i => Fmt i
integral Word64
len Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'x' Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
ty)
ppType (PtrTo Type
ty)        = Fmt Type
Type -> Doc
ppType Type
ty Doc -> Doc -> Doc
<> Char -> Doc
char Char
'*'
ppType Type
PtrOpaque         = Doc
"ptr"
ppType (Struct [Type]
ts)       = Fmt Doc
Doc -> Doc
structBraces (Fmt [Doc]
[Doc] -> Doc
commas ((Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Type
Type -> Doc
ppType [Type]
ts))
ppType (PackedStruct [Type]
ts) = Fmt Doc
Doc -> Doc
angles (Fmt Doc
Doc -> Doc
structBraces (Fmt [Doc]
[Doc] -> Doc
commas ((Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Type
Type -> Doc
ppType [Type]
ts)))
ppType (FunTy Type
r [Type]
as Bool
va)   = Fmt Type
Type -> Doc
ppType Type
r Doc -> Doc -> Doc
<> Bool -> Fmt [Doc]
ppArgList Bool
va ((Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Type
Type -> Doc
ppType [Type]
as)
ppType (Vector Word64
len Type
pt)   = Fmt Doc
Doc -> Doc
angles (Word64 -> Doc
forall i. Integral i => Fmt i
integral Word64
len Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'x' Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
pt)
ppType Type
Opaque            = Doc
"opaque"

ppTypeDecl :: Fmt TypeDecl
ppTypeDecl :: Fmt TypeDecl
ppTypeDecl TypeDecl
td = Fmt Ident
Ident -> Doc
ppIdent (TypeDecl -> Ident
typeName TypeDecl
td) Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'='
            Doc -> Doc -> Doc
<+> Doc
"type" Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType (TypeDecl -> Type
typeValue TypeDecl
td)


-- Declarations ----------------------------------------------------------------

ppGlobal :: Fmt Global
ppGlobal :: Fmt Global
ppGlobal Global
g = Fmt Symbol
Symbol -> Doc
ppSymbol (Global -> Symbol
globalSym Global
g) Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'='
         Doc -> Doc -> Doc
<+> Bool -> Fmt GlobalAttrs
ppGlobalAttrs (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> Maybe Value -> Bool
forall a b. (a -> b) -> a -> b
$ Global -> Maybe Value
globalValue Global
g) (Global -> GlobalAttrs
globalAttrs Global
g)
         Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType (Global -> Type
globalType Global
g) Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Maybe Value)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Value
Value -> Doc
ppValue (Global -> Maybe Value
globalValue Global
g)
          Doc -> Doc -> Doc
<> Fmt (Maybe LLVMVer)
Maybe LLVMVer -> Doc
ppAlign (Global -> Maybe LLVMVer
globalAlign Global
g)
          Doc -> Doc -> Doc
<> Fmt [([Char], ValMd)]
[([Char], ValMd)] -> Doc
ppAttachedMetadata (Map [Char] ValMd -> [([Char], ValMd)]
forall k a. Map k a -> [(k, a)]
Map.toList (Global -> Map [Char] ValMd
globalMetadata Global
g))

-- | Pretty-print Global Attributes (usually associated with a global variable
-- declaration). The first argument to ppGlobalAttrs indicates whether there is a
-- value associated with this global declaration: a global declaration with a
-- value should not be identified as \"external\" and \"default\" visibility,
-- whereas one without a value may have those attributes.

ppGlobalAttrs :: Bool -> Fmt GlobalAttrs
ppGlobalAttrs :: Bool -> Fmt GlobalAttrs
ppGlobalAttrs Bool
hasValue GlobalAttrs
ga
    -- LLVM 3.8 does not emit or parse linkage information w/ hidden visibility
    | Just Visibility
HiddenVisibility <- GlobalAttrs -> Maybe Visibility
gaVisibility GlobalAttrs
ga =
            Fmt Visibility
Visibility -> Doc
ppVisibility Visibility
HiddenVisibility Doc -> Doc -> Doc
<+> Doc
constant
    | Just Linkage
External <- GlobalAttrs -> Maybe Linkage
gaLinkage GlobalAttrs
ga
    , Just Visibility
DefaultVisibility <- GlobalAttrs -> Maybe Visibility
gaVisibility GlobalAttrs
ga
    , Bool
hasValue =
        -- Just show the value, no "external" or "default".  This is based on
        -- empirical testing as described in the comment above (testing the
        -- following 6 configurations:
        --   * uninitialized scalar
        --   * uninitialized structure
        --   * initialized scalar
        --   * initialized structure
        --   * external scalar
        --   * external structure
        Doc
constant
    | Bool
otherwise =
        Fmt Linkage -> Fmt (Maybe Linkage)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Linkage
Linkage -> Doc
ppLinkage (GlobalAttrs -> Maybe Linkage
gaLinkage GlobalAttrs
ga) Doc -> Doc -> Doc
<+> Fmt Visibility -> Fmt (Maybe Visibility)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Visibility
Visibility -> Doc
ppVisibility (GlobalAttrs -> Maybe Visibility
gaVisibility GlobalAttrs
ga) Doc -> Doc -> Doc
<+> Doc
constant
  where
  constant :: Doc
constant | GlobalAttrs -> Bool
gaConstant GlobalAttrs
ga = Doc
"constant"
           | Bool
otherwise     = Doc
"global"

ppDeclare :: Fmt Declare
ppDeclare :: Fmt Declare
ppDeclare Declare
d = Doc
"declare"
          Doc -> Doc -> Doc
<+> Fmt Linkage -> Fmt (Maybe Linkage)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Linkage
Linkage -> Doc
ppLinkage (Declare -> Maybe Linkage
decLinkage Declare
d)
          Doc -> Doc -> Doc
<+> Fmt Visibility -> Fmt (Maybe Visibility)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Visibility
Visibility -> Doc
ppVisibility (Declare -> Maybe Visibility
decVisibility Declare
d)
          Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType (Declare -> Type
decRetType Declare
d)
          Doc -> Doc -> Doc
<+> Fmt Symbol
Symbol -> Doc
ppSymbol (Declare -> Symbol
decName Declare
d)
           Doc -> Doc -> Doc
<> Bool -> Fmt [Doc]
ppArgList (Declare -> Bool
decVarArgs Declare
d) ((Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Type
Type -> Doc
ppType (Declare -> [Type]
decArgs Declare
d))
          Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Fmt FunAttr
FunAttr -> Doc
ppFunAttr (FunAttr -> Doc) -> [FunAttr] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Declare -> [FunAttr]
decAttrs Declare
d)
          Doc -> Doc -> Doc
<> Doc -> ([Char] -> Doc) -> Maybe [Char] -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty ((Char -> Doc
char Char
' ' Doc -> Doc -> Doc
<>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt [Char]
[Char] -> Doc
ppComdatName) (Declare -> Maybe [Char]
decComdat Declare
d)

ppComdatName :: Fmt String
ppComdatName :: Fmt [Char]
ppComdatName [Char]
s = Doc
"comdat" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Char -> Doc
char Char
'$' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
s)

ppComdat :: Fmt (String,SelectionKind)
ppComdat :: Fmt ([Char], SelectionKind)
ppComdat ([Char]
n,SelectionKind
k) = Fmt [Char]
[Char] -> Doc
ppComdatName [Char]
n Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"comdat" Doc -> Doc -> Doc
<+> Fmt SelectionKind
SelectionKind -> Doc
ppSelectionKind SelectionKind
k

ppSelectionKind :: Fmt SelectionKind
ppSelectionKind :: Fmt SelectionKind
ppSelectionKind SelectionKind
k =
    case SelectionKind
k of
      SelectionKind
ComdatAny             -> Doc
"any"
      SelectionKind
ComdatExactMatch      -> Doc
"exactmatch"
      SelectionKind
ComdatLargest         -> Doc
"largest"
      SelectionKind
ComdatNoDuplicates    -> Doc
"noduplicates"
      SelectionKind
ComdatSameSize        -> Doc
"samesize"

ppDefine :: Fmt Define
ppDefine :: Fmt Define
ppDefine Define
d = Doc
"define"
         Doc -> Doc -> Doc
<+> Fmt Linkage -> Fmt (Maybe Linkage)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Linkage
Linkage -> Doc
ppLinkage (Define -> Maybe Linkage
defLinkage Define
d)
         Doc -> Doc -> Doc
<+> Fmt Visibility -> Fmt (Maybe Visibility)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt Visibility
Visibility -> Doc
ppVisibility (Define -> Maybe Visibility
defVisibility Define
d)
         Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType (Define -> Type
defRetType Define
d)
         Doc -> Doc -> Doc
<+> Fmt Symbol
Symbol -> Doc
ppSymbol (Define -> Symbol
defName Define
d)
          Doc -> Doc -> Doc
<> Bool -> Fmt [Doc]
ppArgList (Define -> Bool
defVarArgs Define
d) ((Typed Ident -> Doc) -> [Typed Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt Ident -> Fmt (Typed Ident)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Ident
Ident -> Doc
ppIdent) (Define -> [Typed Ident]
defArgs Define
d))
         Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Fmt FunAttr
FunAttr -> Doc
ppFunAttr (FunAttr -> Doc) -> [FunAttr] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Define -> [FunAttr]
defAttrs Define
d)
         Doc -> Doc -> Doc
<+> Fmt [Char] -> Fmt (Maybe [Char])
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe (\[Char]
s  -> Doc
"section" Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Char] -> Doc
text [Char]
s)) (Define -> Maybe [Char]
defSection Define
d)
         Doc -> Doc -> Doc
<+> Fmt GC -> Fmt (Maybe GC)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe (\GC
gc -> Doc
"gc" Doc -> Doc -> Doc
<+> Fmt GC
GC -> Doc
ppGC GC
gc) (Define -> Maybe GC
defGC Define
d)
         Doc -> Doc -> Doc
<+> (?config::Config) => Map [Char] ValMd -> Doc
Map [Char] ValMd -> Doc
ppMds (Define -> Map [Char] ValMd
defMetadata Define
d)
         Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{'
         Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat ((BasicBlock -> Doc) -> [BasicBlock] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt BasicBlock
BasicBlock -> Doc
ppBasicBlock (Define -> [BasicBlock]
defBody Define
d))
         Doc -> Doc -> Doc
$+$ Char -> Doc
char Char
'}'
  where
  ppMds :: Map [Char] ValMd -> Doc
ppMds Map [Char] ValMd
mdm =
    case Map [Char] ValMd -> [([Char], ValMd)]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Char] ValMd
mdm of
      [] -> Doc
empty
      [([Char], ValMd)]
mds -> [Doc] -> Doc
hsep [ Doc
"!" Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
k Doc -> Doc -> Doc
<+> Fmt ValMd
ValMd -> Doc
ppValMd ValMd
md | ([Char]
k, ValMd
md) <- [([Char], ValMd)]
mds ]

-- FunAttr ---------------------------------------------------------------------

ppFunAttr :: Fmt FunAttr
ppFunAttr :: Fmt FunAttr
ppFunAttr FunAttr
a =
  case FunAttr
a of
    AlignStack LLVMVer
w    -> [Char] -> Doc
text [Char]
"alignstack" Doc -> Doc -> Doc
<> Doc -> Doc
parens (LLVMVer -> Doc
int LLVMVer
w)
    FunAttr
Alwaysinline    -> [Char] -> Doc
text [Char]
"alwaysinline"
    FunAttr
Builtin         -> [Char] -> Doc
text [Char]
"builtin"
    FunAttr
Cold            -> [Char] -> Doc
text [Char]
"cold"
    FunAttr
Inlinehint      -> [Char] -> Doc
text [Char]
"inlinehint"
    FunAttr
Jumptable       -> [Char] -> Doc
text [Char]
"jumptable"
    FunAttr
Minsize         -> [Char] -> Doc
text [Char]
"minsize"
    FunAttr
Naked           -> [Char] -> Doc
text [Char]
"naked"
    FunAttr
Nobuiltin       -> [Char] -> Doc
text [Char]
"nobuiltin"
    FunAttr
Noduplicate     -> [Char] -> Doc
text [Char]
"noduplicate"
    FunAttr
Noimplicitfloat -> [Char] -> Doc
text [Char]
"noimplicitfloat"
    FunAttr
Noinline        -> [Char] -> Doc
text [Char]
"noinline"
    FunAttr
Nonlazybind     -> [Char] -> Doc
text [Char]
"nonlazybind"
    FunAttr
Noredzone       -> [Char] -> Doc
text [Char]
"noredzone"
    FunAttr
Noreturn        -> [Char] -> Doc
text [Char]
"noreturn"
    FunAttr
Nounwind        -> [Char] -> Doc
text [Char]
"nounwind"
    FunAttr
Optnone         -> [Char] -> Doc
text [Char]
"optnone"
    FunAttr
Optsize         -> [Char] -> Doc
text [Char]
"optsize"
    FunAttr
Readnone        -> [Char] -> Doc
text [Char]
"readnone"
    FunAttr
Readonly        -> [Char] -> Doc
text [Char]
"readonly"
    FunAttr
ReturnsTwice    -> [Char] -> Doc
text [Char]
"returns_twice"
    FunAttr
SanitizeAddress -> [Char] -> Doc
text [Char]
"sanitize_address"
    FunAttr
SanitizeMemory  -> [Char] -> Doc
text [Char]
"sanitize_memory"
    FunAttr
SanitizeThread  -> [Char] -> Doc
text [Char]
"sanitize_thread"
    FunAttr
SSP             -> [Char] -> Doc
text [Char]
"ssp"
    FunAttr
SSPreq          -> [Char] -> Doc
text [Char]
"sspreq"
    FunAttr
SSPstrong       -> [Char] -> Doc
text [Char]
"sspstrong"
    FunAttr
UWTable         -> [Char] -> Doc
text [Char]
"uwtable"

-- Basic Blocks ----------------------------------------------------------------

ppLabelDef :: Fmt BlockLabel
ppLabelDef :: Fmt BlockLabel
ppLabelDef (Named (Ident [Char]
l)) = [Char] -> Doc
text [Char]
l Doc -> Doc -> Doc
<> Char -> Doc
char Char
':'
ppLabelDef (Anon LLVMVer
i)          = Char -> Doc
char Char
';' Doc -> Doc -> Doc
<+> Doc
"<label>:" Doc -> Doc -> Doc
<+> LLVMVer -> Doc
int LLVMVer
i

ppLabel :: Fmt BlockLabel
ppLabel :: Fmt BlockLabel
ppLabel (Named Ident
l) = Fmt Ident
Ident -> Doc
ppIdent Ident
l
ppLabel (Anon LLVMVer
i)  = Char -> Doc
char Char
'%' Doc -> Doc -> Doc
<> LLVMVer -> Doc
int LLVMVer
i

ppBasicBlock :: Fmt BasicBlock
ppBasicBlock :: Fmt BasicBlock
ppBasicBlock BasicBlock
bb = Fmt BlockLabel -> Fmt (Maybe BlockLabel)
forall a. Fmt a -> Fmt (Maybe a)
ppMaybe Fmt BlockLabel
BlockLabel -> Doc
ppLabelDef (BasicBlock -> Maybe BlockLabel
forall lab. BasicBlock' lab -> Maybe lab
bbLabel BasicBlock
bb)
              Doc -> Doc -> Doc
$+$ LLVMVer -> Doc -> Doc
nest LLVMVer
2 ([Doc] -> Doc
vcat ((Stmt -> Doc) -> [Stmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Stmt
Stmt -> Doc
ppStmt (BasicBlock -> [Stmt]
forall lab. BasicBlock' lab -> [Stmt' lab]
bbStmts BasicBlock
bb)))


-- Statements ------------------------------------------------------------------

ppStmt :: Fmt Stmt
ppStmt :: Fmt Stmt
ppStmt Stmt
stmt = case Stmt
stmt of
  Result Ident
var Instr' BlockLabel
i [([Char], ValMd)]
mds -> Fmt Ident
Ident -> Doc
ppIdent Ident
var Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Fmt (Instr' BlockLabel)
Instr' BlockLabel -> Doc
ppInstr Instr' BlockLabel
i
                   Doc -> Doc -> Doc
<> Fmt [([Char], ValMd)]
[([Char], ValMd)] -> Doc
ppAttachedMetadata [([Char], ValMd)]
mds
  Effect Instr' BlockLabel
i [([Char], ValMd)]
mds     -> Fmt (Instr' BlockLabel)
Instr' BlockLabel -> Doc
ppInstr Instr' BlockLabel
i Doc -> Doc -> Doc
<> Fmt [([Char], ValMd)]
[([Char], ValMd)] -> Doc
ppAttachedMetadata [([Char], ValMd)]
mds

ppAttachedMetadata :: Fmt [(String,ValMd)]
ppAttachedMetadata :: Fmt [([Char], ValMd)]
ppAttachedMetadata [([Char], ValMd)]
mds
  | [([Char], ValMd)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], ValMd)]
mds  = Doc
empty
  | Bool
otherwise = Doc
comma Doc -> Doc -> Doc
<+> Fmt [Doc]
[Doc] -> Doc
commas ((([Char], ValMd) -> Doc) -> [([Char], ValMd)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (?config::Config) => ([Char], ValMd) -> Doc
([Char], ValMd) -> Doc
step [([Char], ValMd)]
mds)
  where
  step :: ([Char], ValMd) -> Doc
step ([Char]
l,ValMd
md) = Fmt Doc
Doc -> Doc
ppMetadata ([Char] -> Doc
text [Char]
l) Doc -> Doc -> Doc
<+> Fmt ValMd
ValMd -> Doc
ppValMd ValMd
md


-- Linkage ---------------------------------------------------------------------

ppLinkage :: Fmt Linkage
ppLinkage :: Fmt Linkage
ppLinkage Linkage
linkage = case Linkage
linkage of
  Linkage
Private                  -> Doc
"private"
  Linkage
LinkerPrivate            -> Doc
"linker_private"
  Linkage
LinkerPrivateWeak        -> Doc
"linker_private_weak"
  Linkage
LinkerPrivateWeakDefAuto -> Doc
"linker_private_weak_def_auto"
  Linkage
Internal                 -> Doc
"internal"
  Linkage
AvailableExternally      -> Doc
"available_externally"
  Linkage
Linkonce                 -> Doc
"linkonce"
  Linkage
Weak                     -> Doc
"weak"
  Linkage
Common                   -> Doc
"common"
  Linkage
Appending                -> Doc
"appending"
  Linkage
ExternWeak               -> Doc
"extern_weak"
  Linkage
LinkonceODR              -> Doc
"linkonce_ddr"
  Linkage
WeakODR                  -> Doc
"weak_odr"
  Linkage
External                 -> Doc
"external"
  Linkage
DLLImport                -> Doc
"dllimport"
  Linkage
DLLExport                -> Doc
"dllexport"

ppVisibility :: Fmt Visibility
ppVisibility :: Fmt Visibility
ppVisibility Visibility
v = case Visibility
v of
    Visibility
DefaultVisibility   -> Doc
"default"
    Visibility
HiddenVisibility    -> Doc
"hidden"
    Visibility
ProtectedVisibility -> Doc
"protected"

ppGC :: Fmt GC
ppGC :: Fmt GC
ppGC  = Doc -> Doc
doubleQuotes (Doc -> Doc) -> (GC -> Doc) -> GC -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text ([Char] -> Doc) -> (GC -> [Char]) -> GC -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GC -> [Char]
getGC


-- Expressions -----------------------------------------------------------------

ppTyped :: Fmt a -> Fmt (Typed a)
ppTyped :: forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt a
fmt Typed a
ty = Fmt Type
Type -> Doc
ppType (Typed a -> Type
forall a. Typed a -> Type
typedType Typed a
ty) Doc -> Doc -> Doc
<+> a -> Doc
Fmt a
fmt (Typed a -> a
forall a. Typed a -> a
typedValue Typed a
ty)

ppSignBits :: Bool -> Fmt Bool
ppSignBits :: Bool -> Fmt Bool
ppSignBits Bool
nuw Bool
nsw = Bool -> Fmt Doc
opt Bool
nuw Doc
"nuw" Doc -> Doc -> Doc
<+> Bool -> Fmt Doc
opt Bool
nsw Doc
"nsw"

ppExact :: Fmt Bool
ppExact :: Fmt Bool
ppExact Bool
e = Bool -> Fmt Doc
opt Bool
e Doc
"exact"

ppArithOp :: Fmt ArithOp
ppArithOp :: Fmt ArithOp
ppArithOp (Add Bool
nuw Bool
nsw) = Doc
"add" Doc -> Doc -> Doc
<+> Bool -> Fmt Bool
ppSignBits Bool
nuw Bool
nsw
ppArithOp ArithOp
FAdd          = Doc
"fadd"
ppArithOp (Sub Bool
nuw Bool
nsw) = Doc
"sub" Doc -> Doc -> Doc
<+> Bool -> Fmt Bool
ppSignBits Bool
nuw Bool
nsw
ppArithOp ArithOp
FSub          = Doc
"fsub"
ppArithOp (Mul Bool
nuw Bool
nsw) = Doc
"mul" Doc -> Doc -> Doc
<+> Bool -> Fmt Bool
ppSignBits Bool
nuw Bool
nsw
ppArithOp ArithOp
FMul          = Doc
"fmul"
ppArithOp (UDiv Bool
e)      = Doc
"udiv" Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppExact Bool
e
ppArithOp (SDiv Bool
e)      = Doc
"sdiv" Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppExact Bool
e
ppArithOp ArithOp
FDiv          = Doc
"fdiv"
ppArithOp ArithOp
URem          = Doc
"urem"
ppArithOp ArithOp
SRem          = Doc
"srem"
ppArithOp ArithOp
FRem          = Doc
"frem"

ppUnaryArithOp :: Fmt UnaryArithOp
ppUnaryArithOp :: Fmt UnaryArithOp
ppUnaryArithOp UnaryArithOp
FNeg = Doc
"fneg"

ppBitOp :: Fmt BitOp
ppBitOp :: Fmt BitOp
ppBitOp (Shl Bool
nuw Bool
nsw) = Doc
"shl"  Doc -> Doc -> Doc
<+> Bool -> Fmt Bool
ppSignBits Bool
nuw Bool
nsw
ppBitOp (Lshr Bool
e)      = Doc
"lshr" Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppExact Bool
e
ppBitOp (Ashr Bool
e)      = Doc
"ashr" Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppExact Bool
e
ppBitOp BitOp
And           = Doc
"and"
ppBitOp BitOp
Or            = Doc
"or"
ppBitOp BitOp
Xor           = Doc
"xor"

ppConvOp :: Fmt ConvOp
ppConvOp :: Fmt ConvOp
ppConvOp ConvOp
Trunc    = Doc
"trunc"
ppConvOp ConvOp
ZExt     = Doc
"zext"
ppConvOp ConvOp
SExt     = Doc
"sext"
ppConvOp ConvOp
FpTrunc  = Doc
"fptrunc"
ppConvOp ConvOp
FpExt    = Doc
"fpext"
ppConvOp ConvOp
FpToUi   = Doc
"fptoui"
ppConvOp ConvOp
FpToSi   = Doc
"fptosi"
ppConvOp ConvOp
UiToFp   = Doc
"uitofp"
ppConvOp ConvOp
SiToFp   = Doc
"sitofp"
ppConvOp ConvOp
PtrToInt = Doc
"ptrtoint"
ppConvOp ConvOp
IntToPtr = Doc
"inttoptr"
ppConvOp ConvOp
BitCast  = Doc
"bitcast"

ppAtomicOrdering :: Fmt AtomicOrdering
ppAtomicOrdering :: Fmt AtomicOrdering
ppAtomicOrdering AtomicOrdering
Unordered = [Char] -> Doc
text [Char]
"unordered"
ppAtomicOrdering AtomicOrdering
Monotonic = [Char] -> Doc
text [Char]
"monotonic"
ppAtomicOrdering AtomicOrdering
Acquire   = [Char] -> Doc
text [Char]
"acquire"
ppAtomicOrdering AtomicOrdering
Release   = [Char] -> Doc
text [Char]
"release"
ppAtomicOrdering AtomicOrdering
AcqRel    = [Char] -> Doc
text [Char]
"acq_rel"
ppAtomicOrdering AtomicOrdering
SeqCst    = [Char] -> Doc
text [Char]
"seq_cst"

ppAtomicOp :: Fmt AtomicRWOp
ppAtomicOp :: Fmt AtomicRWOp
ppAtomicOp AtomicRWOp
AtomicXchg = Doc
"xchg"
ppAtomicOp AtomicRWOp
AtomicAdd  = Doc
"add"
ppAtomicOp AtomicRWOp
AtomicSub  = Doc
"sub"
ppAtomicOp AtomicRWOp
AtomicAnd  = Doc
"and"
ppAtomicOp AtomicRWOp
AtomicNand = Doc
"nand"
ppAtomicOp AtomicRWOp
AtomicOr   = Doc
"or"
ppAtomicOp AtomicRWOp
AtomicXor  = Doc
"xor"
ppAtomicOp AtomicRWOp
AtomicMax  = Doc
"max"
ppAtomicOp AtomicRWOp
AtomicMin  = Doc
"min"
ppAtomicOp AtomicRWOp
AtomicUMax = Doc
"umax"
ppAtomicOp AtomicRWOp
AtomicUMin = Doc
"umin"
ppAtomicOp AtomicRWOp
AtomicFAdd = LLVMVer -> [Char] -> Doc -> Doc
forall a. (?config::Config) => LLVMVer -> [Char] -> a -> a
onlyOnLLVM LLVMVer
9 [Char]
"AtomicFAdd" Doc
"fadd"
ppAtomicOp AtomicRWOp
AtomicFSub = LLVMVer -> [Char] -> Doc -> Doc
forall a. (?config::Config) => LLVMVer -> [Char] -> a -> a
onlyOnLLVM LLVMVer
9 [Char]
"AtomicFSub" Doc
"fsub"
ppAtomicOp AtomicRWOp
AtomicFMax = LLVMVer -> [Char] -> Doc -> Doc
forall a. (?config::Config) => LLVMVer -> [Char] -> a -> a
onlyOnLLVM LLVMVer
15 [Char]
"AtomicFMax" Doc
"fmax"
ppAtomicOp AtomicRWOp
AtomicFMin = LLVMVer -> [Char] -> Doc -> Doc
forall a. (?config::Config) => LLVMVer -> [Char] -> a -> a
onlyOnLLVM LLVMVer
15 [Char]
"AtomicFMin" Doc
"fmin"
ppAtomicOp AtomicRWOp
AtomicUIncWrap = LLVMVer -> [Char] -> Doc -> Doc
forall a. (?config::Config) => LLVMVer -> [Char] -> a -> a
onlyOnLLVM LLVMVer
16 [Char]
"AtomicUIncWrap" Doc
"uinc_wrap"
ppAtomicOp AtomicRWOp
AtomicUDecWrap = LLVMVer -> [Char] -> Doc -> Doc
forall a. (?config::Config) => LLVMVer -> [Char] -> a -> a
onlyOnLLVM LLVMVer
16 [Char]
"AtomicUDecWrap" Doc
"udec_wrap"

ppScope ::  Fmt (Maybe String)
ppScope :: Fmt (Maybe [Char])
ppScope Maybe [Char]
Nothing = Doc
empty
ppScope (Just [Char]
s) = Doc
"syncscope" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc -> Doc
doubleQuotes ([Char] -> Doc
text [Char]
s))

ppInstr :: Fmt Instr
ppInstr :: Fmt (Instr' BlockLabel)
ppInstr Instr' BlockLabel
instr = case Instr' BlockLabel
instr of
  Ret Typed Value
tv                 -> Doc
"ret" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
tv
  Instr' BlockLabel
RetVoid                -> Doc
"ret void"
  Arith ArithOp
op Typed Value
l Value
r           -> Fmt ArithOp
ArithOp -> Doc
ppArithOp ArithOp
op Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
l
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppValue Value
r
  UnaryArith UnaryArithOp
op Typed Value
a        -> Fmt UnaryArithOp
UnaryArithOp -> Doc
ppUnaryArithOp UnaryArithOp
op Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
a
  Bit BitOp
op Typed Value
l Value
r             -> Fmt BitOp
BitOp -> Doc
ppBitOp BitOp
op Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
l
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppValue Value
r
  Conv ConvOp
op Typed Value
a Type
ty           -> Fmt ConvOp
ConvOp -> Doc
ppConvOp ConvOp
op Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
a
                        Doc -> Doc -> Doc
<+> Doc
"to" Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
ty
  Call Bool
tc Type
ty Value
f [Typed Value]
args      -> Bool -> Type -> Value -> Fmt [Typed Value]
ppCall Bool
tc Type
ty Value
f [Typed Value]
args
  CallBr Type
ty Value
f [Typed Value]
args BlockLabel
u [BlockLabel]
es  -> Type -> Value -> [Typed Value] -> BlockLabel -> Fmt [BlockLabel]
ppCallBr Type
ty Value
f [Typed Value]
args BlockLabel
u [BlockLabel]
es
  Alloca Type
ty Maybe (Typed Value)
len Maybe LLVMVer
align    -> Type -> Maybe (Typed Value) -> Fmt (Maybe LLVMVer)
ppAlloca Type
ty Maybe (Typed Value)
len Maybe LLVMVer
align
  Load Type
ty Typed Value
ptr Maybe AtomicOrdering
mo Maybe LLVMVer
ma      -> Type -> Typed Value -> Maybe AtomicOrdering -> Fmt (Maybe LLVMVer)
ppLoad Type
ty Typed Value
ptr Maybe AtomicOrdering
mo Maybe LLVMVer
ma
  Store Typed Value
a Typed Value
ptr Maybe AtomicOrdering
mo Maybe LLVMVer
ma      -> Typed Value
-> Typed Value -> Maybe AtomicOrdering -> Fmt (Maybe LLVMVer)
ppStore Typed Value
a Typed Value
ptr Maybe AtomicOrdering
mo Maybe LLVMVer
ma
  Fence Maybe [Char]
scope AtomicOrdering
order      -> Doc
"fence" Doc -> Doc -> Doc
<+> Fmt (Maybe [Char])
Maybe [Char] -> Doc
ppScope Maybe [Char]
scope Doc -> Doc -> Doc
<+> Fmt AtomicOrdering
AtomicOrdering -> Doc
ppAtomicOrdering AtomicOrdering
order
  CmpXchg Bool
w Bool
v Typed Value
p Typed Value
a Typed Value
n Maybe [Char]
s AtomicOrdering
o AtomicOrdering
o' -> Doc
"cmpxchg" Doc -> Doc -> Doc
<+> Bool -> Fmt Doc
opt Bool
w Doc
"weak"
                         Doc -> Doc -> Doc
<+> Bool -> Fmt Doc
opt Bool
v Doc
"volatile"
                         Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
p
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
a
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
n
                         Doc -> Doc -> Doc
<+> Fmt (Maybe [Char])
Maybe [Char] -> Doc
ppScope Maybe [Char]
s
                         Doc -> Doc -> Doc
<+> Fmt AtomicOrdering
AtomicOrdering -> Doc
ppAtomicOrdering AtomicOrdering
o
                         Doc -> Doc -> Doc
<+> Fmt AtomicOrdering
AtomicOrdering -> Doc
ppAtomicOrdering AtomicOrdering
o'
  AtomicRW Bool
v AtomicRWOp
op Typed Value
p Typed Value
a Maybe [Char]
s AtomicOrdering
o  -> Doc
"atomicrmw"
                         Doc -> Doc -> Doc
<+> Bool -> Fmt Doc
opt Bool
v Doc
"volatile"
                         Doc -> Doc -> Doc
<+> Fmt AtomicRWOp
AtomicRWOp -> Doc
ppAtomicOp AtomicRWOp
op
                         Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
p
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
a
                         Doc -> Doc -> Doc
<+> Fmt (Maybe [Char])
Maybe [Char] -> Doc
ppScope Maybe [Char]
s
                         Doc -> Doc -> Doc
<+> Fmt AtomicOrdering
AtomicOrdering -> Doc
ppAtomicOrdering AtomicOrdering
o
  ICmp ICmpOp
op Typed Value
l Value
r            -> Doc
"icmp" Doc -> Doc -> Doc
<+> Fmt ICmpOp
ICmpOp -> Doc
ppICmpOp ICmpOp
op
                        Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
l Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppValue Value
r
  FCmp FCmpOp
op Typed Value
l Value
r            -> Doc
"fcmp" Doc -> Doc -> Doc
<+> Fmt FCmpOp
FCmpOp -> Doc
ppFCmpOp FCmpOp
op
                        Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
l Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppValue Value
r
  Phi Type
ty [(Value, BlockLabel)]
vls             -> Doc
"phi" Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
ty
                        Doc -> Doc -> Doc
<+> Fmt [Doc]
[Doc] -> Doc
commas (((Value, BlockLabel) -> Doc) -> [(Value, BlockLabel)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt (Value, BlockLabel)
(Value, BlockLabel) -> Doc
ppPhiArg [(Value, BlockLabel)]
vls)
  Select Typed Value
c Typed Value
t Value
f           -> Doc
"select" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
c
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
t
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue (Value
f Value -> Typed Value -> Typed Value
forall a b. a -> Typed b -> Typed a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Typed Value
t)
  ExtractValue Typed Value
v [Int32]
is      -> Doc
"extractvalue" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
v
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> (Fmt [Doc]
[Doc] -> Doc
commas ((Int32 -> Doc) -> [Int32] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Doc
forall i. Integral i => Fmt i
integral [Int32]
is))
  InsertValue Typed Value
a Typed Value
v [Int32]
is     -> Doc
"insertvalue" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
a
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
v
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt [Doc]
[Doc] -> Doc
commas ((Int32 -> Doc) -> [Int32] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Doc
forall i. Integral i => Fmt i
integral [Int32]
is)
  ShuffleVector Typed Value
a Value
b Typed Value
m    -> Doc
"shufflevector" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
a
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue (Value
b Value -> Typed Value -> Typed Value
forall a b. a -> Typed b -> Typed a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Typed Value
a)
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
m
  GEP Bool
ib Type
ty Typed Value
ptr [Typed Value]
ixs      -> Bool -> Type -> Typed Value -> Fmt [Typed Value]
ppGEP Bool
ib Type
ty Typed Value
ptr [Typed Value]
ixs
  Comment [Char]
str            -> Char -> Doc
char Char
';' Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
str
  Jump BlockLabel
i                 -> Doc
"br"
                        Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppTypedLabel BlockLabel
i
  Br Typed Value
c BlockLabel
t BlockLabel
f               -> Doc
"br" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
c
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Label)
                        Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppLabel BlockLabel
t
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Label)
                        Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppLabel BlockLabel
f
  Invoke Type
ty Value
f [Typed Value]
args BlockLabel
to BlockLabel
uw -> Type -> Value -> [Typed Value] -> BlockLabel -> Fmt BlockLabel
ppInvoke Type
ty Value
f [Typed Value]
args BlockLabel
to BlockLabel
uw
  Instr' BlockLabel
Unreachable            -> Doc
"unreachable"
  Instr' BlockLabel
Unwind                 -> Doc
"unwind"
  VaArg Typed Value
al Type
t             -> Doc
"va_arg" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
al
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
t
  ExtractElt Typed Value
v Value
i         -> Doc
"extractelement"
                        Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
v
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppVectorIndex Value
i
  InsertElt Typed Value
v Typed Value
e Value
i        -> Doc
"insertelement"
                        Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
v
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
e
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppVectorIndex Value
i
  IndirectBr Typed Value
d [BlockLabel]
ls        -> Doc
"indirectbr"
                        Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
d
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt [Doc]
[Doc] -> Doc
commas ((BlockLabel -> Doc) -> [BlockLabel] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt BlockLabel
BlockLabel -> Doc
ppTypedLabel [BlockLabel]
ls)
  Switch Typed Value
c BlockLabel
d [(Integer, BlockLabel)]
ls          -> Doc
"switch"
                        Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
c
                         Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppTypedLabel BlockLabel
d
                        Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'['
                         Doc -> Doc -> Doc
$$ LLVMVer -> Doc -> Doc
nest LLVMVer
2 ([Doc] -> Doc
vcat (((Integer, BlockLabel) -> Doc) -> [(Integer, BlockLabel)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Type -> Fmt (Integer, BlockLabel)
ppSwitchEntry (Typed Value -> Type
forall a. Typed a -> Type
typedType Typed Value
c)) [(Integer, BlockLabel)]
ls))
                         Doc -> Doc -> Doc
$$ Char -> Doc
char Char
']'
  LandingPad Type
ty Maybe (Typed Value)
mfn Bool
c [Clause' BlockLabel]
cs  ->
        case Maybe (Typed Value)
mfn of
            Just Typed Value
fn -> Doc
"landingpad"
                        Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
ty
                        Doc -> Doc -> Doc
<+> Doc
"personality"
                        Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
fn
                        Doc -> Doc -> Doc
$$ LLVMVer -> Doc -> Doc
nest LLVMVer
2 (Bool -> Fmt [Clause' BlockLabel]
ppClauses Bool
c [Clause' BlockLabel]
cs)
            Maybe (Typed Value)
Nothing -> Doc
"landingpad"
                        Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
ty
                        Doc -> Doc -> Doc
$$ LLVMVer -> Doc -> Doc
nest LLVMVer
2 (Bool -> Fmt [Clause' BlockLabel]
ppClauses Bool
c [Clause' BlockLabel]
cs)
  Resume Typed Value
tv           -> Doc
"resume" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
tv
  Freeze Typed Value
tv           -> Doc
"freeze" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
tv

ppLoad :: Type -> Typed (Value' BlockLabel) -> Maybe AtomicOrdering -> Fmt (Maybe Align)
ppLoad :: Type -> Typed Value -> Maybe AtomicOrdering -> Fmt (Maybe LLVMVer)
ppLoad Type
ty Typed Value
ptr Maybe AtomicOrdering
mo Maybe LLVMVer
ma =
  Doc
"load" Doc -> Doc -> Doc
<+> (if Bool
isAtomic   then Doc
"atomic" else Doc
empty)
         Doc -> Doc -> Doc
<+> (if Bool
isExplicit then Doc
explicit else Doc
empty)
         Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
ptr
         Doc -> Doc -> Doc
<+> Doc
ordering
          Doc -> Doc -> Doc
<> Fmt (Maybe LLVMVer)
Maybe LLVMVer -> Doc
ppAlign Maybe LLVMVer
ma

  where
  isAtomic :: Bool
isAtomic = Maybe AtomicOrdering -> Bool
forall a. Maybe a -> Bool
isJust Maybe AtomicOrdering
mo

  isExplicit :: Bool
isExplicit = LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
llvmV3_7

  ordering :: Doc
ordering =
    case Maybe AtomicOrdering
mo of
      Just AtomicOrdering
ao -> Fmt AtomicOrdering
AtomicOrdering -> Doc
ppAtomicOrdering AtomicOrdering
ao
      Maybe AtomicOrdering
_       -> Doc
empty

  explicit :: Doc
explicit = Fmt Type
Type -> Doc
ppType Type
ty Doc -> Doc -> Doc
<> Doc
comma

ppStore :: Typed (Value' BlockLabel)
        -> Typed (Value' BlockLabel)
        -> Maybe AtomicOrdering
        -> Fmt (Maybe Align)
ppStore :: Typed Value
-> Typed Value -> Maybe AtomicOrdering -> Fmt (Maybe LLVMVer)
ppStore Typed Value
ptr Typed Value
val Maybe AtomicOrdering
mo Maybe LLVMVer
ma =
  Doc
"store" Doc -> Doc -> Doc
<+> (if Maybe AtomicOrdering -> Bool
forall a. Maybe a -> Bool
isJust Maybe AtomicOrdering
mo  then Doc
"atomic" else Doc
empty)
          Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
ptr Doc -> Doc -> Doc
<> Doc
comma
          Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
val
          Doc -> Doc -> Doc
<+> case Maybe AtomicOrdering
mo of
                Just AtomicOrdering
ao -> Fmt AtomicOrdering
AtomicOrdering -> Doc
ppAtomicOrdering AtomicOrdering
ao
                Maybe AtomicOrdering
_       -> Doc
empty
          Doc -> Doc -> Doc
<> Fmt (Maybe LLVMVer)
Maybe LLVMVer -> Doc
ppAlign Maybe LLVMVer
ma


ppClauses :: Bool -> Fmt [Clause]
ppClauses :: Bool -> Fmt [Clause' BlockLabel]
ppClauses Bool
isCleanup [Clause' BlockLabel]
cs = [Doc] -> Doc
vcat (Doc
cleanup Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Clause' BlockLabel -> Doc) -> [Clause' BlockLabel] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt (Clause' BlockLabel)
Clause' BlockLabel -> Doc
ppClause [Clause' BlockLabel]
cs)
  where
  cleanup :: Doc
cleanup | Bool
isCleanup = Doc
"cleanup"
          | Bool
otherwise = Doc
empty

ppClause :: Fmt Clause
ppClause :: Fmt (Clause' BlockLabel)
ppClause Clause' BlockLabel
c = case Clause' BlockLabel
c of
  Catch  Typed Value
tv -> Doc
"catch"  Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
tv
  Filter Typed Value
tv -> Doc
"filter" Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
tv


ppTypedLabel :: Fmt BlockLabel
ppTypedLabel :: Fmt BlockLabel
ppTypedLabel BlockLabel
i = Fmt Type
Type -> Doc
ppType (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Label) Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppLabel BlockLabel
i

ppSwitchEntry :: Type -> Fmt (Integer,BlockLabel)
ppSwitchEntry :: Type -> Fmt (Integer, BlockLabel)
ppSwitchEntry Type
ty (Integer
i,BlockLabel
l) = Fmt Type
Type -> Doc
ppType Type
ty Doc -> Doc -> Doc
<+> Integer -> Doc
integer Integer
i Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppTypedLabel BlockLabel
l

ppVectorIndex :: Fmt Value
ppVectorIndex :: Fmt Value
ppVectorIndex Value
i = Fmt Type
Type -> Doc
ppType (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType (Word32 -> PrimType
Integer Word32
32)) Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppValue Value
i

ppAlign :: Fmt (Maybe Align)
ppAlign :: Fmt (Maybe LLVMVer)
ppAlign Maybe LLVMVer
Nothing      = Doc
empty
ppAlign (Just LLVMVer
align) = Doc
comma Doc -> Doc -> Doc
<+> Doc
"align" Doc -> Doc -> Doc
<+> LLVMVer -> Doc
int LLVMVer
align

ppAlloca :: Type -> Maybe (Typed Value) -> Fmt (Maybe Int)
ppAlloca :: Type -> Maybe (Typed Value) -> Fmt (Maybe LLVMVer)
ppAlloca Type
ty Maybe (Typed Value)
mbLen Maybe LLVMVer
mbAlign = Doc
"alloca" Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
ty Doc -> Doc -> Doc
<> Doc
len Doc -> Doc -> Doc
<> Doc
align
  where
  len :: Doc
len = Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
empty (Maybe Doc -> Doc) -> Maybe Doc -> Doc
forall a b. (a -> b) -> a -> b
$ do
    Typed Value
l <- Maybe (Typed Value)
mbLen
    Doc -> Maybe Doc
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
comma Doc -> Doc -> Doc
<+> Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue Typed Value
l)
  align :: Doc
align = Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
empty (Maybe Doc -> Doc) -> Maybe Doc -> Doc
forall a b. (a -> b) -> a -> b
$ do
    LLVMVer
a <- Maybe LLVMVer
mbAlign
    Doc -> Maybe Doc
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
comma Doc -> Doc -> Doc
<+> Doc
"align" Doc -> Doc -> Doc
<+> LLVMVer -> Doc
int LLVMVer
a)

ppCall :: Bool -> Type -> Value -> Fmt [Typed Value]
ppCall :: Bool -> Type -> Value -> Fmt [Typed Value]
ppCall Bool
tc Type
ty Value
f [Typed Value]
args
  | Bool
tc        = Doc
"tail" Doc -> Doc -> Doc
<+> Doc
body
  | Bool
otherwise = Doc
body
  where
  body :: Doc
body = Doc
"call" Doc -> Doc -> Doc
<+> Type -> Fmt Value
ppCallSym Type
ty Value
f
      Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas ((Typed Value -> Doc) -> [Typed Value] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue) [Typed Value]
args))

-- | Note that the textual syntax changed in LLVM 10 (@callbr@ was introduced in
-- LLVM 9).
ppCallBr :: Type -> Value -> [Typed Value] -> BlockLabel -> Fmt [BlockLabel]
ppCallBr :: Type -> Value -> [Typed Value] -> BlockLabel -> Fmt [BlockLabel]
ppCallBr Type
ty Value
f [Typed Value]
args BlockLabel
to [BlockLabel]
indirectDests =
  Doc
"callbr"
     Doc -> Doc -> Doc
<+> Type -> Fmt Value
ppCallSym Type
ty Value
f Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas ((Typed Value -> Doc) -> [Typed Value] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue) [Typed Value]
args))
     Doc -> Doc -> Doc
<+> Doc
"to" Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppLab BlockLabel
to Doc -> Doc -> Doc
<+> Doc -> Doc
brackets (Fmt [Doc]
[Doc] -> Doc
commas ((BlockLabel -> Doc) -> [BlockLabel] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt BlockLabel
BlockLabel -> Doc
ppLab [BlockLabel]
indirectDests))
  where
    ppLab :: BlockLabel -> Doc
ppLab BlockLabel
l = Fmt Type
Type -> Doc
ppType (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Label) Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppLabel BlockLabel
l

-- | Print out the @<ty>|<fnty> <fnptrval>@ portion of a @call@, @callbr@, or
-- @invoke@ instruction, where:
--
-- * @<ty>@ is the return type.
--
-- * @<fnty>@ is the overall function type.
--
-- * @<fnptrval>@ is a pointer value, where the memory it points to is treated
--   as a value of type @<fnty>@.
--
-- The LLVM Language Reference Manual indicates that either @<ty>@ or @<fnty>@
-- can be used, but in practice, @<ty>@ is typically preferred unless the
-- function type involves varargs. We adopt the same convention here.
ppCallSym :: Type -> Fmt Value
ppCallSym :: Type -> Fmt Value
ppCallSym Type
ty Value
val = Doc
pp_ty Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppValue Value
val
  where
    pp_ty :: Doc
pp_ty =
      case Type
ty of
        FunTy Type
res [Type]
args Bool
va
          |  Bool
va
          -> Fmt Type
Type -> Doc
ppType Type
res Doc -> Doc -> Doc
<+> Bool -> Fmt [Doc]
ppArgList Bool
va ((Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Fmt Type
Type -> Doc
ppType [Type]
args)
          |  Bool
otherwise
          -> Fmt Type
Type -> Doc
ppType Type
res
        Type
_ -> Fmt Type
Type -> Doc
ppType Type
ty

ppGEP :: Bool -> Type -> Typed Value -> Fmt [Typed Value]
ppGEP :: Bool -> Type -> Typed Value -> Fmt [Typed Value]
ppGEP Bool
ib Type
ty Typed Value
ptr [Typed Value]
ixs =
  Doc
"getelementptr" Doc -> Doc -> Doc
<+> Doc
inbounds
    Doc -> Doc -> Doc
<+> (if Bool
isExplicit then Doc
explicit else Doc
empty)
    Doc -> Doc -> Doc
<+> Fmt [Doc]
[Doc] -> Doc
commas ((Typed Value -> Doc) -> [Typed Value] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue) (Typed Value
ptrTyped Value -> [Typed Value] -> [Typed Value]
forall a. a -> [a] -> [a]
:[Typed Value]
ixs))
  where
  isExplicit :: Bool
isExplicit = LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
llvmV3_7

  explicit :: Doc
explicit = Fmt Type
Type -> Doc
ppType Type
ty Doc -> Doc -> Doc
<> Doc
comma

  inbounds :: Doc
inbounds | Bool
ib        = Doc
"inbounds"
           | Bool
otherwise = Doc
empty

ppInvoke :: Type -> Value -> [Typed Value] -> BlockLabel -> Fmt BlockLabel
ppInvoke :: Type -> Value -> [Typed Value] -> BlockLabel -> Fmt BlockLabel
ppInvoke Type
ty Value
f [Typed Value]
args BlockLabel
to BlockLabel
uw = Doc
body
  where
  body :: Doc
body = Doc
"invoke" Doc -> Doc -> Doc
<+> Type -> Fmt Value
ppCallSym Type
ty Value
f
      Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas ((Typed Value -> Doc) -> [Typed Value] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt Value -> Fmt (Typed Value)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt Value
Value -> Doc
ppValue) [Typed Value]
args))
     Doc -> Doc -> Doc
<+> Doc
"to" Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Label) Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppLabel BlockLabel
to
     Doc -> Doc -> Doc
<+> Doc
"unwind" Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Label) Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppLabel BlockLabel
uw

ppPhiArg :: Fmt (Value,BlockLabel)
ppPhiArg :: Fmt (Value, BlockLabel)
ppPhiArg (Value
v,BlockLabel
l) = Char -> Doc
char Char
'[' Doc -> Doc -> Doc
<+> Fmt Value
Value -> Doc
ppValue Value
v Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt BlockLabel
BlockLabel -> Doc
ppLabel BlockLabel
l Doc -> Doc -> Doc
<+> Char -> Doc
char Char
']'

ppICmpOp :: Fmt ICmpOp
ppICmpOp :: Fmt ICmpOp
ppICmpOp ICmpOp
Ieq  = Doc
"eq"
ppICmpOp ICmpOp
Ine  = Doc
"ne"
ppICmpOp ICmpOp
Iugt = Doc
"ugt"
ppICmpOp ICmpOp
Iuge = Doc
"uge"
ppICmpOp ICmpOp
Iult = Doc
"ult"
ppICmpOp ICmpOp
Iule = Doc
"ule"
ppICmpOp ICmpOp
Isgt = Doc
"sgt"
ppICmpOp ICmpOp
Isge = Doc
"sge"
ppICmpOp ICmpOp
Islt = Doc
"slt"
ppICmpOp ICmpOp
Isle = Doc
"sle"

ppFCmpOp :: Fmt FCmpOp
ppFCmpOp :: Fmt FCmpOp
ppFCmpOp FCmpOp
Ffalse = Doc
"false"
ppFCmpOp FCmpOp
Foeq   = Doc
"oeq"
ppFCmpOp FCmpOp
Fogt   = Doc
"ogt"
ppFCmpOp FCmpOp
Foge   = Doc
"oge"
ppFCmpOp FCmpOp
Folt   = Doc
"olt"
ppFCmpOp FCmpOp
Fole   = Doc
"ole"
ppFCmpOp FCmpOp
Fone   = Doc
"one"
ppFCmpOp FCmpOp
Ford   = Doc
"ord"
ppFCmpOp FCmpOp
Fueq   = Doc
"ueq"
ppFCmpOp FCmpOp
Fugt   = Doc
"ugt"
ppFCmpOp FCmpOp
Fuge   = Doc
"uge"
ppFCmpOp FCmpOp
Fult   = Doc
"ult"
ppFCmpOp FCmpOp
Fule   = Doc
"ule"
ppFCmpOp FCmpOp
Fune   = Doc
"une"
ppFCmpOp FCmpOp
Funo   = Doc
"uno"
ppFCmpOp FCmpOp
Ftrue  = Doc
"true"

ppValue' :: Fmt i -> Fmt (Value' i)
ppValue' :: forall i. Fmt i -> Fmt (Value' i)
ppValue' Fmt i
pp Value' i
val = case Value' i
val of
  ValInteger Integer
i       -> Integer -> Doc
integer Integer
i
  ValBool Bool
b          -> Fmt Bool
Bool -> Doc
ppBool Bool
b
  -- Note: for +Inf/-Inf/NaNs, we want to output the bit-correct sequence
  ValFloat Float
f         ->
    if Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
f Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
f
      then [Char] -> Doc
text [Char]
"0x" Doc -> Doc -> Doc
<> [Char] -> Doc
text (Word32 -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex (Float -> Word32
castFloatToWord32 Float
f) [Char]
"")
      else Float -> Doc
float Float
f
  ValDouble Double
d        ->
    if Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d
      then [Char] -> Doc
text [Char]
"0x" Doc -> Doc -> Doc
<> [Char] -> Doc
text (Word64 -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex (Double -> Word64
castDoubleToWord64 Double
d) [Char]
"")
      else Double -> Doc
double Double
d
  ValFP80 (FP80_LongDouble Word16
e Word64
s) ->
    -- shown as 0xK<<20-hex-digits>>, per
    -- https://llvm.org/docs/LangRef.html#simple-constants
    let pad :: a -> [Char] -> [Char]
pad a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x10  = LLVMVer -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows (LLVMVer
0::Int) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex a
n
              | Bool
otherwise = a -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex a
n
        fld :: a -> LLVMVer -> [Char] -> [Char]
fld a
v LLVMVer
i = a -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
pad ((a
v a -> LLVMVer -> a
forall a. Bits a => a -> LLVMVer -> a
`shiftR` (LLVMVer
i LLVMVer -> LLVMVer -> LLVMVer
forall a. Num a => a -> a -> a
* LLVMVer
8)) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xff)
    in Doc
"0xK" Doc -> Doc -> Doc
<> [Char] -> Doc
text ((LLVMVer -> [Char] -> [Char]) -> [Char] -> [LLVMVer] -> [Char]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Word16 -> LLVMVer -> [Char] -> [Char]
forall {a}.
(Integral a, Bits a) =>
a -> LLVMVer -> [Char] -> [Char]
fld Word16
e) ((LLVMVer -> [Char] -> [Char]) -> [Char] -> [LLVMVer] -> [Char]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Word64 -> LLVMVer -> [Char] -> [Char]
forall {a}.
(Integral a, Bits a) =>
a -> LLVMVer -> [Char] -> [Char]
fld Word64
s) [Char]
"" ([LLVMVer] -> [Char]) -> [LLVMVer] -> [Char]
forall a b. (a -> b) -> a -> b
$ [LLVMVer] -> [LLVMVer]
forall a. [a] -> [a]
reverse [LLVMVer
0..LLVMVer
7::Int]) [LLVMVer
1, LLVMVer
0])
  ValIdent Ident
i         -> Fmt Ident
Ident -> Doc
ppIdent Ident
i
  ValSymbol Symbol
s        -> Fmt Symbol
Symbol -> Doc
ppSymbol Symbol
s
  Value' i
ValNull            -> Doc
"null"
  ValArray Type
ty [Value' i]
es     -> Doc -> Doc
brackets
                      (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt [Doc]
[Doc] -> Doc
commas ((Value' i -> Doc) -> [Value' i] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt (Value' i) -> Fmt (Typed (Value' i))
forall a. Fmt a -> Fmt (Typed a)
ppTyped (Fmt i -> Fmt (Value' i)
forall i. Fmt i -> Fmt (Value' i)
ppValue' i -> Doc
Fmt i
pp) (Typed (Value' i) -> Doc)
-> (Value' i -> Typed (Value' i)) -> Value' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Value' i -> Typed (Value' i)
forall a. Type -> a -> Typed a
Typed Type
ty) [Value' i]
es)
  ValVector Type
ty [Value' i]
es   -> Fmt Doc
Doc -> Doc
angles (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt [Doc]
[Doc] -> Doc
commas
                     ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Value' i -> Doc) -> [Value' i] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt (Value' i) -> Fmt (Typed (Value' i))
forall a. Fmt a -> Fmt (Typed a)
ppTyped (Fmt i -> Fmt (Value' i)
forall i. Fmt i -> Fmt (Value' i)
ppValue' i -> Doc
Fmt i
pp) (Typed (Value' i) -> Doc)
-> (Value' i -> Typed (Value' i)) -> Value' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Value' i -> Typed (Value' i)
forall a. Type -> a -> Typed a
Typed Type
ty) [Value' i]
es
  ValStruct [Typed (Value' i)]
fs       -> Fmt Doc
Doc -> Doc
structBraces (Fmt [Doc]
[Doc] -> Doc
commas ((Typed (Value' i) -> Doc) -> [Typed (Value' i)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt (Value' i) -> Fmt (Typed (Value' i))
forall a. Fmt a -> Fmt (Typed a)
ppTyped (Fmt i -> Fmt (Value' i)
forall i. Fmt i -> Fmt (Value' i)
ppValue' i -> Doc
Fmt i
pp)) [Typed (Value' i)]
fs))
  ValPackedStruct [Typed (Value' i)]
fs -> Fmt Doc
Doc -> Doc
angles
                      (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt Doc
Doc -> Doc
structBraces (Fmt [Doc]
[Doc] -> Doc
commas ((Typed (Value' i) -> Doc) -> [Typed (Value' i)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt (Value' i) -> Fmt (Typed (Value' i))
forall a. Fmt a -> Fmt (Typed a)
ppTyped (Fmt i -> Fmt (Value' i)
forall i. Fmt i -> Fmt (Value' i)
ppValue' i -> Doc
Fmt i
pp)) [Typed (Value' i)]
fs))
  ValString [Word8]
s        -> Char -> Doc
char Char
'c' Doc -> Doc -> Doc
<> Fmt [Char]
[Char] -> Doc
ppStringLiteral ((Word8 -> Char) -> [Word8] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (LLVMVer -> Char
forall a. Enum a => LLVMVer -> a
toEnum (LLVMVer -> Char) -> (Word8 -> LLVMVer) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> LLVMVer
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Word8]
s)
  ValConstExpr ConstExpr' i
ce    -> Fmt i -> Fmt (ConstExpr' i)
forall i. Fmt i -> Fmt (ConstExpr' i)
ppConstExpr' i -> Doc
Fmt i
pp ConstExpr' i
ce
  Value' i
ValUndef           -> Doc
"undef"
  ValLabel i
l         -> i -> Doc
Fmt i
pp i
l
  Value' i
ValZeroInit        -> Doc
"zeroinitializer"
  ValAsm Bool
s Bool
a [Char]
i [Char]
c     -> Bool -> Bool -> [Char] -> Fmt [Char]
ppAsm Bool
s Bool
a [Char]
i [Char]
c
  ValMd ValMd' i
m            -> Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp ValMd' i
m
  Value' i
ValPoison          -> Doc
"poison"

ppValue :: Fmt Value
ppValue :: Fmt Value
ppValue = Fmt BlockLabel -> Fmt Value
forall i. Fmt i -> Fmt (Value' i)
ppValue' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppValMd' :: Fmt i -> Fmt (ValMd' i)
ppValMd' :: forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' Fmt i
pp ValMd' i
m = case ValMd' i
m of
  ValMdString [Char]
str   -> Fmt Doc
Doc -> Doc
ppMetadata (Fmt [Char]
[Char] -> Doc
ppStringLiteral [Char]
str)
  ValMdValue Typed (Value' i)
tv     -> Fmt (Value' i) -> Fmt (Typed (Value' i))
forall a. Fmt a -> Fmt (Typed a)
ppTyped (Fmt i -> Fmt (Value' i)
forall i. Fmt i -> Fmt (Value' i)
ppValue' i -> Doc
Fmt i
pp) Typed (Value' i)
tv
  ValMdRef LLVMVer
i        -> Fmt Doc
Doc -> Doc
ppMetadata (LLVMVer -> Doc
int LLVMVer
i)
  ValMdNode [Maybe (ValMd' i)]
vs      -> Fmt i -> Fmt [Maybe (ValMd' i)]
forall i. Fmt i -> Fmt [Maybe (ValMd' i)]
ppMetadataNode' i -> Doc
Fmt i
pp [Maybe (ValMd' i)]
vs
  ValMdLoc DebugLoc' i
l        -> Fmt i -> Fmt (DebugLoc' i)
forall i. Fmt i -> Fmt (DebugLoc' i)
ppDebugLoc' i -> Doc
Fmt i
pp DebugLoc' i
l
  ValMdDebugInfo DebugInfo' i
di -> Fmt i -> Fmt (DebugInfo' i)
forall i. Fmt i -> Fmt (DebugInfo' i)
ppDebugInfo' i -> Doc
Fmt i
pp DebugInfo' i
di

ppValMd :: Fmt ValMd
ppValMd :: Fmt ValMd
ppValMd = Fmt BlockLabel -> Fmt ValMd
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDebugLoc' :: Fmt i -> Fmt (DebugLoc' i)
ppDebugLoc' :: forall i. Fmt i -> Fmt (DebugLoc' i)
ppDebugLoc' Fmt i
pp DebugLoc' i
dl = (if LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
llvmV3_7 then Doc
"!DILocation"
                                            else Doc
"!MDLocation")
             Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas [ Doc
"line:"   Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DebugLoc' i -> Word32
forall lab. DebugLoc' lab -> Word32
dlLine DebugLoc' i
dl)
                               , Doc
"column:" Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DebugLoc' i -> Word32
forall lab. DebugLoc' lab -> Word32
dlCol DebugLoc' i
dl)
                               , Doc
"scope:"  Doc -> Doc -> Doc
<+> Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (DebugLoc' i -> ValMd' i
forall lab. DebugLoc' lab -> ValMd' lab
dlScope DebugLoc' i
dl)
                               ] Doc -> Doc -> Doc
<> Doc
mbIA Doc -> Doc -> Doc
<> Doc
mbImplicit)

  where
  mbIA :: Doc
mbIA = case DebugLoc' i -> Maybe (ValMd' i)
forall lab. DebugLoc' lab -> Maybe (ValMd' lab)
dlIA DebugLoc' i
dl of
           Just ValMd' i
md -> Doc
comma Doc -> Doc -> Doc
<+> Doc
"inlinedAt:" Doc -> Doc -> Doc
<+> Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp ValMd' i
md
           Maybe (ValMd' i)
Nothing -> Doc
empty
  mbImplicit :: Doc
mbImplicit = if DebugLoc' i -> Bool
forall lab. DebugLoc' lab -> Bool
dlImplicit DebugLoc' i
dl then Doc
comma Doc -> Doc -> Doc
<+> Doc
"implicit" else Doc
empty

ppDebugLoc :: Fmt DebugLoc
ppDebugLoc :: Fmt DebugLoc
ppDebugLoc = Fmt BlockLabel -> Fmt DebugLoc
forall i. Fmt i -> Fmt (DebugLoc' i)
ppDebugLoc' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppTypedValMd :: Fmt ValMd
ppTypedValMd :: Fmt ValMd
ppTypedValMd  = Fmt ValMd -> Fmt (Typed ValMd)
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt ValMd
ValMd -> Doc
ppValMd (Typed ValMd -> Doc) -> (ValMd -> Typed ValMd) -> ValMd -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ValMd -> Typed ValMd
forall a. Type -> a -> Typed a
Typed (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Metadata)

ppMetadata :: Fmt Doc
ppMetadata :: Fmt Doc
ppMetadata Doc
body = Char -> Doc
char Char
'!' Doc -> Doc -> Doc
<> Doc
body

ppMetadataNode' :: Fmt i -> Fmt [Maybe (ValMd' i)]
ppMetadataNode' :: forall i. Fmt i -> Fmt [Maybe (ValMd' i)]
ppMetadataNode' Fmt i
pp [Maybe (ValMd' i)]
vs = Fmt Doc
Doc -> Doc
ppMetadata (Doc -> Doc
braces (Fmt [Doc]
[Doc] -> Doc
commas ((Maybe (ValMd' i) -> Doc) -> [Maybe (ValMd' i)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (ValMd' i) -> Doc
arg [Maybe (ValMd' i)]
vs)))
  where arg :: Maybe (ValMd' i) -> Doc
arg = Doc -> (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Doc
"null") (Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp)

ppMetadataNode :: Fmt [Maybe ValMd]
ppMetadataNode :: Fmt [Maybe ValMd]
ppMetadataNode = Fmt BlockLabel -> Fmt [Maybe ValMd]
forall i. Fmt i -> Fmt [Maybe (ValMd' i)]
ppMetadataNode' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppStringLiteral :: Fmt String
ppStringLiteral :: Fmt [Char]
ppStringLiteral  = Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text ([Char] -> Doc) -> ([Char] -> [Char]) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escape
  where
  escape :: Char -> [Char]
escape Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'  = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: LLVMVer -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex (Char -> LLVMVer
forall a. Enum a => a -> LLVMVer
fromEnum Char
c) [Char]
""
           | Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
c = [Char
c]
           | Bool
otherwise              = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: LLVMVer -> [Char]
forall {a}. Integral a => a -> [Char]
pad (Char -> LLVMVer
ord Char
c)

  pad :: a -> [Char]
pad a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x10  = Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (a -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex a
n [Char]
"")
        | Bool
otherwise =       (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (a -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex a
n [Char]
"")

ppAsm :: Bool -> Bool -> String -> Fmt String
ppAsm :: Bool -> Bool -> [Char] -> Fmt [Char]
ppAsm Bool
s Bool
a [Char]
i [Char]
c =
  Doc
"asm" Doc -> Doc -> Doc
<+> Doc
sideeffect Doc -> Doc -> Doc
<+> Doc
alignstack
        Doc -> Doc -> Doc
<+> Fmt [Char]
[Char] -> Doc
ppStringLiteral [Char]
i Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Fmt [Char]
[Char] -> Doc
ppStringLiteral [Char]
c
  where
  sideeffect :: Doc
sideeffect | Bool
s         = Doc
"sideeffect"
             | Bool
otherwise = Doc
empty

  alignstack :: Doc
alignstack | Bool
a         = Doc
"alignstack"
             | Bool
otherwise = Doc
empty


ppConstExpr' :: Fmt i -> Fmt (ConstExpr' i)
ppConstExpr' :: forall i. Fmt i -> Fmt (ConstExpr' i)
ppConstExpr' Fmt i
pp ConstExpr' i
expr =
  case ConstExpr' i
expr of
    ConstGEP Bool
inb Maybe Word64
_mix Type
ty Typed (Value' i)
ptr [Typed (Value' i)]
ixs  ->
      Doc
"getelementptr"
        Doc -> Doc -> Doc
<+> Bool -> Fmt Doc
opt Bool
inb Doc
"inbounds"
        Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas (Fmt Type
Type -> Doc
ppType Type
ty Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Typed (Value' i) -> Doc) -> [Typed (Value' i)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Typed (Value' i) -> Doc
ppTyp' (Typed (Value' i)
ptrTyped (Value' i) -> [Typed (Value' i)] -> [Typed (Value' i)]
forall a. a -> [a] -> [a]
:[Typed (Value' i)]
ixs)))
    ConstConv ConvOp
op Typed (Value' i)
tv Type
t  -> Fmt ConvOp
ConvOp -> Doc
ppConvOp ConvOp
op Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Typed (Value' i) -> Doc
ppTyp' Typed (Value' i)
tv Doc -> Doc -> Doc
<+> Doc
"to" Doc -> Doc -> Doc
<+> Fmt Type
Type -> Doc
ppType Type
t)
    ConstSelect Typed (Value' i)
c Typed (Value' i)
l Typed (Value' i)
r  ->
      Doc
"select" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas [ Typed (Value' i) -> Doc
ppTyp' Typed (Value' i)
c, Typed (Value' i) -> Doc
ppTyp' Typed (Value' i)
l , Typed (Value' i) -> Doc
ppTyp' Typed (Value' i)
r])
    ConstBlockAddr Typed (Value' i)
t i
l -> Doc
"blockaddress" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Value' i -> Doc
ppVal' (Typed (Value' i) -> Value' i
forall a. Typed a -> a
typedValue Typed (Value' i)
t) Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> i -> Doc
Fmt i
pp i
l)
    ConstFCmp       FCmpOp
op Typed (Value' i)
a Typed (Value' i)
b -> Doc
"fcmp" Doc -> Doc -> Doc
<+> Fmt FCmpOp
FCmpOp -> Doc
ppFCmpOp FCmpOp
op Doc -> Doc -> Doc
<+> (?config::Config) => Typed (Value' i) -> Typed (Value' i) -> Doc
Typed (Value' i) -> Typed (Value' i) -> Doc
ppTupleT Typed (Value' i)
a Typed (Value' i)
b
    ConstICmp       ICmpOp
op Typed (Value' i)
a Typed (Value' i)
b -> Doc
"icmp" Doc -> Doc -> Doc
<+> Fmt ICmpOp
ICmpOp -> Doc
ppICmpOp ICmpOp
op Doc -> Doc -> Doc
<+> (?config::Config) => Typed (Value' i) -> Typed (Value' i) -> Doc
Typed (Value' i) -> Typed (Value' i) -> Doc
ppTupleT Typed (Value' i)
a Typed (Value' i)
b
    ConstArith      ArithOp
op Typed (Value' i)
a Value' i
b -> Fmt ArithOp
ArithOp -> Doc
ppArithOp ArithOp
op Doc -> Doc -> Doc
<+> (?config::Config) => Typed (Value' i) -> Value' i -> Doc
Typed (Value' i) -> Value' i -> Doc
ppTuple Typed (Value' i)
a Value' i
b
    ConstUnaryArith UnaryArithOp
op Typed (Value' i)
a   -> Fmt UnaryArithOp
UnaryArithOp -> Doc
ppUnaryArithOp UnaryArithOp
op Doc -> Doc -> Doc
<+> Typed (Value' i) -> Doc
ppTyp' Typed (Value' i)
a
    ConstBit        BitOp
op Typed (Value' i)
a Value' i
b -> Fmt BitOp
BitOp -> Doc
ppBitOp BitOp
op   Doc -> Doc -> Doc
<+> (?config::Config) => Typed (Value' i) -> Value' i -> Doc
Typed (Value' i) -> Value' i -> Doc
ppTuple Typed (Value' i)
a Value' i
b
  where ppTuple :: Typed (Value' i) -> Value' i -> Doc
ppTuple  Typed (Value' i)
a Value' i
b = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt (Value' i) -> Fmt (Typed (Value' i))
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt (Value' i)
Value' i -> Doc
ppVal' Typed (Value' i)
a Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Value' i -> Doc
ppVal' Value' i
b
        ppTupleT :: Typed (Value' i) -> Typed (Value' i) -> Doc
ppTupleT Typed (Value' i)
a Typed (Value' i)
b = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt (Value' i) -> Fmt (Typed (Value' i))
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt (Value' i)
Value' i -> Doc
ppVal' Typed (Value' i)
a Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Typed (Value' i) -> Doc
ppTyp' Typed (Value' i)
b
        ppVal' :: Value' i -> Doc
ppVal'       = Fmt i -> Fmt (Value' i)
forall i. Fmt i -> Fmt (Value' i)
ppValue' i -> Doc
Fmt i
pp
        ppTyp' :: Typed (Value' i) -> Doc
ppTyp'       = Fmt (Value' i) -> Fmt (Typed (Value' i))
forall a. Fmt a -> Fmt (Typed a)
ppTyped Fmt (Value' i)
Value' i -> Doc
ppVal'

ppConstExpr :: Fmt ConstExpr
ppConstExpr :: Fmt ConstExpr
ppConstExpr = Fmt BlockLabel -> Fmt ConstExpr
forall i. Fmt i -> Fmt (ConstExpr' i)
ppConstExpr' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

-- DWARF Debug Info ------------------------------------------------------------

ppDebugInfo' :: Fmt i -> Fmt (DebugInfo' i)
ppDebugInfo' :: forall i. Fmt i -> Fmt (DebugInfo' i)
ppDebugInfo' Fmt i
pp DebugInfo' i
di = case DebugInfo' i
di of
  DebugInfoBasicType DIBasicType
bt         -> Fmt DIBasicType
DIBasicType -> Doc
ppDIBasicType DIBasicType
bt
  DebugInfoCompileUnit DICompileUnit' i
cu       -> Fmt i -> Fmt (DICompileUnit' i)
forall i. Fmt i -> Fmt (DICompileUnit' i)
ppDICompileUnit' i -> Doc
Fmt i
pp DICompileUnit' i
cu
  DebugInfoCompositeType DICompositeType' i
ct     -> Fmt i -> Fmt (DICompositeType' i)
forall i. Fmt i -> Fmt (DICompositeType' i)
ppDICompositeType' i -> Doc
Fmt i
pp DICompositeType' i
ct
  DebugInfoDerivedType DIDerivedType' i
dt       -> Fmt i -> Fmt (DIDerivedType' i)
forall i. Fmt i -> Fmt (DIDerivedType' i)
ppDIDerivedType' i -> Doc
Fmt i
pp DIDerivedType' i
dt
  DebugInfoEnumerator [Char]
nm Integer
v Bool
u    -> [Char] -> Integer -> Fmt Bool
ppDIEnumerator [Char]
nm Integer
v Bool
u
  DebugInfoExpression DIExpression
e         -> Fmt DIExpression
DIExpression -> Doc
ppDIExpression DIExpression
e
  DebugInfoFile DIFile
f               -> Fmt DIFile
DIFile -> Doc
ppDIFile DIFile
f
  DebugInfoGlobalVariable DIGlobalVariable' i
gv    -> Fmt i -> Fmt (DIGlobalVariable' i)
forall i. Fmt i -> Fmt (DIGlobalVariable' i)
ppDIGlobalVariable' i -> Doc
Fmt i
pp DIGlobalVariable' i
gv
  DebugInfoGlobalVariableExpression DIGlobalVariableExpression' i
gv -> Fmt i -> Fmt (DIGlobalVariableExpression' i)
forall i. Fmt i -> Fmt (DIGlobalVariableExpression' i)
ppDIGlobalVariableExpression' i -> Doc
Fmt i
pp DIGlobalVariableExpression' i
gv
  DebugInfoLexicalBlock DILexicalBlock' i
lb      -> Fmt i -> Fmt (DILexicalBlock' i)
forall i. Fmt i -> Fmt (DILexicalBlock' i)
ppDILexicalBlock' i -> Doc
Fmt i
pp DILexicalBlock' i
lb
  DebugInfoLexicalBlockFile DILexicalBlockFile' i
lbf -> Fmt i -> Fmt (DILexicalBlockFile' i)
forall i. Fmt i -> Fmt (DILexicalBlockFile' i)
ppDILexicalBlockFile' i -> Doc
Fmt i
pp DILexicalBlockFile' i
lbf
  DebugInfoLocalVariable DILocalVariable' i
lv     -> Fmt i -> Fmt (DILocalVariable' i)
forall i. Fmt i -> Fmt (DILocalVariable' i)
ppDILocalVariable' i -> Doc
Fmt i
pp DILocalVariable' i
lv
  DebugInfoSubprogram DISubprogram' i
sp        -> Fmt i -> Fmt (DISubprogram' i)
forall i. Fmt i -> Fmt (DISubprogram' i)
ppDISubprogram' i -> Doc
Fmt i
pp DISubprogram' i
sp
  DebugInfoSubrange DISubrange' i
sr          -> Fmt i -> Fmt (DISubrange' i)
forall i. Fmt i -> Fmt (DISubrange' i)
ppDISubrange' i -> Doc
Fmt i
pp DISubrange' i
sr
  DebugInfoSubroutineType DISubroutineType' i
st    -> Fmt i -> Fmt (DISubroutineType' i)
forall i. Fmt i -> Fmt (DISubroutineType' i)
ppDISubroutineType' i -> Doc
Fmt i
pp DISubroutineType' i
st
  DebugInfoNameSpace DINameSpace' i
ns         -> Fmt i -> Fmt (DINameSpace' i)
forall i. Fmt i -> Fmt (DINameSpace' i)
ppDINameSpace' i -> Doc
Fmt i
pp DINameSpace' i
ns
  DebugInfoTemplateTypeParameter DITemplateTypeParameter' i
dttp  -> Fmt i -> Fmt (DITemplateTypeParameter' i)
forall i. Fmt i -> Fmt (DITemplateTypeParameter' i)
ppDITemplateTypeParameter' i -> Doc
Fmt i
pp DITemplateTypeParameter' i
dttp
  DebugInfoTemplateValueParameter DITemplateValueParameter' i
dtvp -> Fmt i -> Fmt (DITemplateValueParameter' i)
forall i. Fmt i -> Fmt (DITemplateValueParameter' i)
ppDITemplateValueParameter' i -> Doc
Fmt i
pp DITemplateValueParameter' i
dtvp
  DebugInfoImportedEntity DIImportedEntity' i
diip         -> Fmt i -> Fmt (DIImportedEntity' i)
forall i. Fmt i -> Fmt (DIImportedEntity' i)
ppDIImportedEntity' i -> Doc
Fmt i
pp DIImportedEntity' i
diip
  DebugInfoLabel DILabel' i
dil            -> Fmt i -> Fmt (DILabel' i)
forall i. Fmt i -> Fmt (DILabel' i)
ppDILabel' i -> Doc
Fmt i
pp DILabel' i
dil
  DebugInfoArgList DIArgList' i
args         -> Fmt i -> Fmt (DIArgList' i)
forall i. Fmt i -> Fmt (DIArgList' i)
ppDIArgList' i -> Doc
Fmt i
pp DIArgList' i
args
  DebugInfo' i
DebugInfoAssignID             -> Doc
"!DIAssignID()"

ppDebugInfo :: Fmt DebugInfo
ppDebugInfo :: Fmt DebugInfo
ppDebugInfo = Fmt BlockLabel -> Fmt DebugInfo
forall i. Fmt i -> Fmt (DebugInfo' i)
ppDebugInfo' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDIImportedEntity' :: Fmt i -> Fmt (DIImportedEntity' i)
ppDIImportedEntity' :: forall i. Fmt i -> Fmt (DIImportedEntity' i)
ppDIImportedEntity' Fmt i
pp DIImportedEntity' i
ie = Doc
"!DIImportedEntity"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas [ Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"tag:"    Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DIImportedEntity' i -> Word16
forall lab. DIImportedEntity' lab -> Word16
diieTag DIImportedEntity' i
ie))
                     , ((Doc
"scope:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DIImportedEntity' i -> Maybe (ValMd' i)
forall lab. DIImportedEntity' lab -> Maybe (ValMd' lab)
diieScope DIImportedEntity' i
ie
                     , ((Doc
"entity:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DIImportedEntity' i -> Maybe (ValMd' i)
forall lab. DIImportedEntity' lab -> Maybe (ValMd' lab)
diieEntity DIImportedEntity' i
ie
                     , ((Doc
"file:"   Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DIImportedEntity' i -> Maybe (ValMd' i)
forall lab. DIImportedEntity' lab -> Maybe (ValMd' lab)
diieFile DIImportedEntity' i
ie
                     , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"   Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DIImportedEntity' i -> Word32
forall lab. DIImportedEntity' lab -> Word32
diieLine DIImportedEntity' i
ie))
                     , ((Doc
"name:"   Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text)        ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DIImportedEntity' i -> Maybe [Char]
forall lab. DIImportedEntity' lab -> Maybe [Char]
diieName DIImportedEntity' i
ie
                     ])

ppDIImportedEntity :: Fmt DIImportedEntity
ppDIImportedEntity :: Fmt DIImportedEntity
ppDIImportedEntity = Fmt BlockLabel -> Fmt DIImportedEntity
forall i. Fmt i -> Fmt (DIImportedEntity' i)
ppDIImportedEntity' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDILabel' :: Fmt i -> Fmt (DILabel' i)
ppDILabel' :: forall i. Fmt i -> Fmt (DILabel' i)
ppDILabel' Fmt i
pp DILabel' i
ie = Doc
"!DILabel"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas [ ((Doc
"scope:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DILabel' i -> Maybe (ValMd' i)
forall lab. DILabel' lab -> Maybe (ValMd' lab)
dilScope DILabel' i
ie
                     , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"name:" Doc -> Doc -> Doc
<+> Fmt [Char]
[Char] -> Doc
ppStringLiteral (DILabel' i -> [Char]
forall lab. DILabel' lab -> [Char]
dilName DILabel' i
ie))
                     , ((Doc
"file:"   Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DILabel' i -> Maybe (ValMd' i)
forall lab. DILabel' lab -> Maybe (ValMd' lab)
dilFile DILabel' i
ie
                     , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"   Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DILabel' i -> Word32
forall lab. DILabel' lab -> Word32
dilLine DILabel' i
ie))
                     ])

ppDILabel :: Fmt DILabel
ppDILabel :: Fmt DILabel
ppDILabel = Fmt BlockLabel -> Fmt DILabel
forall i. Fmt i -> Fmt (DILabel' i)
ppDILabel' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDINameSpace' :: Fmt i -> Fmt (DINameSpace' i)
ppDINameSpace' :: forall i. Fmt i -> Fmt (DINameSpace' i)
ppDINameSpace' Fmt i
pp DINameSpace' i
ns = Doc
"!DINameSpace"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas [ (Doc
"name:"   Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DINameSpace' i -> Maybe [Char]
forall lab. DINameSpace' lab -> Maybe [Char]
dinsName DINameSpace' i
ns)
                     , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"scope:"  Doc -> Doc -> Doc
<+> Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (DINameSpace' i -> ValMd' i
forall lab. DINameSpace' lab -> ValMd' lab
dinsScope DINameSpace' i
ns))
                     , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"file:"   Doc -> Doc -> Doc
<+> Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (DINameSpace' i -> ValMd' i
forall lab. DINameSpace' lab -> ValMd' lab
dinsFile DINameSpace' i
ns))
                     , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"   Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DINameSpace' i -> Word32
forall lab. DINameSpace' lab -> Word32
dinsLine DINameSpace' i
ns))
                     ])

ppDINameSpace :: Fmt DINameSpace
ppDINameSpace :: Fmt DINameSpace
ppDINameSpace = Fmt BlockLabel -> Fmt DINameSpace
forall i. Fmt i -> Fmt (DINameSpace' i)
ppDINameSpace' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDITemplateTypeParameter' :: Fmt i -> Fmt (DITemplateTypeParameter' i)
ppDITemplateTypeParameter' :: forall i. Fmt i -> Fmt (DITemplateTypeParameter' i)
ppDITemplateTypeParameter' Fmt i
pp DITemplateTypeParameter' i
tp = Doc
"!DITemplateTypeParameter"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas [ (Doc
"name:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text        ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DITemplateTypeParameter' i -> Maybe [Char]
forall lab. DITemplateTypeParameter' lab -> Maybe [Char]
dittpName DITemplateTypeParameter' i
tp
                     , (Doc
"type:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DITemplateTypeParameter' i -> Maybe (ValMd' i)
forall lab. DITemplateTypeParameter' lab -> Maybe (ValMd' lab)
dittpType DITemplateTypeParameter' i
tp
                     ])

ppDITemplateTypeParameter :: Fmt DITemplateTypeParameter
ppDITemplateTypeParameter :: Fmt DITemplateTypeParameter
ppDITemplateTypeParameter = Fmt BlockLabel -> Fmt DITemplateTypeParameter
forall i. Fmt i -> Fmt (DITemplateTypeParameter' i)
ppDITemplateTypeParameter' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDITemplateValueParameter' :: Fmt i -> Fmt (DITemplateValueParameter' i)
ppDITemplateValueParameter' :: forall i. Fmt i -> Fmt (DITemplateValueParameter' i)
ppDITemplateValueParameter' Fmt i
pp DITemplateValueParameter' i
vp = Doc
"!DITemplateValueParameter"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas [ Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"tag:"   Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DITemplateValueParameter' i -> Word16
forall lab. DITemplateValueParameter' lab -> Word16
ditvpTag DITemplateValueParameter' i
vp))
                     , (Doc
"name:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text        ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DITemplateValueParameter' i -> Maybe [Char]
forall lab. DITemplateValueParameter' lab -> Maybe [Char]
ditvpName DITemplateValueParameter' i
vp
                     , (Doc
"type:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DITemplateValueParameter' i -> Maybe (ValMd' i)
forall lab. DITemplateValueParameter' lab -> Maybe (ValMd' lab)
ditvpType DITemplateValueParameter' i
vp
                     , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"value:" Doc -> Doc -> Doc
<+> Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (DITemplateValueParameter' i -> ValMd' i
forall lab. DITemplateValueParameter' lab -> ValMd' lab
ditvpValue DITemplateValueParameter' i
vp))
                     ])

ppDITemplateValueParameter :: Fmt DITemplateValueParameter
ppDITemplateValueParameter :: Fmt DITemplateValueParameter
ppDITemplateValueParameter = Fmt BlockLabel -> Fmt DITemplateValueParameter
forall i. Fmt i -> Fmt (DITemplateValueParameter' i)
ppDITemplateValueParameter' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDIBasicType :: Fmt DIBasicType
ppDIBasicType :: Fmt DIBasicType
ppDIBasicType DIBasicType
bt = Doc
"!DIBasicType"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas [ Doc
"tag:"      Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DIBasicType -> Word16
dibtTag DIBasicType
bt)
                    , Doc
"name:"     Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Char] -> Doc
text (DIBasicType -> [Char]
dibtName DIBasicType
bt))
                    , Doc
"size:"     Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DIBasicType -> Word64
dibtSize DIBasicType
bt)
                    , Doc
"align:"    Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DIBasicType -> Word64
dibtAlign DIBasicType
bt)
                    , Doc
"encoding:" Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DIBasicType -> Word16
dibtEncoding DIBasicType
bt)
                    ] Doc -> Doc -> Doc
<> Doc
mbFlags)
  where
  mbFlags :: Doc
mbFlags = case DIBasicType -> Maybe Word32
dibtFlags DIBasicType
bt of
              Just Word32
flags -> Doc
comma Doc -> Doc -> Doc
<+> Doc
"flags:" Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral Word32
flags
              Maybe Word32
Nothing -> Doc
empty

ppDICompileUnit' :: Fmt i -> Fmt (DICompileUnit' i)
ppDICompileUnit' :: forall i. Fmt i -> Fmt (DICompileUnit' i)
ppDICompileUnit' Fmt i
pp DICompileUnit' i
cu = Doc
"!DICompileUnit"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas ([Maybe Doc] -> Doc) -> [Maybe Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
       [ Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"language:"              Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DICompileUnit' i -> Word16
forall lab. DICompileUnit' lab -> Word16
dicuLanguage DICompileUnit' i
cu))
       ,     ((Doc
"file:"                  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe (ValMd' i)
forall lab. DICompileUnit' lab -> Maybe (ValMd' lab)
dicuFile DICompileUnit' i
cu)
       ,     ((Doc
"producer:"              Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text)
             ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe [Char]
forall lab. DICompileUnit' lab -> Maybe [Char]
dicuProducer DICompileUnit' i
cu)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"isOptimized:"           Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DICompileUnit' i -> Bool
forall lab. DICompileUnit' lab -> Bool
dicuIsOptimized DICompileUnit' i
cu))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"flags:"                 Doc -> Doc -> Doc
<+> Fmt (Maybe [Char])
Maybe [Char] -> Doc
ppFlags (DICompileUnit' i -> Maybe [Char]
forall lab. DICompileUnit' lab -> Maybe [Char]
dicuFlags DICompileUnit' i
cu))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"runtimeVersion:"        Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DICompileUnit' i -> Word16
forall lab. DICompileUnit' lab -> Word16
dicuRuntimeVersion DICompileUnit' i
cu))
       ,     ((Doc
"splitDebugFilename:"    Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text)
             ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe [Char]
forall lab. DICompileUnit' lab -> Maybe [Char]
dicuSplitDebugFilename DICompileUnit' i
cu)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"emissionKind:"          Doc -> Doc -> Doc
<+> Word8 -> Doc
forall i. Integral i => Fmt i
integral (DICompileUnit' i -> Word8
forall lab. DICompileUnit' lab -> Word8
dicuEmissionKind DICompileUnit' i
cu))
       ,     ((Doc
"enums:"                 Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe (ValMd' i)
forall lab. DICompileUnit' lab -> Maybe (ValMd' lab)
dicuEnums DICompileUnit' i
cu)
       ,     ((Doc
"retainedTypes:"         Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe (ValMd' i)
forall lab. DICompileUnit' lab -> Maybe (ValMd' lab)
dicuRetainedTypes DICompileUnit' i
cu)
       ,     ((Doc
"subprograms:"           Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe (ValMd' i)
forall lab. DICompileUnit' lab -> Maybe (ValMd' lab)
dicuSubprograms DICompileUnit' i
cu)
       ,     ((Doc
"globals:"               Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe (ValMd' i)
forall lab. DICompileUnit' lab -> Maybe (ValMd' lab)
dicuGlobals DICompileUnit' i
cu)
       ,     ((Doc
"imports:"               Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe (ValMd' i)
forall lab. DICompileUnit' lab -> Maybe (ValMd' lab)
dicuImports DICompileUnit' i
cu)
       ,     ((Doc
"macros:"                Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe (ValMd' i)
forall lab. DICompileUnit' lab -> Maybe (ValMd' lab)
dicuMacros DICompileUnit' i
cu)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"dwoId:"                 Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DICompileUnit' i -> Word64
forall lab. DICompileUnit' lab -> Word64
dicuDWOId DICompileUnit' i
cu))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"splitDebugInlining:"    Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DICompileUnit' i -> Bool
forall lab. DICompileUnit' lab -> Bool
dicuSplitDebugInlining DICompileUnit' i
cu))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"debugInfoForProfiling:" Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DICompileUnit' i -> Bool
forall lab. DICompileUnit' lab -> Bool
dicuDebugInfoForProf DICompileUnit' i
cu))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"nameTableKind:"         Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DICompileUnit' i -> Word64
forall lab. DICompileUnit' lab -> Word64
dicuNameTableKind DICompileUnit' i
cu))
       ]
       [Maybe Doc] -> [Maybe Doc] -> [Maybe Doc]
forall a. [a] -> [a] -> [a]
++
       Bool -> [Maybe Doc] -> [Maybe Doc]
forall a. Monoid a => Bool -> a -> a
when' (LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
11)
       [ Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"rangesBaseAddress:"     Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DICompileUnit' i -> Bool
forall lab. DICompileUnit' lab -> Bool
dicuRangesBaseAddress DICompileUnit' i
cu))
       ,     ((Doc
"sysroot:"               Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text)
             ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe [Char]
forall lab. DICompileUnit' lab -> Maybe [Char]
dicuSysRoot DICompileUnit' i
cu)
       ,     ((Doc
"sdk:"                   Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text)
             ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompileUnit' i -> Maybe [Char]
forall lab. DICompileUnit' lab -> Maybe [Char]
dicuSDK DICompileUnit' i
cu)
       ]
       )


ppDICompileUnit :: Fmt DICompileUnit
ppDICompileUnit :: Fmt DICompileUnit
ppDICompileUnit = Fmt BlockLabel -> Fmt DICompileUnit
forall i. Fmt i -> Fmt (DICompileUnit' i)
ppDICompileUnit' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppFlags :: Fmt (Maybe String)
ppFlags :: Fmt (Maybe [Char])
ppFlags Maybe [Char]
mb = Doc -> Doc
doubleQuotes (Doc -> ([Char] -> Doc) -> Maybe [Char] -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty [Char] -> Doc
text Maybe [Char]
mb)

ppDICompositeType' :: Fmt i -> Fmt (DICompositeType' i)
ppDICompositeType' :: forall i. Fmt i -> Fmt (DICompositeType' i)
ppDICompositeType' Fmt i
pp DICompositeType' i
ct = Doc
"!DICompositeType"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
       [ Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"tag:"            Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DICompositeType' i -> Word16
forall lab. DICompositeType' lab -> Word16
dictTag DICompositeType' i
ct))
       ,     ((Doc
"name:"           Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text) ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe [Char]
forall lab. DICompositeType' lab -> Maybe [Char]
dictName DICompositeType' i
ct)
       ,     ((Doc
"file:"           Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictFile DICompositeType' i
ct)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"           Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DICompositeType' i -> Word32
forall lab. DICompositeType' lab -> Word32
dictLine DICompositeType' i
ct))
       ,     ((Doc
"baseType:"       Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictBaseType DICompositeType' i
ct)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"size:"           Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DICompositeType' i -> Word64
forall lab. DICompositeType' lab -> Word64
dictSize DICompositeType' i
ct))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"align:"          Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DICompositeType' i -> Word64
forall lab. DICompositeType' lab -> Word64
dictAlign DICompositeType' i
ct))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"offset:"         Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DICompositeType' i -> Word64
forall lab. DICompositeType' lab -> Word64
dictOffset DICompositeType' i
ct))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"flags:"          Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DICompositeType' i -> Word32
forall lab. DICompositeType' lab -> Word32
dictFlags DICompositeType' i
ct))
       ,     ((Doc
"elements:"       Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictElements DICompositeType' i
ct)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"runtimeLang:"    Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DICompositeType' i -> Word16
forall lab. DICompositeType' lab -> Word16
dictRuntimeLang DICompositeType' i
ct))
       ,     ((Doc
"vtableHolder:"   Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictVTableHolder DICompositeType' i
ct)
       ,     ((Doc
"templateParams:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictTemplateParams DICompositeType' i
ct)
       ,     ((Doc
"identifier:"     Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text)
             ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe [Char]
forall lab. DICompositeType' lab -> Maybe [Char]
dictIdentifier DICompositeType' i
ct)
       ,     ((Doc
"discriminator:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictDiscriminator DICompositeType' i
ct)
       ,     ((Doc
"associated:"     Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictAssociated DICompositeType' i
ct)
       ,     ((Doc
"allocated:"      Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictAllocated DICompositeType' i
ct)
       ,     ((Doc
"rank:"           Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictRank DICompositeType' i
ct)
       ,     ((Doc
"annotations:"    Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DICompositeType' i -> Maybe (ValMd' i)
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictAnnotations DICompositeType' i
ct)
       ])

ppDICompositeType :: Fmt DICompositeType
ppDICompositeType :: Fmt DICompositeType
ppDICompositeType = Fmt BlockLabel -> Fmt DICompositeType
forall i. Fmt i -> Fmt (DICompositeType' i)
ppDICompositeType' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDIDerivedType' :: Fmt i -> Fmt (DIDerivedType' i)
ppDIDerivedType' :: forall i. Fmt i -> Fmt (DIDerivedType' i)
ppDIDerivedType' Fmt i
pp DIDerivedType' i
dt = Doc
"!DIDerivedType"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
       [ Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"tag:"       Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DIDerivedType' i -> Word16
forall lab. DIDerivedType' lab -> Word16
didtTag DIDerivedType' i
dt))
       ,     ((Doc
"name:"      Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text) ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIDerivedType' i -> Maybe [Char]
forall lab. DIDerivedType' lab -> Maybe [Char]
didtName DIDerivedType' i
dt)
       ,     ((Doc
"file:"      Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIDerivedType' i -> Maybe (ValMd' i)
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtFile DIDerivedType' i
dt)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"      Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DIDerivedType' i -> Word32
forall lab. DIDerivedType' lab -> Word32
didtLine DIDerivedType' i
dt))
       ,     ((Doc
"scope:"     Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIDerivedType' i -> Maybe (ValMd' i)
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtScope DIDerivedType' i
dt)
       ,      (Doc
"baseType:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> Maybe Doc -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DIDerivedType' i -> Maybe (ValMd' i)
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtBaseType DIDerivedType' i
dt Maybe Doc -> Maybe Doc -> Maybe Doc
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
"null")
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"size:"      Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DIDerivedType' i -> Word64
forall lab. DIDerivedType' lab -> Word64
didtSize DIDerivedType' i
dt))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"align:"     Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DIDerivedType' i -> Word64
forall lab. DIDerivedType' lab -> Word64
didtAlign DIDerivedType' i
dt))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"offset:"    Doc -> Doc -> Doc
<+> Word64 -> Doc
forall i. Integral i => Fmt i
integral (DIDerivedType' i -> Word64
forall lab. DIDerivedType' lab -> Word64
didtOffset DIDerivedType' i
dt))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"flags:"     Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DIDerivedType' i -> Word32
forall lab. DIDerivedType' lab -> Word32
didtFlags DIDerivedType' i
dt))
       ,     ((Doc
"extraData:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIDerivedType' i -> Maybe (ValMd' i)
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtExtraData DIDerivedType' i
dt)
       ,     ((Doc
"dwarfAddressSpace:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (Word32 -> Doc) -> Word32 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Doc
forall i. Integral i => Fmt i
integral) (Word32 -> Doc) -> Maybe Word32 -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DIDerivedType' i -> Maybe Word32
forall lab. DIDerivedType' lab -> Maybe Word32
didtDwarfAddressSpace DIDerivedType' i
dt
       ,     ((Doc
"annotations:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIDerivedType' i -> Maybe (ValMd' i)
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtAnnotations DIDerivedType' i
dt)
       ])

ppDIDerivedType :: Fmt DIDerivedType
ppDIDerivedType :: Fmt DIDerivedType
ppDIDerivedType = Fmt BlockLabel -> Fmt DIDerivedType
forall i. Fmt i -> Fmt (DIDerivedType' i)
ppDIDerivedType' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDIEnumerator :: String -> Integer -> Fmt Bool
ppDIEnumerator :: [Char] -> Integer -> Fmt Bool
ppDIEnumerator [Char]
n Integer
v Bool
u = Doc
"!DIEnumerator"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas [ Doc
"name:"  Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Char] -> Doc
text [Char]
n)
                    , Doc
"value:" Doc -> Doc -> Doc
<+> Integer -> Doc
forall i. Integral i => Fmt i
integral Integer
v
                    , Doc
"isUnsigned:" Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool Bool
u
                    ])

ppDIExpression :: Fmt DIExpression
ppDIExpression :: Fmt DIExpression
ppDIExpression DIExpression
e = Doc
"!DIExpression"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas ((Word64 -> Doc) -> [Word64] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Doc
forall i. Integral i => Fmt i
integral (DIExpression -> [Word64]
dieElements DIExpression
e)))

ppDIFile :: Fmt DIFile
ppDIFile :: Fmt DIFile
ppDIFile DIFile
f = Doc
"!DIFile"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas [ Doc
"filename:"  Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Char] -> Doc
text (DIFile -> [Char]
difFilename DIFile
f))
                    , Doc
"directory:" Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes ([Char] -> Doc
text (DIFile -> [Char]
difDirectory DIFile
f))
                    ])

ppDIGlobalVariable' :: Fmt i -> Fmt (DIGlobalVariable' i)
ppDIGlobalVariable' :: forall i. Fmt i -> Fmt (DIGlobalVariable' i)
ppDIGlobalVariable' Fmt i
pp DIGlobalVariable' i
gv = Doc
"!DIGlobalVariable"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
       [      ((Doc
"scope:"       Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariable' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariable' lab -> Maybe (ValMd' lab)
digvScope DIGlobalVariable' i
gv)
       ,      ((Doc
"name:"        Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text) ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariable' i -> Maybe [Char]
forall lab. DIGlobalVariable' lab -> Maybe [Char]
digvName DIGlobalVariable' i
gv)
       ,      ((Doc
"linkageName:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text)
              ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariable' i -> Maybe [Char]
forall lab. DIGlobalVariable' lab -> Maybe [Char]
digvLinkageName DIGlobalVariable' i
gv)
       ,      ((Doc
"file:"        Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariable' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariable' lab -> Maybe (ValMd' lab)
digvFile DIGlobalVariable' i
gv)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"         Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DIGlobalVariable' i -> Word32
forall lab. DIGlobalVariable' lab -> Word32
digvLine DIGlobalVariable' i
gv))
       ,      ((Doc
"type:"        Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariable' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariable' lab -> Maybe (ValMd' lab)
digvType DIGlobalVariable' i
gv)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"isLocal:"      Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DIGlobalVariable' i -> Bool
forall lab. DIGlobalVariable' lab -> Bool
digvIsLocal DIGlobalVariable' i
gv))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"isDefinition:" Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DIGlobalVariable' i -> Bool
forall lab. DIGlobalVariable' lab -> Bool
digvIsDefinition DIGlobalVariable' i
gv))
       ,      ((Doc
"variable:"    Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariable' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariable' lab -> Maybe (ValMd' lab)
digvVariable DIGlobalVariable' i
gv)
       ,      ((Doc
"declaration:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariable' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariable' lab -> Maybe (ValMd' lab)
digvDeclaration DIGlobalVariable' i
gv)
       ,      ((Doc
"align:"       Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (Word32 -> Doc) -> Word32 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Doc
forall i. Integral i => Fmt i
integral) (Word32 -> Doc) -> Maybe Word32 -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DIGlobalVariable' i -> Maybe Word32
forall lab. DIGlobalVariable' lab -> Maybe Word32
digvAlignment DIGlobalVariable' i
gv
       ,      ((Doc
"annotations:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariable' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariable' lab -> Maybe (ValMd' lab)
digvAnnotations DIGlobalVariable' i
gv)
       ])

ppDIGlobalVariable :: Fmt DIGlobalVariable
ppDIGlobalVariable :: Fmt DIGlobalVariable
ppDIGlobalVariable = Fmt BlockLabel -> Fmt DIGlobalVariable
forall i. Fmt i -> Fmt (DIGlobalVariable' i)
ppDIGlobalVariable' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDIGlobalVariableExpression' :: Fmt i -> Fmt (DIGlobalVariableExpression' i)
ppDIGlobalVariableExpression' :: forall i. Fmt i -> Fmt (DIGlobalVariableExpression' i)
ppDIGlobalVariableExpression' Fmt i
pp DIGlobalVariableExpression' i
gve = Doc
"!DIGlobalVariableExpression"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
       [      ((Doc
"var:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariableExpression' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariableExpression' lab -> Maybe (ValMd' lab)
digveVariable DIGlobalVariableExpression' i
gve)
       ,      ((Doc
"expr:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DIGlobalVariableExpression' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariableExpression' lab -> Maybe (ValMd' lab)
digveExpression DIGlobalVariableExpression' i
gve)
       ])

ppDIGlobalVariableExpression :: Fmt DIGlobalVariableExpression
ppDIGlobalVariableExpression :: Fmt DIGlobalVariableExpression
ppDIGlobalVariableExpression = Fmt BlockLabel -> Fmt DIGlobalVariableExpression
forall i. Fmt i -> Fmt (DIGlobalVariableExpression' i)
ppDIGlobalVariableExpression' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDILexicalBlock' :: Fmt i -> Fmt (DILexicalBlock' i)
ppDILexicalBlock' :: forall i. Fmt i -> Fmt (DILexicalBlock' i)
ppDILexicalBlock' Fmt i
pp DILexicalBlock' i
ct = Doc
"!DILexicalBlock"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
       [     ((Doc
"scope:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DILexicalBlock' i -> Maybe (ValMd' i)
forall lab. DILexicalBlock' lab -> Maybe (ValMd' lab)
dilbScope DILexicalBlock' i
ct)
       ,     ((Doc
"file:"   Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DILexicalBlock' i -> Maybe (ValMd' i)
forall lab. DILexicalBlock' lab -> Maybe (ValMd' lab)
dilbFile DILexicalBlock' i
ct)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"   Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DILexicalBlock' i -> Word32
forall lab. DILexicalBlock' lab -> Word32
dilbLine DILexicalBlock' i
ct))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"column:" Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DILexicalBlock' i -> Word16
forall lab. DILexicalBlock' lab -> Word16
dilbColumn DILexicalBlock' i
ct))
       ])

ppDILexicalBlock :: Fmt DILexicalBlock
ppDILexicalBlock :: Fmt DILexicalBlock
ppDILexicalBlock = Fmt BlockLabel -> Fmt DILexicalBlock
forall i. Fmt i -> Fmt (DILexicalBlock' i)
ppDILexicalBlock' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDILexicalBlockFile' :: Fmt i -> Fmt (DILexicalBlockFile' i)
ppDILexicalBlockFile' :: forall i. Fmt i -> Fmt (DILexicalBlockFile' i)
ppDILexicalBlockFile' Fmt i
pp DILexicalBlockFile' i
lbf = Doc
"!DILexicalBlockFile"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
       [ Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"scope:"         Doc -> Doc -> Doc
<+> Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (DILexicalBlockFile' i -> ValMd' i
forall lab. DILexicalBlockFile' lab -> ValMd' lab
dilbfScope DILexicalBlockFile' i
lbf))
       ,     ((Doc
"file:"          Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DILexicalBlockFile' i -> Maybe (ValMd' i)
forall lab. DILexicalBlockFile' lab -> Maybe (ValMd' lab)
dilbfFile DILexicalBlockFile' i
lbf)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"discriminator:" Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DILexicalBlockFile' i -> Word32
forall lab. DILexicalBlockFile' lab -> Word32
dilbfDiscriminator DILexicalBlockFile' i
lbf))
       ])

ppDILexicalBlockFile :: Fmt DILexicalBlockFile
ppDILexicalBlockFile :: Fmt DILexicalBlockFile
ppDILexicalBlockFile = Fmt BlockLabel -> Fmt DILexicalBlockFile
forall i. Fmt i -> Fmt (DILexicalBlockFile' i)
ppDILexicalBlockFile' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDILocalVariable' :: Fmt i -> Fmt (DILocalVariable' i)
ppDILocalVariable' :: forall i. Fmt i -> Fmt (DILocalVariable' i)
ppDILocalVariable' Fmt i
pp DILocalVariable' i
lv = Doc
"!DILocalVariable"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
       [      ((Doc
"scope:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DILocalVariable' i -> Maybe (ValMd' i)
forall lab. DILocalVariable' lab -> Maybe (ValMd' lab)
dilvScope DILocalVariable' i
lv)
       ,      ((Doc
"name:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text) ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DILocalVariable' i -> Maybe [Char]
forall lab. DILocalVariable' lab -> Maybe [Char]
dilvName DILocalVariable' i
lv)
       ,      ((Doc
"file:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DILocalVariable' i -> Maybe (ValMd' i)
forall lab. DILocalVariable' lab -> Maybe (ValMd' lab)
dilvFile DILocalVariable' i
lv)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"   Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DILocalVariable' i -> Word32
forall lab. DILocalVariable' lab -> Word32
dilvLine DILocalVariable' i
lv))
       ,      ((Doc
"type:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DILocalVariable' i -> Maybe (ValMd' i)
forall lab. DILocalVariable' lab -> Maybe (ValMd' lab)
dilvType DILocalVariable' i
lv)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"arg:"    Doc -> Doc -> Doc
<+> Word16 -> Doc
forall i. Integral i => Fmt i
integral (DILocalVariable' i -> Word16
forall lab. DILocalVariable' lab -> Word16
dilvArg DILocalVariable' i
lv))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"flags:"  Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DILocalVariable' i -> Word32
forall lab. DILocalVariable' lab -> Word32
dilvFlags DILocalVariable' i
lv))
       ,      ((Doc
"align:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (Word32 -> Doc) -> Word32 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Doc
forall i. Integral i => Fmt i
integral) (Word32 -> Doc) -> Maybe Word32 -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DILocalVariable' i -> Maybe Word32
forall lab. DILocalVariable' lab -> Maybe Word32
dilvAlignment DILocalVariable' i
lv
       ,      ((Doc
"annotations:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DILocalVariable' i -> Maybe (ValMd' i)
forall lab. DILocalVariable' lab -> Maybe (ValMd' lab)
dilvAnnotations DILocalVariable' i
lv)
       ])

ppDILocalVariable :: Fmt DILocalVariable
ppDILocalVariable :: Fmt DILocalVariable
ppDILocalVariable = Fmt BlockLabel -> Fmt DILocalVariable
forall i. Fmt i -> Fmt (DILocalVariable' i)
ppDILocalVariable' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

-- | See @writeDISubprogram@ in the LLVM source, in the file @AsmWriter.cpp@
--
-- Note that the textual syntax changed in LLVM 7, as the @retainedNodes@ field
-- was called @variables@ in previous LLVM versions.
ppDISubprogram' :: Fmt i -> Fmt (DISubprogram' i)
ppDISubprogram' :: forall i. Fmt i -> Fmt (DISubprogram' i)
ppDISubprogram' Fmt i
pp DISubprogram' i
sp = Doc
"!DISubprogram"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
       [      ((Doc
"scope:"          Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispScope DISubprogram' i
sp)
       ,      ((Doc
"name:"           Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text) ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe [Char]
forall lab. DISubprogram' lab -> Maybe [Char]
dispName DISubprogram' i
sp)
       ,      ((Doc
"linkageName:"    Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text)
              ([Char] -> Doc) -> Maybe [Char] -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe [Char]
forall lab. DISubprogram' lab -> Maybe [Char]
dispLinkageName DISubprogram' i
sp)
       ,      ((Doc
"file:"           Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispFile DISubprogram' i
sp)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"line:"            Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DISubprogram' i -> Word32
forall lab. DISubprogram' lab -> Word32
dispLine DISubprogram' i
sp))
       ,      ((Doc
"type:"           Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispType DISubprogram' i
sp)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"isLocal:"         Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DISubprogram' i -> Bool
forall lab. DISubprogram' lab -> Bool
dispIsLocal DISubprogram' i
sp))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"isDefinition:"    Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DISubprogram' i -> Bool
forall lab. DISubprogram' lab -> Bool
dispIsDefinition DISubprogram' i
sp))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"scopeLine:"       Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DISubprogram' i -> Word32
forall lab. DISubprogram' lab -> Word32
dispScopeLine DISubprogram' i
sp))
       ,      ((Doc
"containingType:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispContainingType DISubprogram' i
sp)
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"virtuality:"      Doc -> Doc -> Doc
<+> Word8 -> Doc
forall i. Integral i => Fmt i
integral (DISubprogram' i -> Word8
forall lab. DISubprogram' lab -> Word8
dispVirtuality DISubprogram' i
sp))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"virtualIndex:"    Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DISubprogram' i -> Word32
forall lab. DISubprogram' lab -> Word32
dispVirtualIndex DISubprogram' i
sp))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"flags:"           Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DISubprogram' i -> Word32
forall lab. DISubprogram' lab -> Word32
dispFlags DISubprogram' i
sp))
       , Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"isOptimized:"     Doc -> Doc -> Doc
<+> Fmt Bool
Bool -> Doc
ppBool (DISubprogram' i -> Bool
forall lab. DISubprogram' lab -> Bool
dispIsOptimized DISubprogram' i
sp))
       ,      ((Doc
"unit:"           Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispUnit DISubprogram' i
sp)
       ,      ((Doc
"templateParams:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispTemplateParams DISubprogram' i
sp)
       ,      ((Doc
"declaration:"    Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispDeclaration DISubprogram' i
sp)
       ,      ((Doc
"retainedNodes:"  Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispRetainedNodes DISubprogram' i
sp)
       ,      ((Doc
"thrownTypes:"    Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispThrownTypes DISubprogram' i
sp)
       ,      ((Doc
"annotations:"    Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubprogram' i -> Maybe (ValMd' i)
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispAnnotations DISubprogram' i
sp)
       ])

ppDISubprogram :: Fmt DISubprogram
ppDISubprogram :: Fmt DISubprogram
ppDISubprogram = Fmt BlockLabel -> Fmt DISubprogram
forall i. Fmt i -> Fmt (DISubprogram' i)
ppDISubprogram' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDISubrange' :: Fmt i -> Fmt (DISubrange' i)
ppDISubrange' :: forall i. Fmt i -> Fmt (DISubrange' i)
ppDISubrange' Fmt i
pp DISubrange' i
sr =
  Doc
"!DISubrange"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens
  (Fmt [Maybe Doc]
[Maybe Doc] -> Doc
mcommas
   -- LLVM < 7: count and lowerBound as signed int 64
   -- LLVM < 11: count as ValMd, lowerBound as signed in 64
   -- LLVM >= 11: ValMd of count, lowerBound, upperBound, and stride
   -- Valid through LLVM 17.
   -- See AST.hs description for more details on the structure.
   -- See https://github.com/llvm/llvm-project/blob/431969e/llvm/lib/IR/AsmWriter.cpp#L1888-L1927
   -- for more details on output generation.
   [
     ((Doc
"count:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Fmt i -> Fmt (ValMd' i)
forall i. Bool -> Fmt i -> Fmt (ValMd' i)
ppInt64ValMd' (LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
7) i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DISubrange' i -> Maybe (ValMd' i)
forall lab. DISubrange' lab -> Maybe (ValMd' lab)
disrCount DISubrange' i
sr
   , ((Doc
"lowerBound:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Fmt i -> Fmt (ValMd' i)
forall i. Bool -> Fmt i -> Fmt (ValMd' i)
ppInt64ValMd' (LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
11) i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DISubrange' i -> Maybe (ValMd' i)
forall lab. DISubrange' lab -> Maybe (ValMd' lab)
disrLowerBound DISubrange' i
sr
   , Bool -> Maybe Doc -> Maybe Doc
forall a. Monoid a => Bool -> a -> a
when' (LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
11)
     (Maybe Doc -> Maybe Doc) -> Maybe Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ ((Doc
"upperBound:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Fmt i -> Fmt (ValMd' i)
forall i. Bool -> Fmt i -> Fmt (ValMd' i)
ppInt64ValMd' Bool
True i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DISubrange' i -> Maybe (ValMd' i)
forall lab. DISubrange' lab -> Maybe (ValMd' lab)
disrUpperBound DISubrange' i
sr
   , Bool -> Maybe Doc -> Maybe Doc
forall a. Monoid a => Bool -> a -> a
when' (LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
11)
     (Maybe Doc -> Maybe Doc) -> Maybe Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ ((Doc
"stride:" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (ValMd' i -> Doc) -> ValMd' i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Fmt i -> Fmt (ValMd' i)
forall i. Bool -> Fmt i -> Fmt (ValMd' i)
ppInt64ValMd' Bool
True i -> Doc
Fmt i
pp) (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DISubrange' i -> Maybe (ValMd' i)
forall lab. DISubrange' lab -> Maybe (ValMd' lab)
disrStride DISubrange' i
sr
   ])

ppDISubrange :: Fmt DISubrange
ppDISubrange :: Fmt DISubrange
ppDISubrange = Fmt BlockLabel -> Fmt DISubrange
forall i. Fmt i -> Fmt (DISubrange' i)
ppDISubrange' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDISubroutineType' :: Fmt i -> Fmt (DISubroutineType' i)
ppDISubroutineType' :: forall i. Fmt i -> Fmt (DISubroutineType' i)
ppDISubroutineType' Fmt i
pp DISubroutineType' i
st = Doc
"!DISubroutineType"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas
       [ Doc
"flags:" Doc -> Doc -> Doc
<+> Word32 -> Doc
forall i. Integral i => Fmt i
integral (DISubroutineType' i -> Word32
forall lab. DISubroutineType' lab -> Word32
distFlags DISubroutineType' i
st)
       , Doc
"types:" Doc -> Doc -> Doc
<+> Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
"null" (Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp (ValMd' i -> Doc) -> Maybe (ValMd' i) -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DISubroutineType' i -> Maybe (ValMd' i)
forall lab. DISubroutineType' lab -> Maybe (ValMd' lab)
distTypeArray DISubroutineType' i
st))
       ])

ppDISubroutineType :: Fmt DISubroutineType
ppDISubroutineType :: Fmt DISubroutineType
ppDISubroutineType = Fmt BlockLabel -> Fmt DISubroutineType
forall i. Fmt i -> Fmt (DISubroutineType' i)
ppDISubroutineType' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

ppDIArgList' :: Fmt i -> Fmt (DIArgList' i)
ppDIArgList' :: forall i. Fmt i -> Fmt (DIArgList' i)
ppDIArgList' Fmt i
pp DIArgList' i
args = Doc
"!DIArgList"
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas ((ValMd' i -> Doc) -> [ValMd' i] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp) (DIArgList' i -> [ValMd' i]
forall lab. DIArgList' lab -> [ValMd' lab]
dialArgs DIArgList' i
args)))

ppDIArgList :: Fmt DIArgList
ppDIArgList :: Fmt DIArgList
ppDIArgList = Fmt BlockLabel -> Fmt DIArgList
forall i. Fmt i -> Fmt (DIArgList' i)
ppDIArgList' Fmt BlockLabel
BlockLabel -> Doc
ppLabel

-- Utilities -------------------------------------------------------------------

ppBool :: Fmt Bool
ppBool :: Fmt Bool
ppBool Bool
b | Bool
b         = Doc
"true"
         | Bool
otherwise = Doc
"false"

-- | Build a variable-argument argument list.
ppArgList :: Bool -> Fmt [Doc]
ppArgList :: Bool -> Fmt [Doc]
ppArgList Bool
True  [Doc]
ds = Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas ([Doc]
ds [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
"..."]))
ppArgList Bool
False [Doc]
ds = Doc -> Doc
parens (Fmt [Doc]
[Doc] -> Doc
commas [Doc]
ds)

integral :: Integral i => Fmt i
integral :: forall i. Integral i => Fmt i
integral  = Integer -> Doc
integer (Integer -> Doc) -> (i -> Integer) -> i -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

hex :: (Integral i, Show i) => Fmt i
hex :: forall i. (Integral i, Show i) => Fmt i
hex i
i = [Char] -> Doc
text (i -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex i
i [Char]
"0x")

opt :: Bool -> Fmt Doc
opt :: Bool -> Fmt Doc
opt Bool
True  = Doc -> Doc
forall a. a -> a
id
opt Bool
False = Doc -> Doc -> Doc
forall a b. a -> b -> a
const Doc
empty

-- | Print a ValMd' value as a plain signed integer (Int64) if possible.  If the
-- ValMd' is not representable as an Int64, defer to ValMd' printing (if
-- canFallBack is True) or print nothing (for when a ValMd is not a valid
-- representation).

ppInt64ValMd' :: Bool -> Fmt i -> Fmt (ValMd' i)
ppInt64ValMd' :: forall i. Bool -> Fmt i -> Fmt (ValMd' i)
ppInt64ValMd' Bool
canFallBack Fmt i
pp = ValMd' i -> Doc
go
  where go :: ValMd' i -> Doc
go = \case
          ValMdValue Typed (Value' i)
tv
            | PrimType (Integer Word32
_) <- Typed (Value' i) -> Type
forall a. Typed a -> Type
typedType Typed (Value' i)
tv
            , ValInteger Integer
i <- Typed (Value' i) -> Value' i
forall a. Typed a -> a
typedValue Typed (Value' i)
tv
              -> Integer -> Doc
integer Integer
i  -- 64 bits is the largest Int, so no conversion needed
          o :: ValMd' i
o@(ValMdDebugInfo (DebugInfoGlobalVariable DIGlobalVariable' i
gv)) ->
            case DIGlobalVariable' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariable' lab -> Maybe (ValMd' lab)
digvVariable DIGlobalVariable' i
gv of
              Maybe (ValMd' i)
Nothing -> Bool -> Doc -> Doc
forall a. Monoid a => Bool -> a -> a
when' Bool
canFallBack (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp ValMd' i
o
              Just ValMd' i
v -> ValMd' i -> Doc
go ValMd' i
v
          o :: ValMd' i
o@(ValMdDebugInfo (DebugInfoGlobalVariableExpression DIGlobalVariableExpression' i
expr)) ->
            case DIGlobalVariableExpression' i -> Maybe (ValMd' i)
forall lab. DIGlobalVariableExpression' lab -> Maybe (ValMd' lab)
digveExpression DIGlobalVariableExpression' i
expr of
              Maybe (ValMd' i)
Nothing -> Bool -> Doc -> Doc
forall a. Monoid a => Bool -> a -> a
when' Bool
canFallBack (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp ValMd' i
o
              Just ValMd' i
e -> ValMd' i -> Doc
go ValMd' i
e
          ValMdDebugInfo (DebugInfoLocalVariable DILocalVariable' i
lv) ->
            Integer -> Doc
integer (Integer -> Doc) -> Integer -> Doc
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ DILocalVariable' i -> Word16
forall lab. DILocalVariable' lab -> Word16
dilvArg DILocalVariable' i
lv  -- ??
          -- ValMdRef _idx -> mempty -- no table here to look this up...
          ValMd' i
o -> Bool -> Doc -> Doc
forall a. Monoid a => Bool -> a -> a
when' Bool
canFallBack (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Fmt i -> Fmt (ValMd' i)
forall i. Fmt i -> Fmt (ValMd' i)
ppValMd' i -> Doc
Fmt i
pp ValMd' i
o


commas :: Fmt [Doc]
commas :: Fmt [Doc]
commas  = [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

-- | Helpful for all of the optional fields that appear in the
-- metadata values
mcommas :: Fmt [Maybe Doc]
mcommas :: Fmt [Maybe Doc]
mcommas = Fmt [Doc]
[Doc] -> Doc
commas ([Doc] -> Doc) -> ([Maybe Doc] -> [Doc]) -> [Maybe Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes

angles :: Fmt Doc
angles :: Fmt Doc
angles Doc
d = Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> Doc
d Doc -> Doc -> Doc
<> Char -> Doc
char Char
'>'

structBraces :: Fmt Doc
structBraces :: Fmt Doc
structBraces Doc
body = Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<+> Doc
body Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'}'

ppMaybe :: Fmt a -> Fmt (Maybe a)
ppMaybe :: forall a. Fmt a -> Fmt (Maybe a)
ppMaybe  = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty

-- | Throw an error if the @?config@ version is older than the given version. The
-- String indicates which constructor is unavailable in the error message.
onlyOnLLVM :: (?config :: Config) => LLVMVer -> String -> a -> a
onlyOnLLVM :: forall a. (?config::Config) => LLVMVer -> [Char] -> a -> a
onlyOnLLVM LLVMVer
fromVer [Char]
name
  | LLVMVer
(?config::Config) => LLVMVer
llvmVer LLVMVer -> LLVMVer -> Bool
forall a. Ord a => a -> a -> Bool
>= LLVMVer
fromVer = a -> a
forall a. a -> a
id
  | Bool
otherwise          = [Char] -> a -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a -> a) -> [Char] -> a -> a
forall a b. (a -> b) -> a -> b
$ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is supported only on LLVM >= "
                                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LLVMVer -> [Char]
llvmVerToString LLVMVer
fromVer