{-#
  LANGUAGE
  TemplateHaskell,
  ScopedTypeVariables,
  MultiParamTypeClasses
  #-}
-- | This Haskell module is for/of functions for handling LLVM modules.
module LLVM.Internal.Module where

import LLVM.Prelude

import Control.Monad.AnyCont
import Control.Monad.Catch
import Control.Monad.Trans.Except
import Control.Monad.State (gets)
import Control.Monad.Trans

import Foreign.Ptr
import Foreign.C
import Data.IORef
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as SBS
import qualified Data.Map as Map

import qualified LLVM.Internal.FFI.Assembly as FFI
import qualified LLVM.Internal.FFI.Attribute as FFI
import qualified LLVM.Internal.FFI.Builder as FFI
import qualified LLVM.Internal.FFI.Bitcode as FFI
import qualified LLVM.Internal.FFI.Function as FFI
import qualified LLVM.Internal.FFI.GlobalAlias as FFI
import qualified LLVM.Internal.FFI.GlobalValue as FFI
import qualified LLVM.Internal.FFI.GlobalVariable as FFI
import qualified LLVM.Internal.FFI.Iterate as FFI
import qualified LLVM.Internal.FFI.LLVMCTypes as FFI
import qualified LLVM.Internal.FFI.MemoryBuffer as FFI
import qualified LLVM.Internal.FFI.Metadata as FFI
import qualified LLVM.Internal.FFI.Module as FFI
import qualified LLVM.Internal.FFI.PtrHierarchy as FFI
import qualified LLVM.Internal.FFI.RawOStream as FFI
import qualified LLVM.Internal.FFI.Target as FFI
import qualified LLVM.Internal.FFI.Value as FFI

import LLVM.Internal.Attribute
import LLVM.Internal.BasicBlock
import LLVM.Internal.Coding
import LLVM.Internal.Context
import LLVM.Internal.DecodeAST
import LLVM.Internal.EncodeAST
import LLVM.Internal.Function
import LLVM.Internal.Global
import LLVM.Internal.Instruction ()
import qualified LLVM.Internal.MemoryBuffer as MB
import LLVM.Internal.Metadata
import LLVM.Internal.Operand
import LLVM.Internal.RawOStream
import LLVM.Internal.String
import LLVM.Internal.Target
import LLVM.Internal.Type
import LLVM.Internal.Value

import LLVM.DataLayout
import LLVM.Exception

import qualified LLVM.AST as A
import qualified LLVM.AST.DataLayout as A
import qualified LLVM.AST.AddrSpace as A
import qualified LLVM.AST.Global as A.G

-- | <http://llvm.org/doxygen/classllvm_1_1Module.html>
newtype Module = Module (IORef (Ptr FFI.Module))

newModule :: Ptr FFI.Module -> IO (Module)
newModule :: Ptr Module -> IO Module
newModule Ptr Module
m = (IORef (Ptr Module) -> Module)
-> IO (IORef (Ptr Module)) -> IO Module
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef (Ptr Module) -> Module
Module (Ptr Module -> IO (IORef (Ptr Module))
forall a. a -> IO (IORef a)
newIORef Ptr Module
m)

readModule :: MonadIO m => Module -> m (Ptr FFI.Module)
readModule :: forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule (Module IORef (Ptr Module)
ref) = IO (Ptr Module) -> m (Ptr Module)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Module) -> m (Ptr Module))
-> IO (Ptr Module) -> m (Ptr Module)
forall a b. (a -> b) -> a -> b
$ IORef (Ptr Module) -> IO (Ptr Module)
forall a. IORef a -> IO a
readIORef IORef (Ptr Module)
ref

-- | Signal that a module does no longer exist and thus must not be
-- disposed. It is the responsibility of the caller to ensure that the
-- module has been disposed. If you use only the functions provided by
-- llvm-hs you should never call this yourself.
deleteModule :: Module -> IO ()
deleteModule :: Module -> IO ()
deleteModule (Module IORef (Ptr Module)
r) = IORef (Ptr Module) -> Ptr Module -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Module)
r Ptr Module
forall a. Ptr a
nullPtr

-- | A newtype to distinguish strings used for paths from other strings
newtype File = File FilePath
  deriving (File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: File -> File -> Bool
== :: File -> File -> Bool
$c/= :: File -> File -> Bool
/= :: File -> File -> Bool
Eq, Eq File
Eq File
-> (File -> File -> Ordering)
-> (File -> File -> Bool)
-> (File -> File -> Bool)
-> (File -> File -> Bool)
-> (File -> File -> Bool)
-> (File -> File -> File)
-> (File -> File -> File)
-> Ord File
File -> File -> Bool
File -> File -> Ordering
File -> File -> File
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: File -> File -> Ordering
compare :: File -> File -> Ordering
$c< :: File -> File -> Bool
< :: File -> File -> Bool
$c<= :: File -> File -> Bool
<= :: File -> File -> Bool
$c> :: File -> File -> Bool
> :: File -> File -> Bool
$c>= :: File -> File -> Bool
>= :: File -> File -> Bool
$cmax :: File -> File -> File
max :: File -> File -> File
$cmin :: File -> File -> File
min :: File -> File -> File
Ord, ReadPrec [File]
ReadPrec File
Int -> ReadS File
ReadS [File]
(Int -> ReadS File)
-> ReadS [File] -> ReadPrec File -> ReadPrec [File] -> Read File
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS File
readsPrec :: Int -> ReadS File
$creadList :: ReadS [File]
readList :: ReadS [File]
$creadPrec :: ReadPrec File
readPrec :: ReadPrec File
$creadListPrec :: ReadPrec [File]
readListPrec :: ReadPrec [File]
Read, Int -> File -> String -> String
[File] -> String -> String
File -> String
(Int -> File -> String -> String)
-> (File -> String) -> ([File] -> String -> String) -> Show File
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> File -> String -> String
showsPrec :: Int -> File -> String -> String
$cshow :: File -> String
show :: File -> String
$cshowList :: [File] -> String -> String
showList :: [File] -> String -> String
Show)

-- | link LLVM modules - move or copy parts of a source module into a
-- destination module.  Note that this operation is not commutative -
-- not only concretely (e.g. the destination module is modified,
-- becoming the result) but abstractly (e.g. unused private globals in
-- the source module do not appear in the result, but similar globals
-- in the destination remain). The source module is destroyed. May
-- throw a 'LinkException'.
linkModules ::
     Module -- ^ The module into which to link
  -> Module -- ^ The module to link into the other (this module is destroyed)
  -> IO ()
linkModules :: Module -> Module -> IO ()
linkModules Module
dest Module
src  = (() -> IO ()) -> AnyContT IO () -> IO ()
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO () -> IO ()) -> AnyContT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr Module
dest' <- Module -> AnyContT IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
dest
  Ptr Module
src' <- Module -> AnyContT IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
src
  Bool
result <- LLVMBool -> AnyContT IO Bool
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LLVMBool -> AnyContT IO Bool)
-> AnyContT IO LLVMBool -> AnyContT IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO LLVMBool -> AnyContT IO LLVMBool
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Module -> Ptr Module -> IO LLVMBool
FFI.linkModules Ptr Module
dest' Ptr Module
src')
  -- linkModules takes care of deleting the sourcemodule
  IO () -> AnyContT IO ()
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AnyContT IO ()) -> IO () -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ Module -> IO ()
deleteModule Module
src
  Bool -> AnyContT IO () -> AnyContT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
result (LinkException -> AnyContT IO ()
forall e a. Exception e => e -> AnyContT IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (LinkException -> AnyContT IO ())
-> LinkException -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ String -> LinkException
LinkException String
"Couldn’t link modules")

class LLVMAssemblyInput s where
  llvmAssemblyMemoryBuffer :: (MonadThrow m, MonadIO m, MonadAnyCont IO m)
                              => s -> m (FFI.OwnerTransfered (Ptr FFI.MemoryBuffer))

instance LLVMAssemblyInput (String, String) where
  llvmAssemblyMemoryBuffer :: forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
(String, String) -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer (String
id, String
s) = do
    UTF8ByteString ByteString
bs <- String -> m UTF8ByteString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM String
s
    Specification -> m (OwnerTransfered (Ptr MemoryBuffer))
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (String -> ByteString -> Specification
MB.Bytes String
id ByteString
bs)

instance LLVMAssemblyInput (String, ByteString) where
  llvmAssemblyMemoryBuffer :: forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
(String, ByteString) -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer (String
id, ByteString
s) = do
    Specification -> m (OwnerTransfered (Ptr MemoryBuffer))
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (String -> ByteString -> Specification
MB.Bytes String
id ByteString
s)

instance LLVMAssemblyInput String where
  llvmAssemblyMemoryBuffer :: forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
String -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer String
s = (String, String) -> m (OwnerTransfered (Ptr MemoryBuffer))
forall s (m :: * -> *).
(LLVMAssemblyInput s, MonadThrow m, MonadIO m,
 MonadAnyCont IO m) =>
s -> m (OwnerTransfered (Ptr MemoryBuffer))
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
(String, String) -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer (String
"<string>", String
s)

instance LLVMAssemblyInput ByteString where
  llvmAssemblyMemoryBuffer :: forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
ByteString -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer ByteString
s = (String, ByteString) -> m (OwnerTransfered (Ptr MemoryBuffer))
forall s (m :: * -> *).
(LLVMAssemblyInput s, MonadThrow m, MonadIO m,
 MonadAnyCont IO m) =>
s -> m (OwnerTransfered (Ptr MemoryBuffer))
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
(String, ByteString) -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer (String
"<string>", ByteString
s)

instance LLVMAssemblyInput File where
  llvmAssemblyMemoryBuffer :: forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
File -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer (File String
p) = Specification -> m (OwnerTransfered (Ptr MemoryBuffer))
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (String -> Specification
MB.File String
p)

-- | parse 'Module' from LLVM assembly. May throw 'ParseFailureException'.
withModuleFromLLVMAssembly :: LLVMAssemblyInput s
                              => Context -> s -> (Module -> IO a) -> IO a
withModuleFromLLVMAssembly :: forall s a.
LLVMAssemblyInput s =>
Context -> s -> (Module -> IO a) -> IO a
withModuleFromLLVMAssembly (Context Ptr Context
c) s
s Module -> IO a
f = (a -> IO a) -> AnyContT IO a -> IO a
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO a -> IO a) -> AnyContT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
  OwnerTransfered (Ptr MemoryBuffer)
mb <- s -> AnyContT IO (OwnerTransfered (Ptr MemoryBuffer))
forall s (m :: * -> *).
(LLVMAssemblyInput s, MonadThrow m, MonadIO m,
 MonadAnyCont IO m) =>
s -> m (OwnerTransfered (Ptr MemoryBuffer))
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
s -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer s
s
  Ptr (OwnerTransfered (Ptr CChar))
msgPtr <- AnyContT IO (Ptr (OwnerTransfered (Ptr CChar)))
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
  Module
m <- (forall r. (Module -> IO r) -> IO r) -> AnyContT IO Module
forall a. (forall r. (a -> IO r) -> IO r) -> AnyContT IO a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (Module -> IO r) -> IO r) -> AnyContT IO Module)
-> (forall r. (Module -> IO r) -> IO r) -> AnyContT IO Module
forall a b. (a -> b) -> a -> b
$ IO Module -> (Module -> IO ()) -> (Module -> IO r) -> IO r
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (Ptr Module -> IO Module
newModule (Ptr Module -> IO Module) -> IO (Ptr Module) -> IO Module
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Context
-> OwnerTransfered (Ptr MemoryBuffer)
-> Ptr (OwnerTransfered (Ptr CChar))
-> IO (Ptr Module)
FFI.parseLLVMAssembly Ptr Context
c OwnerTransfered (Ptr MemoryBuffer)
mb Ptr (OwnerTransfered (Ptr CChar))
msgPtr) (Ptr Module -> IO ()
FFI.disposeModule (Ptr Module -> IO ())
-> (Module -> IO (Ptr Module)) -> Module -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Module -> IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule)
  Ptr Module
m' <- Module -> AnyContT IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  Bool -> AnyContT IO () -> AnyContT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Module
m' Ptr Module -> Ptr Module -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Module
forall a. Ptr a
nullPtr) (AnyContT IO () -> AnyContT IO ())
-> AnyContT IO () -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ ParseFailureException -> AnyContT IO ()
forall e a. Exception e => e -> AnyContT IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseFailureException -> AnyContT IO ())
-> (String -> ParseFailureException) -> String -> AnyContT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseFailureException
ParseFailureException (String -> AnyContT IO ()) -> AnyContT IO String -> AnyContT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (OwnerTransfered (Ptr CChar)) -> AnyContT IO String
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr (OwnerTransfered (Ptr CChar))
msgPtr
  IO a -> AnyContT IO a
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> AnyContT IO a) -> IO a -> AnyContT IO a
forall a b. (a -> b) -> a -> b
$ Module -> IO a
f Module
m

-- | generate LLVM assembly from a 'Module'
moduleLLVMAssembly :: Module -> IO ByteString
moduleLLVMAssembly :: Module -> IO ByteString
moduleLLVMAssembly Module
m = do
  IORef (Maybe ByteString)
resultRef <- Maybe ByteString -> IO (IORef (Maybe ByteString))
forall a. a -> IO (IORef a)
newIORef Maybe ByteString
forall a. Maybe a
Nothing
  let saveBuffer :: Ptr CChar -> CSize -> IO ()
      saveBuffer :: Ptr CChar -> CSize -> IO ()
saveBuffer Ptr CChar
start CSize
size = do
        ByteString
r <- (Ptr CChar, CSize) -> IO ByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (Ptr CChar
start, CSize
size)
        IORef (Maybe ByteString) -> Maybe ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ByteString)
resultRef (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
r)
  Ptr Module
m' <- Module -> IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  (Ptr CChar -> CSize -> IO ()) -> RawPWriteStreamCallback -> IO ()
FFI.withBufferRawPWriteStream Ptr CChar -> CSize -> IO ()
saveBuffer (RawPWriteStreamCallback -> IO ())
-> RawPWriteStreamCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> Ptr RawOStream -> IO ()
FFI.writeLLVMAssembly Ptr Module
m' (Ptr RawOStream -> IO ())
-> (Ptr RawPWriteStream -> Ptr RawOStream)
-> RawPWriteStreamCallback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr RawPWriteStream -> Ptr RawOStream
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast
  Just ByteString
s <- IORef (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IORef a -> IO a
readIORef IORef (Maybe ByteString)
resultRef
  ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s

-- | write LLVM assembly for a 'Module' to a file
writeLLVMAssemblyToFile :: File -> Module -> IO ()
writeLLVMAssemblyToFile :: File -> Module -> IO ()
writeLLVMAssemblyToFile (File String
path) Module
m = (() -> IO ()) -> AnyContT IO () -> IO ()
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO () -> IO ()) -> AnyContT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr Module
m' <- Module -> AnyContT IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  String
-> Bool -> Bool -> (Ptr RawOStream -> IO ()) -> AnyContT IO ()
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
String -> Bool -> Bool -> (Ptr RawOStream -> IO ()) -> m ()
withFileRawOStream String
path Bool
False Bool
True ((Ptr RawOStream -> IO ()) -> AnyContT IO ())
-> (Ptr RawOStream -> IO ()) -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> Ptr RawOStream -> IO ()
FFI.writeLLVMAssembly Ptr Module
m'

class BitcodeInput b where
  bitcodeMemoryBuffer :: (MonadThrow m, MonadIO m, MonadAnyCont IO m)
                         => b -> m (Ptr FFI.MemoryBuffer)

instance BitcodeInput (String, BS.ByteString) where
  bitcodeMemoryBuffer :: forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
(String, ByteString) -> m (Ptr MemoryBuffer)
bitcodeMemoryBuffer (String
s, ByteString
bs) = Specification -> m (Ptr MemoryBuffer)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (String -> ByteString -> Specification
MB.Bytes String
s ByteString
bs)

instance BitcodeInput File where
  bitcodeMemoryBuffer :: forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
File -> m (Ptr MemoryBuffer)
bitcodeMemoryBuffer (File String
p) = Specification -> m (Ptr MemoryBuffer)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (String -> Specification
MB.File String
p)

-- | parse 'Module' from LLVM bitcode. May throw 'ParseFailureException'.
withModuleFromBitcode :: BitcodeInput b => Context -> b -> (Module -> IO a) -> IO a
withModuleFromBitcode :: forall b a.
BitcodeInput b =>
Context -> b -> (Module -> IO a) -> IO a
withModuleFromBitcode (Context Ptr Context
c) b
b Module -> IO a
f = (a -> IO a) -> AnyContT IO a -> IO a
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO a -> IO a) -> AnyContT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
  Ptr MemoryBuffer
mb <- b -> AnyContT IO (Ptr MemoryBuffer)
forall b (m :: * -> *).
(BitcodeInput b, MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
b -> m (Ptr MemoryBuffer)
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
b -> m (Ptr MemoryBuffer)
bitcodeMemoryBuffer b
b
  Ptr (OwnerTransfered (Ptr CChar))
msgPtr <- AnyContT IO (Ptr (OwnerTransfered (Ptr CChar)))
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
  Module
m <- (forall r. (Module -> IO r) -> IO r) -> AnyContT IO Module
forall a. (forall r. (a -> IO r) -> IO r) -> AnyContT IO a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (Module -> IO r) -> IO r) -> AnyContT IO Module)
-> (forall r. (Module -> IO r) -> IO r) -> AnyContT IO Module
forall a b. (a -> b) -> a -> b
$ IO Module -> (Module -> IO ()) -> (Module -> IO r) -> IO r
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (Ptr Module -> IO Module
newModule (Ptr Module -> IO Module) -> IO (Ptr Module) -> IO Module
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Context
-> Ptr MemoryBuffer
-> Ptr (OwnerTransfered (Ptr CChar))
-> IO (Ptr Module)
FFI.parseBitcode Ptr Context
c Ptr MemoryBuffer
mb Ptr (OwnerTransfered (Ptr CChar))
msgPtr) (Ptr Module -> IO ()
FFI.disposeModule (Ptr Module -> IO ())
-> (Module -> IO (Ptr Module)) -> Module -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Module -> IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule)
  Ptr Module
m' <- Module -> AnyContT IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  Bool -> AnyContT IO () -> AnyContT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Module
m' Ptr Module -> Ptr Module -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Module
forall a. Ptr a
nullPtr) (AnyContT IO () -> AnyContT IO ())
-> AnyContT IO () -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ ParseFailureException -> AnyContT IO ()
forall e a. Exception e => e -> AnyContT IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseFailureException -> AnyContT IO ())
-> (String -> ParseFailureException) -> String -> AnyContT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseFailureException
ParseFailureException (String -> AnyContT IO ()) -> AnyContT IO String -> AnyContT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (OwnerTransfered (Ptr CChar)) -> AnyContT IO String
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr (OwnerTransfered (Ptr CChar))
msgPtr
  IO a -> AnyContT IO a
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> AnyContT IO a) -> IO a -> AnyContT IO a
forall a b. (a -> b) -> a -> b
$ Module -> IO a
f Module
m

-- | generate LLVM bitcode from a 'Module'
moduleBitcode :: Module -> IO BS.ByteString
moduleBitcode :: Module -> IO ByteString
moduleBitcode Module
m = do
  Ptr Module
m' <- Module -> IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  (Ptr RawOStream -> IO ()) -> IO ByteString
forall (m :: * -> *) a.
(MonadIO m, DecodeM IO a (Ptr CChar, CSize)) =>
(Ptr RawOStream -> IO ()) -> m a
withBufferRawOStream (Ptr Module -> Ptr RawOStream -> IO ()
FFI.writeBitcode Ptr Module
m')

-- | write LLVM bitcode from a 'Module' into a file
writeBitcodeToFile :: File -> Module -> IO ()
writeBitcodeToFile :: File -> Module -> IO ()
writeBitcodeToFile (File String
path) Module
m = (() -> IO ()) -> AnyContT IO () -> IO ()
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO () -> IO ()) -> AnyContT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr Module
m' <- Module -> AnyContT IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  String
-> Bool -> Bool -> (Ptr RawOStream -> IO ()) -> AnyContT IO ()
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
String -> Bool -> Bool -> (Ptr RawOStream -> IO ()) -> m ()
withFileRawOStream String
path Bool
False Bool
False ((Ptr RawOStream -> IO ()) -> AnyContT IO ())
-> (Ptr RawOStream -> IO ()) -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> Ptr RawOStream -> IO ()
FFI.writeBitcode Ptr Module
m'

-- | May throw 'TargetMachineEmitException'.
targetMachineEmit :: FFI.CodeGenFileType -> TargetMachine -> Module -> Ptr FFI.RawPWriteStream -> IO ()
targetMachineEmit :: CodeGenFileType
-> TargetMachine -> Module -> RawPWriteStreamCallback
targetMachineEmit CodeGenFileType
fileType (TargetMachine Ptr TargetMachine
tm) Module
m Ptr RawPWriteStream
os = (() -> IO ()) -> AnyContT IO () -> IO ()
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO () -> IO ()) -> AnyContT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr (OwnerTransfered (Ptr CChar))
msgPtr <- AnyContT IO (Ptr (OwnerTransfered (Ptr CChar)))
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
  Ptr Module
m' <- Module -> AnyContT IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  Bool
r <- LLVMBool -> AnyContT IO Bool
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LLVMBool -> AnyContT IO Bool)
-> AnyContT IO LLVMBool -> AnyContT IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO LLVMBool -> AnyContT IO LLVMBool
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LLVMBool -> AnyContT IO LLVMBool)
-> IO LLVMBool -> AnyContT IO LLVMBool
forall a b. (a -> b) -> a -> b
$ Ptr TargetMachine
-> Ptr Module
-> Ptr RawPWriteStream
-> CodeGenFileType
-> Ptr (OwnerTransfered (Ptr CChar))
-> IO LLVMBool
FFI.targetMachineEmit Ptr TargetMachine
tm Ptr Module
m' Ptr RawPWriteStream
os CodeGenFileType
fileType Ptr (OwnerTransfered (Ptr CChar))
msgPtr)
  Bool -> AnyContT IO () -> AnyContT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
r (AnyContT IO () -> AnyContT IO ())
-> AnyContT IO () -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ TargetMachineEmitException -> AnyContT IO ()
forall e a. Exception e => e -> AnyContT IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TargetMachineEmitException -> AnyContT IO ())
-> (String -> TargetMachineEmitException)
-> String
-> AnyContT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TargetMachineEmitException
TargetMachineEmitException (String -> AnyContT IO ()) -> AnyContT IO String -> AnyContT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (OwnerTransfered (Ptr CChar)) -> AnyContT IO String
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr (OwnerTransfered (Ptr CChar))
msgPtr

-- | May throw 'FdStreamException' and 'TargetMachineEmitException'.
emitToFile :: FFI.CodeGenFileType -> TargetMachine -> File -> Module -> IO ()
emitToFile :: CodeGenFileType -> TargetMachine -> File -> Module -> IO ()
emitToFile CodeGenFileType
fileType TargetMachine
tm (File String
path) Module
m = (() -> IO ()) -> AnyContT IO () -> IO ()
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO () -> IO ()) -> AnyContT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  String -> Bool -> Bool -> RawPWriteStreamCallback -> AnyContT IO ()
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadAnyCont IO m) =>
String -> Bool -> Bool -> RawPWriteStreamCallback -> m ()
withFileRawPWriteStream String
path Bool
False Bool
False (RawPWriteStreamCallback -> AnyContT IO ())
-> RawPWriteStreamCallback -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ CodeGenFileType
-> TargetMachine -> Module -> RawPWriteStreamCallback
targetMachineEmit CodeGenFileType
fileType TargetMachine
tm Module
m

-- | May throw 'TargetMachineEmitException'.
emitToByteString :: FFI.CodeGenFileType -> TargetMachine -> Module -> IO BS.ByteString
emitToByteString :: CodeGenFileType -> TargetMachine -> Module -> IO ByteString
emitToByteString CodeGenFileType
fileType TargetMachine
tm Module
m = (ByteString -> IO ByteString)
-> AnyContT IO ByteString -> IO ByteString
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO ByteString -> IO ByteString)
-> AnyContT IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
  RawPWriteStreamCallback -> AnyContT IO ByteString
forall (m :: * -> *) a.
(MonadIO m, DecodeM IO a (Ptr CChar, CSize)) =>
RawPWriteStreamCallback -> m a
withBufferRawPWriteStream (RawPWriteStreamCallback -> AnyContT IO ByteString)
-> RawPWriteStreamCallback -> AnyContT IO ByteString
forall a b. (a -> b) -> a -> b
$ CodeGenFileType
-> TargetMachine -> Module -> RawPWriteStreamCallback
targetMachineEmit CodeGenFileType
fileType TargetMachine
tm Module
m

-- | write target-specific assembly directly into a file
writeTargetAssemblyToFile :: TargetMachine -> File -> Module -> IO ()
writeTargetAssemblyToFile :: TargetMachine -> File -> Module -> IO ()
writeTargetAssemblyToFile = CodeGenFileType -> TargetMachine -> File -> Module -> IO ()
emitToFile CodeGenFileType
FFI.codeGenFileTypeAssembly

-- | produce target-specific assembly as a 'ByteString'
moduleTargetAssembly :: TargetMachine -> Module -> IO ByteString
moduleTargetAssembly :: TargetMachine -> Module -> IO ByteString
moduleTargetAssembly TargetMachine
tm Module
m = CodeGenFileType -> TargetMachine -> Module -> IO ByteString
emitToByteString CodeGenFileType
FFI.codeGenFileTypeAssembly TargetMachine
tm Module
m

-- | produce target-specific object code as a 'ByteString'
moduleObject :: TargetMachine -> Module -> IO BS.ByteString
moduleObject :: TargetMachine -> Module -> IO ByteString
moduleObject = CodeGenFileType -> TargetMachine -> Module -> IO ByteString
emitToByteString CodeGenFileType
FFI.codeGenFileTypeObject

-- | write target-specific object code directly into a file
writeObjectToFile :: TargetMachine -> File -> Module -> IO ()
writeObjectToFile :: TargetMachine -> File -> Module -> IO ()
writeObjectToFile = CodeGenFileType -> TargetMachine -> File -> Module -> IO ()
emitToFile CodeGenFileType
FFI.codeGenFileTypeObject

setTargetTriple :: Ptr FFI.Module -> ShortByteString -> EncodeAST ()
setTargetTriple :: Ptr Module -> ShortByteString -> EncodeAST ()
setTargetTriple Ptr Module
m ShortByteString
t = do
  Ptr CChar
t <- ShortByteString -> EncodeAST (Ptr CChar)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
t
  IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> Ptr CChar -> IO ()
FFI.setTargetTriple Ptr Module
m Ptr CChar
t

getTargetTriple :: Ptr FFI.Module -> IO (Maybe ShortByteString)
getTargetTriple :: Ptr Module -> IO (Maybe ShortByteString)
getTargetTriple Ptr Module
m = do
  ShortByteString
s <- Ptr CChar -> IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (Ptr CChar -> IO ShortByteString)
-> IO (Ptr CChar) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr CChar) -> IO (Ptr CChar)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Module -> IO (Ptr CChar)
FFI.getTargetTriple Ptr Module
m)
  Maybe ShortByteString -> IO (Maybe ShortByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ShortByteString -> IO (Maybe ShortByteString))
-> Maybe ShortByteString -> IO (Maybe ShortByteString)
forall a b. (a -> b) -> a -> b
$ if ShortByteString -> Bool
SBS.null ShortByteString
s then Maybe ShortByteString
forall a. Maybe a
Nothing else ShortByteString -> Maybe ShortByteString
forall a. a -> Maybe a
Just ShortByteString
s

setDataLayout :: Ptr FFI.Module -> A.DataLayout -> EncodeAST ()
setDataLayout :: Ptr Module -> DataLayout -> EncodeAST ()
setDataLayout Ptr Module
m DataLayout
dl = do
  Ptr CChar
s <- ByteString -> EncodeAST (Ptr CChar)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (DataLayout -> ByteString
dataLayoutToString DataLayout
dl)
  IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> Ptr CChar -> IO ()
FFI.setDataLayout Ptr Module
m Ptr CChar
s

getDataLayout :: Ptr FFI.Module -> IO (Maybe A.DataLayout)
getDataLayout :: Ptr Module -> IO (Maybe DataLayout)
getDataLayout Ptr Module
m = do
  ByteString
dlString <- Ptr CChar -> IO ByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (Ptr CChar -> IO ByteString) -> IO (Ptr CChar) -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Module -> IO (Ptr CChar)
FFI.getDataLayout Ptr Module
m
  (String -> IO (Maybe DataLayout))
-> (Maybe DataLayout -> IO (Maybe DataLayout))
-> Either String (Maybe DataLayout)
-> IO (Maybe DataLayout)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO (Maybe DataLayout)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Maybe DataLayout -> IO (Maybe DataLayout)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe DataLayout) -> IO (Maybe DataLayout))
-> (ByteString -> Either String (Maybe DataLayout))
-> ByteString
-> IO (Maybe DataLayout)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except String (Maybe DataLayout)
-> Either String (Maybe DataLayout)
forall e a. Except e a -> Either e a
runExcept (Except String (Maybe DataLayout)
 -> Either String (Maybe DataLayout))
-> (ByteString -> Except String (Maybe DataLayout))
-> ByteString
-> Either String (Maybe DataLayout)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endianness -> ByteString -> Except String (Maybe DataLayout)
parseDataLayout Endianness
A.BigEndian (ByteString -> IO (Maybe DataLayout))
-> ByteString -> IO (Maybe DataLayout)
forall a b. (a -> b) -> a -> b
$ ByteString
dlString

-- | Execute a function after encoding the module in LLVM’s internal representation.
-- May throw 'EncodeException'.
withModuleFromAST :: Context -> A.Module -> (Module -> IO a) -> IO a
withModuleFromAST :: forall a. Context -> Module -> (Module -> IO a) -> IO a
withModuleFromAST Context
context Module
ast =
  IO Module -> (Module -> IO ()) -> (Module -> IO a) -> IO a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (Context -> Module -> IO Module
createModuleFromAST Context
context Module
ast) Module -> IO ()
disposeModule

-- | Encode the module AST in LLVM’s internal representation.
-- May throw 'EncodeException'.
createModuleFromAST :: Context -> A.Module -> IO Module
createModuleFromAST :: Context -> Module -> IO Module
createModuleFromAST context :: Context
context@(Context Ptr Context
c) (A.Module ShortByteString
moduleId ShortByteString
sourceFileName Maybe DataLayout
dataLayout Maybe ShortByteString
triple [Definition]
definitions) = Context -> EncodeAST Module -> IO Module
forall a. Context -> EncodeAST a -> IO a
runEncodeAST Context
context (EncodeAST Module -> IO Module) -> EncodeAST Module -> IO Module
forall a b. (a -> b) -> a -> b
$ do
  Ptr CChar
moduleId <- ShortByteString -> EncodeAST (Ptr CChar)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
moduleId
  Module
m <- IO Module -> EncodeAST Module
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Module -> EncodeAST Module) -> IO Module -> EncodeAST Module
forall a b. (a -> b) -> a -> b
$ Ptr Module -> IO Module
newModule (Ptr Module -> IO Module) -> IO (Ptr Module) -> IO Module
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CChar -> Ptr Context -> IO (Ptr Module)
FFI.moduleCreateWithNameInContext Ptr CChar
moduleId Ptr Context
c
  Ptr Module
ffiMod <- Module -> EncodeAST (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  Ptr CChar
sourceFileName' <- ShortByteString -> EncodeAST (Ptr CChar)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
sourceFileName
  IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> Ptr CChar -> IO ()
FFI.setSourceFileName Ptr Module
ffiMod Ptr CChar
sourceFileName'
  Context Ptr Context
context <- (EncodeState -> Context) -> EncodeAST Context
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EncodeState -> Context
encodeStateContext
  (DataLayout -> EncodeAST ()) -> Maybe DataLayout -> EncodeAST ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ptr Module -> DataLayout -> EncodeAST ()
setDataLayout Ptr Module
ffiMod) Maybe DataLayout
dataLayout
  (ShortByteString -> EncodeAST ())
-> Maybe ShortByteString -> EncodeAST ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ptr Module -> ShortByteString -> EncodeAST ()
setTargetTriple Ptr Module
ffiMod) Maybe ShortByteString
triple
  let sequencePhases :: EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))] -> EncodeAST ()
      sequencePhases :: EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
-> EncodeAST ()
sequencePhases EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
l = (EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
l EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
-> ([EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
    -> EncodeAST [()])
-> EncodeAST [()]
forall a b. EncodeAST a -> (a -> EncodeAST b) -> EncodeAST b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
-> EncodeAST [EncodeAST (EncodeAST (EncodeAST ()))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
 -> EncodeAST [EncodeAST (EncodeAST (EncodeAST ()))])
-> ([EncodeAST (EncodeAST (EncodeAST ()))] -> EncodeAST [()])
-> [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
-> EncodeAST [()]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [EncodeAST (EncodeAST (EncodeAST ()))]
-> EncodeAST [EncodeAST (EncodeAST ())]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([EncodeAST (EncodeAST (EncodeAST ()))]
 -> EncodeAST [EncodeAST (EncodeAST ())])
-> ([EncodeAST (EncodeAST ())] -> EncodeAST [()])
-> [EncodeAST (EncodeAST (EncodeAST ()))]
-> EncodeAST [()]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [EncodeAST (EncodeAST ())] -> EncodeAST [EncodeAST ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([EncodeAST (EncodeAST ())] -> EncodeAST [EncodeAST ()])
-> ([EncodeAST ()] -> EncodeAST [()])
-> [EncodeAST (EncodeAST ())]
-> EncodeAST [()]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [EncodeAST ()] -> EncodeAST [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence)) EncodeAST [()] -> EncodeAST () -> EncodeAST ()
forall a b. EncodeAST a -> EncodeAST b -> EncodeAST b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (() -> EncodeAST ()
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
-> EncodeAST ()
sequencePhases (EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
 -> EncodeAST ())
-> EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
-> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ [Definition]
-> (Definition
    -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Definition]
definitions ((Definition
  -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
 -> EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))])
-> (Definition
    -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
forall a b. (a -> b) -> a -> b
$ \Definition
d -> case Definition
d of
   A.TypeDefinition Name
n Maybe Type
t -> do
     (Ptr Type
t', Maybe ShortByteString
n') <- Name -> EncodeAST (Ptr Type, Maybe ShortByteString)
createNamedType Name
n
     Name -> Maybe ShortByteString -> Ptr Type -> EncodeAST ()
defineType Name
n Maybe ShortByteString
n' Ptr Type
t'
     EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a b. (a -> b) -> a -> b
$ do
       (Type -> EncodeAST ()) -> Maybe Type -> EncodeAST ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ptr Type -> Type -> EncodeAST ()
setNamedType Ptr Type
t') Maybe Type
t
       EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST ()))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> (() -> EncodeAST (EncodeAST (EncodeAST ())))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ())))
-> (() -> EncodeAST (EncodeAST ()))
-> ()
-> EncodeAST (EncodeAST (EncodeAST ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST () -> EncodeAST (EncodeAST ())
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST () -> EncodeAST (EncodeAST ()))
-> (() -> EncodeAST ()) -> () -> EncodeAST (EncodeAST ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> EncodeAST ()
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> () -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall a b. (a -> b) -> a -> b
$ ()

   A.COMDAT ShortByteString
n SelectionKind
csk -> do
     Ptr CChar
n' <- ShortByteString -> EncodeAST (Ptr CChar)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
n
     COMDATSelectionKind
csk <- SelectionKind -> EncodeAST COMDATSelectionKind
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM SelectionKind
csk
     Ptr COMDAT
cd <- IO (Ptr COMDAT) -> EncodeAST (Ptr COMDAT)
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr COMDAT) -> EncodeAST (Ptr COMDAT))
-> IO (Ptr COMDAT) -> EncodeAST (Ptr COMDAT)
forall a b. (a -> b) -> a -> b
$ Ptr Module -> Ptr CChar -> IO (Ptr COMDAT)
FFI.getOrInsertCOMDAT Ptr Module
ffiMod Ptr CChar
n'
     IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr COMDAT -> COMDATSelectionKind -> IO ()
FFI.setCOMDATSelectionKind Ptr COMDAT
cd COMDATSelectionKind
csk
     ShortByteString -> Ptr COMDAT -> EncodeAST ()
defineCOMDAT ShortByteString
n Ptr COMDAT
cd
     EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> (() -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST ()))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> (() -> EncodeAST (EncodeAST (EncodeAST ())))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ())))
-> (() -> EncodeAST (EncodeAST ()))
-> ()
-> EncodeAST (EncodeAST (EncodeAST ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST () -> EncodeAST (EncodeAST ())
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST () -> EncodeAST (EncodeAST ()))
-> (() -> EncodeAST ()) -> () -> EncodeAST (EncodeAST ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> EncodeAST ()
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (()
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a b. (a -> b) -> a -> b
$ ()

   A.MetadataNodeDefinition MetadataNodeID
i MDNode
md -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> (EncodeAST (EncodeAST (EncodeAST ()))
    -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST ()))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a b. (a -> b) -> a -> b
$ do
     Ptr MDNode
t <- IO (Ptr MDNode) -> EncodeAST (Ptr MDNode)
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr MDNode) -> EncodeAST (Ptr MDNode))
-> IO (Ptr MDNode) -> EncodeAST (Ptr MDNode)
forall a b. (a -> b) -> a -> b
$ Ptr Context -> IO (Ptr MDNode)
FFI.createTemporaryMDNodeInContext Ptr Context
context
     MetadataNodeID -> Ptr MDNode -> EncodeAST ()
defineMDNode MetadataNodeID
i Ptr MDNode
t
     EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a b. (a -> b) -> a -> b
$ do
       Ptr MDNode
n <- MDNode -> EncodeAST (Ptr MDNode)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM MDNode
md
       IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr MDNode -> Ptr Metadata -> IO ()
FFI.metadataReplaceAllUsesWith (Ptr MDNode -> Ptr MDNode
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr MDNode
t) (Ptr MDNode -> Ptr Metadata
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr MDNode
n)
       MetadataNodeID -> Ptr MDNode -> EncodeAST ()
defineMDNode MetadataNodeID
i Ptr MDNode
n
       EncodeAST () -> EncodeAST (EncodeAST ())
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST () -> EncodeAST (EncodeAST ()))
-> EncodeAST () -> EncodeAST (EncodeAST ())
forall a b. (a -> b) -> a -> b
$ () -> EncodeAST ()
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

   A.NamedMetadataDefinition ShortByteString
n [MetadataNodeID]
ids -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> (EncodeAST ()
    -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> EncodeAST ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST ()))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> (EncodeAST () -> EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ())))
-> (EncodeAST () -> EncodeAST (EncodeAST ()))
-> EncodeAST ()
-> EncodeAST (EncodeAST (EncodeAST ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST () -> EncodeAST (EncodeAST ())
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST ()
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> EncodeAST ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a b. (a -> b) -> a -> b
$ do
     Ptr CChar
n <- ShortByteString -> EncodeAST (Ptr CChar)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
n
     (CUInt, Ptr (Ptr MDNode))
ids <- [MDRef MDNode] -> EncodeAST (CUInt, Ptr (Ptr MDNode))
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ((MetadataNodeID -> MDRef MDNode)
-> [MetadataNodeID] -> [MDRef MDNode]
forall a b. (a -> b) -> [a] -> [b]
map MetadataNodeID -> MDRef MDNode
forall a. MetadataNodeID -> MDRef a
A.MDRef [MetadataNodeID]
ids :: [A.MDRef A.MDNode])
     Ptr NamedMetadata
nm <- IO (Ptr NamedMetadata) -> EncodeAST (Ptr NamedMetadata)
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr NamedMetadata) -> EncodeAST (Ptr NamedMetadata))
-> IO (Ptr NamedMetadata) -> EncodeAST (Ptr NamedMetadata)
forall a b. (a -> b) -> a -> b
$ Ptr Module -> Ptr CChar -> IO (Ptr NamedMetadata)
FFI.getOrAddNamedMetadata Ptr Module
ffiMod Ptr CChar
n
     IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr NamedMetadata -> (CUInt, Ptr (Ptr MDNode)) -> IO ()
FFI.namedMetadataAddOperands Ptr NamedMetadata
nm (CUInt, Ptr (Ptr MDNode))
ids
     () -> EncodeAST ()
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

   A.ModuleInlineAssembly ByteString
s -> do
     (Ptr CChar, CUInt)
s <- ByteString -> EncodeAST (Ptr CChar, CUInt)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ByteString
s
     IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> ModuleAsm (Ptr CChar, CUInt) -> IO ()
FFI.moduleAppendInlineAsm Ptr Module
ffiMod ((Ptr CChar, CUInt) -> ModuleAsm (Ptr CChar, CUInt)
forall a. a -> ModuleAsm a
FFI.ModuleAsm (Ptr CChar, CUInt)
s)
     EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> (() -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST ()))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> (() -> EncodeAST (EncodeAST (EncodeAST ())))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ())))
-> (() -> EncodeAST (EncodeAST ()))
-> ()
-> EncodeAST (EncodeAST (EncodeAST ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST () -> EncodeAST (EncodeAST ())
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST () -> EncodeAST (EncodeAST ()))
-> (() -> EncodeAST ()) -> () -> EncodeAST (EncodeAST ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> EncodeAST ()
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (()
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a b. (a -> b) -> a -> b
$ ()

   A.FunctionAttributes GroupID
gid [FunctionAttribute]
attrs -> do
     FunctionAttributeSet
attrs <- [FunctionAttribute] -> EncodeAST FunctionAttributeSet
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM [FunctionAttribute]
attrs
     GroupID -> FunctionAttributeSet -> EncodeAST ()
defineAttributeGroup GroupID
gid FunctionAttributeSet
attrs
     EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> (() -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST ()))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> (() -> EncodeAST (EncodeAST (EncodeAST ())))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ())))
-> (() -> EncodeAST (EncodeAST ()))
-> ()
-> EncodeAST (EncodeAST (EncodeAST ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST () -> EncodeAST (EncodeAST ())
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST () -> EncodeAST (EncodeAST ()))
-> (() -> EncodeAST ()) -> () -> EncodeAST (EncodeAST ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> EncodeAST ()
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (()
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> ()
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a b. (a -> b) -> a -> b
$ ()

   A.GlobalDefinition Global
g -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> (EncodeAST (EncodeAST (EncodeAST ()))
    -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
-> EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
forall a. EncodeAST a -> EncodeAST (EncodeAST a)
phase (EncodeAST (EncodeAST (EncodeAST ()))
 -> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))))
-> EncodeAST (EncodeAST (EncodeAST ()))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
forall a b. (a -> b) -> a -> b
$ do
     EncodeAST (Ptr GlobalValue)
eg' :: EncodeAST (Ptr FFI.GlobalValue) <- case Global
g of
       g :: Global
g@(A.GlobalVariable { name :: Global -> Name
A.G.name = Name
n }) -> do
         Ptr Type
typ <- Type -> EncodeAST (Ptr Type)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Global -> Type
A.G.type' Global
g)
         Ptr GlobalVariable
g' <- IO (Ptr GlobalVariable) -> EncodeAST (Ptr GlobalVariable)
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr GlobalVariable) -> EncodeAST (Ptr GlobalVariable))
-> IO (Ptr GlobalVariable) -> EncodeAST (Ptr GlobalVariable)
forall a b. (a -> b) -> a -> b
$ Name
-> (Ptr CChar -> IO (Ptr GlobalVariable))
-> IO (Ptr GlobalVariable)
forall a. Name -> (Ptr CChar -> IO a) -> IO a
withName Name
n ((Ptr CChar -> IO (Ptr GlobalVariable)) -> IO (Ptr GlobalVariable))
-> (Ptr CChar -> IO (Ptr GlobalVariable))
-> IO (Ptr GlobalVariable)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
gName ->
                   Ptr Module
-> Ptr Type -> Ptr CChar -> CUInt -> IO (Ptr GlobalVariable)
FFI.addGlobalInAddressSpace Ptr Module
ffiMod Ptr Type
typ Ptr CChar
gName
                          (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((\(A.AddrSpace Word32
a) -> Word32
a) (AddrSpace -> Word32) -> AddrSpace -> Word32
forall a b. (a -> b) -> a -> b
$ Global -> AddrSpace
A.G.addrSpace Global
g))
         Name -> Ptr GlobalVariable -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Name -> Ptr v -> EncodeAST ()
defineGlobal Name
n Ptr GlobalVariable
g'
         Ptr GlobalVariable -> Maybe Model -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Maybe Model -> EncodeAST ()
setThreadLocalMode Ptr GlobalVariable
g' (Global -> Maybe Model
A.G.threadLocalMode Global
g)
         IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ do
           UnnamedAddr
hua <- Maybe UnnamedAddr -> IO UnnamedAddr
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Global -> Maybe UnnamedAddr
A.G.unnamedAddr Global
g)
           Ptr GlobalValue -> UnnamedAddr -> IO ()
FFI.setUnnamedAddr (Ptr GlobalVariable -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr GlobalVariable
g') UnnamedAddr
hua
           LLVMBool
ic <- Bool -> IO LLVMBool
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Global -> Bool
A.G.isConstant Global
g)
           Ptr GlobalVariable -> LLVMBool -> IO ()
FFI.setGlobalConstant Ptr GlobalVariable
g' LLVMBool
ic
         EncodeAST (Ptr GlobalValue)
-> EncodeAST (EncodeAST (Ptr GlobalValue))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (Ptr GlobalValue)
 -> EncodeAST (EncodeAST (Ptr GlobalValue)))
-> EncodeAST (Ptr GlobalValue)
-> EncodeAST (EncodeAST (Ptr GlobalValue))
forall a b. (a -> b) -> a -> b
$ do
           (Constant -> EncodeAST ()) -> Maybe Constant -> EncodeAST ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ())
-> (Ptr Constant -> IO ()) -> Ptr Constant -> EncodeAST ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr GlobalVariable -> Ptr Constant -> IO ()
FFI.setInitializer Ptr GlobalVariable
g') (Ptr Constant -> EncodeAST ())
-> (Constant -> EncodeAST (Ptr Constant))
-> Constant
-> EncodeAST ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Constant -> EncodeAST (Ptr Constant)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM) (Global -> Maybe Constant
A.G.initializer Global
g)
           Ptr GlobalVariable -> Maybe ShortByteString -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Maybe ShortByteString -> EncodeAST ()
setSection Ptr GlobalVariable
g' (Global -> Maybe ShortByteString
A.G.section Global
g)
           Ptr GlobalVariable -> Maybe ShortByteString -> EncodeAST ()
forall v.
DescendentOf GlobalObject v =>
Ptr v -> Maybe ShortByteString -> EncodeAST ()
setCOMDAT Ptr GlobalVariable
g' (Global -> Maybe ShortByteString
A.G.comdat Global
g)
           Ptr GlobalVariable -> Word32 -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Word32 -> EncodeAST ()
setAlignment Ptr GlobalVariable
g' (Global -> Word32
A.G.alignment Global
g)
           Ptr GlobalObject
-> [(ShortByteString, MDRef MDNode)] -> EncodeAST ()
setMetadata (Ptr GlobalVariable -> Ptr GlobalObject
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr GlobalVariable
g') (Global -> [(ShortByteString, MDRef MDNode)]
A.G.metadata Global
g)
           Ptr GlobalValue -> EncodeAST (Ptr GlobalValue)
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr GlobalVariable -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr GlobalVariable
g')
       (a :: Global
a@A.G.GlobalAlias { name :: Global -> Name
A.G.name = Name
n }) -> do
         Ptr Type
typ <- Type -> EncodeAST (Ptr Type)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Global -> Type
A.G.type' Global
a)
         AddrSpace
as <- AddrSpace -> EncodeAST AddrSpace
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Global -> AddrSpace
A.G.addrSpace Global
a)
         Ptr GlobalAlias
a' <- IO (Ptr GlobalAlias) -> EncodeAST (Ptr GlobalAlias)
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr GlobalAlias) -> EncodeAST (Ptr GlobalAlias))
-> IO (Ptr GlobalAlias) -> EncodeAST (Ptr GlobalAlias)
forall a b. (a -> b) -> a -> b
$ Name -> (Ptr CChar -> IO (Ptr GlobalAlias)) -> IO (Ptr GlobalAlias)
forall a. Name -> (Ptr CChar -> IO a) -> IO a
withName Name
n ((Ptr CChar -> IO (Ptr GlobalAlias)) -> IO (Ptr GlobalAlias))
-> (Ptr CChar -> IO (Ptr GlobalAlias)) -> IO (Ptr GlobalAlias)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
name -> Ptr Module
-> Ptr Type -> AddrSpace -> Ptr CChar -> IO (Ptr GlobalAlias)
FFI.justAddAlias Ptr Module
ffiMod Ptr Type
typ AddrSpace
as Ptr CChar
name
         Name -> Ptr GlobalAlias -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Name -> Ptr v -> EncodeAST ()
defineGlobal Name
n Ptr GlobalAlias
a'
         IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ do
           UnnamedAddr
hua <- Maybe UnnamedAddr -> IO UnnamedAddr
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Global -> Maybe UnnamedAddr
A.G.unnamedAddr Global
a)
           Ptr GlobalValue -> UnnamedAddr -> IO ()
FFI.setUnnamedAddr (Ptr GlobalAlias -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr GlobalAlias
a') UnnamedAddr
hua
         EncodeAST (Ptr GlobalValue)
-> EncodeAST (EncodeAST (Ptr GlobalValue))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (Ptr GlobalValue)
 -> EncodeAST (EncodeAST (Ptr GlobalValue)))
-> EncodeAST (Ptr GlobalValue)
-> EncodeAST (EncodeAST (Ptr GlobalValue))
forall a b. (a -> b) -> a -> b
$ do
           Ptr GlobalAlias -> Maybe Model -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Maybe Model -> EncodeAST ()
setThreadLocalMode Ptr GlobalAlias
a' (Global -> Maybe Model
A.G.threadLocalMode Global
a)
           (IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ())
-> (Ptr Constant -> IO ()) -> Ptr Constant -> EncodeAST ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr GlobalAlias -> Ptr Constant -> IO ()
FFI.setAliasee Ptr GlobalAlias
a') (Ptr Constant -> EncodeAST ())
-> EncodeAST (Ptr Constant) -> EncodeAST ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Constant -> EncodeAST (Ptr Constant)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Global -> Constant
A.G.aliasee Global
a)
           Ptr GlobalValue -> EncodeAST (Ptr GlobalValue)
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr GlobalAlias -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr GlobalAlias
a')
       (A.Function Linkage
_ Visibility
_ Maybe StorageClass
_ CallingConvention
cc [ParameterAttribute]
rAttrs Type
resultType Name
fName ([Parameter]
args, Bool
isVarArgs) [Either GroupID FunctionAttribute]
attrs Maybe ShortByteString
_ Maybe ShortByteString
_ Word32
_ Maybe ShortByteString
gc Maybe Constant
prefix [BasicBlock]
blocks Maybe Constant
personality [(ShortByteString, MDRef MDNode)]
metadata) -> do
         Ptr Type
typ <- Type -> EncodeAST (Ptr Type)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Type -> EncodeAST (Ptr Type)) -> Type -> EncodeAST (Ptr Type)
forall a b. (a -> b) -> a -> b
$ Type -> [Type] -> Bool -> Type
A.FunctionType Type
resultType [Type
t | A.Parameter Type
t Name
_ [ParameterAttribute]
_ <- [Parameter]
args] Bool
isVarArgs
         Ptr Function
f <- IO (Ptr Function) -> EncodeAST (Ptr Function)
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Function) -> EncodeAST (Ptr Function))
-> ((Ptr CChar -> IO (Ptr Function)) -> IO (Ptr Function))
-> (Ptr CChar -> IO (Ptr Function))
-> EncodeAST (Ptr Function)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (Ptr CChar -> IO (Ptr Function)) -> IO (Ptr Function)
forall a. Name -> (Ptr CChar -> IO a) -> IO a
withName Name
fName ((Ptr CChar -> IO (Ptr Function)) -> EncodeAST (Ptr Function))
-> (Ptr CChar -> IO (Ptr Function)) -> EncodeAST (Ptr Function)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fName -> Ptr Module -> Ptr CChar -> Ptr Type -> IO (Ptr Function)
FFI.addFunction Ptr Module
ffiMod Ptr CChar
fName Ptr Type
typ
         Name -> Ptr Function -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Name -> Ptr v -> EncodeAST ()
defineGlobal Name
fName Ptr Function
f
         CallingConvention
cc <- CallingConvention -> EncodeAST CallingConvention
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM CallingConvention
cc
         IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Function -> CallingConvention -> IO ()
FFI.setFunctionCallingConvention Ptr Function
f CallingConvention
cc
         Ptr Function -> AttributeList -> EncodeAST ()
setFunctionAttributes Ptr Function
f ([Either GroupID FunctionAttribute]
-> [ParameterAttribute] -> [[ParameterAttribute]] -> AttributeList
AttributeList [Either GroupID FunctionAttribute]
attrs [ParameterAttribute]
rAttrs [[ParameterAttribute]
pa | A.Parameter Type
_ Name
_ [ParameterAttribute]
pa <- [Parameter]
args])
         Ptr Function -> Maybe Constant -> EncodeAST ()
setPrefixData Ptr Function
f Maybe Constant
prefix
         Ptr Function -> Maybe ShortByteString -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Maybe ShortByteString -> EncodeAST ()
setSection Ptr Function
f (Global -> Maybe ShortByteString
A.G.section Global
g)
         Ptr Function -> Maybe ShortByteString -> EncodeAST ()
forall v.
DescendentOf GlobalObject v =>
Ptr v -> Maybe ShortByteString -> EncodeAST ()
setCOMDAT Ptr Function
f (Global -> Maybe ShortByteString
A.G.comdat Global
g)
         Ptr Function -> Word32 -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Word32 -> EncodeAST ()
setAlignment Ptr Function
f (Global -> Word32
A.G.alignment Global
g)
         Ptr Function -> Maybe ShortByteString -> EncodeAST ()
setGC Ptr Function
f Maybe ShortByteString
gc
         Ptr Function -> Maybe Constant -> EncodeAST ()
setPersonalityFn Ptr Function
f Maybe Constant
personality
         [BasicBlock] -> (BasicBlock -> EncodeAST ()) -> EncodeAST ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BasicBlock]
blocks ((BasicBlock -> EncodeAST ()) -> EncodeAST ())
-> (BasicBlock -> EncodeAST ()) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \(A.BasicBlock Name
bName [Named Instruction]
_ Named Terminator
_) -> do
           Ptr BasicBlock
b <- IO (Ptr BasicBlock) -> EncodeAST (Ptr BasicBlock)
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr BasicBlock) -> EncodeAST (Ptr BasicBlock))
-> IO (Ptr BasicBlock) -> EncodeAST (Ptr BasicBlock)
forall a b. (a -> b) -> a -> b
$ Name -> (Ptr CChar -> IO (Ptr BasicBlock)) -> IO (Ptr BasicBlock)
forall a. Name -> (Ptr CChar -> IO a) -> IO a
withName Name
bName ((Ptr CChar -> IO (Ptr BasicBlock)) -> IO (Ptr BasicBlock))
-> (Ptr CChar -> IO (Ptr BasicBlock)) -> IO (Ptr BasicBlock)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
bName -> Ptr Context -> Ptr Function -> Ptr CChar -> IO (Ptr BasicBlock)
FFI.appendBasicBlockInContext Ptr Context
context Ptr Function
f Ptr CChar
bName
           Name -> Name -> Ptr BasicBlock -> EncodeAST ()
defineBasicBlock Name
fName Name
bName Ptr BasicBlock
b
         EncodeAST (Ptr GlobalValue)
-> EncodeAST (EncodeAST (Ptr GlobalValue))
forall a. EncodeAST a -> EncodeAST (EncodeAST a)
phase (EncodeAST (Ptr GlobalValue)
 -> EncodeAST (EncodeAST (Ptr GlobalValue)))
-> EncodeAST (Ptr GlobalValue)
-> EncodeAST (EncodeAST (Ptr GlobalValue))
forall a b. (a -> b) -> a -> b
$ do
           let nParams :: Int
nParams = [Parameter] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Parameter]
args
           Ptr (Ptr Parameter)
ps <- Int -> EncodeAST (Ptr (Ptr Parameter))
forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray Int
nParams
           IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Function -> Ptr (Ptr Parameter) -> IO ()
FFI.getParams Ptr Function
f Ptr (Ptr Parameter)
ps
           [Ptr Parameter]
params <- Int -> Ptr (Ptr Parameter) -> EncodeAST [Ptr Parameter]
forall i a (m :: * -> *).
(Integral i, Storable a, MonadIO m) =>
i -> Ptr a -> m [a]
peekArray Int
nParams Ptr (Ptr Parameter)
ps
           [(Parameter, Ptr Parameter)]
-> ((Parameter, Ptr Parameter) -> EncodeAST ()) -> EncodeAST ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Parameter] -> [Ptr Parameter] -> [(Parameter, Ptr Parameter)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Parameter]
args [Ptr Parameter]
params) (((Parameter, Ptr Parameter) -> EncodeAST ()) -> EncodeAST ())
-> ((Parameter, Ptr Parameter) -> EncodeAST ()) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \(A.Parameter Type
_ Name
n [ParameterAttribute]
_, Ptr Parameter
p) -> do
             Name -> Ptr Parameter -> EncodeAST ()
forall v. DescendentOf Value v => Name -> Ptr v -> EncodeAST ()
defineLocal Name
n Ptr Parameter
p
             Ptr CChar
n <- Name -> EncodeAST (Ptr CChar)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Name
n
             IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Value -> Ptr CChar -> IO ()
FFI.setValueName (Ptr Parameter -> Ptr Value
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr Parameter
p) Ptr CChar
n
           [EncodeAST ()]
finishInstrs <- [BasicBlock]
-> (BasicBlock -> EncodeAST (EncodeAST ()))
-> EncodeAST [EncodeAST ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [BasicBlock]
blocks ((BasicBlock -> EncodeAST (EncodeAST ()))
 -> EncodeAST [EncodeAST ()])
-> (BasicBlock -> EncodeAST (EncodeAST ()))
-> EncodeAST [EncodeAST ()]
forall a b. (a -> b) -> a -> b
$ \(A.BasicBlock Name
bName [Named Instruction]
namedInstrs Named Terminator
term) -> do
             Ptr BasicBlock
b <- Name -> EncodeAST (Ptr BasicBlock)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Name
bName
             (do
               Ptr Builder
builder <- (EncodeState -> Ptr Builder) -> EncodeAST (Ptr Builder)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EncodeState -> Ptr Builder
encodeStateBuilder
               IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Builder -> Ptr BasicBlock -> IO ()
FFI.positionBuilderAtEnd Ptr Builder
builder Ptr BasicBlock
b)
             [EncodeAST ()]
finishes <- (Named Instruction -> EncodeAST (EncodeAST ()))
-> [Named Instruction] -> EncodeAST [EncodeAST ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Named Instruction -> EncodeAST (EncodeAST ())
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM [Named Instruction]
namedInstrs :: EncodeAST [EncodeAST ()]
             EncodeAST (Ptr Instruction) -> EncodeAST ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Named Terminator -> EncodeAST (Ptr Instruction)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Named Terminator
term :: EncodeAST (Ptr FFI.Instruction))
             EncodeAST () -> EncodeAST (EncodeAST ())
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return ([EncodeAST ()] -> EncodeAST ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [EncodeAST ()]
finishes)
           [EncodeAST ()] -> EncodeAST ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [EncodeAST ()]
finishInstrs
           [(Name, LocalValue)]
locals <- (EncodeState -> [(Name, LocalValue)])
-> EncodeAST [(Name, LocalValue)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((EncodeState -> [(Name, LocalValue)])
 -> EncodeAST [(Name, LocalValue)])
-> (EncodeState -> [(Name, LocalValue)])
-> EncodeAST [(Name, LocalValue)]
forall a b. (a -> b) -> a -> b
$ Map Name LocalValue -> [(Name, LocalValue)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Name LocalValue -> [(Name, LocalValue)])
-> (EncodeState -> Map Name LocalValue)
-> EncodeState
-> [(Name, LocalValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeState -> Map Name LocalValue
encodeStateLocals
           [Name] -> (Name -> EncodeAST Any) -> EncodeAST ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ Name
n | (Name
n, ForwardValue Ptr Value
_) <- [(Name, LocalValue)]
locals ] ((Name -> EncodeAST Any) -> EncodeAST ())
-> (Name -> EncodeAST Any) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \Name
n -> String -> Name -> EncodeAST Any
forall n a. Show n => String -> n -> EncodeAST a
undefinedReference String
"local" Name
n
           Ptr GlobalObject
-> [(ShortByteString, MDRef MDNode)] -> EncodeAST ()
setMetadata (Ptr Function -> Ptr GlobalObject
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr Function
f) [(ShortByteString, MDRef MDNode)]
metadata
           Ptr GlobalValue -> EncodeAST (Ptr GlobalValue)
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Function -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr Function
f)
     EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST ()) -> EncodeAST (EncodeAST (EncodeAST ()))
forall a b. (a -> b) -> a -> b
$ do
       Ptr GlobalValue
g' <- EncodeAST (Ptr GlobalValue)
eg'
       Ptr GlobalValue -> Linkage -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Linkage -> EncodeAST ()
setLinkage Ptr GlobalValue
g' (Global -> Linkage
A.G.linkage Global
g)
       Ptr GlobalValue -> Visibility -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Visibility -> EncodeAST ()
setVisibility Ptr GlobalValue
g' (Global -> Visibility
A.G.visibility Global
g)
       Ptr GlobalValue -> Maybe StorageClass -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Ptr v -> Maybe StorageClass -> EncodeAST ()
setDLLStorageClass Ptr GlobalValue
g' (Global -> Maybe StorageClass
A.G.dllStorageClass Global
g)
       EncodeAST () -> EncodeAST (EncodeAST ())
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST () -> EncodeAST (EncodeAST ()))
-> EncodeAST () -> EncodeAST (EncodeAST ())
forall a b. (a -> b) -> a -> b
$ () -> EncodeAST ()
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Module -> EncodeAST Module
forall a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Module
m

-- | Destroys a module created by 'createModuleFromAST'.
disposeModule :: Module -> IO ()
disposeModule :: Module -> IO ()
disposeModule Module
m = Ptr Module -> IO ()
FFI.disposeModule (Ptr Module -> IO ()) -> IO (Ptr Module) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m

-- | Retrieves the context associated with a module.
moduleContext :: Module -> IO Context
moduleContext :: Module -> IO Context
moduleContext Module
m = Ptr Context -> Context
Context (Ptr Context -> Context) -> IO (Ptr Context) -> IO Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Module -> IO (Ptr Context)
FFI.getModuleContext (Ptr Module -> IO (Ptr Context))
-> IO (Ptr Module) -> IO (Ptr Context)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m)

-- This returns a nested DecodeAST to allow interleaving of different
-- decoding steps. Take a look at the call site in moduleAST for more
-- details.
decodeGlobalVariables :: Ptr FFI.Module -> DecodeAST (DecodeAST [A.G.Global])
decodeGlobalVariables :: Ptr Module -> DecodeAST (DecodeAST [Global])
decodeGlobalVariables Ptr Module
mod = do
  [Ptr GlobalVariable]
ffiGlobals <- IO [Ptr GlobalVariable] -> DecodeAST [Ptr GlobalVariable]
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr GlobalVariable] -> DecodeAST [Ptr GlobalVariable])
-> IO [Ptr GlobalVariable] -> DecodeAST [Ptr GlobalVariable]
forall a b. (a -> b) -> a -> b
$ IO (Ptr GlobalVariable)
-> (Ptr GlobalVariable -> IO (Ptr GlobalVariable))
-> IO [Ptr GlobalVariable]
forall a. IO (Ptr a) -> (Ptr a -> IO (Ptr a)) -> IO [Ptr a]
FFI.getXs (Ptr Module -> IO (Ptr GlobalVariable)
FFI.getFirstGlobal Ptr Module
mod) Ptr GlobalVariable -> IO (Ptr GlobalVariable)
FFI.getNextGlobal
  ([DecodeAST Global] -> DecodeAST [Global])
-> DecodeAST [DecodeAST Global] -> DecodeAST (DecodeAST [Global])
forall a b. (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DecodeAST Global] -> DecodeAST [Global]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (DecodeAST [DecodeAST Global] -> DecodeAST (DecodeAST [Global]))
-> ((Ptr GlobalVariable -> DecodeAST (DecodeAST Global))
    -> DecodeAST [DecodeAST Global])
-> (Ptr GlobalVariable -> DecodeAST (DecodeAST Global))
-> DecodeAST (DecodeAST [Global])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ptr GlobalVariable]
-> (Ptr GlobalVariable -> DecodeAST (DecodeAST Global))
-> DecodeAST [DecodeAST Global]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ptr GlobalVariable]
ffiGlobals ((Ptr GlobalVariable -> DecodeAST (DecodeAST Global))
 -> DecodeAST (DecodeAST [Global]))
-> (Ptr GlobalVariable -> DecodeAST (DecodeAST Global))
-> DecodeAST (DecodeAST [Global])
forall a b. (a -> b) -> a -> b
$ \Ptr GlobalVariable
g -> do
    A.PointerType Type
t AddrSpace
as <- Ptr GlobalVariable -> DecodeAST Type
forall v. DescendentOf Value v => Ptr v -> DecodeAST Type
typeOf Ptr GlobalVariable
g
    Name
n <- Ptr GlobalVariable -> DecodeAST Name
forall v. DescendentOf GlobalValue v => Ptr v -> DecodeAST Name
getGlobalName Ptr GlobalVariable
g
    DecodeAST Global -> DecodeAST (DecodeAST Global)
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeAST Global -> DecodeAST (DecodeAST Global))
-> DecodeAST Global -> DecodeAST (DecodeAST Global)
forall a b. (a -> b) -> a -> b
$
      Name
-> Linkage
-> Visibility
-> Maybe StorageClass
-> Maybe Model
-> Maybe UnnamedAddr
-> Bool
-> Type
-> AddrSpace
-> Maybe Constant
-> Maybe ShortByteString
-> Maybe ShortByteString
-> Word32
-> [(ShortByteString, MDRef MDNode)]
-> Global
A.GlobalVariable
        (Name
 -> Linkage
 -> Visibility
 -> Maybe StorageClass
 -> Maybe Model
 -> Maybe UnnamedAddr
 -> Bool
 -> Type
 -> AddrSpace
 -> Maybe Constant
 -> Maybe ShortByteString
 -> Maybe ShortByteString
 -> Word32
 -> [(ShortByteString, MDRef MDNode)]
 -> Global)
-> DecodeAST Name
-> DecodeAST
     (Linkage
      -> Visibility
      -> Maybe StorageClass
      -> Maybe Model
      -> Maybe UnnamedAddr
      -> Bool
      -> Type
      -> AddrSpace
      -> Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> DecodeAST Name
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
        DecodeAST
  (Linkage
   -> Visibility
   -> Maybe StorageClass
   -> Maybe Model
   -> Maybe UnnamedAddr
   -> Bool
   -> Type
   -> AddrSpace
   -> Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST Linkage
-> DecodeAST
     (Visibility
      -> Maybe StorageClass
      -> Maybe Model
      -> Maybe UnnamedAddr
      -> Bool
      -> Type
      -> AddrSpace
      -> Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalVariable -> DecodeAST Linkage
forall v. DescendentOf GlobalValue v => Ptr v -> DecodeAST Linkage
getLinkage Ptr GlobalVariable
g
        DecodeAST
  (Visibility
   -> Maybe StorageClass
   -> Maybe Model
   -> Maybe UnnamedAddr
   -> Bool
   -> Type
   -> AddrSpace
   -> Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST Visibility
-> DecodeAST
     (Maybe StorageClass
      -> Maybe Model
      -> Maybe UnnamedAddr
      -> Bool
      -> Type
      -> AddrSpace
      -> Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalVariable -> DecodeAST Visibility
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST Visibility
getVisibility Ptr GlobalVariable
g
        DecodeAST
  (Maybe StorageClass
   -> Maybe Model
   -> Maybe UnnamedAddr
   -> Bool
   -> Type
   -> AddrSpace
   -> Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe StorageClass)
-> DecodeAST
     (Maybe Model
      -> Maybe UnnamedAddr
      -> Bool
      -> Type
      -> AddrSpace
      -> Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalVariable -> DecodeAST (Maybe StorageClass)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe StorageClass)
getDLLStorageClass Ptr GlobalVariable
g
        DecodeAST
  (Maybe Model
   -> Maybe UnnamedAddr
   -> Bool
   -> Type
   -> AddrSpace
   -> Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe Model)
-> DecodeAST
     (Maybe UnnamedAddr
      -> Bool
      -> Type
      -> AddrSpace
      -> Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalVariable -> DecodeAST (Maybe Model)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe Model)
getThreadLocalMode Ptr GlobalVariable
g
        DecodeAST
  (Maybe UnnamedAddr
   -> Bool
   -> Type
   -> AddrSpace
   -> Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe UnnamedAddr)
-> DecodeAST
     (Bool
      -> Type
      -> AddrSpace
      -> Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (Maybe UnnamedAddr) -> DecodeAST (Maybe UnnamedAddr)
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UnnamedAddr) -> DecodeAST (Maybe UnnamedAddr))
-> IO (Maybe UnnamedAddr) -> DecodeAST (Maybe UnnamedAddr)
forall a b. (a -> b) -> a -> b
$ UnnamedAddr -> IO (Maybe UnnamedAddr)
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (UnnamedAddr -> IO (Maybe UnnamedAddr))
-> IO UnnamedAddr -> IO (Maybe UnnamedAddr)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr GlobalValue -> IO UnnamedAddr
FFI.getUnnamedAddr (Ptr GlobalVariable -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr GlobalVariable
g))
        DecodeAST
  (Bool
   -> Type
   -> AddrSpace
   -> Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST Bool
-> DecodeAST
     (Type
      -> AddrSpace
      -> Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO Bool -> DecodeAST Bool
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> DecodeAST Bool) -> IO Bool -> DecodeAST Bool
forall a b. (a -> b) -> a -> b
$ LLVMBool -> IO Bool
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LLVMBool -> IO Bool) -> IO LLVMBool -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr GlobalVariable -> IO LLVMBool
FFI.isGlobalConstant Ptr GlobalVariable
g)
        DecodeAST
  (Type
   -> AddrSpace
   -> Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST Type
-> DecodeAST
     (AddrSpace
      -> Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> DecodeAST Type
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t
        DecodeAST
  (AddrSpace
   -> Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST AddrSpace
-> DecodeAST
     (Maybe Constant
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddrSpace -> DecodeAST AddrSpace
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return AddrSpace
as
        DecodeAST
  (Maybe Constant
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe Constant)
-> DecodeAST
     (Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (do Ptr Constant
i <- IO (Ptr Constant) -> DecodeAST (Ptr Constant)
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Constant) -> DecodeAST (Ptr Constant))
-> IO (Ptr Constant) -> DecodeAST (Ptr Constant)
forall a b. (a -> b) -> a -> b
$ Ptr GlobalVariable -> IO (Ptr Constant)
FFI.getInitializer Ptr GlobalVariable
g
                if Ptr Constant
i Ptr Constant -> Ptr Constant -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Constant
forall a. Ptr a
nullPtr
                  then Maybe Constant -> DecodeAST (Maybe Constant)
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Constant
forall a. Maybe a
Nothing
                  else Constant -> Maybe Constant
forall a. a -> Maybe a
Just (Constant -> Maybe Constant)
-> DecodeAST Constant -> DecodeAST (Maybe Constant)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Constant -> DecodeAST Constant
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr Constant
i)
        DecodeAST
  (Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe ShortByteString)
-> DecodeAST
     (Maybe ShortByteString
      -> Word32 -> [(ShortByteString, MDRef MDNode)] -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalVariable -> DecodeAST (Maybe ShortByteString)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe ShortByteString)
getSection Ptr GlobalVariable
g
        DecodeAST
  (Maybe ShortByteString
   -> Word32 -> [(ShortByteString, MDRef MDNode)] -> Global)
-> DecodeAST (Maybe ShortByteString)
-> DecodeAST
     (Word32 -> [(ShortByteString, MDRef MDNode)] -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalVariable -> DecodeAST (Maybe ShortByteString)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe ShortByteString)
getCOMDATName Ptr GlobalVariable
g
        DecodeAST (Word32 -> [(ShortByteString, MDRef MDNode)] -> Global)
-> DecodeAST Word32
-> DecodeAST ([(ShortByteString, MDRef MDNode)] -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalVariable -> DecodeAST Word32
forall v. DescendentOf GlobalValue v => Ptr v -> DecodeAST Word32
getAlignment Ptr GlobalVariable
g
        DecodeAST ([(ShortByteString, MDRef MDNode)] -> Global)
-> DecodeAST [(ShortByteString, MDRef MDNode)] -> DecodeAST Global
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalObject -> DecodeAST [(ShortByteString, MDRef MDNode)]
getMetadata (Ptr GlobalVariable -> Ptr GlobalObject
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr GlobalVariable
g)

-- This returns a nested DecodeAST to allow interleaving of different
-- decoding steps. Take a look at the call site in moduleAST for more
-- details.
decodeGlobalAliases :: Ptr FFI.Module -> DecodeAST (DecodeAST [A.G.Global])
decodeGlobalAliases :: Ptr Module -> DecodeAST (DecodeAST [Global])
decodeGlobalAliases Ptr Module
mod = do
  [Ptr GlobalAlias]
ffiAliases <- IO [Ptr GlobalAlias] -> DecodeAST [Ptr GlobalAlias]
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr GlobalAlias] -> DecodeAST [Ptr GlobalAlias])
-> IO [Ptr GlobalAlias] -> DecodeAST [Ptr GlobalAlias]
forall a b. (a -> b) -> a -> b
$ IO (Ptr GlobalAlias)
-> (Ptr GlobalAlias -> IO (Ptr GlobalAlias))
-> IO [Ptr GlobalAlias]
forall a. IO (Ptr a) -> (Ptr a -> IO (Ptr a)) -> IO [Ptr a]
FFI.getXs (Ptr Module -> IO (Ptr GlobalAlias)
FFI.getFirstAlias Ptr Module
mod) Ptr GlobalAlias -> IO (Ptr GlobalAlias)
FFI.getNextAlias
  ([DecodeAST Global] -> DecodeAST [Global])
-> DecodeAST [DecodeAST Global] -> DecodeAST (DecodeAST [Global])
forall a b. (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DecodeAST Global] -> DecodeAST [Global]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (DecodeAST [DecodeAST Global] -> DecodeAST (DecodeAST [Global]))
-> ((Ptr GlobalAlias -> DecodeAST (DecodeAST Global))
    -> DecodeAST [DecodeAST Global])
-> (Ptr GlobalAlias -> DecodeAST (DecodeAST Global))
-> DecodeAST (DecodeAST [Global])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ptr GlobalAlias]
-> (Ptr GlobalAlias -> DecodeAST (DecodeAST Global))
-> DecodeAST [DecodeAST Global]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ptr GlobalAlias]
ffiAliases ((Ptr GlobalAlias -> DecodeAST (DecodeAST Global))
 -> DecodeAST (DecodeAST [Global]))
-> (Ptr GlobalAlias -> DecodeAST (DecodeAST Global))
-> DecodeAST (DecodeAST [Global])
forall a b. (a -> b) -> a -> b
$ \Ptr GlobalAlias
a -> do
    Name
n <- Ptr GlobalAlias -> DecodeAST Name
forall v. DescendentOf GlobalValue v => Ptr v -> DecodeAST Name
getGlobalName Ptr GlobalAlias
a
    A.PointerType Type
t AddrSpace
as <- Ptr GlobalAlias -> DecodeAST Type
forall v. DescendentOf Value v => Ptr v -> DecodeAST Type
typeOf Ptr GlobalAlias
a
    DecodeAST Global -> DecodeAST (DecodeAST Global)
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeAST Global -> DecodeAST (DecodeAST Global))
-> DecodeAST Global -> DecodeAST (DecodeAST Global)
forall a b. (a -> b) -> a -> b
$
      Name
-> Linkage
-> Visibility
-> Maybe StorageClass
-> Maybe Model
-> Maybe UnnamedAddr
-> Type
-> AddrSpace
-> Constant
-> Global
A.G.GlobalAlias
        (Name
 -> Linkage
 -> Visibility
 -> Maybe StorageClass
 -> Maybe Model
 -> Maybe UnnamedAddr
 -> Type
 -> AddrSpace
 -> Constant
 -> Global)
-> DecodeAST Name
-> DecodeAST
     (Linkage
      -> Visibility
      -> Maybe StorageClass
      -> Maybe Model
      -> Maybe UnnamedAddr
      -> Type
      -> AddrSpace
      -> Constant
      -> Global)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> DecodeAST Name
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
        DecodeAST
  (Linkage
   -> Visibility
   -> Maybe StorageClass
   -> Maybe Model
   -> Maybe UnnamedAddr
   -> Type
   -> AddrSpace
   -> Constant
   -> Global)
-> DecodeAST Linkage
-> DecodeAST
     (Visibility
      -> Maybe StorageClass
      -> Maybe Model
      -> Maybe UnnamedAddr
      -> Type
      -> AddrSpace
      -> Constant
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalAlias -> DecodeAST Linkage
forall v. DescendentOf GlobalValue v => Ptr v -> DecodeAST Linkage
getLinkage Ptr GlobalAlias
a
        DecodeAST
  (Visibility
   -> Maybe StorageClass
   -> Maybe Model
   -> Maybe UnnamedAddr
   -> Type
   -> AddrSpace
   -> Constant
   -> Global)
-> DecodeAST Visibility
-> DecodeAST
     (Maybe StorageClass
      -> Maybe Model
      -> Maybe UnnamedAddr
      -> Type
      -> AddrSpace
      -> Constant
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalAlias -> DecodeAST Visibility
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST Visibility
getVisibility Ptr GlobalAlias
a
        DecodeAST
  (Maybe StorageClass
   -> Maybe Model
   -> Maybe UnnamedAddr
   -> Type
   -> AddrSpace
   -> Constant
   -> Global)
-> DecodeAST (Maybe StorageClass)
-> DecodeAST
     (Maybe Model
      -> Maybe UnnamedAddr -> Type -> AddrSpace -> Constant -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalAlias -> DecodeAST (Maybe StorageClass)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe StorageClass)
getDLLStorageClass Ptr GlobalAlias
a
        DecodeAST
  (Maybe Model
   -> Maybe UnnamedAddr -> Type -> AddrSpace -> Constant -> Global)
-> DecodeAST (Maybe Model)
-> DecodeAST
     (Maybe UnnamedAddr -> Type -> AddrSpace -> Constant -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalAlias -> DecodeAST (Maybe Model)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe Model)
getThreadLocalMode Ptr GlobalAlias
a
        DecodeAST
  (Maybe UnnamedAddr -> Type -> AddrSpace -> Constant -> Global)
-> DecodeAST (Maybe UnnamedAddr)
-> DecodeAST (Type -> AddrSpace -> Constant -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (Maybe UnnamedAddr) -> DecodeAST (Maybe UnnamedAddr)
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UnnamedAddr) -> DecodeAST (Maybe UnnamedAddr))
-> IO (Maybe UnnamedAddr) -> DecodeAST (Maybe UnnamedAddr)
forall a b. (a -> b) -> a -> b
$ UnnamedAddr -> IO (Maybe UnnamedAddr)
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (UnnamedAddr -> IO (Maybe UnnamedAddr))
-> IO UnnamedAddr -> IO (Maybe UnnamedAddr)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr GlobalValue -> IO UnnamedAddr
FFI.getUnnamedAddr (Ptr GlobalAlias -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr GlobalAlias
a))
        DecodeAST (Type -> AddrSpace -> Constant -> Global)
-> DecodeAST Type -> DecodeAST (AddrSpace -> Constant -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> DecodeAST Type
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t
        DecodeAST (AddrSpace -> Constant -> Global)
-> DecodeAST AddrSpace -> DecodeAST (Constant -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddrSpace -> DecodeAST AddrSpace
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return AddrSpace
as
        DecodeAST (Constant -> Global)
-> DecodeAST Constant -> DecodeAST Global
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr Constant -> DecodeAST Constant
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (Ptr Constant -> DecodeAST Constant)
-> DecodeAST (Ptr Constant) -> DecodeAST Constant
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO (Ptr Constant) -> DecodeAST (Ptr Constant)
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Constant) -> DecodeAST (Ptr Constant))
-> IO (Ptr Constant) -> DecodeAST (Ptr Constant)
forall a b. (a -> b) -> a -> b
$ Ptr GlobalAlias -> IO (Ptr Constant)
FFI.getAliasee Ptr GlobalAlias
a))

getMetadata :: Ptr FFI.GlobalObject -> DecodeAST [(ShortByteString, A.MDRef A.MDNode)]
getMetadata :: Ptr GlobalObject -> DecodeAST [(ShortByteString, MDRef MDNode)]
getMetadata Ptr GlobalObject
o = DecodeAST [(ShortByteString, MDRef MDNode)]
-> DecodeAST [(ShortByteString, MDRef MDNode)]
forall a. DecodeAST a -> DecodeAST a
forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a
scopeAnyCont (DecodeAST [(ShortByteString, MDRef MDNode)]
 -> DecodeAST [(ShortByteString, MDRef MDNode)])
-> DecodeAST [(ShortByteString, MDRef MDNode)]
-> DecodeAST [(ShortByteString, MDRef MDNode)]
forall a b. (a -> b) -> a -> b
$ do
  CUInt
n <- IO CUInt -> DecodeAST CUInt
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr GlobalObject -> IO CUInt
FFI.getNumMetadata Ptr GlobalObject
o)
  Ptr MDKindID
ks <- CUInt -> DecodeAST (Ptr MDKindID)
forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray CUInt
n
  Ptr (Ptr MDNode)
ps <- CUInt -> DecodeAST (Ptr (Ptr MDNode))
forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray CUInt
n
  IO () -> DecodeAST ()
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr GlobalObject -> Ptr MDKindID -> Ptr (Ptr MDNode) -> IO ()
FFI.getAllMetadata Ptr GlobalObject
o Ptr MDKindID
ks Ptr (Ptr MDNode)
ps)
  [ShortByteString]
-> [MDRef MDNode] -> [(ShortByteString, MDRef MDNode)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([ShortByteString]
 -> [MDRef MDNode] -> [(ShortByteString, MDRef MDNode)])
-> DecodeAST [ShortByteString]
-> DecodeAST ([MDRef MDNode] -> [(ShortByteString, MDRef MDNode)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CUInt, Ptr MDKindID) -> DecodeAST [ShortByteString]
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (CUInt
n, Ptr MDKindID
ks) DecodeAST ([MDRef MDNode] -> [(ShortByteString, MDRef MDNode)])
-> DecodeAST [MDRef MDNode]
-> DecodeAST [(ShortByteString, MDRef MDNode)]
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CUInt, Ptr (Ptr MDNode)) -> DecodeAST [MDRef MDNode]
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (CUInt
n, Ptr (Ptr MDNode)
ps)

setMetadata :: Ptr FFI.GlobalObject -> [(ShortByteString, A.MDRef A.MDNode)] -> EncodeAST ()
setMetadata :: Ptr GlobalObject
-> [(ShortByteString, MDRef MDNode)] -> EncodeAST ()
setMetadata Ptr GlobalObject
o [(ShortByteString, MDRef MDNode)]
md =
  [(ShortByteString, MDRef MDNode)]
-> ((ShortByteString, MDRef MDNode) -> EncodeAST ())
-> EncodeAST ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ShortByteString, MDRef MDNode)]
md (((ShortByteString, MDRef MDNode) -> EncodeAST ()) -> EncodeAST ())
-> ((ShortByteString, MDRef MDNode) -> EncodeAST ())
-> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \(ShortByteString
kindName, MDRef MDNode
node) -> do
    MDKindID
kindID <- ShortByteString -> EncodeAST MDKindID
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
kindName
    Ptr MDNode
node <- MDRef MDNode -> EncodeAST (Ptr MDNode)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM MDRef MDNode
node
    IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr GlobalObject -> MDKindID -> Ptr MDNode -> IO ()
FFI.setMetadata Ptr GlobalObject
o MDKindID
kindID Ptr MDNode
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.
decodeFunctions :: Ptr FFI.Module -> DecodeAST (DecodeAST [A.G.Global])
decodeFunctions :: Ptr Module -> DecodeAST (DecodeAST [Global])
decodeFunctions Ptr Module
mod = do
  [Ptr Function]
ffiFunctions <-
    IO [Ptr Function] -> DecodeAST [Ptr Function]
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr Function] -> DecodeAST [Ptr Function])
-> IO [Ptr Function] -> DecodeAST [Ptr Function]
forall a b. (a -> b) -> a -> b
$ IO (Ptr Function)
-> (Ptr Function -> IO (Ptr Function)) -> IO [Ptr Function]
forall a. IO (Ptr a) -> (Ptr a -> IO (Ptr a)) -> IO [Ptr a]
FFI.getXs (Ptr Module -> IO (Ptr Function)
FFI.getFirstFunction Ptr Module
mod) Ptr Function -> IO (Ptr Function)
FFI.getNextFunction
  ([DecodeAST Global] -> DecodeAST [Global])
-> DecodeAST [DecodeAST Global] -> DecodeAST (DecodeAST [Global])
forall a b. (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DecodeAST Global] -> DecodeAST [Global]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (DecodeAST [DecodeAST Global] -> DecodeAST (DecodeAST [Global]))
-> ((Ptr Function -> DecodeAST (DecodeAST Global))
    -> DecodeAST [DecodeAST Global])
-> (Ptr Function -> DecodeAST (DecodeAST Global))
-> DecodeAST (DecodeAST [Global])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ptr Function]
-> (Ptr Function -> DecodeAST (DecodeAST Global))
-> DecodeAST [DecodeAST Global]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ptr Function]
ffiFunctions ((Ptr Function -> DecodeAST (DecodeAST Global))
 -> DecodeAST (DecodeAST [Global]))
-> (Ptr Function -> DecodeAST (DecodeAST Global))
-> DecodeAST (DecodeAST [Global])
forall a b. (a -> b) -> a -> b
$ \Ptr Function
f ->
    DecodeAST (DecodeAST Global) -> DecodeAST (DecodeAST Global)
forall a. DecodeAST a -> DecodeAST a
localScope (DecodeAST (DecodeAST Global) -> DecodeAST (DecodeAST Global))
-> DecodeAST (DecodeAST Global) -> DecodeAST (DecodeAST Global)
forall a b. (a -> b) -> a -> b
$ do
      A.PointerType (A.FunctionType Type
returnType [Type]
_ Bool
isVarArg) AddrSpace
_ <- Ptr Function -> DecodeAST Type
forall v. DescendentOf Value v => Ptr v -> DecodeAST Type
typeOf Ptr Function
f
      Name
n <- Ptr Function -> DecodeAST Name
forall v. DescendentOf GlobalValue v => Ptr v -> DecodeAST Name
getGlobalName Ptr Function
f
      AttributeList [Either GroupID FunctionAttribute]
fAttrs [ParameterAttribute]
rAttrs [[ParameterAttribute]]
pAttrs <- Ptr Function -> DecodeAST AttributeList
getAttributeList Ptr Function
f
      [Parameter]
parameters <- Ptr Function -> [[ParameterAttribute]] -> DecodeAST [Parameter]
getParameters Ptr Function
f [[ParameterAttribute]]
pAttrs
      DecodeAST [BasicBlock]
decodeBlocks <- do
        [Ptr BasicBlock]
ffiBasicBlocks <-
          IO [Ptr BasicBlock] -> DecodeAST [Ptr BasicBlock]
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr BasicBlock] -> DecodeAST [Ptr BasicBlock])
-> IO [Ptr BasicBlock] -> DecodeAST [Ptr BasicBlock]
forall a b. (a -> b) -> a -> b
$ IO (Ptr BasicBlock)
-> (Ptr BasicBlock -> IO (Ptr BasicBlock)) -> IO [Ptr BasicBlock]
forall a. IO (Ptr a) -> (Ptr a -> IO (Ptr a)) -> IO [Ptr a]
FFI.getXs (Ptr Function -> IO (Ptr BasicBlock)
FFI.getFirstBasicBlock Ptr Function
f) Ptr BasicBlock -> IO (Ptr BasicBlock)
FFI.getNextBasicBlock
        ([DecodeAST BasicBlock] -> DecodeAST [BasicBlock])
-> DecodeAST [DecodeAST BasicBlock]
-> DecodeAST (DecodeAST [BasicBlock])
forall a b. (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DecodeAST BasicBlock] -> DecodeAST [BasicBlock]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (DecodeAST [DecodeAST BasicBlock]
 -> DecodeAST (DecodeAST [BasicBlock]))
-> ((Ptr BasicBlock -> DecodeAST (DecodeAST BasicBlock))
    -> DecodeAST [DecodeAST BasicBlock])
-> (Ptr BasicBlock -> DecodeAST (DecodeAST BasicBlock))
-> DecodeAST (DecodeAST [BasicBlock])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ptr BasicBlock]
-> (Ptr BasicBlock -> DecodeAST (DecodeAST BasicBlock))
-> DecodeAST [DecodeAST BasicBlock]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ptr BasicBlock]
ffiBasicBlocks ((Ptr BasicBlock -> DecodeAST (DecodeAST BasicBlock))
 -> DecodeAST (DecodeAST [BasicBlock]))
-> (Ptr BasicBlock -> DecodeAST (DecodeAST BasicBlock))
-> DecodeAST (DecodeAST [BasicBlock])
forall a b. (a -> b) -> a -> b
$ \Ptr BasicBlock
b -> do
          Name
n <- Ptr BasicBlock -> DecodeAST Name
forall v. DescendentOf Value v => Ptr v -> DecodeAST Name
getLocalName Ptr BasicBlock
b
          DecodeAST [Named Instruction]
decodeInstructions <- Ptr BasicBlock -> DecodeAST (DecodeAST [Named Instruction])
getNamedInstructions Ptr BasicBlock
b
          DecodeAST (Named Terminator)
decodeTerminator <- Ptr BasicBlock -> DecodeAST (DecodeAST (Named Terminator))
getBasicBlockTerminator Ptr BasicBlock
b
          DecodeAST BasicBlock -> DecodeAST (DecodeAST BasicBlock)
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeAST BasicBlock -> DecodeAST (DecodeAST BasicBlock))
-> DecodeAST BasicBlock -> DecodeAST (DecodeAST BasicBlock)
forall a b. (a -> b) -> a -> b
$
            Name -> [Named Instruction] -> Named Terminator -> BasicBlock
A.BasicBlock
              (Name -> [Named Instruction] -> Named Terminator -> BasicBlock)
-> DecodeAST Name
-> DecodeAST
     ([Named Instruction] -> Named Terminator -> BasicBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> DecodeAST Name
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
              DecodeAST ([Named Instruction] -> Named Terminator -> BasicBlock)
-> DecodeAST [Named Instruction]
-> DecodeAST (Named Terminator -> BasicBlock)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DecodeAST [Named Instruction]
decodeInstructions
              DecodeAST (Named Terminator -> BasicBlock)
-> DecodeAST (Named Terminator) -> DecodeAST BasicBlock
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DecodeAST (Named Terminator)
decodeTerminator
      DecodeAST Global -> DecodeAST (DecodeAST Global)
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeAST Global -> DecodeAST (DecodeAST Global))
-> DecodeAST Global -> DecodeAST (DecodeAST Global)
forall a b. (a -> b) -> a -> b
$
        Linkage
-> Visibility
-> Maybe StorageClass
-> CallingConvention
-> [ParameterAttribute]
-> Type
-> Name
-> ([Parameter], Bool)
-> [Either GroupID FunctionAttribute]
-> Maybe ShortByteString
-> Maybe ShortByteString
-> Word32
-> Maybe ShortByteString
-> Maybe Constant
-> [BasicBlock]
-> Maybe Constant
-> [(ShortByteString, MDRef MDNode)]
-> Global
A.Function
          (Linkage
 -> Visibility
 -> Maybe StorageClass
 -> CallingConvention
 -> [ParameterAttribute]
 -> Type
 -> Name
 -> ([Parameter], Bool)
 -> [Either GroupID FunctionAttribute]
 -> Maybe ShortByteString
 -> Maybe ShortByteString
 -> Word32
 -> Maybe ShortByteString
 -> Maybe Constant
 -> [BasicBlock]
 -> Maybe Constant
 -> [(ShortByteString, MDRef MDNode)]
 -> Global)
-> DecodeAST Linkage
-> DecodeAST
     (Visibility
      -> Maybe StorageClass
      -> CallingConvention
      -> [ParameterAttribute]
      -> Type
      -> Name
      -> ([Parameter], Bool)
      -> [Either GroupID FunctionAttribute]
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Function -> DecodeAST Linkage
forall v. DescendentOf GlobalValue v => Ptr v -> DecodeAST Linkage
getLinkage Ptr Function
f
          DecodeAST
  (Visibility
   -> Maybe StorageClass
   -> CallingConvention
   -> [ParameterAttribute]
   -> Type
   -> Name
   -> ([Parameter], Bool)
   -> [Either GroupID FunctionAttribute]
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST Visibility
-> DecodeAST
     (Maybe StorageClass
      -> CallingConvention
      -> [ParameterAttribute]
      -> Type
      -> Name
      -> ([Parameter], Bool)
      -> [Either GroupID FunctionAttribute]
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Function -> DecodeAST Visibility
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST Visibility
getVisibility Ptr Function
f
          DecodeAST
  (Maybe StorageClass
   -> CallingConvention
   -> [ParameterAttribute]
   -> Type
   -> Name
   -> ([Parameter], Bool)
   -> [Either GroupID FunctionAttribute]
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe StorageClass)
-> DecodeAST
     (CallingConvention
      -> [ParameterAttribute]
      -> Type
      -> Name
      -> ([Parameter], Bool)
      -> [Either GroupID FunctionAttribute]
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Function -> DecodeAST (Maybe StorageClass)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe StorageClass)
getDLLStorageClass Ptr Function
f
          DecodeAST
  (CallingConvention
   -> [ParameterAttribute]
   -> Type
   -> Name
   -> ([Parameter], Bool)
   -> [Either GroupID FunctionAttribute]
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST CallingConvention
-> DecodeAST
     ([ParameterAttribute]
      -> Type
      -> Name
      -> ([Parameter], Bool)
      -> [Either GroupID FunctionAttribute]
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO CallingConvention -> DecodeAST CallingConvention
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CallingConvention -> DecodeAST CallingConvention)
-> IO CallingConvention -> DecodeAST CallingConvention
forall a b. (a -> b) -> a -> b
$ CallingConvention -> IO CallingConvention
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (CallingConvention -> IO CallingConvention)
-> IO CallingConvention -> IO CallingConvention
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Function -> IO CallingConvention
FFI.getFunctionCallingConvention Ptr Function
f)
          DecodeAST
  ([ParameterAttribute]
   -> Type
   -> Name
   -> ([Parameter], Bool)
   -> [Either GroupID FunctionAttribute]
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST [ParameterAttribute]
-> DecodeAST
     (Type
      -> Name
      -> ([Parameter], Bool)
      -> [Either GroupID FunctionAttribute]
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ParameterAttribute] -> DecodeAST [ParameterAttribute]
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParameterAttribute]
rAttrs
          DecodeAST
  (Type
   -> Name
   -> ([Parameter], Bool)
   -> [Either GroupID FunctionAttribute]
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST Type
-> DecodeAST
     (Name
      -> ([Parameter], Bool)
      -> [Either GroupID FunctionAttribute]
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> DecodeAST Type
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
returnType
          DecodeAST
  (Name
   -> ([Parameter], Bool)
   -> [Either GroupID FunctionAttribute]
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST Name
-> DecodeAST
     (([Parameter], Bool)
      -> [Either GroupID FunctionAttribute]
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> DecodeAST Name
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
          DecodeAST
  (([Parameter], Bool)
   -> [Either GroupID FunctionAttribute]
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST ([Parameter], Bool)
-> DecodeAST
     ([Either GroupID FunctionAttribute]
      -> Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Parameter], Bool) -> DecodeAST ([Parameter], Bool)
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Parameter]
parameters, Bool
isVarArg)
          DecodeAST
  ([Either GroupID FunctionAttribute]
   -> Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST [Either GroupID FunctionAttribute]
-> DecodeAST
     (Maybe ShortByteString
      -> Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Either GroupID FunctionAttribute]
-> DecodeAST [Either GroupID FunctionAttribute]
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return [Either GroupID FunctionAttribute]
fAttrs
          DecodeAST
  (Maybe ShortByteString
   -> Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe ShortByteString)
-> DecodeAST
     (Maybe ShortByteString
      -> Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Function -> DecodeAST (Maybe ShortByteString)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe ShortByteString)
getSection Ptr Function
f
          DecodeAST
  (Maybe ShortByteString
   -> Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe ShortByteString)
-> DecodeAST
     (Word32
      -> Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Function -> DecodeAST (Maybe ShortByteString)
forall v.
DescendentOf GlobalValue v =>
Ptr v -> DecodeAST (Maybe ShortByteString)
getCOMDATName Ptr Function
f
          DecodeAST
  (Word32
   -> Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST Word32
-> DecodeAST
     (Maybe ShortByteString
      -> Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Function -> DecodeAST Word32
forall v. DescendentOf GlobalValue v => Ptr v -> DecodeAST Word32
getAlignment Ptr Function
f
          DecodeAST
  (Maybe ShortByteString
   -> Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe ShortByteString)
-> DecodeAST
     (Maybe Constant
      -> [BasicBlock]
      -> Maybe Constant
      -> [(ShortByteString, MDRef MDNode)]
      -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Function -> DecodeAST (Maybe ShortByteString)
getGC Ptr Function
f
          DecodeAST
  (Maybe Constant
   -> [BasicBlock]
   -> Maybe Constant
   -> [(ShortByteString, MDRef MDNode)]
   -> Global)
-> DecodeAST (Maybe Constant)
-> DecodeAST
     ([BasicBlock]
      -> Maybe Constant -> [(ShortByteString, MDRef MDNode)] -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Function -> DecodeAST (Maybe Constant)
getPrefixData Ptr Function
f
          DecodeAST
  ([BasicBlock]
   -> Maybe Constant -> [(ShortByteString, MDRef MDNode)] -> Global)
-> DecodeAST [BasicBlock]
-> DecodeAST
     (Maybe Constant -> [(ShortByteString, MDRef MDNode)] -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DecodeAST [BasicBlock]
decodeBlocks
          DecodeAST
  (Maybe Constant -> [(ShortByteString, MDRef MDNode)] -> Global)
-> DecodeAST (Maybe Constant)
-> DecodeAST ([(ShortByteString, MDRef MDNode)] -> Global)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Function -> DecodeAST (Maybe Constant)
getPersonalityFn Ptr Function
f
          DecodeAST ([(ShortByteString, MDRef MDNode)] -> Global)
-> DecodeAST [(ShortByteString, MDRef MDNode)] -> DecodeAST Global
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr GlobalObject -> DecodeAST [(ShortByteString, MDRef MDNode)]
getMetadata (Ptr Function -> Ptr GlobalObject
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr Function
f)

decodeNamedMetadataDefinitions :: Ptr FFI.Module -> DecodeAST [A.Definition]
decodeNamedMetadataDefinitions :: Ptr Module -> DecodeAST [Definition]
decodeNamedMetadataDefinitions Ptr Module
mod = do
  [Ptr NamedMetadata]
ffiNamedMetadataNodes <-
    IO [Ptr NamedMetadata] -> DecodeAST [Ptr NamedMetadata]
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr NamedMetadata] -> DecodeAST [Ptr NamedMetadata])
-> IO [Ptr NamedMetadata] -> DecodeAST [Ptr NamedMetadata]
forall a b. (a -> b) -> a -> b
$ IO (Ptr NamedMetadata)
-> (Ptr NamedMetadata -> IO (Ptr NamedMetadata))
-> IO [Ptr NamedMetadata]
forall a. IO (Ptr a) -> (Ptr a -> IO (Ptr a)) -> IO [Ptr a]
FFI.getXs (Ptr Module -> IO (Ptr NamedMetadata)
FFI.getFirstNamedMetadata Ptr Module
mod) Ptr NamedMetadata -> IO (Ptr NamedMetadata)
FFI.getNextNamedMetadata
  [Ptr NamedMetadata]
-> (Ptr NamedMetadata -> DecodeAST Definition)
-> DecodeAST [Definition]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ptr NamedMetadata]
ffiNamedMetadataNodes ((Ptr NamedMetadata -> DecodeAST Definition)
 -> DecodeAST [Definition])
-> (Ptr NamedMetadata -> DecodeAST Definition)
-> DecodeAST [Definition]
forall a b. (a -> b) -> a -> b
$ \Ptr NamedMetadata
nm ->
    DecodeAST Definition -> DecodeAST Definition
forall a. DecodeAST a -> DecodeAST a
forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a
scopeAnyCont (DecodeAST Definition -> DecodeAST Definition)
-> DecodeAST Definition -> DecodeAST Definition
forall a b. (a -> b) -> a -> b
$ do
      CUInt
n <- IO CUInt -> DecodeAST CUInt
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CUInt -> DecodeAST CUInt) -> IO CUInt -> DecodeAST CUInt
forall a b. (a -> b) -> a -> b
$ Ptr NamedMetadata -> IO CUInt
FFI.getNamedMetadataNumOperands Ptr NamedMetadata
nm
      Ptr (Ptr MDNode)
os <- CUInt -> DecodeAST (Ptr (Ptr MDNode))
forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray CUInt
n
      IO () -> DecodeAST ()
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DecodeAST ()) -> IO () -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr NamedMetadata -> Ptr (Ptr MDNode) -> IO ()
FFI.getNamedMetadataOperands Ptr NamedMetadata
nm Ptr (Ptr MDNode)
os
      ShortByteString -> [MetadataNodeID] -> Definition
A.NamedMetadataDefinition
        (ShortByteString -> [MetadataNodeID] -> Definition)
-> DecodeAST ShortByteString
-> DecodeAST ([MetadataNodeID] -> Definition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Ptr CUInt -> IO (Ptr CChar)) -> DecodeAST ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM ((Ptr CUInt -> IO (Ptr CChar)) -> DecodeAST ShortByteString)
-> (Ptr CUInt -> IO (Ptr CChar)) -> DecodeAST ShortByteString
forall a b. (a -> b) -> a -> b
$ Ptr NamedMetadata -> Ptr CUInt -> IO (Ptr CChar)
FFI.getNamedMetadataName Ptr NamedMetadata
nm)
        DecodeAST ([MetadataNodeID] -> Definition)
-> DecodeAST [MetadataNodeID] -> DecodeAST Definition
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([MDRef MDNode] -> [MetadataNodeID])
-> DecodeAST [MDRef MDNode] -> DecodeAST [MetadataNodeID]
forall a b. (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              ((MDRef MDNode -> MetadataNodeID)
-> [MDRef MDNode] -> [MetadataNodeID]
forall a b. (a -> b) -> [a] -> [b]
map (\(A.MDRef MetadataNodeID
mid) -> MetadataNodeID
mid))
              ((CUInt, Ptr (Ptr MDNode)) -> DecodeAST [MDRef MDNode]
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (CUInt
n, Ptr (Ptr MDNode)
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.
moduleAST :: Module -> IO A.Module
moduleAST :: Module -> IO Module
moduleAST Module
m = DecodeAST Module -> IO Module
forall a. DecodeAST a -> IO a
runDecodeAST (DecodeAST Module -> IO Module) -> DecodeAST Module -> IO Module
forall a b. (a -> b) -> a -> b
$ do
  Ptr Module
mod <- Module -> DecodeAST (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  Context
c <- (Ptr Context -> Context) -> DecodeAST (Ptr Context -> Context)
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Context -> Context
Context DecodeAST (Ptr Context -> Context)
-> DecodeAST (Ptr Context) -> DecodeAST Context
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO (Ptr Context) -> DecodeAST (Ptr Context)
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Module -> IO (Ptr Context)
FFI.getModuleContext Ptr Module
mod)
  Context -> DecodeAST ()
getMetadataKindNames Context
c
  ShortByteString
-> ShortByteString
-> Maybe DataLayout
-> Maybe ShortByteString
-> [Definition]
-> Module
A.Module
    (ShortByteString
 -> ShortByteString
 -> Maybe DataLayout
 -> Maybe ShortByteString
 -> [Definition]
 -> Module)
-> DecodeAST ShortByteString
-> DecodeAST
     (ShortByteString
      -> Maybe DataLayout
      -> Maybe ShortByteString
      -> [Definition]
      -> Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO ShortByteString -> DecodeAST ShortByteString
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortByteString -> DecodeAST ShortByteString)
-> IO ShortByteString -> DecodeAST ShortByteString
forall a b. (a -> b) -> a -> b
$ OwnerTransfered (Ptr CChar) -> IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (OwnerTransfered (Ptr CChar) -> IO ShortByteString)
-> IO (OwnerTransfered (Ptr CChar)) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Module -> IO (OwnerTransfered (Ptr CChar))
FFI.getModuleIdentifier Ptr Module
mod)
    DecodeAST
  (ShortByteString
   -> Maybe DataLayout
   -> Maybe ShortByteString
   -> [Definition]
   -> Module)
-> DecodeAST ShortByteString
-> DecodeAST
     (Maybe DataLayout
      -> Maybe ShortByteString -> [Definition] -> Module)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO ShortByteString -> DecodeAST ShortByteString
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortByteString -> DecodeAST ShortByteString)
-> IO ShortByteString -> DecodeAST ShortByteString
forall a b. (a -> b) -> a -> b
$ OwnerTransfered (Ptr CChar) -> IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (OwnerTransfered (Ptr CChar) -> IO ShortByteString)
-> IO (OwnerTransfered (Ptr CChar)) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Module -> IO (OwnerTransfered (Ptr CChar))
FFI.getSourceFileName Ptr Module
mod)
    DecodeAST
  (Maybe DataLayout
   -> Maybe ShortByteString -> [Definition] -> Module)
-> DecodeAST (Maybe DataLayout)
-> DecodeAST (Maybe ShortByteString -> [Definition] -> Module)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (Maybe DataLayout) -> DecodeAST (Maybe DataLayout)
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DataLayout) -> DecodeAST (Maybe DataLayout))
-> IO (Maybe DataLayout) -> DecodeAST (Maybe DataLayout)
forall a b. (a -> b) -> a -> b
$ Ptr Module -> IO (Maybe DataLayout)
getDataLayout Ptr Module
mod)
    DecodeAST (Maybe ShortByteString -> [Definition] -> Module)
-> DecodeAST (Maybe ShortByteString)
-> DecodeAST ([Definition] -> Module)
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (Maybe ShortByteString) -> DecodeAST (Maybe ShortByteString)
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortByteString) -> DecodeAST (Maybe ShortByteString))
-> IO (Maybe ShortByteString) -> DecodeAST (Maybe ShortByteString)
forall a b. (a -> b) -> a -> b
$ do
           ShortByteString
s <- Ptr CChar -> IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (Ptr CChar -> IO ShortByteString)
-> IO (Ptr CChar) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Module -> IO (Ptr CChar)
FFI.getTargetTriple Ptr Module
mod
           Maybe ShortByteString -> IO (Maybe ShortByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ShortByteString -> IO (Maybe ShortByteString))
-> Maybe ShortByteString -> IO (Maybe ShortByteString)
forall a b. (a -> b) -> a -> b
$ if ShortByteString -> Bool
SBS.null ShortByteString
s then Maybe ShortByteString
forall a. Maybe a
Nothing else ShortByteString -> Maybe ShortByteString
forall a. a -> Maybe a
Just ShortByteString
s)
    DecodeAST ([Definition] -> Module)
-> DecodeAST [Definition] -> DecodeAST Module
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (do
      [Definition]
globalDefinitions <-
        (Global -> Definition) -> [Global] -> [Definition]
forall a b. (a -> b) -> [a] -> [b]
map Global -> Definition
A.GlobalDefinition ([Global] -> [Definition])
-> ([[Global]] -> [Global]) -> [[Global]] -> [Definition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Global]] -> [Global]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Global]] -> [Definition])
-> DecodeAST [[Global]] -> DecodeAST [Definition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        -- Variables, aliases & functions can reference each other. To
        -- resolve this references properly during decoding a two step
        -- process is used: In the first step, the names of the
        -- different definitions are stored. In the second step we can
        -- then decode the definitions and look up the previously
        -- stored references.
        (DecodeAST (DecodeAST [[Global]]) -> DecodeAST [[Global]]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (DecodeAST (DecodeAST [[Global]]) -> DecodeAST [[Global]])
-> ([DecodeAST (DecodeAST [Global])]
    -> DecodeAST (DecodeAST [[Global]]))
-> [DecodeAST (DecodeAST [Global])]
-> DecodeAST [[Global]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([DecodeAST [Global]] -> DecodeAST [[Global]])
-> DecodeAST [DecodeAST [Global]]
-> DecodeAST (DecodeAST [[Global]])
forall a b. (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DecodeAST [Global]] -> DecodeAST [[Global]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (DecodeAST [DecodeAST [Global]]
 -> DecodeAST (DecodeAST [[Global]]))
-> ([DecodeAST (DecodeAST [Global])]
    -> DecodeAST [DecodeAST [Global]])
-> [DecodeAST (DecodeAST [Global])]
-> DecodeAST (DecodeAST [[Global]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DecodeAST (DecodeAST [Global])] -> DecodeAST [DecodeAST [Global]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence)
          [ Ptr Module -> DecodeAST (DecodeAST [Global])
decodeGlobalVariables Ptr Module
mod
          , Ptr Module -> DecodeAST (DecodeAST [Global])
decodeGlobalAliases Ptr Module
mod
          , Ptr Module -> DecodeAST (DecodeAST [Global])
decodeFunctions Ptr Module
mod
          ]
      [Definition]
structDefinitions <- DecodeAST [Definition]
getStructDefinitions
      [Definition]
inlineAsm <- ModuleAsm (Ptr CChar) -> DecodeAST [Definition]
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (ModuleAsm (Ptr CChar) -> DecodeAST [Definition])
-> DecodeAST (ModuleAsm (Ptr CChar)) -> DecodeAST [Definition]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (ModuleAsm (Ptr CChar)) -> DecodeAST (ModuleAsm (Ptr CChar))
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Module -> IO (ModuleAsm (Ptr CChar))
FFI.moduleGetInlineAsm Ptr Module
mod)
      [Definition]
namedMetadata <- Ptr Module -> DecodeAST [Definition]
decodeNamedMetadataDefinitions Ptr Module
mod
      [Definition]
metadata <- DecodeAST [Definition]
getMetadataDefinitions
      [Definition]
functionAttributes <- do
        [(FunctionAttributeSet, GroupID)]
functionAttributes <- (DecodeState -> [(FunctionAttributeSet, GroupID)])
-> DecodeAST [(FunctionAttributeSet, GroupID)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((DecodeState -> [(FunctionAttributeSet, GroupID)])
 -> DecodeAST [(FunctionAttributeSet, GroupID)])
-> (DecodeState -> [(FunctionAttributeSet, GroupID)])
-> DecodeAST [(FunctionAttributeSet, GroupID)]
forall a b. (a -> b) -> a -> b
$ DecodeState -> [(FunctionAttributeSet, GroupID)]
functionAttributeListIDs
        [(FunctionAttributeSet, GroupID)]
-> ((FunctionAttributeSet, GroupID) -> DecodeAST Definition)
-> DecodeAST [Definition]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(FunctionAttributeSet, GroupID)]
functionAttributes (((FunctionAttributeSet, GroupID) -> DecodeAST Definition)
 -> DecodeAST [Definition])
-> ((FunctionAttributeSet, GroupID) -> DecodeAST Definition)
-> DecodeAST [Definition]
forall a b. (a -> b) -> a -> b
$ \(FunctionAttributeSet
as, GroupID
gid) -> do
          Definition
fAttrs <- GroupID -> [FunctionAttribute] -> Definition
A.FunctionAttributes (GroupID -> [FunctionAttribute] -> Definition)
-> DecodeAST GroupID
-> DecodeAST ([FunctionAttribute] -> Definition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupID -> DecodeAST GroupID
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return GroupID
gid DecodeAST ([FunctionAttribute] -> Definition)
-> DecodeAST [FunctionAttribute] -> DecodeAST Definition
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FunctionAttributeSet -> DecodeAST [FunctionAttribute]
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM FunctionAttributeSet
as
          IO () -> DecodeAST ()
forall a. IO a -> DecodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FunctionAttributeSet -> IO ()
forall a. AttributeSet a -> IO ()
FFI.disposeAttributeSet FunctionAttributeSet
as)
          Definition -> DecodeAST Definition
forall a. a -> DecodeAST a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Definition
fAttrs
      [Definition]
comdats <- (DecodeState -> [Definition]) -> DecodeAST [Definition]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((DecodeState -> [Definition]) -> DecodeAST [Definition])
-> (DecodeState -> [Definition]) -> DecodeAST [Definition]
forall a b. (a -> b) -> a -> b
$ ((ShortByteString, SelectionKind) -> Definition)
-> [(ShortByteString, SelectionKind)] -> [Definition]
forall a b. (a -> b) -> [a] -> [b]
map ((ShortByteString -> SelectionKind -> Definition)
-> (ShortByteString, SelectionKind) -> Definition
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ShortByteString -> SelectionKind -> Definition
A.COMDAT) ([(ShortByteString, SelectionKind)] -> [Definition])
-> (DecodeState -> [(ShortByteString, SelectionKind)])
-> DecodeState
-> [Definition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Ptr COMDAT) (ShortByteString, SelectionKind)
-> [(ShortByteString, SelectionKind)]
forall k a. Map k a -> [a]
Map.elems (Map (Ptr COMDAT) (ShortByteString, SelectionKind)
 -> [(ShortByteString, SelectionKind)])
-> (DecodeState
    -> Map (Ptr COMDAT) (ShortByteString, SelectionKind))
-> DecodeState
-> [(ShortByteString, SelectionKind)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeState -> Map (Ptr COMDAT) (ShortByteString, SelectionKind)
comdats
      [Definition] -> DecodeAST [Definition]
forall a. a -> DecodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Definition] -> DecodeAST [Definition])
-> [Definition] -> DecodeAST [Definition]
forall a b. (a -> b) -> a -> b
$
        [Definition]
structDefinitions [Definition] -> [Definition] -> [Definition]
forall a. [a] -> [a] -> [a]
++
        [Definition]
inlineAsm [Definition] -> [Definition] -> [Definition]
forall a. [a] -> [a] -> [a]
++
        [Definition]
globalDefinitions [Definition] -> [Definition] -> [Definition]
forall a. [a] -> [a] -> [a]
++
        [Definition]
namedMetadata [Definition] -> [Definition] -> [Definition]
forall a. [a] -> [a] -> [a]
++
        [Definition]
metadata [Definition] -> [Definition] -> [Definition]
forall a. [a] -> [a] -> [a]
++
        [Definition]
functionAttributes [Definition] -> [Definition] -> [Definition]
forall a. [a] -> [a] -> [a]
++
        [Definition]
comdats)