llvm-hs 6.0.0 → 6.1.0

raw patch · 37 files changed

+3893/−314 lines, 37 filesdep −semigroupsdep ~basedep ~llvm-hs-purePVP ok

version bump matches the API change (PVP)

Dependencies removed: semigroups

Dependency ranges changed: base, llvm-hs-pure

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• llvm-hs.cabal +16/−25
• src/LLVM/Exception.hs +8/−0
• src/LLVM/Internal/Attribute.hs +2/−5
• src/LLVM/Internal/Coding.hs +23/−10
• src/LLVM/Internal/Constant.hs +3/−2
• src/LLVM/Internal/DecodeAST.hs +2/−0
• src/LLVM/Internal/EncodeAST.hs +7/−2
• src/LLVM/Internal/FFI/ErrorHandling.cpp +1/−0
• src/LLVM/Internal/FFI/ErrorHandling.hpp +2/−2
• src/LLVM/Internal/FFI/GlobalValue.hs +7/−0
• src/LLVM/Internal/FFI/GlobalValueC.cpp +20/−0
• src/LLVM/Internal/FFI/LLVMCTypes.hsc +61/−2
• src/LLVM/Internal/FFI/Metadata.hs +526/−12
• src/LLVM/Internal/FFI/MetadataC.cpp +728/−12
• src/LLVM/Internal/FFI/ObjectFile.hs +17/−0
• src/LLVM/Internal/FFI/OrcJIT.hs +0/−13
• src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs +1/−1
• src/LLVM/Internal/FFI/OrcJIT/LinkingLayer.hs +32/−0
• src/LLVM/Internal/FFI/OrcJITC.cpp +44/−18
• src/LLVM/Internal/FFI/PtrHierarchy.hs +167/−0
• src/LLVM/Internal/FFI/Type.hs +1/−1
• src/LLVM/Internal/FFI/TypeC.cpp +5/−2
• src/LLVM/Internal/Instruction.hs +4/−4
• src/LLVM/Internal/Metadata.hs +14/−6
• src/LLVM/Internal/Module.hs +29/−10
• src/LLVM/Internal/ObjectFile.hs +28/−0
• src/LLVM/Internal/Operand.hs +1147/−130
• src/LLVM/Internal/OrcJIT.hs +1/−26
• src/LLVM/Internal/OrcJIT/IRCompileLayer.hs +1/−0
• src/LLVM/Internal/OrcJIT/LinkingLayer.hs +64/−0
• src/LLVM/Internal/Type.hs +31/−2
• src/LLVM/OrcJIT.hs +3/−0
• test/LLVM/Test/Attribute.hs +1/−1
• test/LLVM/Test/Metadata.hs +852/−26
• test/LLVM/Test/Module.hs +32/−1
• test/LLVM/Test/Regression.hs +1/−1

@@ -1,3 +1,15 @@+## 6.1.0 (2018-05-05)++* Remove the `MetadataNodeReference` constructor. References to+  metadata nodes are now encoded using the polymorphic `MDRef` type.+* Add support for encoding and decoding debug metadata. Thanks to+  @xldenis who started that effort!+* Drop support for GHC 7.10.+* Support decoding/encoding of metadata in `GlobalVariable` and `Function`.+* Fix check that the type of `GlobalReference` is correct in the+  presence of automatic renamings due to name collisions.+* Extract LinkingLayer into a separate module.+ ## 6.0.0 (2018-03-06)  * Support for LLVM 6.0, take a look at the changelog of llvm-hs-pure for details.

@@ -1,5 +1,5 @@ name: llvm-hs-version: 6.0.0+version: 6.1.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer <moritz.kiefer@purelyfunctional.org>, Benjamin S. Scarlet@@ -9,7 +9,7 @@ bug-reports: http://github.com/llvm-hs/llvm-hs/issues build-type: Custom stability: experimental-cabal-version: >= 1.8+cabal-version: 1.24 category: Compilers/Interpreters, Code Generation synopsis: General purpose LLVM bindings description:@@ -35,7 +35,7 @@   src/LLVM/Internal/FFI/Target.hpp   src/LLVM/Internal/FFI/Type.h   src/LLVM/Internal/FFI/Value.h-tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1+tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1 extra-source-files: CHANGELOG.md  source-repository head@@ -51,26 +51,18 @@   description: compile C(++) shims with debug info for ease of troubleshooting   default: False -flag semigroups-  description: Add semigroups to build-depends for Data.List.NonEmpty. This will be selected automatically by cabal.-  default: False- custom-setup   setup-depends: base                , Cabal                , containers  library+  default-language: Haskell2010   build-tools: hsc2hs, llvm-config   ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans-  if flag(semigroups)-    build-depends:-      base >= 4.8 && < 4.9,-      semigroups >= 0.18 && < 0.19-  else-    build-depends:-      base >= 4.9 && < 5+   build-depends:+    base >= 4.9 && < 5,     attoparsec >= 0.13,     exceptions >= 0.8,     utf8-string >= 0.3.7,@@ -80,9 +72,9 @@     template-haskell >= 2.5.0.0,     containers >= 0.4.2.1,     array >= 0.4.0.0,-    llvm-hs-pure == 6.0.*+    llvm-hs-pure == 6.1.*   hs-source-dirs: src-  extensions:+  default-extensions:     NoImplicitPrelude     TupleSections     DeriveDataTypeable@@ -128,8 +120,10 @@     LLVM.Internal.MemoryBuffer     LLVM.Internal.Metadata     LLVM.Internal.Module+    LLVM.Internal.ObjectFile     LLVM.Internal.OrcJIT     LLVM.Internal.OrcJIT.CompileLayer+    LLVM.Internal.OrcJIT.LinkingLayer     LLVM.Internal.OrcJIT.CompileOnDemandLayer     LLVM.Internal.OrcJIT.IRCompileLayer     LLVM.Internal.OrcJIT.IRTransformLayer@@ -170,8 +164,10 @@     LLVM.Internal.FFI.MemoryBuffer     LLVM.Internal.FFI.Metadata     LLVM.Internal.FFI.Module+    LLVM.Internal.FFI.ObjectFile     LLVM.Internal.FFI.OrcJIT     LLVM.Internal.FFI.OrcJIT.CompileLayer+    LLVM.Internal.FFI.OrcJIT.LinkingLayer     LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer     LLVM.Internal.FFI.OrcJIT.IRCompileLayer     LLVM.Internal.FFI.OrcJIT.IRTransformLayer@@ -235,15 +231,10 @@     cc-options: -g  test-suite test+  default-language: Haskell2010   type: exitcode-stdio-1.0-  if flag(semigroups)-    build-depends:-      base >= 4.8 && < 4.9,-      semigroups >= 0.18 && < 0.19-  else-    build-depends:-      base >= 4.9 && < 5   build-depends:+    base >= 4.9 && < 5,     bytestring >= 0.10 && < 0.11,     tasty >= 0.11,     tasty-hunit >= 0.9,@@ -254,10 +245,10 @@     containers >= 0.4.2.1,     mtl >= 2.1,     transformers >= 0.3.0.0,-    temporary >= 1.2 && < 1.3,+    temporary >= 1.2 && < 1.4,     pretty-show >= 1.6 && < 1.8   hs-source-dirs: test-  extensions:+  default-extensions:     TupleSections     FlexibleInstances     FlexibleContexts

@@ -17,6 +17,14 @@  instance Exception EncodeException +-- | Indicates an error during the translation of LLVM’s internal representation+-- to the AST provided 'llvm-hs-pure'.+data DecodeException =+  DecodeException !String+  deriving (Show, Eq, Ord, Typeable)++instance Exception DecodeException+ -- | Indicates an error during the parsing of a module. This is used -- for errors encountered when parsing LLVM’s human readable assembly -- format and when parsing the binary bitcode format.

@@ -164,12 +164,9 @@          case enum of            [functionAttributeKindP|AllocSize|] -> do              x <- alloca-             y <- alloca-             isJust <- liftIO $ FFI.attributeGetAllocSizeArgs a x y+             y <- decodeOptional (FFI.attributeGetAllocSizeArgs a x)              x' <- decodeM =<< peek x-             y' <- peek y-             yM <- decodeM (y', isJust)-             return (A.FA.AllocSize x' yM)+             return (A.FA.AllocSize x' y)            [functionAttributeKindP|NoReturn|] -> return A.FA.NoReturn            [functionAttributeKindP|NoUnwind|] -> return A.FA.NoUnwind            [functionAttributeKindP|ReadNone|] -> return A.FA.ReadNone

@@ -16,9 +16,10 @@  import Foreign.C import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array+import Foreign.Storable (Storable)+import qualified Foreign.Storable+import qualified Foreign.Marshal.Alloc+import qualified Foreign.Marshal.Array  import qualified LLVM.Internal.FFI.LLVMCTypes as FFI @@ -97,14 +98,11 @@  instance Monad m => EncodeM m (Maybe Word32) (CUInt, FFI.LLVMBool) where   encodeM (Just a) = liftM2 (,) (encodeM a) (encodeM True)-  encodeM Nothing = return (0,) `ap` (encodeM False)+  encodeM Nothing = (0,) <$> encodeM False -instance Monad m => DecodeM m (Maybe Word32) (CUInt, FFI.LLVMBool) where-  decodeM (a, isJust) = do-    isJust' <- decodeM isJust-    if isJust'-       then liftM Just (decodeM a)-       else return Nothing+instance Monad m => EncodeM m (Maybe Word32) (Word32, FFI.LLVMBool) where+  encodeM (Just a) = (a,) <$> encodeM True+  encodeM Nothing = (0,) <$> encodeM False  instance Monad m => EncodeM m Word CUInt where   encodeM = return . fromIntegral@@ -138,3 +136,18 @@  instance Monad m => DecodeM m Word64 Word64 where   decodeM = return++decodeOptional :: (DecodeM m b a, Storable a, MonadAnyCont IO m, MonadIO m) => (Ptr a -> IO FFI.LLVMBool) -> m (Maybe b)+decodeOptional f = do+  ptr <- alloca+  isJust <- decodeM =<< liftIO (f ptr)+  if isJust+    then Just <$> (decodeM =<< peek ptr)+    else pure Nothing++decodeArray :: (DecodeM m b' b, MonadIO m) => (a -> IO CUInt) -> (a -> CUInt -> IO b) -> a -> m [b']+decodeArray numElems getElem a = do+  n <- liftIO (numElems a)+  if n == 0+    then pure []+    else traverse (decodeM <=< liftIO . getElem a) [0 .. n - 1]

@@ -47,7 +47,7 @@ import LLVM.Internal.EncodeAST import LLVM.Internal.FloatingPointPredicate () import LLVM.Internal.IntegerPredicate ()-import LLVM.Internal.Type ()+import LLVM.Internal.Type (renameType) import LLVM.Internal.Value  allocaWords :: forall a m . (Storable a, MonadAnyCont IO m, Monad m, MonadIO m) => Word32 -> m (Ptr a)@@ -99,7 +99,8 @@     A.C.GlobalReference ty n -> do       ref <- FFI.upCast <$> referGlobal n       ty' <- (liftIO . runDecodeAST . typeOf) ref-      if ty /= ty'+      renamedTy <- renameType ty+      if renamedTy /= ty'         then throwM                (EncodeException                   ("The serialized GlobalReference " ++ show n  ++ " has type " ++ show ty ++ " but should have type " ++ show ty'))

@@ -8,6 +8,7 @@  import LLVM.Prelude +import Control.Monad.Catch import Control.Monad.State import Control.Monad.AnyCont @@ -72,6 +73,7 @@     Monad,     MonadIO,     MonadState DecodeState,+    MonadThrow,     MonadAnyCont IO,     ScopeAnyCont   )

@@ -48,6 +48,7 @@       encodeStateBlocks :: Map A.Name (Ptr FFI.BasicBlock),       encodeStateMDNodes :: Map A.MetadataNodeID (Ptr FFI.MDNode),       encodeStateNamedTypes :: Map A.Name (Ptr FFI.Type),+      encodeStateRenamedTypes :: Map A.Name ShortByteString,       encodeStateAttributeGroups :: Map A.A.GroupID FFI.FunctionAttributeSet,       encodeStateCOMDATs :: Map ShortByteString (Ptr FFI.COMDAT)     }@@ -69,8 +70,11 @@   t <- gets $ Map.lookup n . encodeStateNamedTypes   maybe (throwM . EncodeException $ "reference to undefined type: " ++ show n) return t -defineType :: A.Name -> Ptr FFI.Type -> EncodeAST ()-defineType n t = modify $ \s -> s { encodeStateNamedTypes = Map.insert n t (encodeStateNamedTypes s) }+defineType :: A.Name -> Maybe ShortByteString -> Ptr FFI.Type -> EncodeAST ()+defineType n n' t = do+  modify $ \s -> s { encodeStateNamedTypes = Map.insert n t (encodeStateNamedTypes s) }+  for_ n' $ \renamedName ->+    modify $ \s -> s { encodeStateRenamedTypes = Map.insert n renamedName (encodeStateRenamedTypes s) }  runEncodeAST :: Context -> EncodeAST a -> IO a runEncodeAST context@(Context ctx) (EncodeAST a) =@@ -84,6 +88,7 @@               encodeStateBlocks = Map.empty,               encodeStateMDNodes = Map.empty,               encodeStateNamedTypes = Map.empty,+              encodeStateRenamedTypes = Map.empty,               encodeStateAttributeGroups = Map.empty,               encodeStateCOMDATs = Map.empty             }

@@ -1,5 +1,6 @@ #include "LLVM/Internal/FFI/ErrorHandling.hpp" #include <iostream>+#include <cstdlib>  void reportFatalError(const std::string &errorMsg) {     std::cerr << "LLVM-HS ERROR at " << __FILE__ << ":" << __LINE__ << ": "

@@ -1,5 +1,5 @@-#ifndef __LLVM_INTERNAL_FFI__ANALYSIS__H__-#define __LLVM_INTERNAL_FFI__ANALYSIS__H__+#ifndef __LLVM_INTERNAL_FFI__ERRORHANDLING__H__+#define __LLVM_INTERNAL_FFI__ERRORHANDLING__H__ #include <string>  [[noreturn]] void reportFatalError(const std::string &errorMsg);

@@ -76,4 +76,11 @@ foreign import ccall unsafe "LLVM_Hs_SetThreadLocalMode" setThreadLocalMode ::   Ptr GlobalValue -> ThreadLocalMode -> IO () +foreign import ccall unsafe "LLVM_Hs_GlobalObject_GetNumMetadata" getNumMetadata ::+  Ptr GlobalObject -> IO CUInt +foreign import ccall unsafe "LLVM_Hs_GlobalObject_GetAllMetadata" getAllMetadata ::+  Ptr GlobalObject -> Ptr MDKindID -> Ptr (Ptr MDNode) -> IO ()++foreign import ccall unsafe "LLVM_Hs_GlobalObject_SetMetadata" setMetadata ::+  Ptr GlobalObject -> MDKindID -> Ptr MDNode -> IO ()

@@ -2,6 +2,7 @@ #include "llvm/IR/Comdat.h" #include "llvm/IR/GlobalValue.h" #include "llvm/IR/GlobalObject.h"+#include "llvm/IR/Metadata.h" #include "llvm-c/Core.h" #include "LLVM/Internal/FFI/GlobalValue.h" @@ -82,6 +83,25 @@  void LLVM_Hs_SetThreadLocalMode(LLVMValueRef globalVal, LLVMThreadLocalMode mode) {     unwrap<GlobalValue>(globalVal)->setThreadLocalMode(GlobalValue::ThreadLocalMode(mode));+}++unsigned LLVM_Hs_GlobalObject_GetNumMetadata(GlobalObject* obj) {+    SmallVector<std::pair<unsigned, MDNode *>, 4> mds;+    obj->getAllMetadata(mds);+    return mds.size();+}++void LLVM_Hs_GlobalObject_GetAllMetadata(GlobalObject* obj, unsigned *kinds, LLVMMetadataRef *nodes) {+    SmallVector<std::pair<unsigned, MDNode*>, 4> mds;+    obj->getAllMetadata(mds);+    for (unsigned i = 0; i < mds.size(); ++i) {+        kinds[i] = mds[i].first;+        nodes[i] = wrap(mds[i].second);+    }+}++void LLVM_Hs_GlobalObject_SetMetadata(GlobalObject* obj, unsigned kind, MDNode* node) {+    obj->setMetadata(kind, node); }  }

@@ -1,5 +1,6 @@ {-# LANGUAGE-  GeneralizedNewtypeDeriving+  GeneralizedNewtypeDeriving,+  PatternSynonyms   #-} -- | Define types which correspond cleanly with some simple types on the C/C++ side. -- Encapsulate hsc macro weirdness here, supporting higher-level tricks elsewhere.@@ -28,6 +29,7 @@ #include "LLVM/Internal/FFI/Analysis.h" #include "LLVM/Internal/FFI/LibFunc.h" #include "LLVM/Internal/FFI/OrcJIT.h"+#include "LLVM/Internal/FFI/Metadata.h"  import Language.Haskell.TH.Quote @@ -57,6 +59,37 @@ } } +#{+define hsc_patsyn(l, typ, cons, hprefix, recmac) { \+  struct { const char *s; unsigned n; } *p, list[] = { LLVM_HS_FOR_EACH_ ## l(recmac) }; \+  for(p = list; p < list + sizeof(list)/sizeof(list[0]); ++p) { \+    hsc_printf("pattern " #hprefix "%s :: " #typ "\n", p->s); \+    hsc_printf("pattern " #hprefix "%s =  " #cons " %u\n", p->s, p->n); \+  } \+}+}++#define DW_OP_Rec(n) { #n, LLVM_Hs_DwOp_##n },+#{patsyn DW_OP, Word64, , DwOp_, DW_OP_Rec}++newtype Encoding = Encoding CUInt+  deriving (Data, Show)++#define DW_ATE_Rec(n) { #n, LLVM_Hs_DwAtE_##n },+#{patsyn DW_ATE, Encoding, Encoding, DwAtE_, DW_ATE_Rec}++newtype DwTag = DwTag Word16+  deriving (Data, Show)++#define DW_TAG_Rec(n) { #n, LLVM_Hs_DwTag_##n },+#{patsyn DW_TAG, DwTag, DwTag, DwTag_, DW_TAG_Rec}++newtype DwVirtuality = DwVirtuality Word8+  deriving (Data, Show)++#define DW_VIRTUALITY_Rec(n) { #n, LLVM_Hs_DwVirtuality_##n },+#{patsyn DW_VIRTUALITY, DwVirtuality, DwVirtuality, DwVirtuality_, DW_VIRTUALITY_Rec}+ deriving instance Data CUInt  newtype LLVMBool = LLVMBool CUInt@@ -65,7 +98,7 @@ -- this value needs to be freed after it has been processed. Usually -- this is done automatically in the 'DecodeM' instance. newtype OwnerTransfered a = OwnerTransfered a-  deriving (Storable)+  deriving (Eq, Storable)  newtype NothingAsMinusOne h = NothingAsMinusOne CInt   deriving (Storable)@@ -115,6 +148,11 @@ newtype MDKindID = MDKindID CUInt   deriving (Storable) +newtype MDSubclassID = MDSubclassID CUInt+  deriving (Eq, Read, Show, Typeable, Data, Generic)+#define MDSID_Rec(n) { #n, n ## Kind },+#{inject MDNODE_SUBCLASS, MDSubclassID, MDSubclassID, mdSubclassId, MDSID_Rec}+ newtype FastMathFlags = FastMathFlags CUInt   deriving (Eq, Ord, Show, Typeable, Data, Num, Bits, Generic) #define FMF_Rec(n,l,ignored) { #n, LLVM ## n, },@@ -304,3 +342,24 @@   deriving (Eq, Read, Show, Bits, Typeable, Data, Num, Storable, Generic) #define SF_Rec(n) { #n, LLVMJITSymbolFlag ## n }, #{inject JIT_SYMBOL_FLAG, JITSymbolFlags, JITSymbolFlags, jitSymbolFlags, SF_Rec}++newtype ChecksumKind = ChecksumKind CUInt+  deriving (Data, Show)++newtype Macinfo = Macinfo CUInt+  deriving (Data, Show)++pattern DW_Macinfo_Define :: Macinfo+pattern DW_Macinfo_Define = Macinfo 0x01+pattern DW_Macinfo_Undef :: Macinfo+pattern DW_Macinfo_Undef = Macinfo 0x02++newtype DebugEmissionKind = DebugEmissionKind CUInt+  deriving (Data, Show)++pattern NoDebug :: DebugEmissionKind+pattern NoDebug = DebugEmissionKind 0+pattern FullDebug :: DebugEmissionKind+pattern FullDebug = DebugEmissionKind 1+pattern LineTablesOnly :: DebugEmissionKind+pattern LineTablesOnly = DebugEmissionKind 2

@@ -14,6 +14,14 @@ import LLVM.Internal.FFI.PtrHierarchy import LLVM.Internal.FFI.LLVMCTypes +newtype DIFlags = DIFlags Word32+  deriving (Show, Eq)++data DITemplateParameterArray++-- | A 'TupleArray a' stores an array of elements of type 'Ptr a' using an 'MDTuple'.+newtype TupleArray a = TupleArray (Ptr MDTuple)+ foreign import ccall unsafe "LLVM_Hs_IsAMDString" isAMDString ::   Ptr Metadata -> IO (Ptr MDString) @@ -26,6 +34,23 @@ foreign import ccall unsafe "LLVM_Hs_IsAMetadataOperand" isAMetadataOperand ::   Ptr Value -> IO (Ptr MetadataAsVal) +foreign import ccall unsafe "LLVM_Hs_GetMetadataClassId" getMetadataClassId ::+  Ptr MDNode -> IO (MDSubclassID)++-- DILocation++foreign import ccall unsafe "LLVM_Hs_DILocation_GetLine" getDILocationLine ::+  Ptr DILocation -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DILocation_GetColumn" getDILocationColumn ::+  Ptr DILocation -> IO Word16++foreign import ccall unsafe "LLVM_Hs_DILocation_GetScope" getDILocationScope ::+  Ptr DILocation -> IO (Ptr DILocalScope)++foreign import ccall unsafe "LLVM_Hs_Get_DILocation" getDILocation ::+  Ptr Context -> Word32 -> Word16 -> Ptr DILocalScope -> IO (Ptr DILocation)+ foreign import ccall unsafe "LLVM_Hs_GetMDValue" getMDValue ::   Ptr MDValue -> IO (Ptr Value) @@ -41,26 +66,26 @@ foreign import ccall unsafe "LLVM_Hs_GetMDKindNames" getMDKindNames ::   Ptr Context -> Ptr (Ptr CChar) -> Ptr CUInt -> CUInt -> IO CUInt -foreign import ccall unsafe "LLVM_Hs_MDStringInContext" mdStringInContext' ::+foreign import ccall unsafe "LLVM_Hs_GetMDString" getMDString' ::   Ptr Context -> CString -> CUInt -> IO (Ptr MDString) +getMDString :: Ptr Context -> (CString, CUInt) -> IO (Ptr MDString)+getMDString ctx (p, n) = getMDString' ctx p n+ foreign import ccall unsafe "LLVM_Hs_MDValue" mdValue ::   Ptr Value -> IO (Ptr MDValue)  foreign import ccall unsafe "LLVM_Hs_MetadataOperand" metadataOperand ::   Ptr Context -> Ptr Metadata -> IO (Ptr Value) -mdStringInContext :: Ptr Context -> (CString, CUInt) -> IO (Ptr MDString)-mdStringInContext ctx (p, n) = mdStringInContext' ctx p n--foreign import ccall unsafe "LLVM_Hs_GetMDString" getMDString ::+foreign import ccall unsafe "LLVM_Hs_GetMDStringValue" getMDStringValue ::   Ptr MDString -> Ptr CUInt -> IO CString -foreign import ccall unsafe "LLVM_Hs_MDNodeInContext" createMDNodeInContext' ::-  Ptr Context -> Ptr (Ptr Metadata) -> CUInt -> IO (Ptr MDNode)+foreign import ccall unsafe "LLVM_Hs_Get_MDTuple" getMDTuple' ::+  Ptr Context -> Ptr (Ptr Metadata) -> CUInt -> IO (Ptr MDTuple) -createMDNodeInContext :: Ptr Context -> (CUInt, Ptr (Ptr Metadata)) -> IO (Ptr MDNode)-createMDNodeInContext ctx (n, vs) = createMDNodeInContext' ctx vs n+getMDTuple :: Ptr Context -> (CUInt, Ptr (Ptr Metadata)) -> IO (Ptr MDTuple)+getMDTuple ctx (n, vs) = getMDTuple' ctx vs n  foreign import ccall unsafe "LLVM_Hs_CreateTemporaryMDNodeInContext" createTemporaryMDNodeInContext ::   Ptr Context -> IO (Ptr MDNode)@@ -68,11 +93,11 @@ foreign import ccall unsafe "LLVM_Hs_DestroyTemporaryMDNode" destroyTemporaryMDNode ::   Ptr MDNode -> IO () -foreign import ccall unsafe "LLVM_Hs_GetMDNodeNumOperands" getMDNodeNumOperands ::+foreign import ccall unsafe "LLVM_Hs_MDNode_GetNumOperands" getMDNodeNumOperands ::   Ptr MDNode -> IO CUInt -foreign import ccall unsafe "LLVM_Hs_GetMDNodeOperands" getMDNodeOperands ::-  Ptr MDNode -> Ptr (Ptr Metadata) -> IO ()+foreign import ccall unsafe "LLVM_Hs_MDNode_GetOperand" getMDNodeOperand ::+  Ptr MDNode -> CUInt -> IO (Ptr Metadata)  foreign import ccall unsafe "LLVM_Hs_GetNamedMetadataName" getNamedMetadataName ::   Ptr NamedMetadata -> Ptr CUInt -> IO (Ptr CChar)@@ -91,3 +116,492 @@  namedMetadataAddOperands :: Ptr NamedMetadata -> (CUInt, Ptr (Ptr MDNode)) -> IO () namedMetadataAddOperands nm (n, vs) = namedMetadataAddOperands' nm vs n++-- DIEnumerator++foreign import ccall unsafe "LLVM_Hs_Get_DIEnumerator" getDIEnumerator ::+  Ptr Context -> Int64 -> Ptr MDString -> IO (Ptr DIEnumerator)++foreign import ccall unsafe "LLVM_Hs_DIEnumerator_GetValue" getDIEnumeratorValue ::+  Ptr DIEnumerator -> IO Int64++foreign import ccall unsafe "LLVM_Hs_DIEnumerator_GetName" getDIEnumeratorName ::+  Ptr DIEnumerator -> IO (Ptr MDString)+++foreign import ccall unsafe "LLVM_Hs_DIFileGetFilename" getFileFilename ::+  Ptr DIFile -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIFileGetDirectory" getFileDirectory ::+  Ptr DIFile -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIFileGetChecksum" getFileChecksum ::+  Ptr DIFile -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIFileGetChecksumKind" getFileChecksumKind ::+  Ptr DIFile -> IO ChecksumKind++foreign import ccall unsafe "LLVM_Hs_DIScope_GetName" getScopeName ::+  Ptr DIScope -> Ptr CUInt -> IO CString++foreign import ccall unsafe "LLVM_Hs_DITypeGetName" getTypeName ::+  Ptr DIType -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DITypeGetAlignInBits" getTypeAlignInBits ::+  Ptr DIType -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DITypeGetSizeInBits" getTypeSizeInBits ::+  Ptr DIType -> IO Word64++foreign import ccall unsafe "LLVM_Hs_DITypeGetOffsetInBits" getTypeOffsetInBits ::+  Ptr DIType -> IO Word64++foreign import ccall unsafe "LLVM_Hs_DINodeGetTag" getTag ::+  Ptr DINode -> IO DwTag++foreign import ccall unsafe "LLVM_Hs_DITypeGetLine" getTypeLine ::+  Ptr DIType -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DITypeGetFlags" getTypeFlags ::+  Ptr DIType -> IO DIFlags++foreign import ccall unsafe "LLVM_Hs_DICompositeType_GetElements" getElements ::+  Ptr DICompositeType -> IO (Ptr MDTuple)++foreign import ccall unsafe "LLVM_Hs_DICompositeTypeGetVTableHolder" getVTableHolder ::+  Ptr DICompositeType -> IO (Ptr DIType)++foreign import ccall unsafe "LLVM_Hs_DICompositeTypeGetBaseType" getCompositeBaseType ::+  Ptr DICompositeType -> IO (Ptr DIType)++foreign import ccall unsafe "LLVM_Hs_DICompositeTypeGetRuntimeLang" getRuntimeLang ::+  Ptr DICompositeType -> IO Word16++foreign import ccall unsafe "LLVM_Hs_DICompositeType_GetTemplateParameters" getTemplateParams ::+  Ptr DICompositeType -> IO (TupleArray DITemplateParameter)++foreign import ccall unsafe "LLVM_Hs_DICompositeTypeGetIdentifier" getIdentifier ::+  Ptr DICompositeType -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_Get_DIArrayType" getDIArrayType ::+  Ptr Context -> TupleArray DISubrange -> Ptr DIType -> Word64 -> Word32 -> DIFlags -> IO (Ptr DICompositeType)++foreign import ccall unsafe "LLVM_Hs_Get_DIEnumerationType" getDIEnumerationType ::+  Ptr Context -> Ptr DIScope -> Ptr MDString -> Ptr DIFile -> Word32 -> Word64 -> Word32 -> TupleArray DIEnumerator -> Ptr DIType -> Ptr MDString -> IO (Ptr DICompositeType)++foreign import ccall unsafe "LLVM_Hs_Get_DIStructType" getDIStructType ::+  Ptr Context -> Ptr DIScope -> Ptr MDString -> Ptr DIFile ->+  Word32 -> Word64 -> Word32 -> DIFlags ->+  Ptr DIType -> TupleArray DIScope ->+  Word16 -> Ptr DIType -> Ptr MDString ->+  IO (Ptr DICompositeType)++foreign import ccall unsafe "LLVM_Hs_Get_DIUnionType" getDIUnionType ::+  Ptr Context -> Ptr DIScope -> Ptr MDString -> Ptr DIFile ->+  Word32 -> Word64 -> Word32 -> DIFlags ->+  TupleArray DIScope ->+  Word16 -> Ptr MDString ->+  IO (Ptr DICompositeType)++foreign import ccall unsafe "LLVM_Hs_Get_DIClassType" getDIClassType ::+  Ptr Context -> Ptr DIScope -> Ptr MDString -> Ptr DIFile ->+  Word32 -> Word64 -> Word32 -> DIFlags ->+  Ptr DIType -> TupleArray DIScope ->+  Ptr DIType -> TupleArray DITemplateParameter -> Ptr MDString ->+  IO (Ptr DICompositeType)++foreign import ccall unsafe "LLVM_Hs_Get_DINamespace" getDINamespace ::+  Ptr Context -> Ptr DIScope -> Ptr MDString -> LLVMBool -> IO (Ptr DINamespace)++foreign import ccall unsafe "LLVM_Hs_DINamespace_GetExportSymbols" getNamespaceExportedSymbols ::+  Ptr DINamespace -> IO LLVMBool++-- DIScope++foreign import ccall unsafe "LLVM_Hs_DIScope_GetScope" getScopeScope ::+  Ptr DIScope -> IO (Ptr DIScope)++foreign import ccall unsafe "LLVM_Hs_DIScope_GetFile" getScopeFile ::+  Ptr DIScope -> IO (Ptr DIFile)++-- DILexicalBlockBase+foreign import ccall unsafe "LLVM_Hs_DILexicalBlockBaseGetScope" getLexicalBlockScope ::+  Ptr DILexicalBlockBase -> IO (Ptr DILocalScope)++-- DILexicalBlockFile+foreign import ccall unsafe "LLVM_Hs_DILexicalBlockFileGetDiscriminator" getLexicalBlockFileDiscriminator ::+  Ptr DILexicalBlockBase -> IO Word32++foreign import ccall unsafe "LLVM_Hs_Get_DILexicalBlockFile" getDILexicalBlockFile ::+  Ptr Context -> Ptr DILocalScope -> Ptr DIFile -> Word32 -> IO (Ptr DILexicalBlockFile)++-- DILexicalBlock+foreign import ccall unsafe "LLVM_Hs_DILexicalBlockGetLine" getLexicalBlockLine ::+  Ptr DILexicalBlockBase -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DILexicalBlockGetColumn" getLexicalBlockColumn ::+  Ptr DILexicalBlockBase -> IO Word16++foreign import ccall unsafe "LLVM_Hs_Get_DILexicalBlock" getDILexicalBlock ::+  Ptr Context -> Ptr DILocalScope -> Ptr DIFile -> Word32 -> Word16 -> IO (Ptr DILexicalBlock)++foreign import ccall unsafe "LLVM_Hs_DIDerivedTypeGetBaseType" getDerivedBaseType ::+  Ptr DIType -> IO (Ptr DIType)++foreign import ccall unsafe "LLVM_Hs_DIDerivedTypeGetAddressSpace" getDerivedAddressSpace ::+  Ptr DIType -> Ptr CUInt -> IO LLVMBool++-- DISubroutineType++foreign import ccall unsafe "LLVM_Hs_Get_DISubroutineType" getDISubroutineType ::+  Ptr Context -> DIFlags -> Word8 -> TupleArray DIType -> IO (Ptr DISubroutineType)++foreign import ccall unsafe "LLVM_Hs_DISubroutineType_GetCC" getSubroutineCC ::+  Ptr DISubroutineType -> IO Word8++foreign import ccall unsafe "LLVM_Hs_DISubroutine_GetTypeArray" getSubroutineTypeArray ::+  Ptr DISubroutineType -> IO (TupleArray DIType)++-- | DIBasicType++foreign import ccall unsafe "LLVM_Hs_Get_DIBasicType" getDIBasicType ::+  Ptr Context -> DwTag -> Ptr MDString -> Word64 -> Word32 -> Encoding -> IO (Ptr DIBasicType)++foreign import ccall unsafe "LLVM_Hs_DIBasicType_GetEncoding" getBasicTypeEncoding ::+  Ptr DIBasicType -> IO Encoding++-- DIDerivedType++foreign import ccall unsafe "LLVM_Hs_Get_DIDerivedType" getDIDerivedType ::+  Ptr Context ->+  DwTag -> Ptr MDString -> Ptr DIFile -> CUInt -> Ptr DIScope ->+  Ptr DIType -> Word64 -> Word32 -> Word64 -> Word32 -> LLVMBool -> DIFlags ->+  IO (Ptr DIDerivedType)++foreign import ccall unsafe "LLVM_Hs_Get_DIFile" getDIFile ::+  Ptr Context -> Ptr MDString -> Ptr MDString -> ChecksumKind -> Ptr MDString -> IO (Ptr DIFile)++-- DISubrange+foreign import ccall unsafe "LLVM_Hs_Get_DISubrange" getDISubrange ::+  Ptr Context -> Int64 -> Int64 -> IO (Ptr DISubrange)++foreign import ccall unsafe "LLVM_Hs_DISubrange_GetCount" getDISubrangeCount ::+  Ptr DISubrange -> IO Int64++foreign import ccall unsafe "LLVM_Hs_DISubrange_GetLowerBound" getDISubrangeLowerBound ::+  Ptr DISubrange -> IO Int64++-- DISubprogram++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetLine" getDISubprogramLine ::+  Ptr DISubprogram -> IO CUInt++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetVirtuality" getDISubprogramVirtuality ::+  Ptr DISubprogram -> IO DwVirtuality++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetVirtualIndex" getDISubprogramVirtualIndex ::+  Ptr DISubprogram -> IO CUInt++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetScopeLine" getDISubprogramScopeLine ::+  Ptr DISubprogram -> IO CUInt++foreign import ccall unsafe "LLVM_Hs_DISubprogram_IsOptimized" getDISubprogramIsOptimized ::+  Ptr DISubprogram -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DISubprogram_IsDefinition" getDISubprogramIsDefinition ::+  Ptr DISubprogram -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetLocalToUnit" getDISubprogramLocalToUnit ::+  Ptr DISubprogram -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetThisAdjustment" getDISubprogramThisAdjustment ::+  Ptr DISubprogram -> IO Int32++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetFlags" getDISubprogramFlags ::+  Ptr DISubprogram -> IO DIFlags++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetLinkageName" getDISubprogramLinkageName ::+  Ptr DISubprogram -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetType" getDISubprogramType ::+  Ptr DISubprogram -> IO (Ptr DISubroutineType)++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetContainingType" getDISubprogramContainingType ::+  Ptr DISubprogram -> IO (Ptr DIType)++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetUnit" getDISubprogramUnit ::+  Ptr DISubprogram -> IO (Ptr DICompileUnit)++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetTemplateParams" getDISubprogramTemplateParams ::+  Ptr DISubprogram -> IO (TupleArray DITemplateParameter)++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetVariables" getDISubprogramVariables ::+  Ptr DISubprogram -> IO (TupleArray DILocalVariable)++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetThrownTypes" getDISubprogramThrownTypes ::+  Ptr DISubprogram -> IO (TupleArray DIType)++foreign import ccall unsafe "LLVM_Hs_DISubprogram_GetDeclaration" getDISubprogramDeclaration ::+  Ptr DISubprogram -> IO (Ptr DISubprogram)++foreign import ccall unsafe "LLVM_Hs_Get_DISubprogram" getDISubprogram ::+  Ptr Context -> Ptr DIScope -> Ptr MDString ->+  Ptr MDString -> Ptr DIFile -> CUInt ->+  Ptr DISubroutineType -> LLVMBool -> LLVMBool -> CUInt ->+  Ptr DIType -> DwVirtuality -> CUInt ->+  Int32 -> DIFlags -> LLVMBool ->+  Ptr DICompileUnit -> TupleArray DITemplateParameter -> Ptr DISubprogram ->+  TupleArray DILocalVariable -> TupleArray DIType ->+  IO (Ptr DISubprogram)++-- DIExpression++foreign import ccall unsafe "LLVM_Hs_Get_DIExpression" getDIExpression' ::+  Ptr Context -> CUInt -> Ptr Word64 -> IO (Ptr DIExpression)++getDIExpression :: Ptr Context -> (CUInt, Ptr Word64) -> IO (Ptr DIExpression)+getDIExpression ctx (numOps, ops) = getDIExpression' ctx numOps ops++foreign import ccall unsafe "LLVM_Hs_DIExpression_GetNumElements" getDIExpressionNumElements ::+  Ptr DIExpression -> IO CUInt++foreign import ccall unsafe "LLVM_Hs_DIExpression_GetElement" getDIExpressionElement ::+  Ptr DIExpression -> CUInt -> IO Word64++-- DIVariable++foreign import ccall unsafe "LLVM_Hs_DIVariable_GetScope" getDIVariableScope ::+  Ptr DIVariable -> IO (Ptr DIScope)++foreign import ccall unsafe "LLVM_Hs_DIVariable_GetFile" getDIVariableFile ::+  Ptr DIVariable -> IO (Ptr DIFile)++foreign import ccall unsafe "LLVM_Hs_DIVariable_GetName" getDIVariableName ::+  Ptr DIVariable -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIVariable_GetLine" getDIVariableLine ::+  Ptr DIVariable -> IO CUInt++foreign import ccall unsafe "LLVM_Hs_DIVariable_GetType" getDIVariableType ::+  Ptr DIVariable -> IO (Ptr DIType)++foreign import ccall unsafe "LLVM_Hs_DIVariable_GetAlignInBits" getDIVariableAlignInBits ::+  Ptr DIVariable -> IO Word32++-- DILocalVariable++foreign import ccall unsafe "LLVM_Hs_Get_DILocalVariable" getDILocalVariable ::+  Ptr Context ->+  Ptr DIScope -> CString -> Ptr DIFile -> Word32 -> Ptr DIType -> Word16 -> DIFlags -> Word32 ->+  IO (Ptr DILocalVariable)++foreign import ccall unsafe "LLVM_Hs_DILocalVariable_GetArg" getDILocalVariableArg ::+  Ptr DILocalVariable -> IO Word16++foreign import ccall unsafe "LLVM_Hs_DILocalVariable_GetFlags" getDILocalVariableFlags ::+  Ptr DILocalVariable -> IO DIFlags++-- DIGlobalVariable++foreign import ccall unsafe "LLVM_Hs_Get_DIGlobalVariable" getDIGlobalVariable ::+  Ptr Context ->+  Ptr DIScope -> Ptr MDString -> Ptr MDString ->+  Ptr DIFile -> CUInt -> Ptr DIType ->+  LLVMBool -> LLVMBool ->+  Ptr DIDerivedType ->+  Word32 ->+  IO (Ptr DIGlobalVariable)++foreign import ccall unsafe "LLVM_Hs_DIGlobalVariable_GetLocal" getDIGlobalVariableLocal ::+  Ptr DIGlobalVariable -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DIGlobalVariable_GetDefinition" getDIGlobalVariableDefinition ::+  Ptr DIGlobalVariable -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DIGlobalVariable_GetLinkageName" getDIGlobalVariableLinkageName ::+  Ptr DIGlobalVariable -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIGlobalVariable_GetStaticDataMemberDeclaration" getDIGlobalVariableStaticDataMemberDeclaration ::+  Ptr DIGlobalVariable -> IO (Ptr DIDerivedType)++-- DICompileUnit++foreign import ccall unsafe "LLVM_Hs_Get_DICompileUnit" getDICompileUnit ::+  Ptr Context ->+  CUInt -> Ptr DIFile -> Ptr MDString -> LLVMBool -> Ptr MDString ->+  CUInt -> Ptr MDString -> DebugEmissionKind -> TupleArray DICompositeType -> TupleArray DIScope ->+  TupleArray DIGlobalVariableExpression -> TupleArray DIImportedEntity -> TupleArray DIMacroNode -> Word64 -> LLVMBool ->+  LLVMBool -> LLVMBool ->+  IO (Ptr DICompileUnit)++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetLanguage" getDICompileUnitLanguage ::+  Ptr DICompileUnit -> IO CUInt++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetSplitDebugInlining" getDICompileUnitSplitDebugInlining ::+  Ptr DICompileUnit -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetDebugInfoForProfiling" getDICompileUnitDebugInfoForProfiling ::+  Ptr DICompileUnit -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetGnuPubnames" getDICompileUnitGnuPubnames ::+  Ptr DICompileUnit -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetOptimized" getDICompileUnitOptimized ::+  Ptr DICompileUnit -> IO LLVMBool++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetRuntimeVersion" getDICompileUnitRuntimeVersion ::+  Ptr DICompileUnit -> IO CUInt++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetProducer" getDICompileUnitProducer ::+  Ptr DICompileUnit -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetFlags" getDICompileUnitFlags ::+  Ptr DICompileUnit -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetSplitDebugFilename" getDICompileUnitSplitDebugFilename ::+  Ptr DICompileUnit -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetEmissionKind" getDICompileUnitEmissionKind ::+  Ptr DICompileUnit -> IO DebugEmissionKind++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetDWOId" getDICompileUnitDWOId ::+  Ptr DICompileUnit -> IO Word64++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetEnumTypes" getDICompileUnitEnumTypes ::+  Ptr DICompileUnit -> IO (TupleArray DICompositeType)++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetRetainedTypes" getDICompileUnitRetainedTypes ::+  Ptr DICompileUnit -> IO (TupleArray DIScope)++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetGlobalVariables" getDICompileUnitGlobalVariables ::+  Ptr DICompileUnit -> IO (TupleArray DIGlobalVariableExpression)++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetImportedEntities" getDICompileUnitImportedEntities ::+  Ptr DICompileUnit -> IO (TupleArray DIImportedEntity)++foreign import ccall unsafe "LLVM_Hs_DICompileUnit_GetMacros" getDICompileUnitMacros ::+  Ptr DICompileUnit -> IO (TupleArray DIMacroNode)++-- DIFlags+foreign import ccall unsafe "LLVM_Hs_DIFlags_GetFlag" getDIFlag ::+  CString -> IO DIFlags++-- DITemplateParameter++foreign import ccall unsafe "LLVM_Hs_DITemplateParameter_GetName" getDITemplateParameterName ::+  Ptr DITemplateParameter -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DITemplateParameter_GetType" getDITemplateParameterType ::+  Ptr DITemplateParameter -> IO (Ptr DIType)++-- DITemplateTypeParameter++foreign import ccall unsafe "LLVM_Hs_Get_DITemplateTypeParameter" getDITemplateTypeParameter ::+  Ptr Context -> Ptr MDString -> Ptr DIType -> IO (Ptr DITemplateTypeParameter)++-- DITemplateValueParameter++foreign import ccall unsafe "LLVM_Hs_Get_DITemplateValueParameter" getDITemplateValueParameter ::+  Ptr Context -> Ptr MDString -> Ptr DIType -> DwTag -> Ptr Metadata -> IO (Ptr DITemplateValueParameter)++foreign import ccall unsafe "LLVM_Hs_DITemplateValueParameter_GetValue" getDITemplateValueParameterValue ::+  Ptr DITemplateValueParameter -> IO (Ptr Metadata)++-- DIMacro+foreign import ccall unsafe "LLVM_Hs_Get_DIMacro" getDIMacro ::+  Ptr Context -> Macinfo -> Word32 -> Ptr MDString -> Ptr MDString -> IO (Ptr DIMacro)++foreign import ccall unsafe "LLVM_Hs_DIMacro_GetMacinfo" getDIMacroMacinfo ::+  Ptr DIMacro -> IO Macinfo++foreign import ccall unsafe "LLVM_Hs_DIMacro_GetLine" getDIMacroLine ::+  Ptr DIMacro -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DIMacro_GetName" getDIMacroName ::+  Ptr DIMacro -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIMacro_GetValue" getDIMacroValue ::+  Ptr DIMacro -> IO (Ptr MDString)++-- DIMacroFile+foreign import ccall unsafe "LLVM_Hs_Get_DIMacroFile" getDIMacroFile ::+  Ptr Context -> Word32 -> Ptr DIFile -> TupleArray DIMacroNode -> IO (Ptr DIMacroFile)++foreign import ccall unsafe "LLVM_Hs_DIMacroFile_GetLine" getDIMacroFileLine ::+  Ptr DIMacroFile -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DIMacroFile_GetFile" getDIMacroFileFile ::+  Ptr DIMacroFile -> IO (Ptr DIFile)++foreign import ccall unsafe "LLVM_Hs_DIMacroFile_GetNumElements" getDIMacroFileNumElements ::+  Ptr DIMacroFile -> IO CUInt++foreign import ccall unsafe "LLVM_Hs_DIMacroFile_GetElement" getDIMacroFileElement ::+  Ptr DIMacroFile -> CUInt -> IO (Ptr DIMacroNode)++-- DIImportedEntity+foreign import ccall unsafe "LLVM_Hs_Get_DIImportedEntity" getDIImportedEntity ::+  Ptr Context -> DwTag -> Ptr DIScope -> Ptr DINode -> Ptr DIFile -> Word32 -> Ptr MDString -> IO (Ptr DIImportedEntity)++foreign import ccall unsafe "LLVM_Hs_DIImportedEntity_GetLine" getDIImportedEntityLine ::+  Ptr DIImportedEntity -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DIImportedEntity_GetScope" getDIImportedEntityScope ::+  Ptr DIImportedEntity -> IO (Ptr DIScope)++foreign import ccall unsafe "LLVM_Hs_DIImportedEntity_GetEntity" getDIImportedEntityEntity ::+  Ptr DIImportedEntity -> IO (Ptr DINode)++foreign import ccall unsafe "LLVM_Hs_DIImportedEntity_GetName" getDIImportedEntityName ::+  Ptr DIImportedEntity -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIImportedEntity_GetFile" getDIImportedEntityFile ::+  Ptr DIImportedEntity -> IO (Ptr DIFile)++-- DIGlobalVariableExpression+foreign import ccall unsafe "LLVM_Hs_Get_DIGlobalVariableExpression" getDIGlobalVariableExpression ::+  Ptr Context -> Ptr DIGlobalVariable -> Ptr DIExpression -> IO (Ptr DIGlobalVariableExpression)++foreign import ccall unsafe "LLVM_Hs_DIGlobalVariableExpression_GetVariable" getDIGlobalVariableExpressionVariable ::+  Ptr DIGlobalVariableExpression -> IO (Ptr DIGlobalVariable)++foreign import ccall unsafe "LLVM_Hs_DIGlobalVariableExpression_GetExpression" getDIGlobalVariableExpressionExpression ::+  Ptr DIGlobalVariableExpression -> IO (Ptr DIExpression)++-- DIObjCProperty+foreign import ccall unsafe "LLVM_Hs_Get_DIObjCProperty" getDIObjCProperty ::+  Ptr Context -> Ptr MDString -> Ptr DIFile -> Word32 -> Ptr MDString -> Ptr MDString -> Word32 -> Ptr DIType -> IO (Ptr DIObjCProperty)++foreign import ccall unsafe "LLVM_Hs_DIObjCProperty_GetLine" getDIObjCPropertyLine ::+  Ptr DIObjCProperty -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DIObjCProperty_GetAttributes" getDIObjCPropertyAttributes ::+  Ptr DIObjCProperty -> IO Word32++foreign import ccall unsafe "LLVM_Hs_DIObjCProperty_GetName" getDIObjCPropertyName ::+  Ptr DIObjCProperty -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIObjCProperty_GetFile" getDIObjCPropertyFile ::+  Ptr DIObjCProperty -> IO (Ptr DIFile)++foreign import ccall unsafe "LLVM_Hs_DIObjCProperty_GetGetterName" getDIObjCPropertyGetterName ::+  Ptr DIObjCProperty -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIObjCProperty_GetSetterName" getDIObjCPropertySetterName ::+  Ptr DIObjCProperty -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIObjCProperty_GetType" getDIObjCPropertyType ::+  Ptr DIObjCProperty -> IO (Ptr DIType)++-- DIModule+foreign import ccall unsafe "LLVM_Hs_Get_DIModule" getDIModule ::+  Ptr Context -> Ptr DIScope -> Ptr MDString -> Ptr MDString -> Ptr MDString -> Ptr MDString -> IO (Ptr DIModule)++foreign import ccall unsafe "LLVM_Hs_DIModule_GetConfigurationMacros" getDIModuleConfigurationMacros ::+  Ptr DIModule -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIModule_GetIncludePath" getDIModuleIncludePath ::+  Ptr DIModule -> IO (Ptr MDString)++foreign import ccall unsafe "LLVM_Hs_DIModule_GetISysRoot" getDIModuleISysRoot ::+  Ptr DIModule -> IO (Ptr MDString)

@@ -6,6 +6,7 @@ #include "llvm/Config/llvm-config.h" #include "llvm/IR/LLVMContext.h" #include "llvm/IR/Metadata.h"+#include "llvm/IR/DebugInfoMetadata.h" #include "llvm-c/Core.h"  using namespace llvm;@@ -19,12 +20,7 @@     return nullptr; } -LLVMMetadataRef LLVM_Hs_MDStringInContext(LLVMContextRef c,-                                               const char *str, unsigned slen) {-    return wrap(MDString::get(*unwrap(c), StringRef(str, slen)));-}--const char *LLVM_Hs_GetMDString(LLVMMetadataRef md, unsigned* len) {+const char *LLVM_Hs_GetMDStringValue(LLVMMetadataRef md, unsigned* len) {     if (const MDString *S = dyn_cast<MDString>(unwrap(md))) {       *len = S->getString().size();       return S->getString().data();@@ -33,6 +29,13 @@     return nullptr; } +MDString* LLVM_Hs_GetMDString(LLVMContextRef c, const char* str, unsigned len) {+    if (len == 0) {+        return nullptr;+    }+    return MDString::get(*unwrap(c), StringRef(str, len));+}+ LLVMMetadataRef LLVM_Hs_MDValue(LLVMValueRef v) {     return wrap(ValueAsMetadata::get(unwrap(v))); }@@ -56,10 +59,10 @@     return wrap(unwrap<MetadataAsValue>(val)->getMetadata()); } -LLVMMetadataRef LLVM_Hs_MDNodeInContext(LLVMContextRef c,-                                             LLVMMetadataRef *mds,-                                             unsigned count) {-    return wrap(MDNode::get(*unwrap(c), ArrayRef<Metadata *>(unwrap(mds), count)));+MDTuple* LLVM_Hs_Get_MDTuple(LLVMContextRef c,+                                    LLVMMetadataRef *mds,+                                    unsigned count) {+    return MDTuple::get(*unwrap(c), {unwrap(mds), count}); }  LLVMMetadataRef LLVM_Hs_IsAMDValue(LLVMMetadataRef md) {@@ -95,10 +98,14 @@ 	return ns.size(); } -unsigned LLVM_Hs_GetMDNodeNumOperands(LLVMMetadataRef v) {-	return unwrap<MDNode>(v)->getNumOperands();+unsigned LLVM_Hs_MDNode_GetNumOperands(MDNode* v) {+	return v->getNumOperands(); } +Metadata* LLVM_Hs_MDNode_GetOperand(MDNode* v, unsigned i) {+	return v->getOperand(i).get();+}+ void LLVM_Hs_NamedMetadataAddOperands( 	NamedMDNode *n, 	LLVMMetadataRef *ops,@@ -116,6 +123,14 @@ 	return s.data(); } +const char *LLVM_Hs_GetStringRef(+    StringRef* s,+    unsigned *len+) {+    *len = s->size();+    return s->data();+}+ unsigned LLVM_Hs_GetNamedMetadataNumOperands(NamedMDNode *n) { 	return n->getNumOperands(); }@@ -146,5 +161,706 @@     MDNode::deleteTemporary(Node); } +// DILocation++DILocation* LLVM_Hs_Get_DILocation(LLVMContextRef cxt, uint32_t line, uint16_t column, DILocalScope* scope) {+    LLVMContext& c = *unwrap(cxt);++    return DILocation::get(c, line, column, scope); } +uint32_t LLVM_Hs_DILocation_GetLine(DILocation *md) {+    return md->getLine();+}++uint16_t LLVM_Hs_DILocation_GetColumn(DILocation *md) {+    return md->getColumn();+}++DILocalScope* LLVM_Hs_DILocation_GetScope(DILocation *md) {+    return md->getScope();+}++unsigned LLVM_Hs_GetMetadataClassId(LLVMMetadataRef md) {+    return (unwrap(md))->getMetadataID();+}++uint16_t LLVM_Hs_DINodeGetTag(DINode *md) {+    return md->getTag();+}++DINode::DIFlags LLVM_Hs_DITypeGetFlags(DIType *md) {+    return md->getFlags();+}++// DIEnumerator++DIEnumerator* LLVM_Hs_Get_DIEnumerator(LLVMContextRef cxt, int64_t value, MDString* name) {+    LLVMContext& c = *unwrap(cxt);+    return DIEnumerator::get(c, value, name);+}++int64_t LLVM_Hs_DIEnumerator_GetValue(DIEnumerator* md) {+    return md->getValue();+}++MDString* LLVM_Hs_DIEnumerator_GetName(DIEnumerator* md) {+    return md->getRawName();+}++MDString* LLVM_Hs_DIFileGetFilename(DIFile *di) {+    return di->getRawFilename();+}++MDString* LLVM_Hs_DIFileGetDirectory(DIFile *di) {+    return di->getRawDirectory();+}++MDString* LLVM_Hs_DIFileGetChecksum(DIFile *di) {+    return di->getRawChecksum();+}++llvm::DIFile::ChecksumKind LLVM_Hs_DIFileGetChecksumKind(DIFile *di) {+    return di->getChecksumKind();+}++// DIScope++DIScope* LLVM_Hs_DIScope_GetScope(DIScope *ds) {+    return cast_or_null<DIScope>(ds->getScope());+}++DIFile* LLVM_Hs_DIScope_GetFile(DIScope *ds) {+    return ds->getFile();+}++const char* LLVM_Hs_DIScope_GetName(DIScope *ds, unsigned *len) {+    StringRef s = ds->getName();+    *len = s.size();+    return s.data();+}++// DINamespace++DINamespace* LLVM_Hs_Get_DINamespace(LLVMContextRef ctx, DIScope* scope, MDString* name, LLVMBool exportSymbols) {+    return DINamespace::get(*unwrap(ctx), scope, name, exportSymbols);+}++LLVMBool LLVM_Hs_DINamespace_GetExportSymbols(DINamespace *ds) {+    return ds->getExportSymbols();+}++MDString* LLVM_Hs_DITypeGetName(DIType *ds) {+    return ds->getRawName();+}++uint64_t LLVM_Hs_DITypeGetSizeInBits(DIType *ds) {+    return ds->getSizeInBits();+}++uint64_t LLVM_Hs_DITypeGetOffsetInBits(DIType *ds) {+    return ds->getOffsetInBits();+}++uint32_t LLVM_Hs_DITypeGetAlignInBits(DIType *ds) {+    return ds->getAlignInBits();+}++uint32_t LLVM_Hs_DITypeGetLine(DIType *ds) {+    return ds->getLine();+}++// DIBasicType++DIBasicType* LLVM_Hs_Get_DIBasicType(LLVMContextRef ctx, uint16_t tag, MDString *name, uint64_t sizeInBits, uint32_t alignInBits, unsigned encoding) {+    return DIBasicType::get(*unwrap(ctx), tag, name, sizeInBits, alignInBits, encoding);+}+++unsigned LLVM_Hs_DIBasicType_GetEncoding(DIBasicType *ds) {+    return ds->getEncoding();+}++// DIDerivedType+DIDerivedType* LLVM_Hs_Get_DIDerivedType(LLVMContextRef ctx, uint16_t tag, MDString* name, DIFile *file, unsigned line, DIScope *scope, DIType *baseType, uint64_t sizeInBits, uint32_t alignInBits, uint64_t offsetInBits, uint32_t dwarfAddressSpace, LLVMBool dwarfAddressSpacePresent, DINode::DIFlags flags) {+    LLVMContext& c = *unwrap(ctx);+    Optional<unsigned> addrSpace;+    if (dwarfAddressSpacePresent) {+        addrSpace = dwarfAddressSpace;+    }+    return DIDerivedType::get(c, tag, name, file, line, scope, baseType, sizeInBits, alignInBits, offsetInBits, addrSpace, flags);+}++DIFile* LLVM_Hs_Get_DIFile(LLVMContextRef ctx, MDString* filename, MDString* directory, unsigned checksumKind, MDString* checksum) {+    LLVMContext& c = *unwrap(ctx);+    return DIFile::get(c, filename, directory, static_cast<DIFile::ChecksumKind>(checksumKind), checksum);+}++DISubrange* LLVM_Hs_Get_DISubrange(LLVMContextRef ctx, int64_t count, int64_t lowerBound) {+    return DISubrange::get(*unwrap(ctx), count, lowerBound);+}++int64_t LLVM_Hs_DISubrange_GetCount(DISubrange* range) {+    return range->getCount();+}++int64_t LLVM_Hs_DISubrange_GetLowerBound(DISubrange* range) {+    return range->getLowerBound();+}++MDTuple* LLVM_Hs_DICompositeType_GetElements(DICompositeType *dt) {+    return cast_or_null<MDTuple>(dt->getRawElements());+}++DITypeRef LLVM_Hs_DICompositeTypeGetVTableHolder(DICompositeType *dt) {+    return dt->getVTableHolder();+}++DITypeRef LLVM_Hs_DICompositeTypeGetBaseType(DICompositeType *dt) {+    return dt->getBaseType();+}++DITypeRef LLVM_Hs_DIDerivedTypeGetBaseType(DIDerivedType *dt) {+    return dt->getBaseType();+}++uint16_t LLVM_Hs_DICompositeTypeGetRuntimeLang(DICompositeType *dt) {+    return dt->getRuntimeLang();+}++MDTuple* LLVM_Hs_DICompositeType_GetTemplateParameters(DICompositeType *dt) {+    return cast_or_null<MDTuple>(dt->getRawTemplateParams());+}++MDString* LLVM_Hs_DICompositeTypeGetIdentifier(DICompositeType *dt) {+    return dt->getRawIdentifier();+}++DICompositeType *LLVM_Hs_Get_DIArrayType(LLVMContextRef ctx, MDTuple* subscripts, DIType* elTy, uint64_t size, uint32_t align, DINode::DIFlags flags) {+    return DICompositeType::get(*unwrap(ctx), dwarf::DW_TAG_array_type, "", nullptr, 0, nullptr, elTy, size, align, 0, flags, subscripts, 0, nullptr);+}++DICompositeType* LLVM_Hs_Get_DIEnumerationType(LLVMContextRef ctx, DIScope* scope, MDString* name, DIFile *file, uint32_t line, uint64_t size, uint32_t align, MDTuple* elements, DIType* underlyingType, MDString* uniqueIdentifier) {+    return DICompositeType::get(*unwrap(ctx), dwarf::DW_TAG_enumeration_type, name, file, line, scope, underlyingType, size, align, 0, DINode::FlagZero, elements, 0, nullptr, nullptr, uniqueIdentifier);+}++DICompositeType *LLVM_Hs_Get_DIStructType(+    LLVMContextRef ctx, DIScope *scope, MDString *name, DIFile *file,+    uint32_t line, uint64_t size, uint32_t align, DINode::DIFlags flags,+    DIType *derivedFrom, MDTuple *elements,+    uint16_t runtimeLang, DIType *vtableHolder, MDString *uniqueIdentifier) {+    return DICompositeType::get(*unwrap(ctx), dwarf::DW_TAG_structure_type, name, file,+                                line, scope, derivedFrom, size, align, 0, flags,+                                elements, runtimeLang, vtableHolder, nullptr,+                                uniqueIdentifier);+}++DICompositeType *LLVM_Hs_Get_DIUnionType(+    LLVMContextRef ctx, DIScope *scope, MDString *name, DIFile *file,+    uint32_t line, uint64_t size, uint32_t align, DINode::DIFlags flags,+    MDTuple *elements,+    uint16_t runtimeLang, MDString *uniqueIdentifier) {+    return DICompositeType::get(*unwrap(ctx), dwarf::DW_TAG_union_type, name, file,+                                line, scope, nullptr, size, align, 0, flags,+                                elements, runtimeLang, nullptr, nullptr,+                                uniqueIdentifier);+}++DICompositeType *LLVM_Hs_Get_DIClassType(+    LLVMContextRef ctx, DIScope *scope, MDString *name, DIFile *file,+    uint32_t line, uint64_t size, uint32_t align, DINode::DIFlags flags,+    DIType *derivedFrom, MDTuple *elements,+    DIType *vtableHolder, MDTuple* templateParams, MDString *uniqueIdentifier) {+    return DICompositeType::get(*unwrap(ctx), dwarf::DW_TAG_class_type, name, file,+                                line, scope, derivedFrom, size, align, 0, flags,+                                elements, 0, vtableHolder, templateParams,+                                uniqueIdentifier);+}+++// DILexicalBlockBase++DILocalScope* LLVM_Hs_DILexicalBlockBaseGetScope(DILexicalBlockBase* bb) {+    return bb->getScope();+}++// DILexicalBlockFile++uint32_t LLVM_Hs_DILexicalBlockFileGetDiscriminator(DILexicalBlockFile* bf) {+    return bf->getDiscriminator();+}++DILexicalBlockFile* LLVM_Hs_Get_DILexicalBlockFile(LLVMContextRef ctx, DILocalScope* scope, DIFile* file, uint32_t discriminator) {+    return DILexicalBlockFile::get(*unwrap(ctx), scope, file, discriminator);+}++// DILexicalBlock++uint32_t LLVM_Hs_DILexicalBlockGetLine(DILexicalBlock* lb) {+    return lb->getLine();+}++uint16_t LLVM_Hs_DILexicalBlockGetColumn(DILexicalBlock* lb) {+    return lb->getColumn();+}++DILexicalBlock* LLVM_Hs_Get_DILexicalBlock(LLVMContextRef ctx, DILocalScope* scope, DIFile *file, uint32_t line, uint16_t column) {+    return DILexicalBlock::get(*unwrap(ctx), scope, file, line, column);+}++LLVMBool LLVM_Hs_DIDerivedTypeGetAddressSpace(DIDerivedType *a, unsigned *x) {+    auto addressSpace = a->getDWARFAddressSpace();+    if (addressSpace.hasValue()) {+        *x = addressSpace.getValue();+        return 1;+    } else {+        return 0;+    }+}++// DISubroutineType++DISubroutineType* LLVM_Hs_Get_DISubroutineType(LLVMContextRef ctx, DINode::DIFlags flags, uint8_t cc, MDTuple* types) {+    return DISubroutineType::get(*unwrap(ctx), flags, cc, types);+}++uint8_t LLVM_Hs_DISubroutineType_GetCC(DISubroutineType *a) {+    return a->getCC();+}++MDTuple* LLVM_Hs_DISubroutine_GetTypeArray(DISubroutineType *md) {+    return cast_or_null<MDTuple>(md->getRawTypeArray());+}++// DISubprogram++unsigned LLVM_Hs_DISubprogram_GetLine(DISubprogram* p) {+    return p->getLine();+}++uint8_t LLVM_Hs_DISubprogram_GetVirtuality(DISubprogram* p) {+    return p->getVirtuality();+}++unsigned LLVM_Hs_DISubprogram_GetVirtualIndex(DISubprogram* p) {+    return p->getVirtualIndex();+}++unsigned LLVM_Hs_DISubprogram_GetScopeLine(DISubprogram* p) {+    return p->getScopeLine();+}++LLVMBool LLVM_Hs_DISubprogram_IsOptimized(DISubprogram* p) {+    return p->isOptimized();+}++LLVMBool LLVM_Hs_DISubprogram_IsDefinition(DISubprogram* p) {+    return p->isDefinition();+}++LLVMBool LLVM_Hs_DISubprogram_GetLocalToUnit(DISubprogram* p) {+    return p->isLocalToUnit();+}++int32_t LLVM_Hs_DISubprogram_GetThisAdjustment(DISubprogram* p) {+    return p->getThisAdjustment();+}++DINode::DIFlags LLVM_Hs_DISubprogram_GetFlags(DISubprogram* p) {+    return p->getFlags();+}++MDString* LLVM_Hs_DISubprogram_GetLinkageName(DISubprogram* p) {+    return p->getRawLinkageName();+}++DISubroutineType* LLVM_Hs_DISubprogram_GetType(DISubprogram* p) {+    return p->getType();+}++DIType* LLVM_Hs_DISubprogram_GetContainingType(DISubprogram* p) {+    return p->getContainingType().resolve();+}++DICompileUnit* LLVM_Hs_DISubprogram_GetUnit(DISubprogram* p) {+    return p->getUnit();+}++MDTuple* LLVM_Hs_DISubprogram_GetTemplateParams(DISubprogram* p) {+    return cast_or_null<MDTuple>(p->getRawTemplateParams());+}++MDTuple* LLVM_Hs_DISubprogram_GetVariables(DISubprogram* p) {+    return cast_or_null<MDTuple>(p->getRawVariables());+}++MDTuple* LLVM_Hs_DISubprogram_GetThrownTypes(DISubprogram* p) {+    return cast_or_null<MDTuple>(p->getRawThrownTypes());+}++DISubprogram* LLVM_Hs_DISubprogram_GetDeclaration(DISubprogram* p) {+    return p->getDeclaration();+}++DISubprogram *LLVM_Hs_Get_DISubprogram(+    LLVMContextRef ctx, DIScope *scope, MDString *name,+    MDString *linkageName, DIFile *file, unsigned line,+    DISubroutineType *type, LLVMBool isLocal, LLVMBool isDefinition, unsigned scopeLine,+    DIType *containingType, uint8_t virtuality, unsigned virtualIndex,+    int32_t thisAdjustment, DINode::DIFlags flags, LLVMBool isOptimized,+    DICompileUnit *unit, Metadata *templateParams, DISubprogram *declaration,+    Metadata *variables, Metadata *thrownTypes) {+    LLVMContext &c = *unwrap(ctx);+    if (isDefinition) {+        return DISubprogram::getDistinct(+          c, scope, name, linkageName, file,+          line, type, isLocal, isDefinition, scopeLine, containingType,+          virtuality, virtualIndex, thisAdjustment, flags, isOptimized, unit,+          templateParams, declaration, variables, thrownTypes);+    } else {+        return DISubprogram::get(+          c, scope, name, linkageName, file,+          line, type, isLocal, isDefinition, scopeLine, containingType,+          virtuality, virtualIndex, thisAdjustment, flags, isOptimized, unit,+          templateParams, declaration, variables, thrownTypes);+    }+}++// DIExpression++DIExpression* LLVM_Hs_Get_DIExpression(LLVMContextRef ctx, unsigned numOps, uint64_t* ops) {+    return DIExpression::get(*unwrap(ctx), {ops, numOps});+}++unsigned LLVM_Hs_DIExpression_GetNumElements(DIExpression* e) {+    return e->getNumElements();+}++unsigned LLVM_Hs_DIExpression_GetElement(DIExpression* e, unsigned i) {+    return e->getElement(i);+}++// DIVariable++DIScope* LLVM_Hs_DIVariable_GetScope(DIVariable* v) {+    return v->getScope();+}++DIFile* LLVM_Hs_DIVariable_GetFile(DIVariable* v) {+    return v->getFile();+}++MDString* LLVM_Hs_DIVariable_GetName(DIVariable* v) {+    return v->getRawName();+}++unsigned LLVM_Hs_DIVariable_GetLine(DIVariable* v) {+    return v->getLine();+}++DIType* LLVM_Hs_DIVariable_GetType(DIVariable* v) {+    return v->getType().resolve();+}++uint32_t LLVM_Hs_DIVariable_GetAlignInBits(DIVariable* v) {+    return v->getAlignInBits();+}++// DILocalVariable++DILocalVariable* LLVM_Hs_Get_DILocalVariable(LLVMContextRef ctx,+                                             DIScope* scope, MDString* name, DIFile* file,+                                             uint32_t line, DIType* type, uint16_t arg,+                                             DINode::DIFlags flags, uint32_t alignInBits) {+    LLVMContext &c = *unwrap(ctx);+    return DILocalVariable::get(c, static_cast<DILocalScope*>(scope), name, file, line, type,+                                arg, flags, alignInBits);+}++uint16_t LLVM_Hs_DILocalVariable_GetArg(DILocalVariable* v) {+    return v->getArg();+}++DINode::DIFlags LLVM_Hs_DILocalVariable_GetFlags(DILocalVariable* v) {+    return v->getFlags();+}++// DIGlobalVariable++DIGlobalVariable* LLVM_Hs_Get_DIGlobalVariable(LLVMContextRef ctx,+                                               DIScope* scope, MDString* name, MDString* linkageName,+                                               DIFile* file, unsigned line, DIType* type,+                                               LLVMBool isLocalToUnit, LLVMBool isDefinition,+                                               DIDerivedType* declaration,+                                               uint32_t alignInBits) {+    LLVMContext &c = *unwrap(ctx);+    return DIGlobalVariable::get(c, scope, name, linkageName,+                                 file, line, type,+                                 isLocalToUnit, isDefinition,+                                 declaration,+                                 alignInBits);+}++LLVMBool LLVM_Hs_DIGlobalVariable_GetLocal(DIGlobalVariable* v) {+    return v->isLocalToUnit();+}++LLVMBool LLVM_Hs_DIGlobalVariable_GetDefinition(DIGlobalVariable* v) {+    return v->isDefinition();+}++MDString* LLVM_Hs_DIGlobalVariable_GetLinkageName(DIGlobalVariable* v) {+    return v->getRawLinkageName();+}++DIDerivedType* LLVM_Hs_DIGlobalVariable_GetStaticDataMemberDeclaration(DIGlobalVariable* v) {+    return v->getStaticDataMemberDeclaration();+}++// DICompileUnit+DICompileUnit* LLVM_Hs_Get_DICompileUnit+  (LLVMContextRef ctx,+   unsigned sourceLanguage, DIFile* file, MDString* producer, LLVMBool isOptimized, MDString* flags,+   unsigned runtimeVersion, MDString* splitDebugFilename, unsigned emissionKind, Metadata* enumTypes, Metadata* retainedTypes,+   Metadata* globalVariables, Metadata* importedEntities, Metadata* macros, uint64_t dwoid, LLVMBool splitDebugInlining,+   LLVMBool debugInfoForProfiling, LLVMBool gnuPubnames) {+    LLVMContext &c = *unwrap(ctx);+    return DICompileUnit::getDistinct+        (c,+         sourceLanguage, file, producer, isOptimized, flags,+         runtimeVersion, splitDebugFilename, emissionKind, enumTypes, retainedTypes,+         globalVariables, importedEntities, macros, dwoid, splitDebugInlining,+         debugInfoForProfiling, gnuPubnames);+}++unsigned LLVM_Hs_DICompileUnit_GetLanguage(DICompileUnit* cu) {+    return cu->getSourceLanguage();+}++LLVMBool LLVM_Hs_DICompileUnit_GetSplitDebugInlining(DICompileUnit* cu) {+    return cu->getSplitDebugInlining();+}++LLVMBool LLVM_Hs_DICompileUnit_GetDebugInfoForProfiling(DICompileUnit* cu) {+    return cu->getDebugInfoForProfiling();+}++LLVMBool LLVM_Hs_DICompileUnit_GetGnuPubnames(DICompileUnit* cu) {+    return cu->getGnuPubnames();+}++LLVMBool LLVM_Hs_DICompileUnit_GetOptimized(DICompileUnit* cu) {+    return cu->isOptimized();+}++unsigned LLVM_Hs_DICompileUnit_GetRuntimeVersion(DICompileUnit* cu) {+    return cu->getRuntimeVersion();+}++MDString* LLVM_Hs_DICompileUnit_GetProducer(DICompileUnit* cu) {+    return cu->getRawProducer();+}++MDString* LLVM_Hs_DICompileUnit_GetFlags(DICompileUnit* cu) {+    return cu->getRawFlags();+}++MDString* LLVM_Hs_DICompileUnit_GetSplitDebugFilename(DICompileUnit* cu) {+    return cu->getRawSplitDebugFilename();+}++unsigned LLVM_Hs_DICompileUnit_GetEmissionKind(DICompileUnit* cu) {+    return cu->getEmissionKind();+}++uint64_t LLVM_Hs_DICompileUnit_GetDWOId(DICompileUnit* cu) {+    return cu->getDWOId();+}++MDTuple* LLVM_Hs_DICompileUnit_GetEnumTypes(DICompileUnit* cu) {+    return cast_or_null<MDTuple>(cu->getRawEnumTypes());+}++MDTuple* LLVM_Hs_DICompileUnit_GetRetainedTypes(DICompileUnit* cu) {+    return cast_or_null<MDTuple>(cu->getRawRetainedTypes());+}++MDTuple* LLVM_Hs_DICompileUnit_GetGlobalVariables(DICompileUnit* cu) {+    return cast_or_null<MDTuple>(cu->getRawGlobalVariables());+}++MDTuple* LLVM_Hs_DICompileUnit_GetImportedEntities(DICompileUnit* cu) {+    return cast_or_null<MDTuple>(cu->getRawImportedEntities());+}++MDTuple* LLVM_Hs_DICompileUnit_GetMacros(DICompileUnit* cu) {+    return cast_or_null<MDTuple>(cu->getRawMacros());+}++// DIFlags++// This is mainly intended for testing purposes+DINode::DIFlags LLVM_Hs_DIFlags_GetFlag(const char* flag) {+    return DINode::getFlag(flag);+}++// DITemplateParameter++MDString* LLVM_Hs_DITemplateParameter_GetName(DITemplateParameter* p) {+    return p->getRawName();+}++DIType* LLVM_Hs_DITemplateParameter_GetType(DITemplateParameter* p) {+    return p->getType().resolve();+}++// DITemplateTypeParameter++DITemplateTypeParameter* LLVM_Hs_Get_DITemplateTypeParameter(LLVMContextRef ctx, MDString* name, DIType* type) {+    return DITemplateTypeParameter::get(*unwrap(ctx), name, type);+}++// DITemplateValueParameter++DITemplateValueParameter* LLVM_Hs_Get_DITemplateValueParameter(LLVMContextRef ctx, MDString* name, DIType* type, uint16_t tag, Metadata* value) {+    return DITemplateValueParameter::get(*unwrap(ctx), tag, name, type, value);+}++Metadata* LLVM_Hs_DITemplateValueParameter_GetValue(DITemplateValueParameter* p) {+    return p->getValue();+}++// DIMacro+DIMacro* LLVM_Hs_Get_DIMacro(LLVMContextRef ctx, unsigned macinfo, uint32_t line, MDString* name, MDString* value) {+    return DIMacro::get(*unwrap(ctx), macinfo, line, name, value);+}++unsigned LLVM_Hs_DIMacro_GetMacinfo(DIMacro* m) {+    return m->getMacinfoType();+}++uint32_t LLVM_Hs_DIMacro_GetLine(DIMacro* m) {+    return m->getLine();+}++MDString* LLVM_Hs_DIMacro_GetName(DIMacro* m) {+    return m->getRawName();+}++MDString* LLVM_Hs_DIMacro_GetValue(DIMacro* m) {+    return m->getRawValue();+}++// DIMacroFile+DIMacroFile* LLVM_Hs_Get_DIMacroFile(LLVMContextRef ctx, uint32_t line, DIFile* file, MDTuple* elems) {+    return DIMacroFile::get(*unwrap(ctx), dwarf::DW_MACINFO_start_file, line, file, static_cast<Metadata*>(elems));+}++uint32_t LLVM_Hs_DIMacroFile_GetLine(DIMacroFile* m) {+    return m->getLine();+}++DIFile* LLVM_Hs_DIMacroFile_GetFile(DIMacroFile* m) {+    return m->getFile();+}++unsigned LLVM_Hs_DIMacroFile_GetNumElements(DIMacroFile* m) {+    return m->getElements().size();+}++DIMacroNode* LLVM_Hs_DIMacroFile_GetElement(DIMacroFile* m, unsigned i) {+    return m->getElements()[i];+}++// DIImportedEntity++DIImportedEntity* LLVM_Hs_Get_DIImportedEntity(LLVMContextRef ctx, uint16_t tag, DIScope* scope, DINode* entity, DIFile* file, uint32_t line, MDString* name) {+    return DIImportedEntity::get(*unwrap(ctx), tag, scope, entity, file, line, name);+}++uint32_t LLVM_Hs_DIImportedEntity_GetLine(DIImportedEntity* e) {+    return e->getLine();+}++DIScope* LLVM_Hs_DIImportedEntity_GetScope(DIImportedEntity* e) {+    return e->getScope();+}++DINode* LLVM_Hs_DIImportedEntity_GetEntity(DIImportedEntity* e) {+    return e->getEntity().resolve();+}++MDString* LLVM_Hs_DIImportedEntity_GetName(DIImportedEntity* e) {+    return e->getRawName();+}++DIFile* LLVM_Hs_DIImportedEntity_GetFile(DIImportedEntity* e) {+    return e->getFile();+}++// DIGlobalVariableExpression++DIGlobalVariableExpression* LLVM_Hs_Get_DIGlobalVariableExpression(LLVMContextRef ctx, DIGlobalVariable* var, DIExpression* expr) {+    return DIGlobalVariableExpression::get(*unwrap(ctx), var, expr);+}++DIGlobalVariable* LLVM_Hs_DIGlobalVariableExpression_GetVariable(DIGlobalVariableExpression* e) {+    return e->getVariable();+}++DIExpression* LLVM_Hs_DIGlobalVariableExpression_GetExpression(DIGlobalVariableExpression* e) {+    return e->getExpression();+}++// DIObjCProperty++DIObjCProperty* LLVM_Hs_Get_DIObjCProperty(LLVMContextRef ctx, MDString* name, DIFile* file, uint32_t line, MDString* getterName, MDString* setterName, uint32_t attributes, DIType* type) {+    return DIObjCProperty::get(*unwrap(ctx), name, file, line, getterName, setterName, attributes, type);+}++uint32_t LLVM_Hs_DIObjCProperty_GetLine(DIObjCProperty* o) {+    return o->getLine();+}++uint32_t LLVM_Hs_DIObjCProperty_GetAttributes(DIObjCProperty* o) {+    return o->getAttributes();+}++MDString* LLVM_Hs_DIObjCProperty_GetName(DIObjCProperty* o) {+    return o->getRawName();+}++DIFile* LLVM_Hs_DIObjCProperty_GetFile(DIObjCProperty* o) {+    return o->getFile();+}++MDString* LLVM_Hs_DIObjCProperty_GetGetterName(DIObjCProperty* o) {+    return o->getRawGetterName();+}++MDString* LLVM_Hs_DIObjCProperty_GetSetterName(DIObjCProperty* o) {+    return o->getRawSetterName();+}++DIType* LLVM_Hs_DIObjCProperty_GetType(DIObjCProperty* o) {+    return o->getType().resolve();+}++// DIModule++DIModule* LLVM_Hs_Get_DIModule(LLVMContextRef ctx, DIScope* scope, MDString* name, MDString* configurationMacros, MDString* includePath, MDString* isysRoot) {+    return DIModule::get(*unwrap(ctx), scope, name, configurationMacros, includePath, isysRoot);+}++MDString* LLVM_Hs_DIModule_GetConfigurationMacros(DIModule* m) {+    return m->getRawConfigurationMacros();+}++MDString* LLVM_Hs_DIModule_GetIncludePath(DIModule* m) {+    return m->getRawIncludePath();+}++MDString* LLVM_Hs_DIModule_GetISysRoot(DIModule* m) {+    return m->getRawISysRoot();+}+}

@@ -0,0 +1,17 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | <https://llvm.org/doxygen/classllvm_1_1object_1_1ObjectFile.html>+module LLVM.Internal.FFI.ObjectFile where++import Foreign.Ptr++import LLVM.Prelude+import LLVM.Internal.FFI.MemoryBuffer++data ObjectFile++foreign import ccall unsafe "LLVMCreateObjectFile" createObjectFile ::+  Ptr MemoryBuffer -> IO (Ptr ObjectFile)++foreign import ccall unsafe "LLVMDisposeObjectFile" disposeObjectFile ::+  Ptr ObjectFile -> IO ()

@@ -9,17 +9,10 @@  import LLVM.Internal.FFI.DataLayout import LLVM.Internal.FFI.LLVMCTypes-import LLVM.Internal.FFI.PtrHierarchy  data JITSymbol data LambdaResolver -data LinkingLayer--data ObjectLinkingLayer--instance ChildOf LinkingLayer ObjectLinkingLayer- newtype TargetAddress = TargetAddress Word64  type SymbolResolverFn = CString -> Ptr JITSymbol -> IO ()@@ -37,12 +30,6 @@  foreign import ccall safe "LLVM_Hs_disposeLambdaResolver" disposeLambdaResolver ::   Ptr LambdaResolver -> IO ()--foreign import ccall safe "LLVM_Hs_createObjectLinkingLayer" createObjectLinkingLayer ::-  IO (Ptr ObjectLinkingLayer)--foreign import ccall safe "LLVM_Hs_LinkingLayer_dispose" disposeLinkingLayer ::-  Ptr LinkingLayer -> IO ()  foreign import ccall safe "LLVM_Hs_JITSymbol_getAddress" getAddress ::   Ptr JITSymbol -> Ptr (OwnerTransfered CString) -> IO TargetAddress

@@ -3,7 +3,7 @@  import LLVM.Prelude -import LLVM.Internal.FFI.OrcJIT+import LLVM.Internal.FFI.OrcJIT.LinkingLayer import LLVM.Internal.FFI.OrcJIT.CompileLayer import LLVM.Internal.FFI.PtrHierarchy import LLVM.Internal.FFI.Target

@@ -0,0 +1,32 @@+{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses #-}++module LLVM.Internal.FFI.OrcJIT.LinkingLayer where++import LLVM.Prelude++import Foreign.C+import Foreign.Ptr++import LLVM.Internal.FFI.OrcJIT+import LLVM.Internal.FFI.LLVMCTypes+import LLVM.Internal.FFI.PtrHierarchy+import LLVM.Internal.FFI.ObjectFile++data LinkingLayer+data ObjectLinkingLayer+instance ChildOf LinkingLayer ObjectLinkingLayer++newtype ObjectHandle = ObjectHandle Word++foreign import ccall safe "LLVM_Hs_createObjectLinkingLayer" createObjectLinkingLayer ::+  IO (Ptr ObjectLinkingLayer)++foreign import ccall safe "LLVM_Hs_LinkingLayer_dispose" disposeLinkingLayer ::+  Ptr LinkingLayer -> IO ()++foreign import ccall safe "LLVM_Hs_LinkingLayer_addObject" addObjectFile ::+  Ptr LinkingLayer ->+  Ptr ObjectFile ->+  Ptr LambdaResolver ->+  Ptr (OwnerTransfered CString) ->+  IO ObjectHandle

@@ -16,11 +16,14 @@ #include <type_traits> #include <unordered_map> +#include "llvm-c/Object.h"+#include "llvm/ExecutionEngine/Orc/RTDyldObjectLinkingLayer.h"+ using namespace llvm; using namespace orc;  typedef unsigned LLVMModuleHandle;-typedef unsigned LLVMObjSetHandle;+typedef unsigned LLVMObjectHandle; typedef llvm::orc::LambdaResolver<     std::function<JITSymbol(const std::string &name)>,     std::function<JITSymbol(const std::string &name)>>@@ -171,6 +174,32 @@     return mangledName; } +// LLVM doesn’t declare this function in a header so we need to copy it here+static inline object::OwningBinary<object::ObjectFile> *+unwrap(LLVMObjectFileRef OF) {+    return reinterpret_cast<object::OwningBinary<object::ObjectFile> *>(OF);+}++static JITSymbolFlags unwrap(LLVMJITSymbolFlags f) {+    JITSymbolFlags flags = JITSymbolFlags::None;+#define ENUM_CASE(x)                                                           \+    if (f & LLVMJITSymbolFlag##x)                                              \+        flags |= JITSymbolFlags::x;+    LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(ENUM_CASE)+#undef ENUM_CASE+    return flags;+}++static LLVMJITSymbolFlags wrap(JITSymbolFlags f) {+    unsigned r = 0;+#define ENUM_CASE(x)                                                           \+    if ((char)(f & JITSymbolFlags::x))                                         \+        r |= (unsigned)LLVMJITSymbolFlag##x;+    LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(ENUM_CASE)+#undef ENUM_CASE+    return LLVMJITSymbolFlags(r);+}+ extern "C" {  /* Constructor functions for the different compile layers */@@ -295,24 +324,21 @@     delete resolver; } -static JITSymbolFlags unwrap(LLVMJITSymbolFlags f) {-    JITSymbolFlags flags = JITSymbolFlags::None;-#define ENUM_CASE(x)                                                           \-    if (f & LLVMJITSymbolFlag##x)                                              \-        flags |= JITSymbolFlags::x;-    LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(ENUM_CASE)-#undef ENUM_CASE-    return flags;-}+LLVMObjectHandle LLVM_Hs_LinkingLayer_addObject(LinkingLayer *linkLayer,+                                                LLVMObjectFileRef objRef,+                                                LLVMLambdaResolverRef resolver,+                                                char **errorMessage) { -static LLVMJITSymbolFlags wrap(JITSymbolFlags f) {-    unsigned r = 0;-#define ENUM_CASE(x)                                                           \-    if ((char)(f & JITSymbolFlags::x))                                         \-        r |= (unsigned)LLVMJITSymbolFlag##x;-    LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(ENUM_CASE)-#undef ENUM_CASE-    return LLVMJITSymbolFlags(r);+    std::shared_ptr<object::OwningBinary<object::ObjectFile>> obj{+        unwrap(objRef), [](object::OwningBinary<object::ObjectFile> *) {}};+    if (auto handleOrErr = linkLayer->addObject(std::move(obj), *resolver)) {+        *errorMessage = nullptr;+        return *handleOrErr;+    } else {+        std::string errString = toString(handleOrErr.takeError());+        *errorMessage = strdup(errString.c_str());+        return 0;+    } }  JITTargetAddress LLVM_Hs_JITSymbol_getAddress(LLVMJITSymbolRef symbol,

@@ -89,6 +89,10 @@  instance ChildOf Metadata MDNode +data MDTuple++instance ChildOf MDNode MDTuple+ -- | <http://llvm.org/doxygen/classllvm_1_1MDString.html> data MDString @@ -99,6 +103,166 @@  instance ChildOf Metadata MDValue +-- | https://llvm.org/doxygen/classllvm_1_1DIExpression.html+data DIExpression++instance ChildOf MDNode DIExpression++-- | https://llvm.org/doxygen/classllvm_1_1DIGlobalVariableExpression.html+data DIGlobalVariableExpression++instance ChildOf MDNode DIGlobalVariableExpression++-- | https://llvm.org/doxygen/classllvm_1_1DILocation.html+data DILocation++instance ChildOf MDNode DILocation++-- | https://llvm.org/doxygen/classllvm_1_1DINode.html+data DINode++instance ChildOf MDNode DINode++-- | https://llvm.org/doxygen/classllvm_1_1DIImportedEntity.html+data DIImportedEntity++instance ChildOf DINode DIImportedEntity++-- | https://llvm.org/doxygen/classllvm_1_1DIObjCProperty.html+data DIObjCProperty++instance ChildOf DINode DIObjCProperty++-- | https://llvm.org/doxygen/classllvm_1_1DISubrange.html+data DISubrange++instance ChildOf DINode DISubrange++-- | https://llvm.org/doxygen/classllvm_1_1DIEnumerator.html+data DIEnumerator++instance ChildOf DINode DIEnumerator++-- | https://llvm.org/doxygen/classllvm_1_1DIVariable.html+data DIVariable++instance ChildOf DINode DIVariable++-- | https://llvm.org/doxygen/classllvm_1_1DILocalVariable.html+data DILocalVariable++instance ChildOf DIVariable DILocalVariable++-- | https://llvm.org/doxygen/classllvm_1_1DIGlobalVariable.html+data DIGlobalVariable++instance ChildOf DIVariable DIGlobalVariable++-- | https://llvm.org/doxygen/classllvm_1_1DITemplateParameter.html+data DITemplateParameter++instance ChildOf DINode DITemplateParameter++-- | https://llvm.org/doxygen/classllvm_1_1DITemplateTypeParameter.html+data DITemplateTypeParameter++instance ChildOf DITemplateParameter DITemplateTypeParameter++-- | https://llvm.org/doxygen/classllvm_1_1DITemplateValueParameter.html+data DITemplateValueParameter++instance ChildOf DITemplateParameter DITemplateValueParameter++-- | https://llvm.org/doxygen/classllvm_1_1DIScope.html+data DIScope++instance ChildOf DINode DIScope++-- | https://llvm.org/doxygen/classllvm_1_1DIModule.html+data DIModule++instance ChildOf DIScope DIModule++-- | https://llvm.org/doxygen/classllvm_1_1DINamespace.html+data DINamespace++instance ChildOf DIScope DINamespace++-- | https://llvm.org/doxygen/classllvm_1_1DIFile.html+data DIFile++instance ChildOf DIScope DIFile++-- | https://llvm.org/doxygen/classllvm_1_1DICompileUnit.html+data DICompileUnit++instance ChildOf DIScope DICompileUnit++-- | https://llvm.org/doxygen/classllvm_1_1DIType.html+data DIType++instance ChildOf DIScope DIType++-- | https://llvm.org/doxygen/classllvm_1_1DIBasicType.html+data DIBasicType++instance ChildOf DIType DIBasicType++-- | https://llvm.org/doxygen/classllvm_1_1DIDerivedType.html+data DIDerivedType++instance ChildOf DIType DIDerivedType++-- | https://llvm.org/doxygen/classllvm_1_1DISubroutineType.html+data DISubroutineType++instance ChildOf DIType DISubroutineType++-- | https://llvm.org/doxygen/classllvm_1_1DICompositeType.html+data DICompositeType++instance ChildOf DIType DICompositeType++-- | https://llvm.org/doxygen/classllvm_1_1DILocalScope.html+data DILocalScope++instance ChildOf DIScope DILocalScope++-- | <https://llvm.org/doxygen/classllvm_1_1DILexicalBlockBase.html>+data DILexicalBlockBase++instance ChildOf DILocalScope DILexicalBlockBase++-- | <https://llvm.org/doxygen/classllvm_1_1DILexicalBlock.html>+data DILexicalBlock++instance ChildOf DILexicalBlockBase DILexicalBlock++-- | <https://llvm.org/doxygen/classllvm_1_1DILexicalBlockFile.html>+data DILexicalBlockFile++instance ChildOf DILexicalBlockBase DILexicalBlockFile++-- | <https://llvm.org/doxygen/classllvm_1_1DISubprogram.html>+data DISubprogram++instance ChildOf DILocalScope DISubprogram++-- <https://llvm.org/doxygen/classllvm_1_1DIMacroNode.html>+data DIMacroNode++instance ChildOf MDNode DIMacroNode++-- <https://llvm.org/doxygen/classllvm_1_1DIMacro.html>+data DIMacro++instance ChildOf DIMacroNode DIMacro++-- <https://llvm.org/doxygen/classllvm_1_1DIMacroFile.html>+data DIMacroFile++instance ChildOf DIMacroNode DIMacroFile+ -- | <http://llvm.org/doxygen/classllvm_1_1NamedMDNode.html> data NamedMetadata @@ -125,3 +289,6 @@ data RawPWriteStream  instance ChildOf RawOStream RawPWriteStream++-- | <https://llvm.org/doxygen/classllvm_1_1StringRef.html>+data StringRef

@@ -78,7 +78,7 @@ structTypeInContext ctx (n, ts) p = structTypeInContext' ctx ts n p  foreign import ccall unsafe "LLVM_Hs_StructCreateNamed" structCreateNamed ::-  Ptr Context -> CString -> IO (Ptr Type)+  Ptr Context -> CString -> Ptr (OwnerTransfered CString) -> IO (Ptr Type)  foreign import ccall unsafe "LLVMGetStructName" getStructName ::   Ptr Type -> IO CString

@@ -8,10 +8,13 @@  extern "C" { -LLVMTypeRef LLVM_Hs_StructCreateNamed(LLVMContextRef C, const char *Name) {+LLVMTypeRef LLVM_Hs_StructCreateNamed(LLVMContextRef C, const char *Name, char** renamedName) {     if (Name) {-        return wrap(StructType::create(*unwrap(C), Name));+        auto t = StructType::create(*unwrap(C), Name);+        *renamedName = strdup(t->getName().str().c_str());+        return wrap(t);     } else {+        *renamedName = nullptr;         return wrap(StructType::create(*unwrap(C)));     } }

@@ -350,10 +350,10 @@                           -- We need to convert nClauses to a signed                           -- value before subtracting                           forM [0..fromIntegral nClauses - (1 :: Int)] $ \j -> do-                          v <- liftIO $ FFI.getClause i (fromIntegral j)-                          c <- decodeM v-                          t <- typeOf v-                          return $ case t of { A.ArrayType _ _ -> A.Filter; _ -> A.Catch} $ c |])+                            v <- liftIO $ FFI.getClause i (fromIntegral j)+                            c <- decodeM v+                            t <- typeOf v+                            return $ case t of { A.ArrayType _ _ -> A.Filter; _ -> A.Catch} $ c |])                 "functionAttributes" -> (["attrs"], [| return $ functionAttributes $(TH.dyn "attrs") |])                 "type'" -> ([], [| return t |])                 "incomingValues" ->

@@ -23,6 +23,8 @@ import LLVM.Internal.DecodeAST import LLVM.Internal.Value () +import Foreign.C+ instance EncodeM EncodeAST ShortByteString FFI.MDKindID where   encodeM s = do     Context c <- gets encodeStateContext@@ -33,7 +35,7 @@ getMetadataKindNames (Context c) = scopeAnyCont $ do   let g n = do         ps <- allocaArray n-        ls <- allocaArray n +        ls <- allocaArray n         n' <- liftIO $ FFI.getMDKindNames c ps ls n         if n' > n          then g n'@@ -49,8 +51,14 @@   decodeM (FFI.MDKindID k) = gets $ (Array.! (fromIntegral k)) . metadataKinds  instance DecodeM DecodeAST ShortByteString (Ptr FFI.MDString) where-  decodeM p = do-    np <- alloca-    s <- liftIO $ FFI.getMDString p np-    n <- peek np-    decodeM (s, n)+  -- LLVM appears to use null pts to indicate empty byte string fields+  -- including literal empty strings+  decodeM = getByteStringFromFFI FFI.getMDStringValue++getByteStringFromFFI :: (Ptr a -> Ptr CUInt -> IO CString) -> Ptr a -> DecodeAST ShortByteString+getByteStringFromFFI _ p | nullPtr == p = return mempty+getByteStringFromFFI f p = do+  np <- alloca+  s <- liftIO $ f p np+  n <- peek np+  decodeM (s, n)

@@ -41,7 +41,7 @@ import qualified LLVM.Internal.FFI.Value as FFI  import LLVM.Internal.Attribute-import LLVM.Internal.BasicBlock  +import LLVM.Internal.BasicBlock import LLVM.Internal.Coding import LLVM.Internal.Context import LLVM.Internal.DecodeAST@@ -259,8 +259,8 @@       sequencePhases l = (l >>= (sequence >=> sequence >=> sequence >=> sequence)) >> (return ())   sequencePhases $ forM definitions $ \d -> case d of    A.TypeDefinition n t -> do-     t' <- createNamedType n-     defineType n t'+     (t', n') <- createNamedType n+     defineType n n' t'      return $ do        traverse_ (setNamedType t') t        return . return . return . return $ ()@@ -272,19 +272,19 @@      liftIO $ FFI.setCOMDATSelectionKind cd csk      defineCOMDAT n cd      return . return . return . return . return $ ()-     -   A.MetadataNodeDefinition i os -> return . return $ do++   A.MetadataNodeDefinition i md -> return . return $ do      t <- liftIO $ FFI.createTemporaryMDNodeInContext context      defineMDNode i t      return $ do-       n <- encodeM (A.MetadataNode os)+       n <- encodeM md        liftIO $ FFI.metadataReplaceAllUsesWith (FFI.upCast t) (FFI.upCast n)        defineMDNode i n        return $ return ()     A.NamedMetadataDefinition n ids -> return . return . return . return $ do      n <- encodeM n-     ids <- encodeM (map A.MetadataNodeReference ids)+     ids <- encodeM (map A.MDRef ids :: [A.MDRef A.MDNode])      nm <- liftIO $ FFI.getOrAddNamedMetadata ffiMod n      liftIO $ FFI.namedMetadataAddOperands nm ids      return ()@@ -318,6 +318,7 @@            setSection g' (A.G.section g)            setCOMDAT g' (A.G.comdat g)            setAlignment g' (A.G.alignment g)+           setMetadata (FFI.upCast g') (A.G.metadata g)            return (FFI.upCast g')        (a@A.G.GlobalAlias { A.G.name = n }) -> do          typ <- encodeM (A.G.type' a)@@ -331,7 +332,7 @@            setThreadLocalMode a' (A.G.threadLocalMode a)            (liftIO . FFI.setAliasee a') =<< encodeM (A.G.aliasee a)            return (FFI.upCast a')-       (A.Function _ _ _ cc rAttrs resultType fName (args, isVarArgs) attrs _ _ _ gc prefix blocks personality) -> do+       (A.Function _ _ _ cc rAttrs resultType fName (args, isVarArgs) attrs _ _ _ gc prefix blocks personality metadata) -> do          typ <- encodeM $ A.FunctionType resultType [t | A.Parameter t _ _ <- args] isVarArgs          f <- liftIO . withName fName $ \fName -> FFI.addFunction ffiMod fName typ          defineGlobal fName f@@ -367,6 +368,7 @@            sequence_ finishInstrs            locals <- gets $ Map.toList . encodeStateLocals            forM_ [ n | (n, ForwardValue _) <- locals ] $ \n -> undefinedReference "local" n+           setMetadata (FFI.upCast f) metadata            return (FFI.upCast f)      return $ do        g' <- eg'@@ -404,6 +406,7 @@         <*> getSection g         <*> getCOMDATName g         <*> getAlignment g+        <*> getMetadata (FFI.upCast g)  -- This returns a nested DecodeAST to allow interleaving of different -- decoding steps. Take a look at the call site in moduleAST for more@@ -426,6 +429,21 @@         <*> return as         <*> (decodeM =<< (liftIO $ FFI.getAliasee a)) +getMetadata :: Ptr FFI.GlobalObject -> DecodeAST [(ShortByteString, A.MDRef A.MDNode)]+getMetadata o = scopeAnyCont $ do+  n <- liftIO (FFI.getNumMetadata o)+  ks <- allocaArray n+  ps <- allocaArray n+  liftIO (FFI.getAllMetadata o ks ps)+  zip <$> decodeM (n, ks) <*> decodeM (n, ps)++setMetadata :: Ptr FFI.GlobalObject -> [(ShortByteString, A.MDRef A.MDNode)] -> EncodeAST ()+setMetadata o md =+  forM_ md $ \(kindName, node) -> do+    kindID <- encodeM kindName+    node <- encodeM node+    liftIO (FFI.setMetadata o kindID node)+ -- This returns a nested DecodeAST to allow interleaving of different -- decoding steps. Take a look at the call site in moduleAST for more -- details.@@ -469,6 +487,7 @@           <*> getPrefixData f           <*> decodeBlocks           <*> getPersonalityFn f+          <*> getMetadata (FFI.upCast f)  decodeNamedMetadataDefinitions :: Ptr FFI.Module -> DecodeAST [A.Definition] decodeNamedMetadataDefinitions mod = do@@ -482,8 +501,8 @@       A.NamedMetadataDefinition         <$> (decodeM $ FFI.getNamedMetadataName nm)         <*> fmap-              (map (\(A.MetadataNodeReference mid) -> mid))-              (decodeM (n, os))+              (map (\(A.MDRef mid) -> mid))+              (decodeM (n, os) :: DecodeAST [A.MDRef A.MDNode])  -- | Get an LLVM.AST.'LLVM.AST.Module' from a LLVM.'Module' - i.e. -- raise C++ objects into an Haskell AST.

@@ -0,0 +1,28 @@+module LLVM.Internal.ObjectFile where++import Control.Monad.IO.Class+import Control.Monad.AnyCont+import Foreign.Ptr++import LLVM.Prelude+import LLVM.Internal.Coding+import LLVM.Internal.MemoryBuffer+import qualified LLVM.Internal.FFI.ObjectFile as FFI++newtype ObjectFile = ObjectFile (Ptr FFI.ObjectFile)++-- | Dispose of an 'ObjectFile'.+disposeObjectFile :: ObjectFile -> IO ()+disposeObjectFile (ObjectFile obj) = FFI.disposeObjectFile obj++-- | Create a object file which can later be linked with the+-- 'LLVM.Internal.OrcJIT.LinkingLayer'.+--+-- Note that the file at `path` should already be a compiled object file i.e a+-- `.o` file. This does *not* compile source files.+createObjectFile :: FilePath -> IO ObjectFile+createObjectFile path = flip runAnyContT return $ do+  buf <- encodeM (File path)+  obj <- liftIO $ FFI.createObjectFile buf+  when (obj == nullPtr) $ error "LLVMCreateObjectFile returned a null pointer."+  return (ObjectFile obj)

@@ -1,131 +1,1148 @@ {-# LANGUAGE-  MultiParamTypeClasses-  #-}-module LLVM.Internal.Operand where--import LLVM.Prelude--import Control.Monad.State-import Control.Monad.AnyCont-import qualified Data.Map as Map--import Foreign.Ptr--import qualified LLVM.Internal.FFI.Constant as FFI-import qualified LLVM.Internal.FFI.InlineAssembly as FFI-import qualified LLVM.Internal.FFI.Metadata as FFI-import qualified LLVM.Internal.FFI.PtrHierarchy as FFI-import qualified LLVM.Internal.FFI.Value as FFI--import LLVM.Internal.Coding-import LLVM.Internal.Constant ()-import LLVM.Internal.Context-import LLVM.Internal.DecodeAST-import LLVM.Internal.EncodeAST-import LLVM.Internal.InlineAssembly ()-import LLVM.Internal.Metadata ()--import qualified LLVM.AST as A--instance DecodeM DecodeAST A.Operand (Ptr FFI.Value) where-  decodeM v = do-    c <- liftIO $ FFI.isAConstant v-    if (c /= nullPtr) -     then-      return A.ConstantOperand `ap` decodeM c-     else-      do m <- liftIO $ FFI.isAMetadataOperand v-         if (m /= nullPtr)-            then A.MetadataOperand <$> decodeM m-            else return A.LocalReference-                           `ap` (decodeM =<< (liftIO $ FFI.typeOf v))-                           `ap` getLocalName v--instance DecodeM DecodeAST A.Metadata (Ptr FFI.Metadata) where-  decodeM md = do-    s <- liftIO $ FFI.isAMDString md-    if (s /= nullPtr)-       then A.MDString <$> decodeM s-       else do n <- liftIO $ FFI.isAMDNode md-               if (n /= nullPtr)-                  then A.MDNode <$> decodeM n-                  else do v <- liftIO $ FFI.isAMDValue md-                          if (v /= nullPtr)-                              then A.MDValue <$> decodeM v-                              else fail "Metadata was not one of [MDString, MDValue, MDNode]"--instance DecodeM DecodeAST A.CallableOperand (Ptr FFI.Value) where-  decodeM v = do-    ia <- liftIO $ FFI.isAInlineAsm v-    if ia /= nullPtr-     then liftM Left (decodeM ia)-     else liftM Right (decodeM v)--instance EncodeM EncodeAST A.Operand (Ptr FFI.Value) where-  encodeM (A.ConstantOperand c) = (FFI.upCast :: Ptr FFI.Constant -> Ptr FFI.Value) <$> encodeM c-  encodeM (A.LocalReference t n) = do-    lv <- refer encodeStateLocals n $ do-      lv <- do-        n <- encodeM n-        t <- encodeM t-        v <- liftIO $ FFI.createArgument t n-        return $ ForwardValue v-      modify $ \s -> s { encodeStateLocals = Map.insert n lv $ encodeStateLocals s }-      return lv-    return $ case lv of DefinedValue v -> v; ForwardValue v -> v-  encodeM (A.MetadataOperand md) = do-    md' <- encodeM md-    Context c <- gets encodeStateContext-    liftIO $ FFI.upCast <$> FFI.metadataOperand c md'--instance EncodeM EncodeAST A.Metadata (Ptr FFI.Metadata) where-  encodeM (A.MDString s) = do-    Context c <- gets encodeStateContext-    s <- encodeM s-    liftM FFI.upCast $ liftIO $ FFI.mdStringInContext c s-  encodeM (A.MDNode mdn) = (FFI.upCast :: Ptr FFI.MDNode -> Ptr FFI.Metadata) <$> encodeM mdn-  encodeM (A.MDValue v) = do-     v <- encodeM v-     liftIO $ FFI.upCast <$> FFI.mdValue v--instance EncodeM EncodeAST A.CallableOperand (Ptr FFI.Value) where-  encodeM (Right o) = encodeM o-  encodeM (Left i) = liftM (FFI.upCast :: Ptr FFI.InlineAsm -> Ptr FFI.Value) (encodeM i)--instance EncodeM EncodeAST A.MetadataNode (Ptr FFI.MDNode) where-  encodeM (A.MetadataNode ops) = scopeAnyCont $ do-    Context c <- gets encodeStateContext-    ops <- encodeM ops-    liftIO $ FFI.createMDNodeInContext c ops-  encodeM (A.MetadataNodeReference n) = referMDNode n--instance DecodeM DecodeAST [Maybe A.Metadata] (Ptr FFI.MDNode) where-  decodeM p = scopeAnyCont $ do-    n <- liftIO $ FFI.getMDNodeNumOperands p-    ops <- allocaArray n-    liftIO $ FFI.getMDNodeOperands p ops-    decodeM (n, ops)--instance DecodeM DecodeAST A.Operand (Ptr FFI.MDValue) where-  decodeM = decodeM <=< liftIO . FFI.getMDValue--instance DecodeM DecodeAST A.Metadata (Ptr FFI.MetadataAsVal) where-  decodeM = decodeM <=< liftIO . FFI.getMetadataOperand--instance DecodeM DecodeAST A.MetadataNode (Ptr FFI.MDNode) where-  decodeM p = scopeAnyCont $ do--    -- fl <- decodeM =<< liftIO (FFI.mdNodeIsFunctionLocal p)-    -- if fl-    --  then-    --    return A.MetadataNode `ap` decodeM p-    --  else-       return A.MetadataNodeReference `ap` getMetadataNodeID p--getMetadataDefinitions :: DecodeAST [A.Definition]-getMetadataDefinitions = fix $ \continue -> do-  mdntd <- takeMetadataNodeToDefine-  flip (maybe (return [])) mdntd $ \(mid, p) -> do-    return (:)-      `ap` (return A.MetadataNodeDefinition `ap` return mid `ap` decodeM p)-      `ap` continue+  DuplicateRecordFields,+  MultiParamTypeClasses,+  NamedFieldPuns,+  OverloadedStrings,+  PatternSynonyms,+  QuasiQuotes,+  RecordWildCards,+  ScopedTypeVariables,+  TemplateHaskell+  #-}+module LLVM.Internal.Operand where++import LLVM.Prelude++import LLVM.Exception++import Control.Monad.Catch+import Control.Monad.State+import Control.Monad.AnyCont+import Data.Bits+import Data.Functor.Identity+import qualified Data.Map as Map+import Data.Maybe (mapMaybe)++import Foreign.Ptr++import qualified LLVM.Internal.FFI.Constant as FFI+import qualified LLVM.Internal.FFI.InlineAssembly as FFI+import qualified LLVM.Internal.FFI.LLVMCTypes as FFI+import qualified LLVM.Internal.FFI.Metadata as FFI+import qualified LLVM.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.Internal.FFI.Value as FFI++import LLVM.Internal.Coding+import LLVM.Internal.Constant ()+import LLVM.Internal.Context+import LLVM.Internal.DecodeAST+import LLVM.Internal.EncodeAST+import LLVM.Internal.InlineAssembly ()+import LLVM.Internal.Metadata (getByteStringFromFFI)++import qualified LLVM.AST as A hiding (GlobalVariable, Module, PointerType, type')+import qualified LLVM.AST.Operand as A++import LLVM.Internal.FFI.LLVMCTypes (mdSubclassIdP)++instance EncodeM EncodeAST ShortByteString (Ptr FFI.MDString) where+  encodeM s = do+    s' <- encodeM s+    Context c <- gets encodeStateContext+    liftIO (FFI.getMDString c s')++instance Applicative m => EncodeM m [A.DIFlag] FFI.DIFlags where+  encodeM fs = pure (FFI.DIFlags (foldl' (.|.) 0 (map encodeFlag fs)))+    where+      encodeFlag f =+        case f of+          A.Accessibility A.Private -> 1+          A.Accessibility A.Protected -> 2+          A.Accessibility A.Public -> 3+          A.FwdDecl -> 1 `shiftL` 2+          A.AppleBlock -> 1 `shiftL` 3+          A.BlockByrefStruct -> 1 `shiftL` 4+          A.VirtualFlag -> 1 `shiftL` 5+          A.Artificial -> 1 `shiftL` 6+          A.Explicit -> 1 `shiftL` 7+          A.Prototyped -> 1 `shiftL` 8+          A.ObjcClassComplete -> 1 `shiftL` 9+          A.ObjectPointer -> 1 `shiftL` 10+          A.Vector -> 1 `shiftL` 11+          A.StaticMember -> 1 `shiftL` 12+          A.LValueReference -> 1 `shiftL` 13+          A.RValueReference -> 1 `shiftL` 14+          A.InheritanceFlag A.SingleInheritance -> 1 `shiftL` 16+          A.InheritanceFlag A.MultipleInheritance -> 2 `shiftL` 16+          A.InheritanceFlag A.VirtualInheritance -> 3 `shiftL` 16+          A.IntroducedVirtual -> 1 `shiftL` 18+          A.BitField -> 1 `shiftL` 19+          A.NoReturn -> 1 `shiftL` 20+          A.MainSubprogram -> 1 `shiftL` 21++instance Applicative m => DecodeM m [A.DIFlag] FFI.DIFlags where+  decodeM (FFI.DIFlags f) =+    pure $+    accessibility +++    inheritance +++    mapMaybe flagSet flags+    where+      flagSet :: A.DIFlag -> Maybe A.DIFlag+      flagSet f'+        | f'' .&. f /= 0 = Just f'+        | otherwise = Nothing+        where Identity (FFI.DIFlags f'') = encodeM [f']+      accessibility+        | testBit f 0 && testBit f 1 = [A.Accessibility A.Public]+        | testBit f 0 = [A.Accessibility A.Private]+        | testBit f 1 = [A.Accessibility A.Protected]+        | otherwise = []+      inheritance+        | testBit f 16 && testBit f 17 = [A.InheritanceFlag A.VirtualInheritance]+        | testBit f 16 = [A.InheritanceFlag A.SingleInheritance]+        | testBit f 17 = [A.InheritanceFlag A.MultipleInheritance]+        | otherwise = []+      flags =+        [ A.FwdDecl+        , A.AppleBlock+        , A.BlockByrefStruct+        , A.VirtualFlag+        , A.Artificial+        , A.Explicit+        , A.Prototyped+        , A.ObjcClassComplete+        , A.ObjectPointer+        , A.Vector+        , A.StaticMember+        , A.LValueReference+        , A.RValueReference+        , A.IntroducedVirtual+        , A.BitField+        , A.NoReturn+        , A.MainSubprogram+        ]++instance DecodeM DecodeAST A.Operand (Ptr FFI.Value) where+  decodeM v = do+    c <- liftIO $ FFI.isAConstant v+    if c /= nullPtr+     then+      return A.ConstantOperand `ap` decodeM c+     else+      do m <- liftIO $ FFI.isAMetadataOperand v+         if m /= nullPtr+            then A.MetadataOperand <$> decodeM m+            else A.LocalReference+                   <$> (decodeM =<< liftIO (FFI.typeOf v))+                   <*> getLocalName v++instance DecodeM DecodeAST A.Metadata (Ptr FFI.Metadata) where+  decodeM md = do+    s <- liftIO $ FFI.isAMDString md+    if s /= nullPtr+      then A.MDString <$> decodeM s+      else do+        n <- liftIO $ FFI.isAMDNode md+        if n /= nullPtr+          then A.MDNode <$> decodeM n+          else do v <- liftIO $ FFI.isAMDValue md+                  if v /= nullPtr+                    then A.MDValue <$> decodeM v+                    else throwM (DecodeException "Metadata was not one of [MDString, MDValue, MDNode]")++instance DecodeM DecodeAST A.DINode (Ptr FFI.DINode) where+  decodeM diN = do+    sId <- liftIO $ FFI.getMetadataClassId (FFI.upCast diN)+    case sId of+      [mdSubclassIdP|DIEnumerator|] ->+        A.DIEnumerator <$> decodeM (castPtr diN :: Ptr FFI.DIEnumerator)+      [mdSubclassIdP|DIImportedEntity|] -> A.DIImportedEntity <$> decodeM (castPtr diN :: Ptr FFI.DIImportedEntity)+      [mdSubclassIdP|DIObjCProperty|]   -> A.DIObjCProperty <$> decodeM (castPtr diN :: Ptr FFI.DIObjCProperty)+      [mdSubclassIdP|DISubrange|]       -> A.DISubrange <$> decodeM (castPtr diN :: Ptr FFI.DISubrange)+      [mdSubclassIdP|DIBasicType|]        -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DICompositeType|]    -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DIDerivedType|]      -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DISubroutineType|]   -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DILexicalBlock|]     -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DILexicalBlockFile|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DIFile|]             -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DINamespace|]        -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DISubprogram|]       -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DICompileUnit|]      -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)+      [mdSubclassIdP|DIModule|]           -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope)++      [mdSubclassIdP|DIGlobalVariable|] -> A.DIVariable <$> decodeM (castPtr diN :: Ptr FFI.DIVariable)+      [mdSubclassIdP|DILocalVariable|]  -> A.DIVariable <$> decodeM (castPtr diN :: Ptr FFI.DIVariable)++      [mdSubclassIdP|DITemplateTypeParameter|]  -> A.DITemplateParameter <$> decodeM (castPtr diN :: Ptr FFI.DITemplateParameter)+      [mdSubclassIdP|DITemplateValueParameter|] -> A.DITemplateParameter <$> decodeM (castPtr diN :: Ptr FFI.DITemplateParameter)++      _ -> throwM (DecodeException ("Unknown subclass id for DINode: " <> show sId))++instance EncodeM EncodeAST A.DISubrange (Ptr FFI.DISubrange) where+  encodeM (A.Subrange {..}) = do+    Context c <- gets encodeStateContext+    liftIO (FFI.getDISubrange c count lowerBound)++instance DecodeM DecodeAST A.DISubrange (Ptr FFI.DISubrange) where+  decodeM r = do+    count <- liftIO (FFI.getDISubrangeCount r)+    lowerBound <- liftIO (FFI.getDISubrangeLowerBound r)+    pure (A.Subrange count lowerBound)++instance EncodeM EncodeAST A.DIEnumerator (Ptr FFI.DIEnumerator) where+  encodeM (A.Enumerator {..}) = do+    name <- encodeM name+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIEnumerator c value name)++instance DecodeM DecodeAST A.DIEnumerator (Ptr FFI.DIEnumerator) where+  decodeM e = do+    value <- liftIO (FFI.getDIEnumeratorValue e)+    name <- decodeM =<< liftIO (FFI.getDIEnumeratorName e)+    pure (A.Enumerator value name)++instance EncodeM EncodeAST A.DINode (Ptr FFI.DINode) where+  encodeM (A.DISubrange r) = do+    ptr <- encodeM r+    pure (FFI.upCast (ptr :: Ptr FFI.DISubrange))+  encodeM (A.DIEnumerator e) = do+    ptr <- encodeM e+    pure (FFI.upCast (ptr :: Ptr FFI.DIEnumerator))+  encodeM (A.DIScope s) = do+    ptr <- encodeM s+    pure (FFI.upCast (ptr :: Ptr FFI.DIScope))+  encodeM (A.DIVariable v) = do+    ptr <- encodeM v+    pure (FFI.upCast (ptr :: Ptr FFI.DIVariable))+  encodeM (A.DITemplateParameter p) = do+    ptr <- encodeM p+    pure (FFI.upCast (ptr :: Ptr FFI.DITemplateParameter))+  encodeM (A.DIImportedEntity e) = do+    ptr <- encodeM e+    pure (FFI.upCast (ptr :: Ptr FFI.DIImportedEntity))+  encodeM (A.DIObjCProperty o) = FFI.upCast <$> (encodeM o :: EncodeAST (Ptr FFI.DIObjCProperty))++instance DecodeM DecodeAST A.DIScope (Ptr FFI.DIScope) where+  decodeM p = do+    sId <- liftIO $ FFI.getMetadataClassId (FFI.upCast p)+    case sId of+      [mdSubclassIdP|DINamespace|] -> A.DINamespace <$> decodeM (castPtr p :: Ptr FFI.DINamespace)+      [mdSubclassIdP|DIFile|] -> A.DIFile <$> decodeM (castPtr p :: Ptr FFI.DIFile)+      [mdSubclassIdP|DILexicalBlock|]     -> A.DILocalScope <$> decodeM (castPtr p :: Ptr FFI.DILocalScope)+      [mdSubclassIdP|DILexicalBlockFile|] -> A.DILocalScope <$> decodeM (castPtr p :: Ptr FFI.DILocalScope)+      [mdSubclassIdP|DISubprogram|]       -> A.DILocalScope <$> decodeM (castPtr p :: Ptr FFI.DILocalScope)++      [mdSubclassIdP|DIBasicType|]      -> A.DIType <$> decodeM (castPtr p :: Ptr FFI.DIType)+      [mdSubclassIdP|DICompositeType|]  -> A.DIType <$> decodeM (castPtr p :: Ptr FFI.DIType)+      [mdSubclassIdP|DIDerivedType|]    -> A.DIType <$> decodeM (castPtr p :: Ptr FFI.DIType)+      [mdSubclassIdP|DISubroutineType|] -> A.DIType <$> decodeM (castPtr p :: Ptr FFI.DIType)++      [mdSubclassIdP|DICompileUnit|] -> A.DICompileUnit <$> decodeM (castPtr p :: Ptr FFI.DICompileUnit)+      [mdSubclassIdP|DIModule|]      -> A.DIModule <$> decodeM (castPtr p :: Ptr FFI.DIModule)++      _ -> throwM (DecodeException ("Unknown subclass id for DIScope: " <> show sId))++instance DecodeM DecodeAST A.DINamespace (Ptr FFI.DINamespace) where+  decodeM p = do+    scope <- decodeM =<< liftIO (FFI.getScopeScope (FFI.upCast p))+    name  <- getByteStringFromFFI FFI.getScopeName (FFI.upCast p)+    exported <- decodeM =<< liftIO (FFI.getNamespaceExportedSymbols (castPtr p))+    return (A.Namespace name scope exported)++instance EncodeM EncodeAST A.DINamespace (Ptr FFI.DINamespace) where+  encodeM A.Namespace {..} = do+    name <- encodeM name+    scope <- encodeM scope+    exportSyms <- encodeM exportSymbols+    Context c <- gets encodeStateContext+    liftIO (FFI.getDINamespace c scope name exportSyms)++instance DecodeM DecodeAST A.DIModule (Ptr FFI.DIModule) where+  decodeM p = do+    scope <- decodeM =<< liftIO (FFI.getScopeScope (FFI.upCast p))+    name <- getByteStringFromFFI FFI.getScopeName (FFI.upCast p)+    let m = castPtr p :: Ptr FFI.DIModule+    configurationMacros <- decodeM =<< liftIO (FFI.getDIModuleConfigurationMacros m)+    includePath <- decodeM =<< liftIO (FFI.getDIModuleIncludePath m)+    isysRoot <- decodeM =<< liftIO (FFI.getDIModuleISysRoot m)+    pure A.Module+      { A.scope = scope+      , A.name = name+      , A.configurationMacros = configurationMacros+      , A.includePath = includePath+      , A.isysRoot = isysRoot+      }++instance EncodeM EncodeAST A.DIModule (Ptr FFI.DIModule) where+  encodeM A.Module {..} = do+    scope <- encodeM scope+    name <- encodeM name+    configurationMacros <- encodeM configurationMacros+    includePath <- encodeM includePath+    isysRoot <- encodeM isysRoot+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIModule c scope name configurationMacros includePath isysRoot)++genCodingInstance [t|A.DebugEmissionKind|] ''FFI.DebugEmissionKind+  [ (FFI.NoDebug, A.NoDebug)+  , (FFI.FullDebug, A.FullDebug)+  , (FFI.LineTablesOnly, A.LineTablesOnly)+  ]++instance DecodeM DecodeAST A.DICompileUnit (Ptr FFI.DICompileUnit) where+  decodeM p = do+    language <- decodeM =<< liftIO (FFI.getDICompileUnitLanguage p)+    file <- decodeM =<< liftIO (FFI.getScopeFile (FFI.upCast p))+    producer <- decodeM =<< liftIO (FFI.getDICompileUnitProducer p)+    optimized <- decodeM =<< liftIO (FFI.getDICompileUnitOptimized p)+    flags <- decodeM =<< liftIO (FFI.getDICompileUnitFlags p)+    runtimeVersion <- decodeM =<< liftIO (FFI.getDICompileUnitRuntimeVersion p)+    splitDebugFilename <- decodeM =<< liftIO (FFI.getDICompileUnitSplitDebugFilename p)+    emissionKind <- decodeM =<< liftIO (FFI.getDICompileUnitEmissionKind p)+    dwoid <- decodeM =<< liftIO (FFI.getDICompileUnitDWOId p)+    splitDebugInlining <- decodeM =<< liftIO (FFI.getDICompileUnitSplitDebugInlining p)+    debugInfoForProfiling <- decodeM =<< liftIO (FFI.getDICompileUnitDebugInfoForProfiling p)+    gnuPubnames <- decodeM =<< liftIO (FFI.getDICompileUnitGnuPubnames p)+    enums <- decodeM =<< liftIO (FFI.getDICompileUnitEnumTypes p)+    retainedTypes' <- decodeM =<< liftIO (FFI.getDICompileUnitRetainedTypes p)+    let toRetainedType :: A.MDRef A.DIScope -> DecodeAST (A.MDRef (Either A.DIType A.DISubprogram))+        toRetainedType (A.MDRef i) = pure (A.MDRef i)+        toRetainedType (A.MDInline (A.DIType ty)) = pure (A.MDInline (Left ty))+        toRetainedType (A.MDInline (A.DILocalScope (A.DISubprogram p))) = pure (A.MDInline (Right p))+        toRetainedType (A.MDInline e) = throwM (DecodeException ("Retained type must be DISubprogram or DIType but got " <> show e))+    retainedTypes <- traverse toRetainedType retainedTypes'+    globals <- decodeM =<< liftIO (FFI.getDICompileUnitGlobalVariables p)+    entities <- decodeM =<< liftIO (FFI.getDICompileUnitImportedEntities p)+    macros <- decodeM =<< liftIO (FFI.getDICompileUnitMacros p)+    pure A.CompileUnit+      { A.language = language+      , A.file = file+      , A.producer = producer+      , A.optimized = optimized+      , A.flags = flags+      , A.runtimeVersion = runtimeVersion+      , A.splitDebugFileName = splitDebugFilename+      , A.emissionKind = emissionKind+      , A.enums = enums+      , A.retainedTypes = retainedTypes+      , A.globals = globals+      , A.imports = entities+      , A.macros = macros+      , A.dWOId = dwoid+      , A.splitDebugInlining = splitDebugInlining+      , A.debugInfoForProfiling = debugInfoForProfiling+      , A.gnuPubnames = gnuPubnames+      }++instance EncodeM EncodeAST A.DICompileUnit (Ptr FFI.DICompileUnit) where+  encodeM (A.CompileUnit {..}) = do+    language <- encodeM language+    file <- encodeM file+    producer <- encodeM producer+    optimized <- encodeM optimized+    flags <- encodeM flags+    runtimeVersion <- encodeM runtimeVersion+    debugFileName <- encodeM splitDebugFileName+    emissionKind <- encodeM emissionKind+    enums <- encodeM enums+    retainedTypes <- encodeM (map (fmap (either A.DIType (A.DILocalScope . A.DISubprogram))) retainedTypes)+    globals <- encodeM globals+    imports <- encodeM imports+    macros <- encodeM macros+    dwoid <- encodeM dWOId+    splitDebugInlining <- encodeM splitDebugInlining+    debugInfoForProfiling <- encodeM debugInfoForProfiling+    gnuPubnames <- encodeM gnuPubnames+    Context c <- gets encodeStateContext+    liftIO $ FFI.getDICompileUnit+      c+      language file producer optimized flags+      runtimeVersion debugFileName emissionKind enums retainedTypes+      globals imports macros dwoid splitDebugInlining+      debugInfoForProfiling+      gnuPubnames++instance EncodeM EncodeAST A.DIScope (Ptr FFI.DIScope) where+  encodeM (A.DIFile f) = FFI.upCast <$> (encodeM f :: EncodeAST (Ptr FFI.DIFile))+  encodeM (A.DICompileUnit cu) = FFI.upCast <$> (encodeM cu :: EncodeAST (Ptr FFI.DICompileUnit))+  encodeM (A.DIType t) = FFI.upCast <$> (encodeM t :: EncodeAST (Ptr FFI.DIType))+  encodeM (A.DILocalScope t) = FFI.upCast <$> (encodeM t :: EncodeAST (Ptr FFI.DILocalScope))+  encodeM (A.DINamespace ns) = FFI.upCast <$> (encodeM ns :: EncodeAST (Ptr FFI.DINamespace))+  encodeM (A.DIModule m) = FFI.upCast <$> (encodeM m :: EncodeAST (Ptr FFI.DIModule))++instance DecodeM DecodeAST A.DIFile (Ptr FFI.DIFile) where+  decodeM diF = do+    fname <- decodeM =<< liftIO (FFI.getFileFilename diF)+    dir   <- decodeM =<< liftIO (FFI.getFileDirectory diF)+    cksum <- decodeM =<< liftIO (FFI.getFileChecksum diF)+    csk   <- decodeM =<< liftIO (FFI.getFileChecksumKind diF)+    return $ A.File fname dir cksum csk++instance EncodeM EncodeAST A.DIFile (Ptr FFI.DIFile) where+  encodeM (A.File {A.filename, A.directory, A.checksum, A.checksumKind}) = do+    filename <- encodeM filename+    directory <- encodeM directory+    checksum <- encodeM checksum+    checksumKind <- encodeM checksumKind+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIFile c filename directory checksumKind checksum)++instance EncodeM EncodeAST (Maybe A.Encoding) FFI.Encoding where+  encodeM Nothing = pure (FFI.Encoding 0)+  encodeM (Just e) = encodeM e++instance DecodeM DecodeAST (Maybe A.Encoding) FFI.Encoding where+  decodeM (FFI.Encoding 0) = pure Nothing+  decodeM e = Just <$> decodeM e++genCodingInstance [t|A.Encoding|] ''FFI.Encoding+  [ (FFI.DwAtE_address, A.AddressEncoding)+  , (FFI.DwAtE_boolean, A.BooleanEncoding)+  , (FFI.DwAtE_float, A.FloatEncoding)+  , (FFI.DwAtE_signed, A.SignedEncoding)+  , (FFI.DwAtE_signed_char, A.SignedCharEncoding)+  , (FFI.DwAtE_unsigned, A.UnsignedEncoding)+  , (FFI.DwAtE_unsigned_char, A.UnsignedCharEncoding)+  ]++genCodingInstance [t|A.ChecksumKind|] ''FFI.ChecksumKind+  [ (FFI.ChecksumKind 0, A.None)+  , (FFI.ChecksumKind 1, A.MD5)+  , (FFI.ChecksumKind 2, A.SHA1)+  ]++genCodingInstance [t|A.BasicTypeTag|] ''FFI.DwTag+  [ (FFI.DwTag_base_type, A.BaseType)+  , (FFI.DwTag_unspecified_type, A.UnspecifiedType)+  ]++instance EncodeM EncodeAST A.DIType (Ptr FFI.DIType) where+  encodeM (A.DIBasicType t) = FFI.upCast <$> (encodeM t :: EncodeAST (Ptr FFI.DIBasicType))+  encodeM (A.DIDerivedType t) = FFI.upCast <$> (encodeM t :: EncodeAST (Ptr FFI.DIDerivedType))+  encodeM (A.DISubroutineType t) = FFI.upCast <$> (encodeM t :: EncodeAST (Ptr FFI.DISubroutineType))+  encodeM (A.DICompositeType t) = FFI.upCast <$> (encodeM t :: EncodeAST (Ptr FFI.DICompositeType))++instance DecodeM DecodeAST A.DICompositeType (Ptr FFI.DICompositeType) where+  decodeM diTy = do+    tag <- liftIO (FFI.getTag (FFI.upCast diTy))+    size <- liftIO (FFI.getTypeSizeInBits (FFI.upCast diTy))+    align <- liftIO (FFI.getTypeAlignInBits (FFI.upCast diTy))+    elements <- liftIO (FFI.getElements diTy)+    scope <- decodeM =<< liftIO (FFI.getScopeScope (FFI.upCast diTy))+    name <- decodeM =<< liftIO (FFI.getTypeName (FFI.upCast diTy))+    file <- decodeM =<< liftIO (FFI.getScopeFile (FFI.upCast diTy))+    line <- liftIO (FFI.getTypeLine (FFI.upCast diTy))+    flags <- decodeM =<< liftIO (FFI.getTypeFlags (FFI.upCast diTy))+    runtimeLang <- liftIO (FFI.getRuntimeLang diTy)+    vtableHolder <- decodeM =<< liftIO (FFI.getVTableHolder diTy)+    type' <- decodeM =<< liftIO (FFI.getCompositeBaseType diTy)+    identifier <- decodeM =<< liftIO (FFI.getIdentifier diTy)+    case tag of+      FFI.DwTag_array_type -> do+        subscripts <- decodeM (FFI.TupleArray elements :: FFI.TupleArray FFI.DISubrange)+        pure (A.DIArrayType subscripts type' size align flags)+      FFI.DwTag_enumeration_type -> do+        values <- decodeM (FFI.TupleArray elements :: FFI.TupleArray FFI.DIEnumerator)+        pure (A.DIEnumerationType scope name file line values type' identifier size align)+      FFI.DwTag_structure_type -> do+        elements <- decodeM (FFI.TupleArray elements :: FFI.TupleArray FFI.DIScope)+        elements <- traverse fromCompElement elements+        pure (A.DIStructureType scope name file line flags type' elements runtimeLang vtableHolder identifier size align)+      FFI.DwTag_class_type -> do+        elements <- decodeM (FFI.TupleArray elements :: FFI.TupleArray FFI.DIScope)+        elements <- traverse fromCompElement elements+        vtableHolder <- decodeM =<< liftIO (FFI.getVTableHolder diTy)+        params <- decodeM =<< liftIO (FFI.getTemplateParams diTy)+        pure (A.DIClassType scope name file line flags type' elements vtableHolder params identifier size align)+      FFI.DwTag_union_type -> do+        elements <- decodeM (FFI.TupleArray elements :: FFI.TupleArray FFI.DIScope)+        elements <- traverse fromCompElement elements+        pure (A.DIUnionType scope name file line flags elements runtimeLang identifier size align)+      _ -> throwM (DecodeException ("Unknown tag of DICompositeType: " <> show tag))++fromCompElement :: A.MDRef A.DIScope -> DecodeAST (A.MDRef (Either A.DIDerivedType A.DISubprogram))+fromCompElement (A.MDRef r) = pure (A.MDRef r)+fromCompElement (A.MDInline (A.DIType (A.DIDerivedType ty))) = pure (A.MDInline (Left ty))+fromCompElement (A.MDInline (A.DILocalScope (A.DISubprogram p))) = pure (A.MDInline (Right p))+fromCompElement (A.MDInline e) = throwM (DecodeException ("Elements of DIClassType, DIStructureType and DIUnionType must be DIDerivedType or DISubprogram but got " <> show e))++toCompElement :: A.MDRef (Either A.DIDerivedType A.DISubprogram) -> A.MDRef A.DIScope+toCompElement = fmap (either (A.DIType . A.DIDerivedType) (A.DILocalScope . A.DISubprogram))++instance EncodeM EncodeAST A.DICompositeType (Ptr FFI.DICompositeType) where+  encodeM A.DIArrayType {..} = do+    subscripts <- encodeM subscripts+    elementTy <- encodeM elementTy+    flags <- encodeM flags+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIArrayType c subscripts elementTy sizeInBits alignInBits flags)+  encodeM A.DIEnumerationType {..} = do+    scope <- encodeM scope+    name <- encodeM name+    file <- encodeM file+    elements <- encodeM values+    underlyingType <- encodeM baseType+    identifier <- encodeM identifier+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIEnumerationType c scope name file line sizeInBits alignInBits elements underlyingType identifier)+  encodeM A.DIStructureType {..} = do+    scope <- encodeM scope+    name <- encodeM name+    file <- encodeM file+    flags <- encodeM flags+    derivedFrom <- encodeM derivedFrom+    elements <- encodeM (map toCompElement elements)+    vtableHolder <- encodeM vtableHolder+    identifier <- encodeM identifier+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIStructType c scope name file line sizeInBits alignInBits flags derivedFrom elements runtimeLang vtableHolder identifier)+  encodeM A.DIUnionType {..} = do+    scope <- encodeM scope+    name <- encodeM name+    file <- encodeM file+    flags <- encodeM flags+    elements <- encodeM (map toCompElement elements)+    identifier <- encodeM identifier+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIUnionType c scope name file line sizeInBits alignInBits flags elements runtimeLang identifier)+  encodeM A.DIClassType {..} = do+    scope <- encodeM scope+    name <- encodeM name+    file <- encodeM file+    flags <- encodeM flags+    derivedFrom <- encodeM derivedFrom+    elements <- encodeM (map toCompElement elements)+    vtableHolder <- encodeM vtableHolder+    params <- encodeM templateParams+    identifier <- encodeM identifier+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIClassType c scope name file line sizeInBits alignInBits flags derivedFrom elements vtableHolder params identifier)++instance DecodeM DecodeAST A.DIType (Ptr FFI.DIType) where+  decodeM diTy = do+    sId <- liftIO $ FFI.getMetadataClassId (FFI.upCast diTy)+    case sId of+      [mdSubclassIdP|DIBasicType|] ->+        A.DIBasicType <$> decodeM (castPtr diTy :: Ptr FFI.DIBasicType)+      [mdSubclassIdP|DICompositeType|] ->+        A.DICompositeType <$> decodeM (castPtr diTy :: Ptr FFI.DICompositeType)+      [mdSubclassIdP|DIDerivedType|]    -> A.DIDerivedType <$> decodeM (castPtr diTy :: Ptr FFI.DIDerivedType)+      [mdSubclassIdP|DISubroutineType|] -> A.DISubroutineType <$> decodeM (castPtr diTy :: Ptr FFI.DISubroutineType)+      _ -> throwM (DecodeException ("Unknown subclass id for DIType: " <> show sId))++instance DecodeM DecodeAST A.DIBasicType (Ptr FFI.DIBasicType) where+  decodeM diTy = do+    tag <- decodeM =<< liftIO (FFI.getTag (FFI.upCast diTy))+    size <- liftIO (FFI.getTypeSizeInBits (FFI.upCast diTy))+    align <- liftIO (FFI.getTypeAlignInBits (FFI.upCast diTy))+    name <- decodeM =<< liftIO (FFI.getTypeName (FFI.upCast diTy))+    encoding <- decodeM =<< liftIO (FFI.getBasicTypeEncoding diTy)+    pure (A.BasicType name size align encoding tag)++instance EncodeM EncodeAST A.DIBasicType (Ptr FFI.DIBasicType) where+  encodeM A.BasicType {..} = do+    tag <- encodeM typeTag+    typeName <- encodeM typeName+    typeEncoding <- encodeM typeEncoding+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIBasicType c tag typeName sizeInBits alignInBits typeEncoding)+++instance EncodeM EncodeAST A.DISubroutineType (Ptr FFI.DISubroutineType) where+  encodeM A.SubroutineType {..} = do+    flags <- encodeM typeFlags+    types <- encodeM typeTypeArray+    Context c <- gets encodeStateContext+    liftIO (FFI.getDISubroutineType c flags typeCC types)++instance DecodeM DecodeAST A.DISubroutineType (Ptr FFI.DISubroutineType) where+  decodeM p = do+    flags <- decodeM =<< liftIO (FFI.getTypeFlags (FFI.upCast p))+    cc <-  liftIO (FFI.getSubroutineCC p)+    arr <- decodeM =<< liftIO (FFI.getSubroutineTypeArray p)+    pure A.SubroutineType+      { A.typeFlags = flags+      , A.typeCC = cc+      , A.typeTypeArray = arr+      }++instance EncodeM EncodeAST A.DIDerivedType (Ptr FFI.DIDerivedType) where+  encodeM A.DerivedType {..} = do+    tag <- encodeM derivedTag+    name <- encodeM derivedName+    file <- encodeM derivedFile+    line <- encodeM derivedLine+    scope <- encodeM derivedScope+    type' <- encodeM derivedBaseType+    (addrSpace, addrSpacePresent) <- encodeM derivedAddressSpace+    flags <- encodeM derivedFlags+    Context c <- gets encodeStateContext+    FFI.upCast <$> liftIO (FFI.getDIDerivedType c tag name file line scope type' sizeInBits alignInBits derivedOffsetInBits addrSpace addrSpacePresent flags)++instance DecodeM DecodeAST A.DIDerivedType (Ptr FFI.DIDerivedType) where+  decodeM diTy = do+    let diTy' = FFI.upCast diTy+    name <- decodeM =<< liftIO (FFI.getTypeName diTy')+    file   <- decodeM =<< liftIO (FFI.getScopeFile (FFI.upCast diTy))+    scope  <- decodeM =<< liftIO (FFI.getScopeScope (FFI.upCast diTy))+    ty <- decodeM =<< liftIO (FFI.getDerivedBaseType diTy')+    line     <- liftIO (FFI.getTypeLine diTy')+    size     <- liftIO (FFI.getTypeSizeInBits diTy')+    align    <- liftIO (FFI.getTypeAlignInBits diTy')+    offset   <- liftIO (FFI.getTypeOffsetInBits diTy')+    tag      <- decodeM =<< liftIO (FFI.getTag (FFI.upCast diTy))+    flags <- decodeM =<< liftIO (FFI.getTypeFlags diTy')+    addressSpace <- decodeOptional (FFI.getDerivedAddressSpace diTy')+    pure A.DerivedType+      { A.derivedTag = tag+      , A.derivedName = name+      , A.derivedFile = file+      , A.derivedLine = line+      , A.derivedScope = scope+      , A.derivedBaseType = ty+      , A.sizeInBits = size+      , A.alignInBits = align+      , A.derivedOffsetInBits = offset+      , A.derivedAddressSpace = addressSpace+      , A.derivedFlags = flags+      }++genCodingInstance [t|A.DerivedTypeTag|] ''FFI.DwTag+  [ (FFI.DwTag_typedef, A.Typedef)+  , (FFI.DwTag_pointer_type, A.PointerType)+  , (FFI.DwTag_ptr_to_member_type, A.PtrToMemberType)+  , (FFI.DwTag_reference_type, A.ReferenceType)+  , (FFI.DwTag_rvalue_reference_type, A.RValueReferenceType)+  , (FFI.DwTag_const_type, A.ConstType)+  , (FFI.DwTag_volatile_type, A.VolatileType)+  , (FFI.DwTag_restrict_type, A.RestrictType)+  , (FFI.DwTag_atomic_type, A.AtomicType)+  , (FFI.DwTag_member, A.Member)+  , (FFI.DwTag_inheritance, A.Inheritance)+  , (FFI.DwTag_friend, A.Friend)+  ]++instance EncodeM EncodeAST A.DIVariable (Ptr FFI.DIVariable) where+  encodeM (A.DIGlobalVariable v) = do+    ptr <- encodeM v+    pure (FFI.upCast (ptr :: Ptr FFI.DIGlobalVariable))+  encodeM (A.DILocalVariable v) = do+    ptr <- encodeM v+    pure (FFI.upCast (ptr :: Ptr FFI.DILocalVariable))++instance DecodeM DecodeAST A.DIVariable (Ptr FFI.DIVariable) where+  decodeM p = do+    sId <- liftIO $ FFI.getMetadataClassId (FFI.upCast p)+    case sId of+      [mdSubclassIdP|DIGlobalVariable|] ->+        A.DIGlobalVariable <$> decodeM (castPtr p :: Ptr FFI.DIGlobalVariable)+      [mdSubclassIdP|DILocalVariable|] ->+        A.DILocalVariable <$> decodeM (castPtr p :: Ptr FFI.DILocalVariable)+      _ -> throwM (DecodeException ("Unknown subclass id for DIVariable: " <> show sId))++instance DecodeM DecodeAST A.DIGlobalVariable (Ptr FFI.DIGlobalVariable) where+  decodeM p = do+    name <- decodeM =<< liftIO (FFI.getDIVariableName (FFI.upCast p))+    scope <- decodeM =<< liftIO (FFI.getDIVariableScope (FFI.upCast p))+    file <- decodeM =<< liftIO (FFI.getDIVariableFile (FFI.upCast p))+    line <- decodeM =<< liftIO (FFI.getDIVariableLine (FFI.upCast p))+    type' <- decodeM =<< liftIO (FFI.getDIVariableType (FFI.upCast p))+    align <- liftIO (FFI.getDIVariableAlignInBits (FFI.upCast p))+    linkageName <- decodeM =<< liftIO (FFI.getDIGlobalVariableLinkageName p)+    local <- decodeM =<< liftIO (FFI.getDIGlobalVariableLocal p)+    definition <- decodeM =<< liftIO (FFI.getDIGlobalVariableDefinition p)+    decl <- decodeM =<< liftIO (FFI.getDIGlobalVariableStaticDataMemberDeclaration p)+    pure A.GlobalVariable+      { A.name = name+      , A.scope = scope+      , A.file = file+      , A.line = line+      , A.type' = type'+      , A.linkageName = linkageName+      , A.local = local+      , A.definition = definition+      , A.staticDataMemberDeclaration = decl+      , A.alignInBits = align+      }++instance EncodeM EncodeAST A.DIGlobalVariable (Ptr FFI.DIGlobalVariable) where+  encodeM A.GlobalVariable {..} = do+    name <- encodeM name+    scope <- encodeM scope+    file <- encodeM file+    line <- encodeM line+    type' <- encodeM type'+    linkageName <- encodeM linkageName+    local <- encodeM local+    definition <- encodeM definition+    dataMemberDeclaration <- encodeM staticDataMemberDeclaration+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIGlobalVariable c scope name linkageName file line type' local definition dataMemberDeclaration alignInBits)++instance DecodeM DecodeAST A.DILocalVariable (Ptr FFI.DILocalVariable) where+  decodeM p = do+    name <- decodeM =<< liftIO (FFI.getDIVariableName (FFI.upCast p))+    scope <- decodeM =<< liftIO (FFI.getDIVariableScope (FFI.upCast p))+    file <- decodeM =<< liftIO (FFI.getDIVariableFile (FFI.upCast p))+    line <- decodeM =<< liftIO (FFI.getDIVariableLine (FFI.upCast p))+    type' <- decodeM =<< liftIO (FFI.getDIVariableType (FFI.upCast p))+    align <- liftIO (FFI.getDIVariableAlignInBits (FFI.upCast p))+    arg <- liftIO (FFI.getDILocalVariableArg p)+    flags <- decodeM =<< liftIO (FFI.getDILocalVariableFlags p)+    pure A.LocalVariable+      { A.file = file+      , A.scope = scope+      , A.name = name+      , A.line = line+      , A.arg = arg+      , A.flags = flags+      , A.type' = type'+      , A.alignInBits = align+      }++instance EncodeM EncodeAST A.DILocalVariable (Ptr FFI.DILocalVariable) where+  encodeM A.LocalVariable {..} = do+    name <- encodeM name+    scope <- encodeM scope+    file <- encodeM file+    type' <- encodeM type'+    flags <- encodeM flags+    Context c <- gets encodeStateContext+    FFI.upCast <$> liftIO (FFI.getDILocalVariable c scope name file line type' arg flags alignInBits)++genCodingInstance [t|A.TemplateValueParameterTag|] ''FFI.DwTag+  [ (FFI.DwTag_template_value_parameter, A.TemplateValueParameter)+  , (FFI.DwTag_GNU_template_template_param, A.GNUTemplateTemplateParam)+  , (FFI.DwTag_GNU_template_parameter_pack, A.GNUTemplateParameterPack)+  ]++instance EncodeM EncodeAST A.DITemplateParameter (Ptr FFI.DITemplateParameter) where+  encodeM p = do+    name' <- encodeM (A.name (p :: A.DITemplateParameter)) :: EncodeAST (Ptr FFI.MDString)+    ty <- encodeM (A.type' (p :: A.DITemplateParameter))+    Context c <- gets encodeStateContext+    case p of+      A.DITemplateTypeParameter {} -> +        FFI.upCast <$> liftIO (FFI.getDITemplateTypeParameter c name' ty)+      A.DITemplateValueParameter {..} -> do+        tag <- encodeM tag+        value <- encodeM value+        FFI.upCast <$> liftIO (FFI.getDITemplateValueParameter c name' ty tag value)++instance DecodeM DecodeAST A.DITemplateParameter (Ptr FFI.DITemplateParameter) where+  decodeM p = do+    sId <- liftIO (FFI.getMetadataClassId (FFI.upCast p))+    name <- decodeM =<< liftIO (FFI.getDITemplateParameterName p)+    ty <- decodeM =<< liftIO (FFI.getDITemplateParameterType p)+    case sId of+      [mdSubclassIdP|DITemplateTypeParameter|] ->+        pure (A.DITemplateTypeParameter name ty)+      [mdSubclassIdP|DITemplateValueParameter|] -> do+        value <- decodeM =<< liftIO (FFI.getDITemplateValueParameterValue (castPtr p))+        tag <- decodeM =<< liftIO (FFI.getTag (FFI.upCast p))+        pure (A.DITemplateValueParameter name ty value tag)+      _ -> throwM (DecodeException ("Unknown subclass id for DITemplateParameter: " <> show sId))++genCodingInstance [t|A.Virtuality|] ''FFI.DwVirtuality+  [ (FFI.DwVirtuality_none, A.NoVirtuality)+  , (FFI.DwVirtuality_virtual, A.Virtual)+  , (FFI.DwVirtuality_pure_virtual, A.PureVirtual)+  ]++instance DecodeM DecodeAST A.DISubprogram (Ptr FFI.DISubprogram) where+  decodeM p = do+    name  <- getByteStringFromFFI FFI.getScopeName (FFI.upCast p)+    linkageName <- decodeM =<< liftIO (FFI.getDISubprogramLinkageName p)+    file  <- decodeM =<< liftIO (FFI.getScopeFile (FFI.upCast p))+    scope <- decodeM =<< liftIO (FFI.getScopeScope (FFI.upCast p))+    line <- decodeM =<< liftIO (FFI.getDISubprogramLine p)+    virtuality <- decodeM =<< liftIO (FFI.getDISubprogramVirtuality p)+    virtualIndex <- decodeM =<< liftIO (FFI.getDISubprogramVirtualIndex p)+    scopeLine <- decodeM =<< liftIO (FFI.getDISubprogramScopeLine p)+    optimized <- decodeM =<< liftIO (FFI.getDISubprogramIsOptimized p)+    definition <- decodeM =<< liftIO (FFI.getDISubprogramIsDefinition p)+    localToUnit <- decodeM =<< liftIO (FFI.getDISubprogramLocalToUnit p)+    thisAdjustment <- liftIO (FFI.getDISubprogramThisAdjustment p)+    flags <- decodeM =<< liftIO (FFI.getDISubprogramFlags p)+    type' <- decodeM =<< liftIO (FFI.getDISubprogramType p)+    containingType <- decodeM =<< liftIO (FFI.getDISubprogramContainingType p)+    unit <- decodeM =<< liftIO (FFI.getDISubprogramUnit p)+    templateParams <- decodeM =<< liftIO (FFI.getDISubprogramTemplateParams p)+    variables <- decodeM =<< liftIO (FFI.getDISubprogramVariables p)+    thrownTypes <- decodeM =<< liftIO (FFI.getDISubprogramThrownTypes p)+    decl <- decodeM =<< liftIO (FFI.getDISubprogramDeclaration p)+    pure A.Subprogram+      { A.name = name+      , A.linkageName = linkageName+      , A.scope = scope+      , A.file = file+      , A.line = line+      , A.type' = type'+      , A.definition = definition+      , A.scopeLine = scopeLine+      , A.containingType = containingType+      , A.virtuality = virtuality+      , A.virtualityIndex = virtualIndex+      , A.flags = flags+      , A.optimized = optimized+      , A.unit = unit+      , A.templateParams = templateParams+      , A.declaration = decl+      , A.variables = variables+      , A.thrownTypes = thrownTypes+      , A.localToUnit = localToUnit+      , A.thisAdjustment = thisAdjustment+      }++instance EncodeM EncodeAST A.DISubprogram (Ptr FFI.DISubprogram) where+  encodeM A.Subprogram {..} = do+    scope <- encodeM scope+    name <- encodeM name+    linkageName <- encodeM linkageName+    file <- encodeM file+    line <- encodeM line+    type' <- encodeM type'+    localToUnit <- encodeM localToUnit+    definition <- encodeM definition+    scopeLine <- encodeM scopeLine+    containingType <- encodeM containingType+    virtuality <- encodeM virtuality+    virtualityIndex <- encodeM virtualityIndex+    flags <- encodeM flags+    optimized <- encodeM optimized+    unit <- encodeM unit+    templateParams <- encodeM templateParams+    declaration <- encodeM declaration+    variables <- encodeM variables+    thrownTypes <- encodeM thrownTypes+    Context c <- gets encodeStateContext+    FFI.upCast <$> liftIO+      (FFI.getDISubprogram+        c scope name+        linkageName file line+        type' localToUnit definition scopeLine+        containingType virtuality virtualityIndex+        thisAdjustment flags optimized+        unit templateParams declaration+        variables thrownTypes)++instance DecodeM DecodeAST A.DILocalScope (Ptr FFI.DILocalScope) where+  decodeM ls = do+    sId <- liftIO $ FFI.getMetadataClassId (FFI.upCast ls)+    case sId of+      [mdSubclassIdP|DISubprogram|] -> A.DISubprogram <$> decodeM (castPtr ls :: Ptr FFI.DISubprogram)+      [mdSubclassIdP|DILexicalBlock|] -> A.DILexicalBlockBase <$> decodeM (castPtr ls :: Ptr FFI.DILexicalBlockBase)+      [mdSubclassIdP|DILexicalBlockFile|] -> A.DILexicalBlockBase <$> decodeM (castPtr ls :: Ptr FFI.DILexicalBlockBase)+      _ -> throwM (DecodeException ("Unknown subclass id for DILocalScope: " <> show sId))++instance EncodeM EncodeAST A.DILocalScope (Ptr FFI.DILocalScope) where+  encodeM (A.DISubprogram sp) = do+    ptr <- encodeM sp+    pure (FFI.upCast (ptr :: Ptr FFI.DISubprogram))+  encodeM (A.DILexicalBlockBase b) = do+    ptr <- encodeM b+    pure (FFI.upCast (ptr :: Ptr FFI.DILexicalBlockBase))++instance DecodeM DecodeAST A.DILexicalBlockBase (Ptr FFI.DILexicalBlockBase) where+  decodeM p = do+    sId <- liftIO (FFI.getMetadataClassId (FFI.upCast p))+    case sId of+      [mdSubclassIdP|DILexicalBlock|] -> do+        scope <- decodeM =<< liftIO (FFI.getLexicalBlockScope p)+        file  <- decodeM =<< liftIO (FFI.getScopeFile (FFI.upCast p))+        line  <- liftIO (FFI.getLexicalBlockLine p)+        col   <- liftIO (FFI.getLexicalBlockColumn p)+        pure (A.DILexicalBlock scope file line col)+      [mdSubclassIdP|DILexicalBlockFile|] -> do+        scope <- decodeM =<< liftIO (FFI.getLexicalBlockScope p)+        file  <- decodeM =<< liftIO (FFI.getScopeFile (FFI.upCast p))+        disc  <- liftIO (FFI.getLexicalBlockFileDiscriminator p)+        pure (A.DILexicalBlockFile scope file disc)+      _ -> throwM (DecodeException ("Unknown subclass id for DILexicalBlockBase: " <> show sId))++instance EncodeM EncodeAST A.DILexicalBlockBase (Ptr FFI.DILexicalBlockBase) where+  encodeM A.DILexicalBlock {..} = do+    scope <- encodeM scope+    file <- encodeM file+    Context c <- gets encodeStateContext+    FFI.upCast <$> liftIO (FFI.getDILexicalBlock c scope file line column)+  encodeM A.DILexicalBlockFile {..} = do+    scope <- encodeM scope+    file <- encodeM file+    Context c <- gets encodeStateContext+    FFI.upCast <$> liftIO (FFI.getDILexicalBlockFile c scope file discriminator)++instance DecodeM DecodeAST A.CallableOperand (Ptr FFI.Value) where+  decodeM v = do+    ia <- liftIO $ FFI.isAInlineAsm v+    if ia /= nullPtr+     then Left <$> decodeM ia+     else Right <$> decodeM v++instance EncodeM EncodeAST A.Operand (Ptr FFI.Value) where+  encodeM (A.ConstantOperand c) = (FFI.upCast :: Ptr FFI.Constant -> Ptr FFI.Value) <$> encodeM c+  encodeM (A.LocalReference t n) = do+    lv <- refer encodeStateLocals n $ do+      lv <- do+        n <- encodeM n+        t <- encodeM t+        v <- liftIO $ FFI.createArgument t n+        return $ ForwardValue v+      modify $ \s -> s { encodeStateLocals = Map.insert n lv $ encodeStateLocals s }+      return lv+    return $ case lv of DefinedValue v -> v; ForwardValue v -> v+  encodeM (A.MetadataOperand md) = do+    md' <- encodeM md+    Context c <- gets encodeStateContext+    liftIO $ FFI.upCast <$> FFI.metadataOperand c md'++instance EncodeM EncodeAST A.Metadata (Ptr FFI.Metadata) where+  encodeM (A.MDString s) = do+    Context c <- gets encodeStateContext+    s <- encodeM s+    FFI.upCast <$> liftIO (FFI.getMDString c s)+  encodeM (A.MDNode mdn) = (FFI.upCast :: Ptr FFI.MDNode -> Ptr FFI.Metadata) <$> encodeM mdn+  encodeM (A.MDValue v) = do+     v <- encodeM v+     FFI.upCast <$> liftIO (FFI.mdValue v)++instance EncodeM EncodeAST A.CallableOperand (Ptr FFI.Value) where+  encodeM (Right o) = encodeM o+  encodeM (Left i) = (FFI.upCast :: Ptr FFI.InlineAsm -> Ptr FFI.Value) <$> encodeM i++instance EncodeM EncodeAST A.MDNode (Ptr FFI.MDNode) where+  encodeM (A.MDTuple ops) = scopeAnyCont $ do+    Context c <- gets encodeStateContext+    ops <- encodeM ops+    FFI.upCast <$> liftIO (FFI.getMDTuple c ops)+  encodeM (A.DINode n) = do+    ptr <- encodeM n+    pure (FFI.upCast (ptr :: Ptr FFI.DINode))+  encodeM (A.DILocation l) = FFI.upCast <$> (encodeM l :: EncodeAST (Ptr FFI.DILocation))+  encodeM (A.DIExpression e) = FFI.upCast <$> (encodeM e :: EncodeAST (Ptr FFI.DIExpression))+  encodeM (A.DIGlobalVariableExpression e) =+    FFI.upCast <$> (encodeM e :: EncodeAST (Ptr FFI.DIGlobalVariableExpression))+  encodeM (A.DIMacroNode n) = FFI.upCast <$> (encodeM n :: EncodeAST (Ptr FFI.DIMacroNode))++instance EncodeM EncodeAST A.DILocation (Ptr FFI.DILocation) where+  encodeM A.Location {..} = do+    Context c <- gets encodeStateContext+    scopePtr <- encodeM scope+    liftIO (FFI.getDILocation c line column scopePtr)++instance DecodeM DecodeAST A.DILocation (Ptr FFI.DILocation) where+  decodeM p = do+    line <- liftIO (FFI.getDILocationLine p)+    col  <- liftIO (FFI.getDILocationColumn p)+    scope <-  decodeM =<< liftIO (FFI.getDILocationScope p)+    pure (A.Location line col scope)++instance (MonadIO m, MonadState EncodeState m, MonadAnyCont IO m, EncodeM m a (Ptr a'), FFI.DescendentOf FFI.Metadata a') => EncodeM m [a] (FFI.TupleArray a') where+  encodeM [] = pure (FFI.TupleArray nullPtr)+  encodeM els = do+    (numEls, elsPtr) <- encodeM els+    Context c <- gets encodeStateContext+    FFI.TupleArray <$> liftIO (FFI.getMDTuple c (numEls, castPtr (elsPtr :: Ptr (Ptr a'))))++instance (MonadIO m, MonadAnyCont IO m, DecodeM m a (Ptr a')) => DecodeM m [a] (FFI.TupleArray a') where+  decodeM (FFI.TupleArray p)+    | p == nullPtr = pure []+    | otherwise = decodeArray FFI.getMDNodeNumOperands getOperand (FFI.upCast p)+    where getOperand md i = (castPtr <$> FFI.getMDNodeOperand md i) :: IO (Ptr a')++encodeDWOp :: A.DWOp -> [Word64]+encodeDWOp op =+  case op of+    A.DwOpFragment (A.DW_OP_LLVM_Fragment offset size) -> [FFI.DwOp_LLVM_fragment, offset, size]+    A.DW_OP_StackValue -> [FFI.DwOp_stack_value]+    A.DW_OP_Swap -> [FFI.DwOp_swap]+    A.DW_OP_ConstU arg -> [FFI.DwOp_constu, arg]+    A.DW_OP_PlusUConst arg -> [FFI.DwOp_plus_uconst, arg]+    A.DW_OP_Plus -> [FFI.DwOp_plus]+    A.DW_OP_Minus -> [FFI.DwOp_minus]+    A.DW_OP_Mul -> [FFI.DwOp_mul]+    A.DW_OP_Deref -> [FFI.DwOp_deref]+    A.DW_OP_XDeref -> [FFI.DwOp_xderef]++instance DecodeM DecodeAST [Maybe A.Metadata] (Ptr FFI.MDNode) where+  decodeM p = decodeArray FFI.getMDNodeNumOperands FFI.getMDNodeOperand p++instance DecodeM DecodeAST A.Operand (Ptr FFI.MDValue) where+  decodeM = decodeM <=< liftIO . FFI.getMDValue++instance DecodeM DecodeAST A.Metadata (Ptr FFI.MetadataAsVal) where+  decodeM = decodeM <=< liftIO . FFI.getMetadataOperand++genCodingInstance [t|A.DIMacroInfo|] ''FFI.Macinfo [ (FFI.DW_Macinfo_Define, A.Define), (FFI.DW_Macinfo_Undef, A.Undef) ]++decodeMDNode :: Ptr FFI.MDNode -> DecodeAST A.MDNode+decodeMDNode p = scopeAnyCont $ do+  sId <- liftIO $ FFI.getMetadataClassId p+  case sId of+      [mdSubclassIdP|MDTuple|] -> A.MDTuple <$> decodeM p+      [mdSubclassIdP|DIExpression|] ->+        A.DIExpression <$> decodeM (castPtr p :: Ptr FFI.DIExpression)+      [mdSubclassIdP|DIGlobalVariableExpression|] ->+        A.DIGlobalVariableExpression <$> decodeM (castPtr p :: Ptr FFI.DIGlobalVariableExpression)+      [mdSubclassIdP|DILocation|] -> A.DILocation <$> decodeM (castPtr p :: Ptr FFI.DILocation)+      [mdSubclassIdP|DIMacro|] -> A.DIMacroNode <$> decodeM (castPtr p :: Ptr FFI.DIMacroNode)+      [mdSubclassIdP|DIMacroFile|] -> A.DIMacroNode <$> decodeM (castPtr p :: Ptr FFI.DIMacroNode)+      _ -> A.DINode <$> decodeM (castPtr p :: Ptr FFI.DINode)++instance DecodeM DecodeAST A.DIMacroNode (Ptr FFI.DIMacroNode) where+  decodeM p = do+    sId <- liftIO $ FFI.getMetadataClassId (FFI.upCast p)+    case sId of+      [mdSubclassIdP|DIMacro|] -> do+        let p' = castPtr p :: Ptr FFI.DIMacro+        macInfo <- decodeM =<< liftIO (FFI.getDIMacroMacinfo p')+        line <- liftIO (FFI.getDIMacroLine p')+        name <- decodeM =<< liftIO (FFI.getDIMacroName p')+        value <- decodeM =<< liftIO (FFI.getDIMacroValue p')+        pure (A.DIMacro macInfo line name value)+      [mdSubclassIdP|DIMacroFile|] -> do+        let p' = castPtr p :: Ptr FFI.DIMacroFile+        line <- liftIO (FFI.getDIMacroFileLine p')+        file <- decodeM =<< liftIO (FFI.getDIMacroFileFile p')+        elements <- decodeArray FFI.getDIMacroFileNumElements FFI.getDIMacroFileElement p'+        pure (A.DIMacroFile line file elements)+      _ -> throwM (DecodeException ("Unknown subclass id for DIMacroNode: " <> show sId))++instance EncodeM EncodeAST A.DIMacroNode (Ptr FFI.DIMacroNode) where+  encodeM A.DIMacro {..} = do+    macInfo <- encodeM info+    name <- encodeM name+    value <- encodeM value+    Context c <- gets encodeStateContext+    FFI.upCast <$> liftIO (FFI.getDIMacro c macInfo line name value)+  encodeM A.DIMacroFile {..} = do+    file <- encodeM file+    elements <- encodeM elements+    Context c <- gets encodeStateContext+    FFI.upCast <$> liftIO (FFI.getDIMacroFile c line file elements)++instance EncodeM EncodeAST A.DIExpression (Ptr FFI.DIExpression) where+  encodeM A.Expression {..} = do+    ops <- encodeM (concatMap encodeDWOp operands)+    Context c <- gets encodeStateContext+    FFI.upCast <$> liftIO (FFI.getDIExpression c ops)++instance DecodeM DecodeAST A.DIExpression (Ptr FFI.DIExpression) where+  decodeM diExpr = do+    numElems <- liftIO (FFI.getDIExpressionNumElements diExpr)+    let go i+          | i >= numElems = pure []+          | otherwise = do+              op <- FFI.getDIExpressionElement diExpr i+              case op of+                FFI.DwOp_LLVM_fragment -> do+                  expectElems "LLVM_fragment" i 2+                  offset <- FFI.getDIExpressionElement diExpr (i + 1)+                  size <- FFI.getDIExpressionElement diExpr (i + 2)+                  (A.DwOpFragment (A.DW_OP_LLVM_Fragment offset size) :) <$> go (i + 3)+                FFI.DwOp_stack_value -> (A.DW_OP_StackValue :) <$> go (i + 1)+                FFI.DwOp_swap -> (A.DW_OP_Swap :) <$> go (i + 1)+                FFI.DwOp_constu -> do+                  expectElems "constu" i 1+                  arg <- FFI.getDIExpressionElement diExpr (i + 1)+                  (A.DW_OP_ConstU arg:) <$> go (i + 2)+                FFI.DwOp_plus_uconst -> do+                  expectElems "uconst" i 1+                  arg <- FFI.getDIExpressionElement diExpr (i + 1)+                  (A.DW_OP_PlusUConst arg:) <$> go (i + 2)+                FFI.DwOp_plus -> (A.DW_OP_Plus :) <$> go (i + 1)+                FFI.DwOp_minus -> (A.DW_OP_Minus :) <$> go (i + 1)+                FFI.DwOp_mul -> (A.DW_OP_Mul :) <$> go (i + 1)+                FFI.DwOp_deref -> (A.DW_OP_Deref :) <$> go (i + 1)+                FFI.DwOp_xderef -> (A.DW_OP_XDeref :) <$> go (i + 1)+                _ -> throwM (DecodeException ("Unknown DW_OP " <> show op))+        expectElems name i n =+          when (i + n >= numElems)+               (throwM (DecodeException ("Expected " <> show n <> " elements following DW_OP_" <>+                                         name <> " but got " <> show (numElems - i - 1))))+    liftIO (A.Expression <$> go 0)++instance EncodeM EncodeAST A.DIGlobalVariableExpression (Ptr FFI.DIGlobalVariableExpression) where+  encodeM A.GlobalVariableExpression {..} = do+    var <- encodeM var+    expr <- encodeM expr+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIGlobalVariableExpression c var expr)++instance DecodeM DecodeAST A.DIGlobalVariableExpression (Ptr FFI.DIGlobalVariableExpression) where+  decodeM p = do+    var <- decodeM =<< liftIO (FFI.getDIGlobalVariableExpressionVariable p)+    expr <- decodeM =<< liftIO (FFI.getDIGlobalVariableExpressionExpression p)+    pure (A.GlobalVariableExpression var expr)++genCodingInstance [t|A.ImportedEntityTag|] ''FFI.DwTag+  [ (FFI.DwTag_imported_module, A.ImportedModule)+  , (FFI.DwTag_imported_declaration, A.ImportedDeclaration)+  ]++instance EncodeM EncodeAST A.DIImportedEntity (Ptr FFI.DIImportedEntity) where+  encodeM A.ImportedEntity {..} = do+    tag <- encodeM tag+    scope <- encodeM scope+    entity <- encodeM entity+    file <- encodeM file+    name <- encodeM name+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIImportedEntity c tag scope entity file line name)++instance DecodeM DecodeAST A.DIImportedEntity (Ptr FFI.DIImportedEntity) where+  decodeM e = do+    tag <- decodeM =<< liftIO (FFI.getTag (FFI.upCast e))+    scope <- decodeM =<< liftIO (FFI.getDIImportedEntityScope e)+    entity <- decodeM =<< liftIO (FFI.getDIImportedEntityEntity e)+    file <- decodeM =<< liftIO (FFI.getDIImportedEntityFile e)+    name <- decodeM =<< liftIO (FFI.getDIImportedEntityName e)+    line <- liftIO (FFI.getDIImportedEntityLine e)+    pure (A.ImportedEntity tag name scope entity file line)++instance EncodeM EncodeAST A.DIObjCProperty (Ptr FFI.DIObjCProperty) where+  encodeM A.ObjCProperty {..} = do+    name <- encodeM name+    file <- encodeM file+    getterName <- encodeM getterName+    setterName <- encodeM setterName+    type' <- encodeM type'+    Context c <- gets encodeStateContext+    liftIO (FFI.getDIObjCProperty c name file line getterName setterName attributes type')++instance DecodeM DecodeAST A.DIObjCProperty (Ptr FFI.DIObjCProperty) where+  decodeM p = do+    name <- decodeM =<< liftIO (FFI.getDIObjCPropertyName p)+    file <- decodeM =<< liftIO (FFI.getDIObjCPropertyFile p)+    line <- liftIO (FFI.getDIObjCPropertyLine p)+    getterName <- decodeM =<< liftIO (FFI.getDIObjCPropertyGetterName p)+    setterName <- decodeM =<< liftIO (FFI.getDIObjCPropertySetterName p)+    attributes <- liftIO (FFI.getDIObjCPropertyAttributes p)+    type' <- decodeM =<< liftIO (FFI.getDIObjCPropertyType p)+    pure (A.ObjCProperty name file line getterName setterName attributes type')++instance {-# OVERLAPS #-} DecodeM DecodeAST (A.MDRef A.MDNode) (Ptr FFI.MDNode) where+  decodeM p = scopeAnyCont $ do+    sId <- liftIO $ FFI.getMetadataClassId p+    case sId of+      [mdSubclassIdP|DIExpression|] -> A.MDInline . A.DIExpression <$> decodeM (castPtr p :: Ptr FFI.DIExpression)+      _ -> A.MDRef <$> getMetadataNodeID p++instance (DecodeM DecodeAST a (Ptr b), FFI.DescendentOf FFI.MDNode b) => DecodeM DecodeAST (A.MDRef a) (Ptr b) where+  decodeM p = scopeAnyCont $+    A.MDRef <$> getMetadataNodeID (FFI.upCast p)++instance (EncodeM EncodeAST a (Ptr b), FFI.DescendentOf FFI.MDNode b) => EncodeM EncodeAST (A.MDRef a) (Ptr b) where+  encodeM (A.MDRef id) = castPtr <$> referMDNode id+  encodeM (A.MDInline m) = encodeM m++getMetadataDefinitions :: DecodeAST [A.Definition]+getMetadataDefinitions = fix $ \continue -> do+  mdntd <- takeMetadataNodeToDefine+  case mdntd of+    Nothing -> pure []+    Just (mid, p) ->+      (:)+        <$> (A.MetadataNodeDefinition mid <$> decodeMDNode p)+        <*> continue

@@ -17,7 +17,6 @@ import qualified LLVM.Internal.FFI.DataLayout as FFI import qualified LLVM.Internal.FFI.LLVMCTypes as FFI import qualified LLVM.Internal.FFI.OrcJIT as FFI-import qualified LLVM.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.Internal.FFI.Target as FFI  -- | A mangled symbol which can be used in 'findSymbol'. This can be@@ -61,17 +60,6 @@     externalResolver :: !SymbolResolverFn   } --- | After a 'CompileLayer' has compiled the modules to object code,--- it passes the resulting object files to a 'LinkingLayer'.-class LinkingLayer l where-  getLinkingLayer :: l -> Ptr FFI.LinkingLayer---- | Bare bones implementation of a 'LinkingLayer'.-newtype ObjectLinkingLayer = ObjectLinkingLayer (Ptr FFI.ObjectLinkingLayer)--instance LinkingLayer ObjectLinkingLayer where-  getLinkingLayer (ObjectLinkingLayer ptr) = FFI.upCast ptr- instance Monad m => EncodeM m JITSymbolFlags FFI.JITSymbolFlags where   encodeM f = return $ foldr1 (.|.) [       if a f@@ -124,22 +112,9 @@   modifyIORef cleanups (free a :)   pure a --- | allocate a function pointer and register it for cleanup.+-- | Allocate a function pointer and register it for cleanup. allocFunPtr :: IORef [IO ()] -> IO (FunPtr a) -> IO (FunPtr a) allocFunPtr cleanups alloc = allocWithCleanup cleanups alloc freeHaskellFunPtr---- | Dispose of a 'LinkingLayer'.-disposeLinkingLayer :: LinkingLayer l => l -> IO ()-disposeLinkingLayer = FFI.disposeLinkingLayer . getLinkingLayer---- | Create a new 'ObjectLinkingLayer'. This should be disposed using--- 'disposeLinkingLayer' when it is no longer needed.-newObjectLinkingLayer :: IO ObjectLinkingLayer-newObjectLinkingLayer = ObjectLinkingLayer <$> FFI.createObjectLinkingLayer---- | 'bracket'-style wrapper around 'newObjectLinkingLayer' and 'disposeLinkingLayer'.-withObjectLinkingLayer :: (ObjectLinkingLayer -> IO a) -> IO a-withObjectLinkingLayer = bracket newObjectLinkingLayer disposeLinkingLayer  createRegisteredDataLayout :: (MonadAnyCont IO m) => TargetMachine -> IORef [IO ()] -> m (Ptr FFI.DataLayout) createRegisteredDataLayout (TargetMachine tm) cleanups =

@@ -14,6 +14,7 @@ import qualified LLVM.Internal.FFI.PtrHierarchy as FFI import LLVM.Internal.OrcJIT import LLVM.Internal.OrcJIT.CompileLayer+import LLVM.Internal.OrcJIT.LinkingLayer (LinkingLayer(..), getLinkingLayer) import LLVM.Internal.Target  -- | 'IRCompileLayer' compiles modules immediately when they are

@@ -0,0 +1,64 @@+module LLVM.Internal.OrcJIT.LinkingLayer where++import LLVM.Prelude++import Control.Exception+import Control.Monad.AnyCont+import Control.Monad.IO.Class+import Data.IORef+import Foreign.Ptr++import LLVM.Internal.OrcJIT+import LLVM.Internal.Coding+import LLVM.Internal.ObjectFile+import qualified LLVM.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.Internal.FFI.OrcJIT.LinkingLayer as FFI++-- | After a 'CompileLayer' has compiled the modules to object code,+-- it passes the resulting object files to a 'LinkingLayer'.+class LinkingLayer l where+  getLinkingLayer :: l -> Ptr FFI.LinkingLayer+  getCleanups :: l -> IORef [IO ()]++-- | Dispose of a 'LinkingLayer'.+disposeLinkingLayer :: LinkingLayer l => l -> IO ()+disposeLinkingLayer l = do+  FFI.disposeLinkingLayer (getLinkingLayer l)+  sequence_ =<< readIORef (getCleanups l)++-- | Add an object file to the 'LinkingLayer'. The 'SymbolResolver' is used+-- to resolve external symbols in the module.+addObjectFile :: LinkingLayer l => l -> ObjectFile -> SymbolResolver+              -> IO FFI.ObjectHandle+addObjectFile linkingLayer (ObjectFile obj) resolver = flip runAnyContT return $ do+  resolverAct <- encodeM resolver+  resolver'   <- liftIO $ resolverAct (getCleanups linkingLayer)+  errMsg <- alloca+  liftIO $+    FFI.addObjectFile+      (getLinkingLayer linkingLayer)+      obj+      resolver'+      errMsg++-- | Bare bones implementation of a 'LinkingLayer'.+data ObjectLinkingLayer = ObjectLinkingLayer {+   linkingLayer :: !(Ptr FFI.ObjectLinkingLayer),+   cleanupActions :: !(IORef [IO ()])+  }++instance LinkingLayer ObjectLinkingLayer where+  getLinkingLayer (ObjectLinkingLayer ptr _) = FFI.upCast ptr+  getCleanups = cleanupActions++-- | Create a new 'ObjectLinkingLayer'. This should be disposed using+-- 'disposeLinkingLayer' when it is no longer needed.+newObjectLinkingLayer :: IO ObjectLinkingLayer+newObjectLinkingLayer = do+  linkingLayer <- FFI.createObjectLinkingLayer+  cleanups <- liftIO (newIORef [])+  return $ ObjectLinkingLayer linkingLayer cleanups++-- | 'bracket'-style wrapper around 'newObjectLinkingLayer' and 'disposeLinkingLayer'.+withObjectLinkingLayer :: (ObjectLinkingLayer -> IO a) -> IO a+withObjectLinkingLayer = bracket newObjectLinkingLayer disposeLinkingLayer

@@ -10,6 +10,7 @@ import Control.Monad.Catch import Control.Monad.State +import qualified Data.Map as Map import qualified Data.Set as Set  import Foreign.Ptr@@ -148,12 +149,40 @@       [typeKindP|Token|] -> return A.TokenType       _ -> error $ "unhandled type kind " ++ show k -createNamedType :: A.Name -> EncodeAST (Ptr FFI.Type)+createNamedType :: A.Name -> EncodeAST (Ptr FFI.Type, Maybe ShortByteString) createNamedType n = do   Context c <- gets encodeStateContext   n <- case n of { A.Name n -> encodeM n; _ -> return nullPtr }-  liftIO $ FFI.structCreateNamed c n+  renamedName <- alloca+  t <- liftIO $ FFI.structCreateNamed c n renamedName+  p <- peek renamedName+  if p == FFI.OwnerTransfered nullPtr+    then pure (t, Nothing)+    else do+      n' <- decodeM p+      pure (t, Just n') +renameType :: A.Type -> EncodeAST A.Type+renameType A.VoidType = pure A.VoidType+renameType t@(A.IntegerType _) = pure t+renameType (A.PointerType r a) = fmap (\r' -> A.PointerType r' a) (renameType r)+renameType t@(A.FloatingPointType _) = pure t+renameType (A.FunctionType r as varArg) =+  liftA2+    (\r' as' -> A.FunctionType r' as' varArg)+    (renameType r)+    (traverse renameType as)+renameType (A.VectorType n t) = A.VectorType n <$> renameType t+renameType (A.StructureType packed ts) = A.StructureType packed <$> traverse renameType ts+renameType (A.ArrayType n t) = A.ArrayType n <$> renameType t+renameType t@(A.NamedTypeReference n) = do+  renamedTypes <- gets encodeStateRenamedTypes+  case Map.lookup n renamedTypes of+    Just n' -> pure (A.NamedTypeReference (A.Name n'))+    Nothing -> pure t+renameType A.MetadataType = pure A.MetadataType+renameType A.LabelType = pure A.LabelType+renameType A.TokenType = pure A.TokenType  setNamedType :: Ptr FFI.Type -> A.Type -> EncodeAST () setNamedType t (A.StructureType packed ets) = do

@@ -37,6 +37,8 @@     withObjectLinkingLayer,     -- ** Dispose of linking layers     disposeLinkingLayer,+    -- ** Add an object file+    addObjectFile,     -- * JITCompileCallbackManager     JITCompileCallbackManager,     newJITCompileCallbackManager,@@ -51,6 +53,7 @@  import LLVM.Internal.OrcJIT import LLVM.Internal.OrcJIT.CompileLayer+import LLVM.Internal.OrcJIT.LinkingLayer import LLVM.Internal.OrcJIT.CompileOnDemandLayer import LLVM.Internal.OrcJIT.IRCompileLayer import LLVM.Internal.OrcJIT.IRTransformLayer

@@ -7,7 +7,7 @@ import Test.Tasty.HUnit  import LLVM-import LLVM.AST+import LLVM.AST hiding (DIFlag(..)) import LLVM.AST.CallingConvention (CallingConvention(C)) import LLVM.AST.Constant (Constant (Int, GlobalReference)) import LLVM.AST.FunctionAttribute

@@ -1,22 +1,687 @@+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} module LLVM.Test.Metadata where +import LLVM.Prelude+ import Test.Tasty import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Test.QuickCheck as QC  import LLVM.Test.Support -import LLVM.AST as A-import LLVM.AST.Type as A.T+import Control.Monad.IO.Class+import Data.ByteString as B (readFile)+import qualified Data.ByteString.Short as BSS+import Data.Functor.Identity+import Data.Maybe (catMaybes)+import Foreign.Ptr+import Text.Show.Pretty (pPrint)++import LLVM.AST as A hiding (GlobalVariable, PointerType)+import LLVM.AST.Operand hiding (Module)+import qualified LLVM.AST.Operand as O+import qualified LLVM.AST.Operand as A (DIFlag(..), Virtuality(..), DIInheritance(..), DIAccessibility(..))+import LLVM.AST.Type as A.T hiding (PointerType) import LLVM.AST.AddrSpace as A import qualified LLVM.AST.Linkage as L import qualified LLVM.AST.Visibility as V import qualified LLVM.AST.CallingConvention as CC import qualified LLVM.AST.Constant as C-import LLVM.AST.Global as G+import LLVM.AST.Global as G hiding (GlobalVariable) -tests = testGroup "Metadata" [-  testCase "global" $ do+import LLVM.Context+import LLVM.Module+import LLVM.Internal.Coding+import LLVM.Internal.DecodeAST+import LLVM.Internal.EncodeAST+import qualified LLVM.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.Internal.FFI.Metadata as FFI++tests = testGroup "Metadata"+  [ globalMetadata+  , namedMetadata+  , nullMetadata+  , cyclicMetadata+  , globalObjectMetadata+  , roundtripDIBasicType+  , roundtripDIDerivedType+  , roundtripDISubroutineType+  , roundtripDIArrayType+  , roundtripDIEnumerationType+  , roundtripDIStructureType+  , roundtripDIClassType+  , roundtripDIUnionType+  , roundtripDIFile+  , roundtripDINode+  , roundtripDICompileUnit+  , roundtripDIVariable+  , roundtripDIFlags+  , roundtripDISubprogram+  , roundtripDILexicalBlockBase+  , roundtripDITemplateParameter+  , roundtripDINamespace+  , roundtripDIExpression+  , diFlagName+  , testFile+  ]++arbitrarySbs :: Gen ShortByteString+arbitrarySbs = BSS.pack <$> listOf arbitrary++instance Arbitrary Encoding where+  arbitrary =+    QC.elements+      [ AddressEncoding+      , BooleanEncoding+      , FloatEncoding+      , SignedEncoding+      , SignedCharEncoding+      , UnsignedEncoding+      , UnsignedCharEncoding+      ]++instance Arbitrary ChecksumKind where+  arbitrary = QC.elements [None, MD5, SHA1]++instance Arbitrary BasicTypeTag where+  arbitrary = QC.elements [BaseType, UnspecifiedType]++instance Arbitrary DIType where+  arbitrary = oneof [DIBasicType <$> arbitrary]++instance Arbitrary DIBasicType where+  arbitrary = BasicType <$> arbitrarySbs <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++genDIArrayType :: Maybe (MDRef DIType) -> Gen DICompositeType+genDIArrayType elTy =+  DIArrayType <$> arbitrary <*> pure elTy <*> arbitrary <*> arbitrary <*> genDIFlags++instance Arbitrary DIMacroInfo where+  arbitrary = QC.elements [Define, Undef]++genDIMacro :: Gen DIMacroNode+genDIMacro =+  DIMacro <$> arbitrary <*> arbitrary <*> arbitrarySbs <*> arbitrarySbs++roundtripDIArrayType :: TestTree+roundtripDIArrayType = testProperty "roundtrip DIArrayType" $ \elType ->+  forAll (genDIArrayType (Just (MDRef elTyID))) $ \diArrayType -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [arrayTypeID]+                , MetadataNodeDefinition arrayTypeID (DINode (DIScope (DIType (DICompositeType diArrayType))))+                , MetadataNodeDefinition elTyID (DINode (DIScope (DIType elType)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where arrayTypeID = MetadataNodeID 0+        elTyID = MetadataNodeID 1++genDIEnumerationType :: Maybe (MDRef DIScope) -> Maybe (MDRef DIFile) -> Maybe (MDRef DIType) -> Gen DICompositeType+genDIEnumerationType scope file baseTy =+  DIEnumerationType+    <$> pure scope+    <*> arbitrarySbs+    <*> pure file+    <*> arbitrary+    <*> arbitrary+    <*> pure baseTy+    <*> arbitrarySbs+    <*> arbitrary+    <*> arbitrary++roundtripDIEnumerationType :: TestTree+roundtripDIEnumerationType = testProperty "roundtrip DIEnumerationType" $ \file baseType ->+  forAll (genDIEnumerationType Nothing (Just (MDRef fileID)) (Just (MDRef baseTyID))) $ \diEnumType -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [enumTypeID]+                , MetadataNodeDefinition enumTypeID (DINode (DIScope (DIType (DICompositeType diEnumType))))+                , MetadataNodeDefinition fileID (DINode (DIScope (DIFile file)))+                , MetadataNodeDefinition baseTyID (DINode (DIScope (DIType baseType)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where enumTypeID = MetadataNodeID 0+        fileID = MetadataNodeID 1+        baseTyID = MetadataNodeID 2++genDIStructureType :: Maybe (MDRef DIScope) -> Maybe (MDRef DIFile) -> Maybe (MDRef DIType) -> [MDRef (Either DIDerivedType DISubprogram)] -> Maybe (MDRef DIType) -> Gen DICompositeType+genDIStructureType scope file derivedFrom elements vtableHolder =+  DIStructureType+    <$> pure scope+    <*> arbitrarySbs+    <*> pure file+    <*> arbitrary+    <*> genDIFlags+    <*> pure derivedFrom+    <*> pure elements+    <*> arbitrary+    <*> pure vtableHolder+    <*> arbitrarySbs+    <*> arbitrary+    <*> arbitrary++roundtripDIStructureType :: TestTree+roundtripDIStructureType = testProperty "roundtrip DIStructureType" $+  forAll (genDIStructureType Nothing Nothing Nothing [] Nothing) $ \diStructureType -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [structureTypeID]+                , MetadataNodeDefinition structureTypeID (DINode (DIScope (DIType (DICompositeType diStructureType))))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where structureTypeID = MetadataNodeID 0++genDIClassType :: Maybe (MDRef DIScope) -> Maybe (MDRef DIFile) -> Maybe (MDRef DIType) -> [MDRef (Either DIDerivedType DISubprogram)] -> Maybe (MDRef DIType) -> [DITemplateParameter] -> Gen DICompositeType+genDIClassType scope file derivedFrom elements vtableHolder templateParams =+  DIClassType+    <$> pure scope+    <*> arbitrarySbs+    <*> pure file+    <*> arbitrary+    <*> genDIFlags+    <*> pure derivedFrom+    <*> pure elements+    <*> pure vtableHolder+    <*> pure templateParams+    <*> arbitrarySbs+    <*> arbitrary+    <*> arbitrary++roundtripDIClassType :: TestTree+roundtripDIClassType = testProperty "roundtrip DIClassType" $+  forAll (genDIClassType Nothing Nothing Nothing [] Nothing []) $ \diClassType -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [classTypeID]+                , MetadataNodeDefinition classTypeID (DINode (DIScope (DIType (DICompositeType diClassType))))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where classTypeID = MetadataNodeID 0++genDIUnionType :: Maybe (MDRef DIScope) -> Maybe (MDRef DIFile) -> [MDRef (Either DIDerivedType DISubprogram)] -> Gen DICompositeType+genDIUnionType scope file elements =+  DIUnionType+    <$> pure scope+    <*> arbitrarySbs+    <*> pure file+    <*> arbitrary+    <*> genDIFlags+    <*> pure elements+    <*> arbitrary+    <*> arbitrarySbs+    <*> arbitrary+    <*> arbitrary++roundtripDIUnionType :: TestTree+roundtripDIUnionType = testProperty "roundtrip DIUnionType" $+  forAll (genDIUnionType Nothing Nothing []) $ \diUnionType -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [unionTypeID]+                , MetadataNodeDefinition unionTypeID (DINode (DIScope (DIType (DICompositeType diUnionType))))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where unionTypeID = MetadataNodeID 0++instance Arbitrary DIFile where+  arbitrary =+    O.File <$> arbitrarySbs <*> arbitrarySbs <*> arbitrarySbs <*> arbitrary++instance Arbitrary DISubrange where+  arbitrary = Subrange <$> arbitrary <*> arbitrary++instance Arbitrary DIEnumerator where+  arbitrary = Enumerator <$> arbitrary <*> arbitrarySbs++instance Arbitrary DINode where+  arbitrary =+    oneof+      [ DISubrange <$> arbitrary+      , DIEnumerator <$> arbitrary+      -- TODO: Add missing constructors+      ]++roundtripDIBasicType :: TestTree+roundtripDIBasicType = testProperty "roundtrip DIBasicType" $ \diType -> ioProperty $+  withContext $ \context -> runEncodeAST context $ do+    encodedDIType <- encodeM (diType :: DIType)+    decodedDIType <- liftIO (runDecodeAST (decodeM (encodedDIType :: Ptr FFI.DIType)))+    pure (decodedDIType === diType)++roundtripDIDerivedType :: TestTree+roundtripDIDerivedType = testProperty "roundtrip DIDerivedType" $ \baseType ->+  forAll (genDIDerivedType Nothing Nothing (MDRef baseTypeID)) $ \diDerivedType -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [derivedTypeID]+                , MetadataNodeDefinition derivedTypeID (DINode (DIScope (DIType (DIDerivedType diDerivedType))))+                , MetadataNodeDefinition baseTypeID (DINode (DIScope (DIType baseType)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where derivedTypeID = MetadataNodeID 0+        baseTypeID = MetadataNodeID 1++instance Arbitrary DerivedTypeTag where+  arbitrary =+    QC.elements [ Typedef, PointerType, PtrToMemberType, ReferenceType, RValueReferenceType+             , ConstType, VolatileType, RestrictType, AtomicType, Member, Inheritance, Friend+             ]++genDIDerivedType :: Maybe (MDRef DIFile) -> Maybe (MDRef DIScope) -> MDRef DIType -> Gen DIDerivedType+genDIDerivedType file scope baseType =+  DerivedType+    <$> arbitrary+    <*> arbitrarySbs+    <*> pure file+    <*> arbitrary+    <*> pure scope+    <*> pure baseType+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> genDIFlags++roundtripDISubroutineType :: TestTree+roundtripDISubroutineType = testProperty "roundtrip DISubroutineType" $ \argType ->+  forAll (genDISubroutineType [Nothing, Just (MDRef argTypeID)]) $ \diSubroutineType -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [subroutineTypeID]+                , MetadataNodeDefinition subroutineTypeID (DINode (DIScope (DIType (DISubroutineType diSubroutineType))))+                , MetadataNodeDefinition argTypeID (DINode (DIScope (DIType argType)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where subroutineTypeID = MetadataNodeID 0+        argTypeID = MetadataNodeID 1++genDISubroutineType :: [Maybe (MDRef DIType)] -> Gen DISubroutineType+genDISubroutineType types =+  SubroutineType+    <$> genDIFlags+    <*> arbitrary+    <*> pure types++roundtripDIFile :: TestTree+roundtripDIFile = testProperty "roundtrip DIFile" $ \diFile -> ioProperty $+  withContext $ \context -> runEncodeAST context $ do+    encodedDIFile <- encodeM (diFile :: DIFile)+    decodedDIFile <- liftIO (runDecodeAST (decodeM (encodedDIFile :: Ptr FFI.DIFile)))+    pure (decodedDIFile === diFile)++roundtripDINode :: TestTree+roundtripDINode = testProperty "roundtrip DINode" $ \diNode -> ioProperty $+  withContext $ \context -> runEncodeAST context $ do+    encodedDINode <- encodeM (diNode :: DINode)+    decodedDINode <- liftIO (runDecodeAST (decodeM (encodedDINode :: Ptr FFI.DINode)))+    pure (decodedDINode === diNode)++roundtripDICompileUnit :: TestTree+roundtripDICompileUnit = testProperty "roundtrip DICompileUnit" $ \diFile retainedType ->+  forAll genDIMacro $ \diMacro ->+  forAll (genDICompileUnit (MDRef fileID) (MDRef retainedID) (MDRef macroID)) $ \diCompileUnit -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [cuID]+                , NamedMetadataDefinition "dummyMacro" [macroID]+                , NamedMetadataDefinition "dummyRetained" [retainedID]+                , MetadataNodeDefinition cuID (DINode (DIScope (DICompileUnit diCompileUnit)))+                , MetadataNodeDefinition macroID (DIMacroNode diMacro)+                , MetadataNodeDefinition retainedID (DINode (DIScope (DIType retainedType)))+                , MetadataNodeDefinition fileID (DINode (DIScope (DIFile diFile)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where cuID = MetadataNodeID 0+        macroID = MetadataNodeID 1+        retainedID = MetadataNodeID 2+        fileID = MetadataNodeID 3++genDICompileUnit :: MDRef DIFile -> MDRef (Either DIType DISubprogram) -> MDRef DIMacroNode -> Gen DICompileUnit+genDICompileUnit file retained macro =+  CompileUnit+    <$> arbitrary+    <*> pure file+    <*> arbitrarySbs+    <*> arbitrary+    <*> arbitrarySbs+    <*> arbitrary+    <*> arbitrarySbs+    <*> arbitrary+    <*> pure []+    <*> listOf (pure retained)+    <*> pure []+    <*> pure []+    <*> listOf (pure macro)+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++instance Arbitrary DebugEmissionKind where+  arbitrary = QC.elements [NoDebug, FullDebug, LineTablesOnly]++roundtripDIVariable :: TestTree+roundtripDIVariable = testProperty "roundtrip DIVariable" $ \diFile diType ->+  forAll (genDIVariable Nothing (Just (MDRef fileID)) (Just (MDRef typeID))) $ \diVariable -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [varID]+                , MetadataNodeDefinition varID (DINode (DIVariable diVariable))+                , MetadataNodeDefinition fileID (DINode (DIScope (DIFile diFile)))+                , MetadataNodeDefinition typeID (DINode (DIScope (DIType diType)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where varID = MetadataNodeID 0+        fileID = MetadataNodeID 1+        typeID = MetadataNodeID 2++genDIVariable :: Maybe (MDRef DIScope) -> Maybe (MDRef DIFile) -> Maybe (MDRef DIType) -> Gen DIVariable+genDIVariable diScope diFile diType =+  case diScope of+    Nothing -> DIGlobalVariable <$> globalVar+    Just scope -> oneof [DILocalVariable <$> localVar scope, DIGlobalVariable <$> globalVar]+  where+    localVar scope =+      LocalVariable+        <$> arbitrarySbs+        <*> pure scope+        <*> pure diFile+        <*> arbitrary+        <*> pure diType+        <*> genDIFlags+        <*> arbitrary+        <*> arbitrary+    globalVar =+      GlobalVariable+        <$> arbitrarySbs+        <*> pure diScope+        <*> pure diFile+        <*> arbitrary+        <*> pure diType+        <*> arbitrarySbs+        <*> arbitrary+        <*> arbitrary+        <*> pure Nothing+        <*> arbitrary++instance Arbitrary A.DIInheritance where+  arbitrary = QC.elements [A.SingleInheritance, A.MultipleInheritance, A.VirtualInheritance]++instance Arbitrary A.DIAccessibility where+  arbitrary = QC.elements [A.Public, A.Protected, A.Private]++instance Arbitrary A.DIFlag where+  arbitrary =+    oneof+      [ A.Accessibility <$> arbitrary+      , A.InheritanceFlag <$> arbitrary+      , QC.elements+          [ A.FwdDecl+          , A.AppleBlock+          , A.BlockByrefStruct+          , A.VirtualFlag+          , A.Artificial+          , A.Explicit+          , A.Prototyped+          , A.ObjcClassComplete+          , A.ObjectPointer+          , A.Vector+          , A.StaticMember+          , A.LValueReference+          , A.RValueReference+          , A.IntroducedVirtual+          , A.BitField+          , A.NoReturn+          , A.MainSubprogram+          ]+      ]++roundtripDIFlags :: TestTree+roundtripDIFlags =+  testProperty "roundtrip DIFlags" $+  forAll genDIFlags $ \diFlags ->+    let Identity encodedFlags = encodeM diFlags+        Identity decodedFlags = decodeM (encodedFlags :: FFI.DIFlags)+    in decodedFlags === diFlags++genDIFlags :: Gen [DIFlag]+genDIFlags = do+  accessibility <-+    QC.elements [Nothing, Just A.Public, Just A.Protected, Just A.Private]+  inheritance <-+    QC.elements+      [ Nothing+      , Just A.SingleInheritance+      , Just A.MultipleInheritance+      , Just A.VirtualInheritance+      ]+  maybeFlags <- traverse (\f -> QC.elements [Nothing, Just f]) flags+  pure+    (catMaybes+       ((A.Accessibility <$> accessibility) :+        (A.InheritanceFlag <$> inheritance) : maybeFlags))+  where+    flags =+      [ A.FwdDecl+      , A.AppleBlock+      , A.BlockByrefStruct+      , A.VirtualFlag+      , A.Artificial+      , A.Explicit+      , A.Prototyped+      , A.ObjcClassComplete+      , A.ObjectPointer+      , A.Vector+      , A.StaticMember+      , A.LValueReference+      , A.RValueReference+      , A.IntroducedVirtual+      , A.BitField+      , A.NoReturn+      , A.MainSubprogram+      ]++roundtripDISubprogram :: TestTree+roundtripDISubprogram = testProperty "roundtrip DISubprogram" $+  forAll (genDISubprogram Nothing Nothing Nothing Nothing Nothing [] Nothing [] []) $ \diSubprogram -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [subprogramID]+                , MetadataNodeDefinition subprogramID (DINode (DIScope (DILocalScope (DISubprogram diSubprogram))))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where subprogramID = MetadataNodeID 0++genDISubprogram :: Maybe (MDRef DIScope) -> Maybe (MDRef DIFile) -> Maybe (MDRef DISubroutineType) ->+                   Maybe (MDRef DIType) -> Maybe (MDRef DICompileUnit) -> [MDRef DITemplateParameter] ->+                   Maybe (MDRef DISubprogram) ->+                   [MDRef DILocalVariable] -> [MDRef DIType] -> Gen DISubprogram+genDISubprogram scope file type' containingType unit templateParams decl vars thrownTypes =+  Subprogram+    <$> pure scope+    <*> arbitrarySbs+    <*> arbitrarySbs+    <*> pure file+    <*> arbitrary+    <*> pure type'+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> pure containingType+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> genDIFlags+    <*> arbitrary+    <*> pure unit+    <*> pure templateParams+    <*> pure decl+    <*> pure vars+    <*> pure thrownTypes++roundtripDILexicalBlockBase :: TestTree+roundtripDILexicalBlockBase = testProperty "roundtrip DILexicalBlockBase" $ \diFile ->+  forAll (genDISubprogram Nothing Nothing Nothing Nothing Nothing [] Nothing [] []) $ \diSubprogram ->+  forAll (genDILexicalBlockBase (MDRef subprogramID) (Just (MDRef fileID))) $ \block -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [blockID]+                , MetadataNodeDefinition blockID (DINode (DIScope (DILocalScope (DILexicalBlockBase block))))+                , MetadataNodeDefinition subprogramID (DINode (DIScope (DILocalScope (DISubprogram diSubprogram))))+                , MetadataNodeDefinition fileID (DINode (DIScope (DIFile diFile)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where blockID = MetadataNodeID 0+        subprogramID = MetadataNodeID 1+        fileID = MetadataNodeID 2++genDILexicalBlockBase :: MDRef DILocalScope -> Maybe (MDRef DIFile) -> Gen DILexicalBlockBase+genDILexicalBlockBase scope file =+  oneof+    [ DILexicalBlock scope file <$> arbitrary <*> arbitrary+    , DILexicalBlockFile scope file <$> arbitrary+    ]++instance Arbitrary Virtuality where+  arbitrary = QC.elements [A.NoVirtuality, A.Virtual, A.PureVirtual]++roundtripDITemplateParameter :: TestTree+roundtripDITemplateParameter = testProperty "rountrip DITemplateParameter" $ \diType ->+  forAll (genDITemplateParameter (MDValue (ConstantOperand (C.Int 32 1))) (MDRef tyID)) $ \param -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [paramID]+                , MetadataNodeDefinition paramID (DINode (DITemplateParameter param))+                , MetadataNodeDefinition tyID (DINode (DIScope (DIType diType)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where paramID = MetadataNodeID 0+        tyID = MetadataNodeID 1++instance Arbitrary TemplateValueParameterTag where+  arbitrary = QC.elements [TemplateValueParameter, GNUTemplateTemplateParam, GNUTemplateParameterPack]++genDITemplateParameter :: Metadata -> MDRef DIType -> Gen DITemplateParameter+genDITemplateParameter value ty =+  oneof [ DITemplateTypeParameter <$> arbitrarySbs <*> pure ty+        , DITemplateValueParameter <$> arbitrarySbs <*> pure ty <*> pure value <*> arbitrary+        ]++roundtripDINamespace :: TestTree+roundtripDINamespace = testProperty "rountrip DINamespace" $ \diFile ->+  forAll (genDINamespace (MDRef fileID)) $ \diNamespace -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      let mod = defaultModule+            { moduleDefinitions =+                [ NamedMetadataDefinition "dummy" [namespaceID]+                , MetadataNodeDefinition namespaceID (DINode (DIScope (DINamespace diNamespace)))+                , MetadataNodeDefinition fileID (DINode (DIScope (DIFile diFile)))+                ]+            }+      mod' <- liftIO (withModuleFromAST context mod moduleAST)+      pure (mod' === mod)+  where namespaceID = MetadataNodeID 0+        fileID = MetadataNodeID 1++genDINamespace :: MDRef DIScope -> Gen DINamespace+genDINamespace scope = Namespace <$> arbitrarySbs <*> pure scope <*> arbitrary++diFlagName :: TestTree+diFlagName =+  testProperty "LLVM and llvm-hs agree on encoding of DIFlag" $ \diFlag ->+    ioProperty $+    withContext $ \context ->+      runEncodeAST context $ do+        encoded <- encodeM [diFlag]+        flagName' <- encodeM ("DIFlag" <> flagName diFlag)+        encodedByName <- liftIO (FFI.getDIFlag flagName')+        pure (encoded === encodedByName)+  where+    flagName (A.Accessibility f) = show f+    flagName (A.InheritanceFlag f) = show f+    flagName A.VirtualFlag = "Virtual"+    flagName f = show f++roundtripDIExpression :: TestTree+roundtripDIExpression = testProperty "roundtrip DIExpression" $+  forAll genDIExpression $ \expr -> ioProperty $+    withContext $ \context -> runEncodeAST context $ do+      encodedExpr <- encodeM expr+      decodedExpr <- liftIO (runDecodeAST (decodeM (encodedExpr :: Ptr FFI.DIExpression)))+      pure (decodedExpr === expr)++genDIExpression :: Gen DIExpression+genDIExpression = Expression <$> arbitrary++instance Arbitrary DWOp where+  arbitrary =+    oneof+      [ DwOpFragment <$> (DW_OP_LLVM_Fragment <$> arbitrary <*> arbitrary)+      , pure DW_OP_StackValue+      , pure DW_OP_Swap+      , DW_OP_ConstU <$> arbitrary+      , DW_OP_PlusUConst <$> arbitrary+      , pure DW_OP_Plus+      , pure DW_OP_Minus+      , pure DW_OP_Mul+      , pure DW_OP_Deref+      , pure DW_OP_XDeref+      ]++testFile :: TestTree+testFile = do+  testGroup "file parsing and decoding"+    [ testCase "test/debug_metadata_1.ll" $ do+        fStr <- B.readFile "test/debug_metadata_1.ll"+        withContext $ \context -> do+          a <- withModuleFromLLVMAssembly' context fStr moduleAST+          pure ()+    ,  testCase "test/debug_metadata_2.ll" $ do+         fStr <- B.readFile "test/debug_metadata_2.ll"+         withContext $ \context -> do+           a <- withModuleFromLLVMAssembly' context fStr moduleAST+           pure ()+    ]++globalMetadata = testCase "global" $ do     let ast = Module "<string>" "<string>" Nothing Nothing [           GlobalDefinition $ functionDefaults {             G.returnType = i32,@@ -25,12 +690,12 @@               BasicBlock (UnName 0) [               ] (                 Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [-                  ("my-metadatum", MetadataNodeReference (MetadataNodeID 0))+                  ("my-metadatum", A.MDRef (MetadataNodeID 0))                 ]               )              ]             },-          MetadataNodeDefinition (MetadataNodeID 0) [ Just $ MDValue $ ConstantOperand (C.Int 32 1) ]+          MetadataNodeDefinition (MetadataNodeID 0) (MDTuple [ Just $ MDValue $ ConstantOperand (C.Int 32 1) ])          ]     let s = "; ModuleID = '<string>'\n\             \source_filename = \"<string>\"\n\@@ -40,12 +705,12 @@             \}\n\             \\n\             \!0 = !{i32 1}\n"-    strCheck ast s,+    strCheck ast s -  testCase "named" $ do+namedMetadata = testCase "named" $ do     let ast = Module "<string>" "<string>" Nothing Nothing [           NamedMetadataDefinition "my-module-metadata" [ MetadataNodeID 0 ],-          MetadataNodeDefinition (MetadataNodeID 0) [ Just $ MDValue $ ConstantOperand (C.Int 32 1) ]+          MetadataNodeDefinition (MetadataNodeID 0) (MDTuple [ Just $ MDValue $ ConstantOperand (C.Int 32 1) ])          ]     let s = "; ModuleID = '<string>'\n\             \source_filename = \"<string>\"\n\@@ -53,12 +718,12 @@             \!my-module-metadata = !{!0}\n\             \\n\             \!0 = !{i32 1}\n"-    strCheck ast s,+    strCheck ast s -  testCase "null" $ do+nullMetadata = testCase "null" $ do     let ast = Module "<string>" "<string>" Nothing Nothing [           NamedMetadataDefinition "my-module-metadata" [ MetadataNodeID 0 ],-          MetadataNodeDefinition (MetadataNodeID 0) [ Nothing ]+          MetadataNodeDefinition (MetadataNodeID 0) (MDTuple [ Nothing ])          ]     let s = "; ModuleID = '<string>'\n\             \source_filename = \"<string>\"\n\@@ -66,18 +731,18 @@             \!my-module-metadata = !{!0}\n\             \\n\             \!0 = !{null}\n"-    strCheck ast s,+    strCheck ast s -  testGroup "cyclic" [+cyclicMetadata = testGroup "cyclic" [     testCase "metadata-only" $ do       let ast = Module "<string>" "<string>" Nothing Nothing [             NamedMetadataDefinition "my-module-metadata" [MetadataNodeID 0],-            MetadataNodeDefinition (MetadataNodeID 0) [-              Just $ MDNode (MetadataNodeReference (MetadataNodeID 1)) -             ],-            MetadataNodeDefinition (MetadataNodeID 1) [-              Just $ MDNode (MetadataNodeReference (MetadataNodeID 0)) -             ]+            MetadataNodeDefinition+              (MetadataNodeID 0)+              (MDTuple [Just $ MDNode (MDRef (MetadataNodeID 1))]),+            MetadataNodeDefinition+              (MetadataNodeID 1)+              (MDTuple [Just $ MDNode (MDRef (MetadataNodeID 0))])            ]       let s = "; ModuleID = '<string>'\n\               \source_filename = \"<string>\"\n\@@ -96,13 +761,13 @@               G.basicBlocks = [                 BasicBlock (UnName 0) [                  ] (-                   Do $ Ret Nothing [ ("my-metadatum", MetadataNodeReference (MetadataNodeID 0)) ]+                   Do $ Ret Nothing [ ("my-metadatum", MDRef (MetadataNodeID 0)) ]                  )                ]              },-            MetadataNodeDefinition (MetadataNodeID 0) [-              Just $ MDValue $ ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void [] False)) (Name "foo"))-             ]+            MetadataNodeDefinition+              (MetadataNodeID 0)+              (MDTuple [Just $ MDValue $ ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void [] False)) (Name "foo"))])            ]       let s = "; ModuleID = '<string>'\n\               \source_filename = \"<string>\"\n\@@ -115,4 +780,165 @@       strCheck ast s    ] - ]+globalObjectMetadata = testGroup "Metadata on GlobalObject" $+  [ testCase "metadata on functions" $ do+      let ast = Module "<string>" "<string>" Nothing Nothing+                  [ GlobalDefinition+                      functionDefaults+                        { G.name = "main"+                        , G.returnType = A.T.void+                        , basicBlocks = [ BasicBlock (UnName 0) [] (Do (Ret Nothing [])) ]+                        , G.metadata = [("dbg", MDRef (MetadataNodeID 0))]+                        }+                  , NamedMetadataDefinition "llvm.module.flags" [MetadataNodeID 1]+                  , NamedMetadataDefinition "llvm.dbg.cu" [MetadataNodeID 2]+                  , MetadataNodeDefinition (MetadataNodeID 0) $+                    DINode .DIScope .DILocalScope . DISubprogram $+                    Subprogram+                      { scope = Nothing+                      , name = "main"+                      , linkageName = ""+                      , file = Nothing+                      , line = 0+                      , type' = Nothing+                      , localToUnit = False+                      , definition = True+                      , scopeLine = 0+                      , containingType = Nothing+                      , virtuality = NoVirtuality+                      , virtualityIndex = 0+                      , thisAdjustment = 0+                      , flags = []+                      , optimized = False+                      , unit = Just (MDRef (MetadataNodeID 2))+                      , O.templateParams = []+                      , declaration = Nothing+                      , variables = []+                      , thrownTypes = []+                      }+                  , MetadataNodeDefinition (MetadataNodeID 1)+                    (MDTuple [ Just (MDValue (ConstantOperand (C.Int 32 2)))+                             , Just (MDString "Debug Info Version")+                             , Just (MDValue (ConstantOperand (C.Int 32 3)))+                             ])+                  , MetadataNodeDefinition (MetadataNodeID 2) $+                    DINode . DIScope . DICompileUnit $+                    CompileUnit+                      { language = 12+                      , file = MDRef (MetadataNodeID 3)+                      , producer = "clang version 6.0.0 (tags/RELEASE_600/final)"+                      , optimized = True+                      , flags = ""+                      , runtimeVersion = 0+                      , splitDebugFileName = ""+                      , emissionKind = FullDebug+                      , enums = []+                      , retainedTypes = []+                      , globals = []+                      , imports = []+                      , macros = []+                      , dWOId = 0+                      , splitDebugInlining = True+                      , debugInfoForProfiling = False+                      , gnuPubnames = False+                      }+                  , MetadataNodeDefinition (MetadataNodeID 3) $+                    DINode . DIScope . DIFile $+                    O.File "main.c" "/" "" None+                  ]+          s =+            "; ModuleID = '<string>'\n\+            \source_filename = \"<string>\"\n\+            \\n\+            \define void @main() !dbg !3 {\n\+            \  ret void\n\+            \}\n\+            \\n\+            \!llvm.module.flags = !{!0}\n\+            \!llvm.dbg.cu = !{!1}\n\+            \\n\+            \!0 = !{i32 2, !\"Debug Info Version\", i32 3}\n\+            \!1 = distinct !DICompileUnit(language: DW_LANG_C99, file: !2, producer: \"clang version 6.0.0 (tags/RELEASE_600/final)\", isOptimized: true, runtimeVersion: 0, emissionKind: FullDebug)\n\+            \!2 = !DIFile(filename: \"main.c\", directory: \"/\")\n\+            \!3 = distinct !DISubprogram(name: \"main\", scope: null, isLocal: false, isDefinition: true, isOptimized: false, unit: !1)\n"+      strCheck ast s,+   testCase "metadata on global variables" $ do+      let ast = Module "<string>" "<string>" Nothing Nothing+                  [ GlobalDefinition+                      globalVariableDefaults+                        { G.name = "g"+                        , G.type' = A.T.i32+                        , G.linkage = L.Common+                        , G.alignment = 4+                        , G.initializer = Just (C.Int 32 0)+                        , G.metadata = [("dbg", MDRef (MetadataNodeID 0))]+                        }+                  , NamedMetadataDefinition "llvm.module.flags" [MetadataNodeID 1]+                  , NamedMetadataDefinition "llvm.dbg.cu" [MetadataNodeID 2]+                  , MetadataNodeDefinition (MetadataNodeID 0) $+                    DIGlobalVariableExpression $ GlobalVariableExpression (MDRef (MetadataNodeID 3)) (MDRef (MetadataNodeID 4))+                  , MetadataNodeDefinition (MetadataNodeID 1)+                    (MDTuple [ Just (MDValue (ConstantOperand (C.Int 32 2)))+                             , Just (MDString "Debug Info Version")+                             , Just (MDValue (ConstantOperand (C.Int 32 3)))+                             ])+                  , MetadataNodeDefinition (MetadataNodeID 2) $+                    DINode . DIScope . DICompileUnit $+                    CompileUnit+                      { language = 12+                      , file = MDRef (MetadataNodeID 5)+                      , producer = "clang version 6.0.0 (tags/RELEASE_600/final)"+                      , optimized = True+                      , flags = ""+                      , runtimeVersion = 0+                      , splitDebugFileName = ""+                      , emissionKind = FullDebug+                      , enums = []+                      , retainedTypes = []+                      , globals = []+                      , imports = []+                      , macros = []+                      , dWOId = 0+                      , splitDebugInlining = True+                      , debugInfoForProfiling = False+                      , gnuPubnames = False+                      }+                  , MetadataNodeDefinition (MetadataNodeID 3) $+                    DINode . DIVariable . DIGlobalVariable $+                    GlobalVariable+                      { name = "g"+                      , scope = Nothing+                      , file = Nothing+                      , line = 0+                      , type' = Just (MDRef (MetadataNodeID 6))+                      , linkageName = ""+                      , local = False+                      , definition = True+                      , staticDataMemberDeclaration = Nothing+                      , alignInBits = 0+                      }+                  , MetadataNodeDefinition (MetadataNodeID 4) (DIExpression (Expression []))+                  , MetadataNodeDefinition (MetadataNodeID 5) $+                    DINode . DIScope . DIFile $+                    O.File "main.c" "/" "" None+                  , MetadataNodeDefinition (MetadataNodeID 6) $+                    DINode . DIScope . DIType . DIBasicType $+                    BasicType "" 0 0 Nothing BaseType+                  ]+          s =+            "; ModuleID = '<string>'\n\+            \source_filename = \"<string>\"\n\+            \\n\+            \@g = common global i32 0, align 4, !dbg !0\n\+            \\n\+            \!llvm.module.flags = !{!3}\n\+            \!llvm.dbg.cu = !{!4}\n\+            \\n\+            \!0 = !DIGlobalVariableExpression(var: !1, expr: !DIExpression())\n\+            \!1 = !DIGlobalVariable(name: \"g\", scope: null, type: !2, isLocal: false, isDefinition: true)\n\+            \!2 = !DIBasicType()\n\+            \!3 = !{i32 2, !\"Debug Info Version\", i32 3}\n\+            \!4 = distinct !DICompileUnit(language: DW_LANG_C99, file: !5, producer: \"clang version 6.0.0 (tags/RELEASE_600/final)\", isOptimized: true, runtimeVersion: 0, emissionKind: FullDebug)\n\+            \!5 = !DIFile(filename: \"main.c\", directory: \"/\")\n"+      strCheck ast s+  ]

@@ -608,6 +608,37 @@             Module "<string>" "<string>" Nothing Nothing               [TypeDefinition (UnName 0) (Just VoidType)]       t <- try $ withModuleFromAST context badAST $ \_ -> return ()-      t @?= Left (EncodeException "A type definition requires a structure type but got: VoidType")+      t @?= Left (EncodeException "A type definition requires a structure type but got: VoidType"),+    testCase "renamed type definitions" $ do+      let modStr1 = unlines+            [ "%struct = type { %struct* }"+            , "define void @f(%struct*) {"+            , "  ret void"+            , "}"+            ]+          modAST1 = Module "<string>" "<string>" Nothing Nothing+            [+            ]+          modStr2 = unlines+            [ "%struct = type { %struct* }"+            , "declare void @f(%struct*)"+            , "define void @main() {"+            , "  call void @f(%struct* zeroinitializer)"+            , "  ret void"+            , "}"+            ]+      ast1 <- withContext $ \ctx -> withModuleFromLLVMAssembly ctx modStr1 moduleAST+      ast2 <- withContext $ \ctx -> withModuleFromLLVMAssembly ctx modStr2 moduleAST+      (ast1', ast2') <- withContext $ \ctx ->+        withModuleFromAST ctx ast1 $ \mod1 ->+        withModuleFromAST ctx ast2 $ \mod2 ->+          (,) <$> moduleAST mod1 <*> moduleAST mod2+      withContext $ \ctx -> do+        ast1'' <- withModuleFromLLVMAssembly ctx modStr1 moduleAST+        ast2'' <- withModuleFromLLVMAssembly ctx modStr2 moduleAST+        -- Verify that LLVM’s automatic renaming does not produce an error+        -- and that the ASTs produced by llvm-hs and LLVM itself are the same.+        ast1' @?= ast1''+        ast2' @?= ast2''    ]  ]

@@ -9,7 +9,7 @@ import qualified LLVM.AST as AST import           LLVM.AST hiding (Module) import qualified LLVM.AST.Constant as C-import           LLVM.AST.Global+import           LLVM.AST.Global hiding (metadata) import           LLVM.AST.Type  import           LLVM.Context