llvm-pretty 0.5 → 0.6.0.0

raw patch · 5 files changed

+702/−281 lines, 5 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• llvm-pretty.cabal +1/−1
• src/Text/LLVM.hs +16/−14
• src/Text/LLVM/AST.hs +238/−27
• src/Text/LLVM/Labels.hs +62/−59
• src/Text/LLVM/PP.hs +385/−180

@@ -1,5 +1,5 @@ Name:                llvm-pretty-Version:             0.5+Version:             0.6.0.0 License:             BSD3 License-file:        LICENSE Author:              Trevor Elliott

@@ -257,13 +257,14 @@ define attrs rty fun sig k = do   (args,body) <- defineBody [] sig k   emitDefine Define-    { defAttrs   = attrs-    , defName    = fun-    , defRetType = rty-    , defArgs    = args-    , defVarArgs = False-    , defBody    = body-    , defSection = Nothing+    { defAttrs    = attrs+    , defName     = fun+    , defRetType  = rty+    , defArgs     = args+    , defVarArgs  = False+    , defBody     = body+    , defSection  = Nothing+    , defMetadata = Map.empty     }  -- | A combination of define and @freshSymbol@.@@ -281,13 +282,14 @@ define' attrs rty sym sig va k = do   args <- mapM freshArg sig   emitDefine Define-    { defAttrs   = attrs-    , defName    = sym-    , defRetType = rty-    , defArgs    = args-    , defVarArgs = va-    , defBody    = snd (runBB (k (map (fmap toValue) args)))-    , defSection = Nothing+    { defAttrs    = attrs+    , defName     = sym+    , defRetType  = rty+    , defArgs     = args+    , defVarArgs  = va+    , defBody     = snd (runBB (k (map (fmap toValue) args)))+    , defSection  = Nothing+    , defMetadata = Map.empty     }  -- Basic Block Monad -----------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-} @@ -12,10 +12,13 @@  import Text.LLVM.Util (breaks,uncons) -import Control.Monad (MonadPlus(mzero),(<=<),msum,guard,liftM,liftM3)-import Data.Int (Int32)+import Control.Monad (MonadPlus(mzero,mplus),(<=<),msum,guard,liftM,liftM3)+import Data.Int (Int32,Int64) import Data.List (genericIndex,genericLength)+import qualified Data.Map as Map import Data.String (IsString(fromString))+import Data.Word (Word8,Word16,Word32,Word64)+import GHC.Generics (Generic, Generic1)  #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative ((<$))@@ -28,7 +31,8 @@ -- Modules ---------------------------------------------------------------------  data Module = Module-  { modDataLayout :: DataLayout+  { modSourceName :: Maybe String+  , modDataLayout :: DataLayout   , modTypes      :: [TypeDecl]   , modNamedMd    :: [NamedMd]   , modUnnamedMd  :: [UnnamedMd]@@ -42,7 +46,8 @@ instance Monoid Module where   mempty = emptyModule   mappend m1 m2 = Module-    { modDataLayout = modDataLayout m1 `mappend` modDataLayout m2+    { modSourceName = modSourceName m1 `mplus`   modSourceName m2+    , modDataLayout = modDataLayout m1 `mappend` modDataLayout m2     , modTypes      = modTypes      m1 `mappend` modTypes      m2     , modUnnamedMd  = modUnnamedMd  m1 `mappend` modUnnamedMd  m2     , modNamedMd    = modNamedMd    m1 `mappend` modNamedMd    m2@@ -55,7 +60,8 @@  emptyModule :: Module emptyModule  = Module-  { modDataLayout = mempty+  { modSourceName = mempty+  , modDataLayout = mempty   , modTypes      = mempty   , modNamedMd    = mempty   , modUnnamedMd  = mempty@@ -79,7 +85,7 @@  data UnnamedMd = UnnamedMd   { umIndex  :: !Int-  , umValues :: [Maybe ValMd]+  , umValues :: ValMd   , umDistinct :: Bool   } deriving (Show) @@ -393,13 +399,14 @@ -- Function Definitions --------------------------------------------------------  data Define = Define-  { defAttrs   :: FunAttrs-  , defRetType :: Type-  , defName    :: Symbol-  , defArgs    :: [Typed Ident]-  , defVarArgs :: Bool-  , defSection :: Maybe String-  , defBody    :: [BasicBlock]+  { defAttrs    :: FunAttrs+  , defRetType  :: Type+  , defName     :: Symbol+  , defArgs     :: [Typed Ident]+  , defVarArgs  :: Bool+  , defSection  :: Maybe String+  , defBody     :: [BasicBlock]+  , defMetadata :: FnMdAttachments   } deriving (Show)  defFunType :: Define -> Type@@ -664,11 +671,11 @@          * Returns a value of type matching the pointer. -}    | Store (Typed (Value' lab)) (Typed (Value' lab)) (Maybe Align)-    {- ^ * Write a value ot memory:+    {- ^ * Write a value to memory:              value to store;              pointer to location where to store;              assumptions about the alignment of the given pointer.-         * Middle olf basic block.+         * Middle of basic block.          * Effect. -}    | ICmp ICmpOp (Typed (Value' lab)) (Value' lab)@@ -681,7 +688,7 @@          * Middle of basic block.          * Returns a boolean value. -} -  | Phi Type [((Value' lab),lab)]+  | Phi Type [(Value' lab,lab)]     {- ^ * Join point for an SSA value: we get one value per predecessor            basic block.          * Middle of basic block.@@ -771,14 +778,14 @@    | Resume (Typed (Value' lab)) -    deriving (Show,Functor)+    deriving (Show,Functor,Generic)  type Instr = Instr' BlockLabel  data Clause' lab   = Catch  (Typed (Value' lab))   | Filter (Typed (Value' lab))-    deriving (Show,Functor)+    deriving (Show,Functor,Generic,Generic1)  type Clause = Clause' BlockLabel @@ -835,7 +842,7 @@   | ValZeroInit   | ValAsm Bool Bool String String   | ValMd (ValMd' lab)-    deriving (Show,Functor)+    deriving (Show,Functor,Generic,Generic1)  type Value = Value' BlockLabel @@ -845,16 +852,20 @@   | ValMdRef Int   | ValMdNode [Maybe (ValMd' lab)]   | ValMdLoc (DebugLoc' lab)-    deriving (Show,Functor)+  | ValMdDebugInfo (DebugInfo' lab)+    deriving (Show,Functor,Generic,Generic1)  type ValMd = ValMd' BlockLabel +type KindMd = String+type FnMdAttachments = Map.Map KindMd ValMd+ data DebugLoc' lab = DebugLoc-  { dlLine  :: Int32-  , dlCol   :: Int32+  { dlLine  :: Word32+  , dlCol   :: Word32   , dlScope :: ValMd' lab   , dlIA    :: Maybe (ValMd' lab)-  } deriving (Show,Functor)+  } deriving (Show,Functor,Generic,Generic1)  type DebugLoc = DebugLoc' BlockLabel @@ -883,7 +894,7 @@ data Stmt' lab   = Result Ident (Instr' lab) [(String,ValMd' lab)]   | Effect (Instr' lab) [(String,ValMd' lab)]-    deriving (Show,Functor)+    deriving (Show,Functor,Generic,Generic1)  type Stmt = Stmt' BlockLabel @@ -905,15 +916,215 @@ -- Constant Expressions --------------------------------------------------------  data ConstExpr' lab-  = ConstGEP Bool [Typed (Value' lab)]+  = ConstGEP Bool (Maybe Type) [Typed (Value' lab)]+  -- ^ Element type introduced in LLVM 3.7   | ConstConv ConvOp (Typed (Value' lab)) Type   | ConstSelect (Typed (Value' lab)) (Typed (Value' lab)) (Typed (Value' lab))   | ConstBlockAddr Symbol lab-    deriving (Show,Functor)+  | ConstFCmp FCmpOp (Typed (Value' lab)) (Typed (Value' lab))+  | ConstICmp ICmpOp (Typed (Value' lab)) (Typed (Value' lab))+  | ConstArith ArithOp (Typed (Value' lab)) (Value' lab)+  | ConstBit BitOp (Typed (Value' lab)) (Value' lab)+    deriving (Show,Functor,Generic,Generic1)  type ConstExpr = ConstExpr' BlockLabel +-- DWARF Debug Info ------------------------------------------------------------ +data DebugInfo' lab+  = DebugInfoBasicType DIBasicType+  | DebugInfoCompileUnit (DICompileUnit' lab)+  | DebugInfoCompositeType (DICompositeType' lab)+  | DebugInfoDerivedType (DIDerivedType' lab)+  | DebugInfoEnumerator String !Int64+  | DebugInfoExpression DIExpression+  | DebugInfoFile DIFile+  | DebugInfoGlobalVariable (DIGlobalVariable' lab)+  | DebugInfoLexicalBlock (DILexicalBlock' lab)+  | DebugInfoLexicalBlockFile (DILexicalBlockFile' lab)+  | DebugInfoLocalVariable (DILocalVariable' lab)+  | DebugInfoSubprogram (DISubprogram' lab)+  | DebugInfoSubrange DISubrange+  | DebugInfoSubroutineType (DISubroutineType' lab)+  deriving (Show,Functor,Generic,Generic1)++type DebugInfo = DebugInfo' BlockLabel++-- TODO: Turn these into sum types+-- See https://github.com/llvm-mirror/llvm/blob/release_38/include/llvm/Support/Dwarf.def+type DwarfAttrEncoding = Word8+type DwarfLang = Word16+type DwarfTag = Word16+type DwarfVirtuality = Word8+-- See https://github.com/llvm-mirror/llvm/blob/release_38/include/llvm/IR/DebugInfoMetadata.h#L175+type DIFlags = Word32+-- This seems to be defined internally as a small enum, and defined+-- differently across versions. Maybe turn this into a sum type once+-- it stabilizes.+type DIEmissionKind = Word8++data DIBasicType = DIBasicType+  { dibtTag :: DwarfTag+  , dibtName :: String+  , dibtSize :: Word64+  , dibtAlign :: Word64+  , dibtEncoding :: DwarfAttrEncoding+  } deriving (Show)++data DICompileUnit' lab = DICompileUnit+  { dicuLanguage           :: DwarfLang+  , dicuFile               :: Maybe (ValMd' lab)+  , dicuProducer           :: Maybe String+  , dicuIsOptimized        :: Bool+  , dicuFlags              :: DIFlags+  , dicuRuntimeVersion     :: Word16+  , dicuSplitDebugFilename :: Maybe FilePath+  , dicuEmissionKind       :: DIEmissionKind+  , dicuEnums              :: Maybe (ValMd' lab)+  , dicuRetainedTypes      :: Maybe (ValMd' lab)+  , dicuSubprograms        :: Maybe (ValMd' lab)+  , dicuGlobals            :: Maybe (ValMd' lab)+  , dicuImports            :: Maybe (ValMd' lab)+  , dicuMacros             :: Maybe (ValMd' lab)+  , dicuDWOId              :: Word64+  }+  deriving (Show,Functor,Generic,Generic1)++type DICompileUnit = DICompileUnit' BlockLabel++data DICompositeType' lab = DICompositeType+  { dictTag            :: DwarfTag+  , dictName           :: Maybe String+  , dictFile           :: Maybe (ValMd' lab)+  , dictLine           :: Word32+  , dictScope          :: Maybe (ValMd' lab)+  , dictBaseType       :: Maybe (ValMd' lab)+  , dictSize           :: Word64+  , dictAlign          :: Word64+  , dictOffset         :: Word64+  , dictFlags          :: DIFlags+  , dictElements       :: Maybe (ValMd' lab)+  , dictRuntimeLang    :: DwarfLang+  , dictVTableHolder   :: Maybe (ValMd' lab)+  , dictTemplateParams :: Maybe (ValMd' lab)+  , dictIdentifier     :: Maybe String+  }+  deriving (Show,Functor,Generic,Generic1)++type DICompositeType = DICompositeType' BlockLabel++data DIDerivedType' lab = DIDerivedType+  { didtTag :: DwarfTag+  , didtName :: Maybe String+  , didtFile :: Maybe (ValMd' lab)+  , didtLine :: Word32+  , didtScope :: Maybe (ValMd' lab)+  , didtBaseType :: Maybe (ValMd' lab)+  , didtSize :: Word64+  , didtAlign :: Word64+  , didtOffset :: Word64+  , didtFlags :: DIFlags+  , didtExtraData :: Maybe (ValMd' lab)+  }+  deriving (Show,Functor,Generic,Generic1)++type DIDerivedType = DIDerivedType' BlockLabel++data DIExpression = DIExpression+  { dieElements :: [Word64]+  }+  deriving (Show)++data DIFile = DIFile+  { difFilename  :: FilePath+  , difDirectory :: FilePath+  } deriving (Show)++data DIGlobalVariable' lab = DIGlobalVariable+  { digvScope                :: Maybe (ValMd' lab)+  , digvName                 :: Maybe String+  , digvLinkageName          :: Maybe String+  , digvFile                 :: Maybe (ValMd' lab)+  , digvLine                 :: Word32+  , digvType                 :: Maybe (ValMd' lab)+  , digvIsLocal              :: Bool+  , digvIsDefinition         :: Bool+  , digvVariable             :: Maybe (ValMd' lab)+  , digvDeclaration          :: Maybe (ValMd' lab)+  }+  deriving (Show,Functor,Generic,Generic1)++type DIGlobalVariable = DIGlobalVariable' BlockLabel++data DILexicalBlock' lab = DILexicalBlock+  { dilbScope  :: Maybe (ValMd' lab)+  , dilbFile   :: Maybe (ValMd' lab)+  , dilbLine   :: Word32+  , dilbColumn :: Word16+  }+  deriving (Show,Functor,Generic,Generic1)++type DILexicalBlock = DILexicalBlock' BlockLabel++data DILexicalBlockFile' lab = DILexicalBlockFile+  { dilbfScope         :: ValMd' lab+  , dilbfFile          :: Maybe (ValMd' lab)+  , dilbfDiscriminator :: Word32+  }+  deriving (Show,Functor,Generic,Generic1)++type DILexicalBlockFile = DILexicalBlockFile' BlockLabel++data DILocalVariable' lab = DILocalVariable+  { dilvScope :: Maybe (ValMd' lab)+  , dilvName :: Maybe String+  , dilvFile :: Maybe (ValMd' lab)+  , dilvLine :: Word32+  , dilvType :: Maybe (ValMd' lab)+  , dilvArg :: Word16+  , dilvFlags :: DIFlags+  }+  deriving (Show,Functor,Generic,Generic1)++type DILocalVariable = DILocalVariable' BlockLabel++data DISubprogram' lab = DISubprogram+  { dispScope          :: Maybe (ValMd' lab)+  , dispName           :: Maybe String+  , dispLinkageName    :: Maybe String+  , dispFile           :: Maybe (ValMd' lab)+  , dispLine           :: Word32+  , dispType           :: Maybe (ValMd' lab)+  , dispIsLocal        :: Bool+  , dispIsDefinition   :: Bool+  , dispScopeLine      :: Word32+  , dispContainingType :: Maybe (ValMd' lab)+  , dispVirtuality     :: DwarfVirtuality+  , dispVirtualIndex   :: Word32+  , dispThisAdjustment :: Int64+  , dispFlags          :: DIFlags+  , dispIsOptimized    :: Bool+  , dispTemplateParams :: Maybe (ValMd' lab)+  , dispDeclaration    :: Maybe (ValMd' lab)+  , dispVariables      :: Maybe (ValMd' lab)+  }+  deriving (Show,Functor,Generic,Generic1)++type DISubprogram = DISubprogram' BlockLabel++data DISubrange = DISubrange+  { disrCount :: Int64+  , disrLowerBound :: Int64+  }+  deriving (Show)++data DISubroutineType' lab = DISubroutineType+  { distFlags :: DIFlags+  , distTypeArray :: Maybe (ValMd' lab)+  }+  deriving (Show,Functor,Generic,Generic1)++type DISubroutineType = DISubroutineType' BlockLabel  -- Aggregate Utilities --------------------------------------------------------- 

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyCase, TypeOperators, FlexibleContexts #-}  #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1@@ -7,23 +8,61 @@ module Text.LLVM.Labels where  import Text.LLVM.AST+import GHC.Generics  #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative ((<$>),Applicative(..)) import Data.Traversable (traverse) #endif +------------------------------------------------------------------------++-- | Generic implementation of 'relabel' the never provides symbols+genericRelabel ::+  (Applicative m, Generic1 f, GHasLabel (Rep1 f)) =>+  (Maybe Symbol -> a -> m b) -> f a -> m (f b)+genericRelabel f x = to1 <$> grelabel f (from1 x)++-- | Implementation details for 'genericRelabel'+class GHasLabel f where+  grelabel :: Applicative m => (Maybe Symbol -> a -> m b) -> f a -> m (f b)++instance GHasLabel f => GHasLabel (M1 i c f) where+  grelabel f (M1 x) = M1 <$> grelabel f x++instance (GHasLabel f, GHasLabel g) => GHasLabel (f :*: g) where+  grelabel f (x :*: y) = (:*:) <$> grelabel f x <*> grelabel f y++instance (GHasLabel f, GHasLabel g) => GHasLabel (f :+: g) where+  grelabel f (L1 x) = L1 <$> grelabel f x+  grelabel f (R1 x) = R1 <$> grelabel f x++instance GHasLabel U1 where+  grelabel _ U1 = pure U1++instance GHasLabel V1 where+  grelabel _ v1 = case v1 of {}++instance GHasLabel Par1 where+  grelabel f (Par1 x) = Par1 <$> f Nothing x++instance GHasLabel (K1 i a) where+  grelabel _ (K1 a) = pure (K1 a)++instance HasLabel f => GHasLabel (Rec1 f) where+  grelabel f (Rec1 x) = Rec1 <$> relabel f x++instance (Traversable f, GHasLabel g) => GHasLabel (f :.: g) where+  grelabel f (Comp1 x) = Comp1 <$> traverse (grelabel f) x++------------------------------------------------------------------------+ class Functor f => HasLabel f where   -- | Given a function for resolving labels, where the presence of a symbol   -- denotes a label in a different function, rename all labels in a function.   relabel :: Applicative m => (Maybe Symbol -> a -> m b) -> f a -> m (f b) -instance HasLabel Stmt' where-  relabel f stmt = case stmt of-    Result r i mds -> Result r <$> relabel f i <*> traverse relabelMd mds-    Effect i mds   -> Effect   <$> relabel f i <*> traverse relabelMd mds-    where-    relabelMd (str,md) = (\md' -> (str,md')) `fmap` relabel f md+instance HasLabel Stmt' where relabel = genericRelabel  instance HasLabel Instr' where   relabel _ RetVoid               = pure  RetVoid@@ -109,58 +148,22 @@    relabel f (Resume tv)           = Resume <$> traverse (relabel f) tv -instance HasLabel Clause' where-  relabel f clause = case clause of-    Catch  tv -> Catch  <$> traverse (relabel f) tv-    Filter tv -> Filter <$> traverse (relabel f) tv--instance HasLabel Value' where-  relabel _ (ValInteger i)       = pure (ValInteger i)-  relabel _ (ValBool b)          = pure (ValBool b)-  relabel _ (ValFloat f)         = pure (ValFloat f)-  relabel _ (ValDouble d)        = pure (ValDouble d)-  relabel _ (ValIdent i)         = pure (ValIdent i)-  relabel _ (ValSymbol s)        = pure (ValSymbol s)-  relabel _ (ValString str)      = pure (ValString str)-  relabel _  ValUndef            = pure ValUndef-  relabel _  ValNull             = pure ValNull-  relabel _  ValZeroInit         = pure ValZeroInit-  relabel _ (ValAsm s a i c)     = pure (ValAsm s a i c)-  relabel f (ValMd m)            = ValMd <$> relabel f m-  relabel f (ValArray t es)      = ValArray t <$> traverse (relabel f) es-  relabel f (ValVector pt es)    = ValVector pt <$> traverse (relabel f) es-  relabel f (ValStruct fs)       = ValStruct <$> traverse (traverse (relabel f)) fs-  relabel f (ValConstExpr ce)    = ValConstExpr <$> relabel f ce-  relabel f (ValLabel lab)       = ValLabel <$> f Nothing lab-  relabel f (ValPackedStruct es) =-    ValPackedStruct <$> traverse (traverse (relabel f)) es--instance HasLabel ValMd' where-  relabel f md = case md of-    ValMdString str -> pure (ValMdString str)-    ValMdValue tv   -> ValMdValue <$> traverse (relabel f) tv-    ValMdRef i      -> pure (ValMdRef i)-    ValMdNode es    -> ValMdNode <$> traverse (traverse (relabel f)) es-    ValMdLoc dl     -> ValMdLoc <$> relabel f dl--instance HasLabel DebugLoc' where-  relabel f dl = upd <$> relabel f (dlScope dl)-                     <*> traverse (relabel f) (dlIA dl)-    where-    upd scope ia = dl-      { dlScope = scope-      , dlIA    = ia-      }+instance HasLabel Clause'             where relabel = genericRelabel+instance HasLabel Value'              where relabel = genericRelabel+instance HasLabel ValMd'              where relabel = genericRelabel+instance HasLabel DebugLoc'           where relabel = genericRelabel+instance HasLabel DebugInfo'          where relabel = genericRelabel+instance HasLabel DIDerivedType'      where relabel = genericRelabel+instance HasLabel DISubroutineType'   where relabel = genericRelabel+instance HasLabel DIGlobalVariable'   where relabel = genericRelabel+instance HasLabel DILocalVariable'    where relabel = genericRelabel+instance HasLabel DISubprogram'       where relabel = genericRelabel+instance HasLabel DICompositeType'    where relabel = genericRelabel+instance HasLabel DILexicalBlock'     where relabel = genericRelabel+instance HasLabel DICompileUnit'      where relabel = genericRelabel+instance HasLabel DILexicalBlockFile' where relabel = genericRelabel +-- | Clever instance that actually uses the block name instance HasLabel ConstExpr' where-  relabel f (ConstGEP inb is)   = ConstGEP inb-                              <$> traverse (traverse (relabel f)) is-  relabel f (ConstConv op a t)  = ConstConv op-                              <$> traverse (relabel f) a-                              <*> pure t-  relabel f (ConstSelect c l r) = ConstSelect-                              <$> traverse (relabel f) c-                              <*> traverse (relabel f) l-                              <*> traverse (relabel f) r-  relabel f (ConstBlockAddr t l)= ConstBlockAddr t-                              <$> f (Just t) l+  relabel f (ConstBlockAddr t l) = ConstBlockAddr t <$> f (Just t) l+  relabel f x = genericRelabel f x

@@ -1,5 +1,6 @@-{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-}  -- |@@ -18,11 +19,12 @@ import Text.LLVM.AST  import Data.Char (isAscii,isPrint,ord,toUpper)-import Data.Int (Int32) import Data.List (intersperse)-import Data.Maybe (fromMaybe)+import qualified Data.Map as Map+import Data.Maybe (catMaybes,fromMaybe) import Numeric (showHex) import Text.PrettyPrint.HughesPJ+import Data.Int   -- Pretty-printer Config -------------------------------------------------------@@ -90,9 +92,9 @@ ppUnnamedMd :: UnnamedMd -> Doc ppUnnamedMd um =   sep [ ppMetadata (int (umIndex um)) <+> char '='-      , distinct <+> ppMetadataNode (umValues um) ]+      , distinct <+> ppValMd (umValues um) ]   where-  distinct | umDistinct um = text "distinct"+  distinct | umDistinct um = "distinct"            | otherwise     = empty  @@ -112,20 +114,21 @@ -- | Pretty print a data layout specification. ppDataLayout :: DataLayout -> Doc ppDataLayout [] = empty-ppDataLayout ls = text "target" <+> text "datalayout" <+> char '='+ppDataLayout ls = "target" <+> "datalayout" <+> char '='     <+> doubleQuotes (hcat (intersperse (char '-') (map ppLayoutSpec ls)))  -- | Pretty print a single layout specification. ppLayoutSpec :: LayoutSpec -> Doc ppLayoutSpec  BigEndian                  = char 'E' ppLayoutSpec  LittleEndian               = char 'e'-ppLayoutSpec (PointerSize   sz abi pref) = text "p:" <> ppLayoutBody sz abi pref+ppLayoutSpec (PointerSize   sz abi pref) =      "p:" <> ppLayoutBody sz abi pref ppLayoutSpec (IntegerSize   sz abi pref) = char 'i'  <> ppLayoutBody sz abi pref ppLayoutSpec (VectorSize    sz abi pref) = char 'v'  <> ppLayoutBody sz abi pref ppLayoutSpec (FloatSize     sz abi pref) = char 'f'  <> ppLayoutBody sz abi pref ppLayoutSpec (AggregateSize sz abi pref) = char 'a'  <> ppLayoutBody sz abi pref ppLayoutSpec (StackObjSize  sz abi pref) = char 's'  <> ppLayoutBody sz abi pref-ppLayoutSpec (NativeIntSize szs)         = char 'n'  <> colons (map int szs)+ppLayoutSpec (NativeIntSize szs)         =+  char 'n' <> hcat (punctuate (char ':') (map int szs)) ppLayoutSpec (StackAlign a)              = char 'S'  <> int a ppLayoutSpec (Mangling m)                = char 'm'  <> char ':' <> ppMangling m @@ -150,7 +153,7 @@ ppInlineAsm :: InlineAsm -> Doc ppInlineAsm  = foldr ($+$) empty . map ppLine   where-  ppLine l = text "module asm" <+> doubleQuotes (text l)+  ppLine l = "module asm" <+> doubleQuotes (text l)   -- Identifiers -----------------------------------------------------------------@@ -168,35 +171,35 @@ -- Types -----------------------------------------------------------------------  ppPrimType :: PrimType -> Doc-ppPrimType Label          = text "label"-ppPrimType Void           = text "void"+ppPrimType Label          = "label"+ppPrimType Void           = "void" ppPrimType (Integer i)    = char 'i' <> integer (toInteger i) ppPrimType (FloatType ft) = ppFloatType ft-ppPrimType X86mmx         = text "x86mmx"-ppPrimType Metadata       = text "metadata"+ppPrimType X86mmx         = "x86mmx"+ppPrimType Metadata       = "metadata"  ppFloatType :: FloatType -> Doc-ppFloatType Half      = text "half"-ppFloatType Float     = text "float"-ppFloatType Double    = text "double"-ppFloatType Fp128     = text "fp128"-ppFloatType X86_fp80  = text "x86_fp80"-ppFloatType PPC_fp128 = text "ppc_fp128"+ppFloatType Half      = "half"+ppFloatType Float     = "float"+ppFloatType Double    = "double"+ppFloatType Fp128     = "fp128"+ppFloatType X86_fp80  = "x86_fp80"+ppFloatType PPC_fp128 = "ppc_fp128"  ppType :: Type -> Doc ppType (PrimType pt)     = ppPrimType pt ppType (Alias i)         = ppIdent i-ppType (Array len ty)    = brackets (int32 len <+> char 'x' <+> ppType ty)+ppType (Array len ty)    = brackets (integral len <+> char 'x' <+> ppType ty) ppType (PtrTo ty)        = ppType ty <> char '*' ppType (Struct ts)       = structBraces (commas (map ppType ts)) ppType (PackedStruct ts) = angles (structBraces (commas (map ppType ts))) ppType (FunTy r as va)   = ppType r <> ppArgList va (map ppType as)-ppType (Vector len pt)   = angles (int32 len <+> char 'x' <+> ppType pt)-ppType Opaque            = text "opaque"+ppType (Vector len pt)   = angles (integral len <+> char 'x' <+> ppType pt)+ppType Opaque            = "opaque"  ppTypeDecl :: TypeDecl -> Doc ppTypeDecl td = ppIdent (typeName td) <+> char '='-            <+> text "type" <+> ppType (typeValue td)+            <+> "type" <+> ppType (typeValue td)   -- Declarations ----------------------------------------------------------------@@ -210,35 +213,40 @@ ppGlobalAttrs :: GlobalAttrs -> Doc ppGlobalAttrs ga = ppMaybe ppLinkage (gaLinkage ga) <+> constant   where-  constant | gaConstant ga = text "constant"-           | otherwise     = text "global"+  constant | gaConstant ga = "constant"+           | otherwise     = "global"   ppDeclare :: Declare -> Doc-ppDeclare d = text "declare"+ppDeclare d = "declare"           <+> ppType (decRetType d)           <+> ppSymbol (decName d)            <> ppArgList (decVarArgs d) (map ppType (decArgs d))   ppDefine :: LLVM => Define -> Doc-ppDefine d = text "define"+ppDefine d = "define"          <+> ppMaybe ppLinkage (funLinkage (defAttrs d))          <+> ppType (defRetType d)          <+> ppSymbol (defName d)           <> ppArgList (defVarArgs d) (map (ppTyped ppIdent) (defArgs d))-         <+> ppMaybe (\s  -> text "section" <+> doubleQuotes (text s)) (defSection d)-         <+> ppMaybe (\gc -> text "gc" <+> ppGC gc) (funGC (defAttrs d))+         <+> ppMaybe (\s  -> "section" <+> doubleQuotes (text s)) (defSection d)+         <+> ppMaybe (\gc -> "gc" <+> ppGC gc) (funGC (defAttrs d))+         <+> ppMds (defMetadata d)          <+> char '{'          $+$ vcat (map ppBasicBlock (defBody d))          $+$ char '}'-+  where+  ppMds mdm =+    case Map.toList mdm of+      [] -> empty+      mds -> hsep [ "!" <> text k <+> ppValMd md | (k, md) <- mds ]  -- Basic Blocks ----------------------------------------------------------------  ppLabelDef :: BlockLabel -> Doc ppLabelDef (Named (Ident l)) = text l <> char ':'-ppLabelDef (Anon i)          = char ';' <+> text "<label>:" <+> int i+ppLabelDef (Anon i)          = char ';' <+> "<label>:" <+> int i  ppLabel :: BlockLabel -> Doc ppLabel (Named l) = ppIdent l@@ -269,22 +277,22 @@  ppLinkage :: Linkage -> Doc ppLinkage linkage = case linkage of-  Private                  -> text "private"-  LinkerPrivate            -> text "linker_private"-  LinkerPrivateWeak        -> text "linker_private_weak"-  LinkerPrivateWeakDefAuto -> text "linker_private_weak_def_auto"-  Internal                 -> text "internal"-  AvailableExternally      -> text "available_externally"-  Linkonce                 -> text "linkonce"-  Weak                     -> text "weak"-  Common                   -> text "common"-  Appending                -> text "appending"-  ExternWeak               -> text "extern_weak"-  LinkonceODR              -> text "linkonce_ddr"-  WeakODR                  -> text "weak_odr"-  External                 -> text "external"-  DLLImport                -> text "dllimport"-  DLLExport                -> text "dllexport"+  Private                  -> "private"+  LinkerPrivate            -> "linker_private"+  LinkerPrivateWeak        -> "linker_private_weak"+  LinkerPrivateWeakDefAuto -> "linker_private_weak_def_auto"+  Internal                 -> "internal"+  AvailableExternally      -> "available_externally"+  Linkonce                 -> "linkonce"+  Weak                     -> "weak"+  Common                   -> "common"+  Appending                -> "appending"+  ExternWeak               -> "extern_weak"+  LinkonceODR              -> "linkonce_ddr"+  WeakODR                  -> "weak_odr"+  External                 -> "external"+  DLLImport                -> "dllimport"+  DLLExport                -> "dllexport"  ppGC :: GC -> Doc ppGC  = doubleQuotes . text . getGC@@ -296,122 +304,122 @@ ppTyped fmt ty = ppType (typedType ty) <+> fmt (typedValue ty)  ppSignBits :: Bool -> Bool -> Doc-ppSignBits nuw nsw = opt nuw (text "nuw") <+> opt nsw (text "nsw")+ppSignBits nuw nsw = opt nuw "nuw" <+> opt nsw "nsw"  ppExact :: Bool -> Doc-ppExact e = opt e (text "exact")+ppExact e = opt e "exact"  ppArithOp :: ArithOp -> Doc-ppArithOp (Add nuw nsw) = text "add" <+> ppSignBits nuw nsw-ppArithOp FAdd          = text "fadd"-ppArithOp (Sub nuw nsw) = text "sub" <+> ppSignBits nuw nsw-ppArithOp FSub          = text "fsub"-ppArithOp (Mul nuw nsw) = text "mul" <+> ppSignBits nuw nsw-ppArithOp FMul          = text "fmul"-ppArithOp (UDiv e)      = text "udiv" <+> ppExact e-ppArithOp (SDiv e)      = text "sdiv" <+> ppExact e-ppArithOp FDiv          = text "fdiv"-ppArithOp URem          = text "urem"-ppArithOp SRem          = text "srem"-ppArithOp FRem          = text "frem"+ppArithOp (Add nuw nsw) = "add" <+> ppSignBits nuw nsw+ppArithOp FAdd          = "fadd"+ppArithOp (Sub nuw nsw) = "sub" <+> ppSignBits nuw nsw+ppArithOp FSub          = "fsub"+ppArithOp (Mul nuw nsw) = "mul" <+> ppSignBits nuw nsw+ppArithOp FMul          = "fmul"+ppArithOp (UDiv e)      = "udiv" <+> ppExact e+ppArithOp (SDiv e)      = "sdiv" <+> ppExact e+ppArithOp FDiv          = "fdiv"+ppArithOp URem          = "urem"+ppArithOp SRem          = "srem"+ppArithOp FRem          = "frem"  ppBitOp :: BitOp -> Doc-ppBitOp (Shl nuw nsw) = text "shl"  <+> ppSignBits nuw nsw-ppBitOp (Lshr e)      = text "lshr" <+> ppExact e-ppBitOp (Ashr e)      = text "ashr" <+> ppExact e-ppBitOp And           = text "and"-ppBitOp Or            = text "or"-ppBitOp Xor           = text "xor"+ppBitOp (Shl nuw nsw) = "shl"  <+> ppSignBits nuw nsw+ppBitOp (Lshr e)      = "lshr" <+> ppExact e+ppBitOp (Ashr e)      = "ashr" <+> ppExact e+ppBitOp And           = "and"+ppBitOp Or            = "or"+ppBitOp Xor           = "xor"  ppConvOp :: ConvOp -> Doc-ppConvOp Trunc    = text "trunc"-ppConvOp ZExt     = text "zext"-ppConvOp SExt     = text "sext"-ppConvOp FpTrunc  = text "fptrunc"-ppConvOp FpExt    = text "fpext"-ppConvOp FpToUi   = text "fptoui"-ppConvOp FpToSi   = text "fptosi"-ppConvOp UiToFp   = text "uitofp"-ppConvOp SiToFp   = text "sitofp"-ppConvOp PtrToInt = text "ptrtoint"-ppConvOp IntToPtr = text "inttoptr"-ppConvOp BitCast  = text "bitcast"+ppConvOp Trunc    = "trunc"+ppConvOp ZExt     = "zext"+ppConvOp SExt     = "sext"+ppConvOp FpTrunc  = "fptrunc"+ppConvOp FpExt    = "fpext"+ppConvOp FpToUi   = "fptoui"+ppConvOp FpToSi   = "fptosi"+ppConvOp UiToFp   = "uitofp"+ppConvOp SiToFp   = "sitofp"+ppConvOp PtrToInt = "ptrtoint"+ppConvOp IntToPtr = "inttoptr"+ppConvOp BitCast  = "bitcast"  ppInstr :: LLVM => Instr -> Doc ppInstr instr = case instr of-  Ret tv                 -> text "ret" <+> ppTyped ppValue tv-  RetVoid                -> text "ret void"+  Ret tv                 -> "ret" <+> ppTyped ppValue tv+  RetVoid                -> "ret void"   Arith op l r           -> ppArithOp op <+> ppTyped ppValue l                          <> comma <+> ppValue r   Bit op l r             -> ppBitOp op <+> ppTyped ppValue l                          <> comma <+> ppValue r   Conv op a ty           -> ppConvOp op <+> ppTyped ppValue a-                        <+> text "to" <+> ppType ty+                        <+> "to" <+> ppType ty   Call tc ty f args      -> ppCall tc ty f args   Alloca ty len align    -> ppAlloca ty len align   Load ptr ma            -> ppLoad ptr ma-  Store a ptr ma         -> text "store" <+> ppTyped ppValue a+  Store a ptr ma         -> "store" <+> ppTyped ppValue a                          <> comma <+> ppTyped ppValue ptr                          <> ppAlign ma-  ICmp op l r            -> text "icmp" <+> ppICmpOp op+  ICmp op l r            -> "icmp" <+> ppICmpOp op                         <+> ppTyped ppValue l <> comma <+> ppValue r-  FCmp op l r            -> text "fcmp" <+> ppFCmpOp op+  FCmp op l r            -> "fcmp" <+> ppFCmpOp op                         <+> ppTyped ppValue l <> comma <+> ppValue r-  Phi ty vls             -> text "phi" <+> ppType ty+  Phi ty vls             -> "phi" <+> ppType ty                         <+> commas (map ppPhiArg vls)-  Select c t f           -> text "select" <+> ppTyped ppValue c+  Select c t f           -> "select" <+> ppTyped ppValue c                          <> comma <+> ppTyped ppValue t                          <> comma <+> ppTyped ppValue (f <$ t)-  ExtractValue v is      -> text "extractvalue" <+> ppTyped ppValue v-                         <> comma <+> (commas (map int32 is))-  InsertValue a v is     -> text "insertvalue" <+> ppTyped ppValue a+  ExtractValue v is      -> "extractvalue" <+> ppTyped ppValue v+                         <> comma <+> (commas (map integral is))+  InsertValue a v is     -> "insertvalue" <+> ppTyped ppValue a                          <> comma <+> ppTyped ppValue v-                         <> comma <+> commas (map int32 is)-  ShuffleVector a b m    -> text "shufflevector" <+> ppTyped ppValue a+                         <> comma <+> commas (map integral is)+  ShuffleVector a b m    -> "shufflevector" <+> ppTyped ppValue a                          <> comma <+> ppTyped ppValue (b <$ a)                          <> comma <+> ppTyped ppValue m   GEP ib ptr ixs         -> ppGEP ib ptr ixs   Comment str            -> char ';' <+> text str-  Jump i                 -> text "br"+  Jump i                 -> "br"                         <+> ppTypedLabel i-  Br c t f               -> text "br" <+> ppTyped ppValue c+  Br c t f               -> "br" <+> ppTyped ppValue c                          <> comma <+> ppType (PrimType Label)                         <+> ppLabel t                          <> comma <+> ppType (PrimType Label)                         <+> ppLabel f   Invoke ty f args to uw -> ppInvoke ty f args to uw-  Unreachable            -> text "unreachable"-  Unwind                 -> text "unwind"-  VaArg al t             -> text "va_arg" <+> ppTyped ppValue al+  Unreachable            -> "unreachable"+  Unwind                 -> "unwind"+  VaArg al t             -> "va_arg" <+> ppTyped ppValue al                          <> comma <+> ppType t-  ExtractElt v i         -> text "extractelement"+  ExtractElt v i         -> "extractelement"                         <+> ppTyped ppValue v                          <> comma <+> ppVectorIndex i-  InsertElt v e i        -> text "insertelement"+  InsertElt v e i        -> "insertelement"                         <+> ppTyped ppValue v                          <> comma <+> ppTyped ppValue e                          <> comma <+> ppVectorIndex i-  IndirectBr d ls        -> text "indirectbr"+  IndirectBr d ls        -> "indirectbr"                         <+> ppTyped ppValue d                          <> comma <+> commas (map ppTypedLabel ls)-  Switch c d ls          -> text "switch"+  Switch c d ls          -> "switch"                         <+> ppTyped ppValue c                          <> comma <+> ppTypedLabel d                         <+> char '['                          $$ nest 2 (vcat (map (ppSwitchEntry (typedType c)) ls))                          $$ char ']'-  LandingPad ty fn c cs  -> text "landingpad"+  LandingPad ty fn c cs  -> "landingpad"                         <+> ppType ty-                        <+> text "personality"+                        <+> "personality"                         <+> ppTyped ppValue fn                          $$ nest 2 (ppClauses c cs)-  Resume tv              -> text "resume" <+> ppTyped ppValue tv+  Resume tv              -> "resume" <+> ppTyped ppValue tv  ppLoad :: LLVM => Typed (Value' BlockLabel) -> Maybe Align -> Doc ppLoad ptr ma =-  text "load" <+> (if isImplicit then empty else explicit)-              <+> ppTyped ppValue ptr-               <> ppAlign ma+  "load" <+> (if isImplicit then empty else explicit)+         <+> ppTyped ppValue ptr+          <> ppAlign ma    where   isImplicit = checkConfig cfgLoadImplicitType@@ -424,13 +432,13 @@ ppClauses :: Bool -> [Clause] -> Doc ppClauses isCleanup cs = vcat (cleanup : map ppClause cs)   where-  cleanup | isCleanup = text "cleanup"+  cleanup | isCleanup = "cleanup"           | otherwise = empty  ppClause :: Clause -> Doc ppClause c = case c of-  Catch  tv -> text "catch"  <+> ppTyped ppValue tv-  Filter tv -> text "filter" <+> ppTyped ppValue tv+  Catch  tv -> "catch"  <+> ppTyped ppValue tv+  Filter tv -> "filter" <+> ppTyped ppValue tv   ppTypedLabel :: BlockLabel -> Doc@@ -444,24 +452,24 @@  ppAlign :: Maybe Align -> Doc ppAlign Nothing      = empty-ppAlign (Just align) = comma <+> text "align" <+> int align+ppAlign (Just align) = comma <+> "align" <+> int align  ppAlloca :: Type -> Maybe (Typed Value) -> Maybe Int -> Doc-ppAlloca ty mbLen mbAlign = text "alloca" <+> ppType ty <> len <> align+ppAlloca ty mbLen mbAlign = "alloca" <+> ppType ty <> len <> align   where   len = fromMaybe empty $ do     l <- mbLen     return (comma <+> ppTyped ppValue l)   align = fromMaybe empty $ do     a <- mbAlign-    return (comma <+> text "align" <+> int a)+    return (comma <+> "align" <+> int a)  ppCall :: Bool -> Type -> Value -> [Typed Value] -> Doc ppCall tc ty f args-  | tc        = text "tail" <+> body+  | tc        = "tail" <+> body   | otherwise = body   where-  body = text "call" <+> ppCallSym ty f+  body = "call" <+> ppCallSym ty f       <> parens (commas (map (ppTyped ppValue) args))  ppCallSym :: Type -> Value -> Doc@@ -469,7 +477,7 @@ ppCallSym ty              val                     = ppType ty  <+> ppValue val  ppGEP :: LLVM => Bool -> Typed Value -> [Typed Value] -> Doc-ppGEP ib ptr ixs = text "getelementptr" <+> inbounds+ppGEP ib ptr ixs = "getelementptr" <+> inbounds                <+> (if isImplicit then empty else explicit)                <+> commas (map (ppTyped ppValue) (ptr:ixs))   where@@ -480,49 +488,49 @@       PtrTo ty -> ppType ty <> comma       ty       -> ppType ty <> comma -  inbounds | ib        = text "inbounds"+  inbounds | ib        = "inbounds"            | otherwise = empty  ppInvoke :: Type -> Value -> [Typed Value] -> BlockLabel -> BlockLabel -> Doc ppInvoke ty f args to uw = body   where-  body = text "invoke" <+> ppType ty <+> ppValue f+  body = "invoke" <+> ppType ty <+> ppValue f       <> parens (commas (map (ppTyped ppValue) args))-     <+> text "to" <+> ppType (PrimType Label) <+> ppLabel to-     <+> text "unwind" <+> ppType (PrimType Label) <+> ppLabel uw+     <+> "to" <+> ppType (PrimType Label) <+> ppLabel to+     <+> "unwind" <+> ppType (PrimType Label) <+> ppLabel uw  ppPhiArg :: (Value,BlockLabel) -> Doc ppPhiArg (v,l) = char '[' <+> ppValue v <> comma <+> ppLabel l <+> char ']'  ppICmpOp :: ICmpOp -> Doc-ppICmpOp Ieq  = text "eq"-ppICmpOp Ine  = text "ne"-ppICmpOp Iugt = text "ugt"-ppICmpOp Iuge = text "uge"-ppICmpOp Iult = text "ult"-ppICmpOp Iule = text "ule"-ppICmpOp Isgt = text "sgt"-ppICmpOp Isge = text "sge"-ppICmpOp Islt = text "slt"-ppICmpOp Isle = text "sle"+ppICmpOp Ieq  = "eq"+ppICmpOp Ine  = "ne"+ppICmpOp Iugt = "ugt"+ppICmpOp Iuge = "uge"+ppICmpOp Iult = "ult"+ppICmpOp Iule = "ule"+ppICmpOp Isgt = "sgt"+ppICmpOp Isge = "sge"+ppICmpOp Islt = "slt"+ppICmpOp Isle = "sle"  ppFCmpOp :: FCmpOp -> Doc-ppFCmpOp Ffalse = text "false"-ppFCmpOp Foeq   = text "oeq"-ppFCmpOp Fogt   = text "ogt"-ppFCmpOp Foge   = text "oge"-ppFCmpOp Folt   = text "olt"-ppFCmpOp Fole   = text "ole"-ppFCmpOp Fone   = text "one"-ppFCmpOp Ford   = text "ord"-ppFCmpOp Fueq   = text "ueq"-ppFCmpOp Fugt   = text "ugt"-ppFCmpOp Fuge   = text "uge"-ppFCmpOp Fult   = text "ult"-ppFCmpOp Fule   = text "ule"-ppFCmpOp Fune   = text "une"-ppFCmpOp Funo   = text "uno"-ppFCmpOp Ftrue  = text "true"+ppFCmpOp Ffalse = "false"+ppFCmpOp Foeq   = "oeq"+ppFCmpOp Fogt   = "ogt"+ppFCmpOp Foge   = "oge"+ppFCmpOp Folt   = "olt"+ppFCmpOp Fole   = "ole"+ppFCmpOp Fone   = "one"+ppFCmpOp Ford   = "ord"+ppFCmpOp Fueq   = "ueq"+ppFCmpOp Fugt   = "ugt"+ppFCmpOp Fuge   = "uge"+ppFCmpOp Fult   = "ult"+ppFCmpOp Fule   = "ule"+ppFCmpOp Fune   = "une"+ppFCmpOp Funo   = "uno"+ppFCmpOp Ftrue  = "true"  ppValue :: Value -> Doc ppValue val = case val of@@ -532,7 +540,7 @@   ValDouble i        -> double i   ValIdent i         -> ppIdent i   ValSymbol s        -> ppSymbol s-  ValNull            -> text "null"+  ValNull            -> "null"   ValArray ty es     -> brackets                       $ commas (map (ppTyped ppValue . Typed ty) es)   ValVector ty es   -> angles $ commas@@ -542,30 +550,31 @@                       $ structBraces (commas (map (ppTyped ppValue) fs))   ValString s        -> char 'c' <> ppStringLiteral s   ValConstExpr ce    -> ppConstExpr ce-  ValUndef           -> text "undef"+  ValUndef           -> "undef"   ValLabel l         -> ppLabel l-  ValZeroInit        -> text "zeroinitializer"+  ValZeroInit        -> "zeroinitializer"   ValAsm s a i c     -> ppAsm s a i c   ValMd m            -> ppValMd m  ppValMd :: ValMd -> Doc ppValMd m = case m of-  ValMdString str -> ppMetadata (ppStringLiteral str)-  ValMdValue tv   -> ppTyped ppValue tv-  ValMdRef i      -> ppMetadata (int i)-  ValMdNode vs    -> ppMetadataNode vs-  ValMdLoc l      -> ppDebugLoc l+  ValMdString str   -> ppMetadata (ppStringLiteral str)+  ValMdValue tv     -> ppTyped ppValue tv+  ValMdRef i        -> ppMetadata (int i)+  ValMdNode vs      -> ppMetadataNode vs+  ValMdLoc l        -> ppDebugLoc l+  ValMdDebugInfo di -> ppDebugInfo di  ppDebugLoc :: DebugLoc -> Doc-ppDebugLoc dl = text "!MDLocation"-             <> parens (commas [ text "line:"    <+> int32 (dlLine dl)-                               , text "column:"  <+> int32 (dlCol dl)-                               , text "scope:"   <+> ppValMd (dlScope dl)+ppDebugLoc dl = "!MDLocation"+             <> parens (commas [ "line:"   <+> integral (dlLine dl)+                               , "column:" <+> integral (dlCol dl)+                               , "scope:"  <+> ppValMd (dlScope dl)                                ] <+> mbIA)    where   mbIA = case dlIA dl of-           Just md -> comma <+> text "inlinedAt:" <+> ppValMd md+           Just md -> comma <+> "inlinedAt:" <+> ppValMd md            Nothing -> empty  ppTypedValMd :: ValMd -> Doc@@ -577,11 +586,7 @@ ppMetadataNode :: [Maybe ValMd] -> Doc ppMetadataNode vs = ppMetadata (braces (commas (map arg vs)))   where-  arg = maybe (text "null") ppValMd--ppBool :: Bool -> Doc-ppBool b | b         = text "true"-         | otherwise = text "false"+  arg = maybe ("null") ppValMd  ppStringLiteral :: String -> Doc ppStringLiteral  = doubleQuotes . text . concatMap escape@@ -594,39 +599,237 @@  ppAsm :: Bool -> Bool -> String -> String -> Doc ppAsm s a i c =-  text "asm" <+> sideeffect <+> alignstack-             <+> ppStringLiteral i <> comma <+> ppStringLiteral c+  "asm" <+> sideeffect <+> alignstack+        <+> ppStringLiteral i <> comma <+> ppStringLiteral c   where-  sideeffect | s         = text "sideeffect"+  sideeffect | s         = "sideeffect"              | otherwise = empty -  alignstack | a         = text "alignstack"+  alignstack | a         = "alignstack"              | otherwise = empty   ppConstExpr :: ConstExpr -> Doc-ppConstExpr (ConstGEP inb ixs)  = text "getelementptr"-                              <+> opt inb (text "inbounds")-                              <+> parens (commas (map (ppTyped ppValue) ixs))+ppConstExpr (ConstGEP inb mp ixs)  = "getelementptr"+  <+> opt inb "inbounds"+  <+> parens (mcommas ((ppType <$> mp) : (map (pure . ppTyped ppValue) ixs))) ppConstExpr (ConstConv op tv t) = ppConvOp op <+> parens-                                 (ppTyped ppValue tv <+> text "to" <+> ppType t)-ppConstExpr (ConstSelect c l r) = text "select" <+> parens+                                 (ppTyped ppValue tv <+> "to" <+> ppType t)+ppConstExpr (ConstSelect c l r) = "select" <+> parens                                  (commas [ ppTyped ppValue c, ppTyped ppValue l                                          , ppTyped ppValue r])-ppConstExpr (ConstBlockAddr t l)= text "blockaddress" <+> parens+ppConstExpr (ConstBlockAddr t l)= "blockaddress" <+> parens                                  (ppSymbol t <> comma <+> ppLabel l) +ppConstExpr (ConstFCmp op a b)  = "fcmp" <+> ppFCmpOp op <+> parens+                                 (ppTyped ppValue a <> comma <+> ppTyped ppValue b) +ppConstExpr (ConstICmp op a b)  = "icmp" <+> ppICmpOp op <+> parens+                                 (ppTyped ppValue a <> comma <+> ppTyped ppValue b)+ppConstExpr (ConstArith op a b) = ppArithOp op <+> parens+                                  (ppTyped ppValue a <> comma <+> ppValue b)+ppConstExpr (ConstBit op a b)   = ppBitOp op <+> parens+                                  (ppTyped ppValue a <> comma <+> ppValue b)++-- DWARF Debug Info ------------------------------------------------------------++ppDebugInfo :: DebugInfo -> Doc+ppDebugInfo di = case di of+  DebugInfoBasicType bt         -> ppDIBasicType bt+  DebugInfoCompileUnit cu       -> ppDICompileUnit cu+  DebugInfoCompositeType ct     -> ppDICompositeType ct+  DebugInfoDerivedType dt       -> ppDIDerivedType dt+  DebugInfoEnumerator nm v      -> ppDIEnumerator nm v+  DebugInfoExpression e         -> ppDIExpression e+  DebugInfoFile f               -> ppDIFile f+  DebugInfoGlobalVariable gv    -> ppDIGlobalVariable gv+  DebugInfoLexicalBlock lb      -> ppDILexicalBlock lb+  DebugInfoLexicalBlockFile lbf -> ppDILexicalBlockFile lbf+  DebugInfoLocalVariable lv     -> ppDILocalVariable lv+  DebugInfoSubprogram sp        -> ppDISubprogram sp+  DebugInfoSubrange sr          -> ppDISubrange sr+  DebugInfoSubroutineType st    -> ppDISubroutineType st++ppDIBasicType :: DIBasicType -> Doc+ppDIBasicType bt = "!DIBasicType"+  <> parens (commas [ "tag:"      <+> integral (dibtTag bt)+                    , "name:"     <+> doubleQuotes (text (dibtName bt))+                    , "size:"     <+> integral (dibtSize bt)+                    , "align:"    <+> integral (dibtAlign bt)+                    , "encoding:" <+> integral (dibtEncoding bt)+                    ])++ppDICompileUnit :: DICompileUnit -> Doc+ppDICompileUnit cu = "!DICompileUnit"+  <> parens (mcommas+       [ pure ("language:"           <+> integral (dicuLanguage cu))+       ,     (("file:"               <+>) . ppValMd) <$> (dicuFile cu)+       ,     (("producer:"           <+>) . doubleQuotes . text)+             <$> (dicuProducer cu)+       , pure ("isOptimized:"        <+> ppBool (dicuIsOptimized cu))+       , pure ("flags:"              <+> integral (dicuFlags cu))+       , pure ("runtimeVersion:"     <+> integral (dicuRuntimeVersion cu))+       ,     (("splitDebugFilename:" <+>) . doubleQuotes . text)+             <$> (dicuSplitDebugFilename cu)+       , pure ("emissionKind:"       <+> integral (dicuEmissionKind cu))+       ,     (("enums:"              <+>) . ppValMd) <$> (dicuEnums cu)+       ,     (("retainedTypes:"      <+>) . ppValMd) <$> (dicuRetainedTypes cu)+       ,     (("subprograms:"        <+>) . ppValMd) <$> (dicuSubprograms cu)+       ,     (("globals:"            <+>) . ppValMd) <$> (dicuGlobals cu)+       ,     (("imports:"            <+>) . ppValMd) <$> (dicuImports cu)+       ,     (("macros:"             <+>) . ppValMd) <$> (dicuMacros cu)+       , pure ("dwoId:"              <+> integral (dicuDWOId cu))+       ])++ppDICompositeType :: DICompositeType -> Doc+ppDICompositeType ct = "!DICompositeType"+  <> parens (mcommas+       [ pure ("tag:"            <+> integral (dictTag ct))+       ,     (("name:"           <+>) . doubleQuotes . text) <$> (dictName ct)+       ,     (("file:"           <+>) . ppValMd) <$> (dictFile ct)+       , pure ("line:"           <+> integral (dictLine ct))+       ,     (("baseType:"       <+>) . ppValMd) <$> (dictBaseType ct)+       , pure ("size:"           <+> integral (dictSize ct))+       , pure ("align:"          <+> integral (dictAlign ct))+       , pure ("offset:"         <+> integral (dictOffset ct))+       , pure ("flags:"          <+> integral (dictFlags ct))+       ,     (("elements:"       <+>) . ppValMd) <$> (dictElements ct)+       , pure ("runtimeLang:"    <+> integral (dictRuntimeLang ct))+       ,     (("vtableHolder:"   <+>) . ppValMd) <$> (dictVTableHolder ct)+       ,     (("templateParams:" <+>) . ppValMd) <$> (dictTemplateParams ct)+       ,     (("identifier:"     <+>) . doubleQuotes . text)+             <$> (dictIdentifier ct)+       ])++ppDIDerivedType :: DIDerivedType -> Doc+ppDIDerivedType dt = "!DIDerivedType"+  <> parens (mcommas+       [ pure ("tag:"       <+> integral (didtTag dt))+       ,     (("name:"      <+>) . doubleQuotes . text) <$> (didtName dt)+       ,     (("file:"      <+>) . ppValMd) <$> (didtFile dt)+       , pure ("line:"      <+> integral (didtLine dt))+       ,     (("baseType:"  <+>) . ppValMd) <$> (didtBaseType dt)+       , pure ("size:"      <+> integral (didtSize dt))+       , pure ("align:"     <+> integral (didtAlign dt))+       , pure ("offset:"    <+> integral (didtOffset dt))+       , pure ("flags:"     <+> integral (didtFlags dt))+       ,     (("extraData:" <+>) . ppValMd) <$> (didtExtraData dt)+       ])++ppDIEnumerator :: String -> Int64 -> Doc+ppDIEnumerator n v = "!DIEnumerator"+  <> parens (commas [ "name:"  <+> doubleQuotes (text n)+                    , "value:" <+> integral v+                    ])++ppDIExpression :: DIExpression -> Doc+ppDIExpression e = "!DIExpression"+  <> parens (commas (map integral (dieElements e)))++ppDIFile :: DIFile -> Doc+ppDIFile f = "!DIFile"+  <> parens (commas [ "filename:"  <+> doubleQuotes (text (difFilename f))+                    , "directory:" <+> doubleQuotes (text (difDirectory f))+                    ])++ppDIGlobalVariable :: DIGlobalVariable -> Doc+ppDIGlobalVariable gv = "!DIGlobalVariable"+  <> parens (mcommas+       [      (("scope:"       <+>) . ppValMd) <$> (digvScope gv)+       ,      (("name:"        <+>) . doubleQuotes . text) <$> (digvName gv)+       ,      (("linkageName:" <+>) . doubleQuotes . text)+              <$> (digvLinkageName gv)+       ,      (("file:"        <+>) . ppValMd) <$> (digvFile gv)+       , pure ("line:"         <+> integral (digvLine gv))+       ,      (("type:"        <+>) . ppValMd) <$> (digvType gv)+       , pure ("isLocal:"      <+> ppBool (digvIsLocal gv))+       , pure ("isDefinition:" <+> ppBool (digvIsDefinition gv))+       ,      (("variable:"    <+>) . ppValMd) <$> (digvType gv)+       ,      (("declaration:" <+>) . ppValMd) <$> (digvDeclaration gv)+       ])++ppDILexicalBlock :: DILexicalBlock -> Doc+ppDILexicalBlock ct = "!DILexicalBlock"+  <> parens (mcommas+       [     (("scope:"  <+>) . ppValMd) <$> (dilbScope ct)+       ,     (("file:"   <+>) . ppValMd) <$> (dilbFile ct)+       , pure ("line:"   <+> integral (dilbLine ct))+       , pure ("column:" <+> integral (dilbColumn ct))+       ])++ppDILexicalBlockFile :: DILexicalBlockFile -> Doc+ppDILexicalBlockFile lbf = "!DILexicalBlockFile"+  <> parens (mcommas+       [ pure ("scope:"         <+> ppValMd (dilbfScope lbf))+       ,     (("file:"          <+>) . ppValMd) <$> (dilbfFile lbf)+       , pure ("discriminator:" <+> integral (dilbfDiscriminator lbf))+       ])++ppDILocalVariable :: DILocalVariable -> Doc+ppDILocalVariable lv = "!DILocalVariable"+  <> parens (mcommas+       [      (("scope:" <+>) . ppValMd) <$> (dilvScope lv)+       ,      (("name:"  <+>) . doubleQuotes . text) <$> (dilvName lv)+       ,      (("file:"  <+>) . ppValMd) <$> (dilvFile lv)+       , pure ("line:"   <+> integral (dilvLine lv))+       ,      (("type:"  <+>) . ppValMd) <$> (dilvType lv)+       , pure ("arg:"    <+> integral (dilvArg lv))+       , pure ("flags:"  <+> integral (dilvFlags lv))+       ])++ppDISubprogram :: DISubprogram -> Doc+ppDISubprogram sp = "!DISubprogram"+  <> parens (mcommas+       [      (("scope:"          <+>) . ppValMd) <$> (dispScope sp)+       ,      (("name:"           <+>) . doubleQuotes . text) <$> (dispName sp)+       ,      (("linkageName:"    <+>) . doubleQuotes . text)+              <$> (dispLinkageName sp)+       ,      (("file:"           <+>) . ppValMd) <$> (dispFile sp)+       , pure ("line:"            <+> integral (dispLine sp))+       ,      (("type:"           <+>) . ppValMd) <$> (dispType sp)+       , pure ("isLocal:"         <+> ppBool (dispIsLocal sp))+       , pure ("isDefinition:"    <+> ppBool (dispIsDefinition sp))+       , pure ("scopeLine:"       <+> integral (dispScopeLine sp))+       ,      (("containingType:" <+>) . ppValMd) <$> (dispContainingType sp)+       , pure ("virtuality:"      <+> integral (dispVirtuality sp))+       , pure ("virtualIndex:"    <+> integral (dispVirtualIndex sp))+       , pure ("flags:"           <+> integral (dispFlags sp))+       , pure ("isOptimized:"     <+> ppBool (dispIsOptimized sp))+       ,      (("templateParams:" <+>) . ppValMd) <$> (dispTemplateParams sp)+       ,      (("declaration:"    <+>) . ppValMd) <$> (dispDeclaration sp)+       ,      (("variables:"      <+>) . ppValMd) <$> (dispVariables sp)+       ])++ppDISubrange :: DISubrange -> Doc+ppDISubrange sr = "!DISubrange"+  <> parens (commas [ "count:" <+> integral (disrCount sr)+                    , "lowerBound:" <+> integral (disrLowerBound sr)+                    ])++ppDISubroutineType :: DISubroutineType -> Doc+ppDISubroutineType st = "!DISubroutineType"+  <> parens (commas+       [ "flags:" <+> integral (distFlags st)+       , "types:" <+> fromMaybe "null" (ppValMd <$> (distTypeArray st))+       ])+ -- Utilities ------------------------------------------------------------------- +ppBool :: Bool -> Doc+ppBool b | b         = "true"+         | otherwise = "false"+ -- | Build a variable-argument argument list. ppArgList :: Bool -> [Doc] -> Doc-ppArgList True  ds = parens (commas (ds ++ [text "..."]))+ppArgList True  ds = parens (commas (ds ++ ["..."])) ppArgList False ds = parens (commas ds) -int32 :: Int32 -> Doc-int32  = int . fromIntegral+integral :: Integral i => i -> Doc+integral  = integer . fromIntegral +hex :: (Integral i, Show i) => i -> Doc+hex i = text (showHex i "0x")+ opt :: Bool -> Doc -> Doc opt True  = id opt False = const empty@@ -634,6 +837,11 @@ commas :: [Doc] -> Doc commas  = fsep . punctuate comma +-- | Helpful for all of the optional fields that appear in the+-- metadata values+mcommas :: [Maybe Doc] -> Doc+mcommas = commas . catMaybes+ angles :: Doc -> Doc angles d = char '<' <> d <> char '>' @@ -642,6 +850,3 @@  ppMaybe :: (a -> Doc) -> Maybe a -> Doc ppMaybe  = maybe empty--colons :: [Doc] -> Doc-colons  = fsep . punctuate (char ':')