{-#
  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 m :: Ptr Module
m = (IORef (Ptr Module) -> Module)
-> IO (IORef (Ptr Module)) -> IO Module
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 :: Module -> m (Ptr Module)
readModule (Module ref :: IORef (Ptr Module)
ref) = IO (Ptr Module) -> m (Ptr Module)
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 r :: 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
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: 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
min :: File -> File -> File
$cmin :: File -> File -> File
max :: File -> File -> File
$cmax :: File -> File -> File
>= :: File -> File -> Bool
$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
compare :: File -> File -> Ordering
$ccompare :: File -> File -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [File]
$creadListPrec :: ReadPrec [File]
readPrec :: ReadPrec File
$creadPrec :: ReadPrec File
readList :: ReadS [File]
$creadList :: ReadS [File]
readsPrec :: Int -> ReadS File
$creadsPrec :: Int -> ReadS File
Read, Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
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 dest :: Module
dest src :: Module
src  = (AnyContT IO () -> (() -> IO ()) -> IO ())
-> (() -> IO ()) -> AnyContT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT () -> IO ()
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 => 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 (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 (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 (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 "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 :: (String, String) -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer (id :: String
id, s :: String
s) = do
    UTF8ByteString bs :: ByteString
bs <- String -> m UTF8ByteString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM String
s
    Specification -> m (OwnerTransfered (Ptr MemoryBuffer))
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM (String -> ByteString -> Specification
MB.Bytes String
id ByteString
bs)

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

instance LLVMAssemblyInput String where
  llvmAssemblyMemoryBuffer :: String -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer s :: 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))
llvmAssemblyMemoryBuffer ("<string>", String
s)

instance LLVMAssemblyInput ByteString where
  llvmAssemblyMemoryBuffer :: ByteString -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer s :: 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))
llvmAssemblyMemoryBuffer ("<string>", ByteString
s)

instance LLVMAssemblyInput File where
  llvmAssemblyMemoryBuffer :: File -> m (OwnerTransfered (Ptr MemoryBuffer))
llvmAssemblyMemoryBuffer (File p :: String
p) = Specification -> m (OwnerTransfered (Ptr MemoryBuffer))
forall (e :: * -> *) h c. EncodeM e h c => 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 :: Context -> s -> (Module -> IO a) -> IO a
withModuleFromLLVMAssembly (Context c :: Ptr Context
c) s :: s
s f :: Module -> IO a
f = (AnyContT IO a -> (a -> IO a) -> IO a)
-> (a -> IO a) -> AnyContT IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT 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))
llvmAssemblyMemoryBuffer s
s
  Ptr (OwnerTransfered CString)
msgPtr <- AnyContT IO (Ptr (OwnerTransfered CString))
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 (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 CString)
-> IO (Ptr Module)
FFI.parseLLVMAssembly Ptr Context
c OwnerTransfered (Ptr MemoryBuffer)
mb Ptr (OwnerTransfered CString)
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 (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 CString) -> AnyContT IO String
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM Ptr (OwnerTransfered CString)
msgPtr
  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 m :: 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 :: CString -> CSize -> IO ()
saveBuffer start :: CString
start size :: CSize
size = do
        ByteString
r <- (CString, CSize) -> IO ByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (CString
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
  (CString -> CSize -> IO ()) -> RawPWriteStreamCallback -> IO ()
FFI.withBufferRawPWriteStream CString -> 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 s :: ByteString
s <- IORef (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IORef a -> IO a
readIORef IORef (Maybe ByteString)
resultRef
  ByteString -> IO ByteString
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 path :: String
path) m :: Module
m = (AnyContT IO () -> (() -> IO ()) -> IO ())
-> (() -> IO ()) -> AnyContT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT () -> IO ()
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 :: (String, ByteString) -> m (Ptr MemoryBuffer)
bitcodeMemoryBuffer (s :: String
s, bs :: ByteString
bs) = Specification -> m (Ptr MemoryBuffer)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM (String -> ByteString -> Specification
MB.Bytes String
s ByteString
bs)

instance BitcodeInput File where
  bitcodeMemoryBuffer :: File -> m (Ptr MemoryBuffer)
bitcodeMemoryBuffer (File p :: String
p) = Specification -> m (Ptr MemoryBuffer)
forall (e :: * -> *) h c. EncodeM e h c => 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 :: Context -> b -> (Module -> IO a) -> IO a
withModuleFromBitcode (Context c :: Ptr Context
c) b :: b
b f :: Module -> IO a
f = (AnyContT IO a -> (a -> IO a) -> IO a)
-> (a -> IO a) -> AnyContT IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT 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)
bitcodeMemoryBuffer b
b
  Ptr (OwnerTransfered CString)
msgPtr <- AnyContT IO (Ptr (OwnerTransfered CString))
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 (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 CString)
-> IO (Ptr Module)
FFI.parseBitcode Ptr Context
c Ptr MemoryBuffer
mb Ptr (OwnerTransfered CString)
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 (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 CString) -> AnyContT IO String
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM Ptr (OwnerTransfered CString)
msgPtr
  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 m :: 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 (CString, 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 path :: String
path) m :: Module
m = (AnyContT IO () -> (() -> IO ()) -> IO ())
-> (() -> IO ()) -> AnyContT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT () -> IO ()
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 fileType :: CodeGenFileType
fileType (TargetMachine tm :: Ptr TargetMachine
tm) m :: Module
m os :: Ptr RawPWriteStream
os = (AnyContT IO () -> (() -> IO ()) -> IO ())
-> (() -> IO ()) -> AnyContT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT () -> IO ()
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 CString)
msgPtr <- AnyContT IO (Ptr (OwnerTransfered CString))
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 => 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 (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 CString)
-> IO LLVMBool
FFI.targetMachineEmit Ptr TargetMachine
tm Ptr Module
m' Ptr RawPWriteStream
os CodeGenFileType
fileType Ptr (OwnerTransfered CString)
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 (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 CString) -> AnyContT IO String
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM Ptr (OwnerTransfered CString)
msgPtr

-- | May throw 'FdStreamException' and 'TargetMachineEmitException'.
emitToFile :: FFI.CodeGenFileType -> TargetMachine -> File -> Module -> IO ()
emitToFile :: CodeGenFileType -> TargetMachine -> File -> Module -> IO ()
emitToFile fileType :: CodeGenFileType
fileType tm :: TargetMachine
tm (File path :: String
path) m :: Module
m = (AnyContT IO () -> (() -> IO ()) -> IO ())
-> (() -> IO ()) -> AnyContT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT () -> IO ()
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 fileType :: CodeGenFileType
fileType tm :: TargetMachine
tm m :: Module
m = (AnyContT IO ByteString
 -> (ByteString -> IO ByteString) -> IO ByteString)
-> (ByteString -> IO ByteString)
-> AnyContT IO ByteString
-> IO ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO ByteString
-> (ByteString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT ByteString -> IO ByteString
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 (CString, 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 tm :: TargetMachine
tm m :: 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 m :: Ptr Module
m t :: ShortByteString
t = do
  CString
t <- ShortByteString -> EncodeAST CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
t
  IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> CString -> IO ()
FFI.setTargetTriple Ptr Module
m CString
t

getTargetTriple :: Ptr FFI.Module -> IO (Maybe ShortByteString)
getTargetTriple :: Ptr Module -> IO (Maybe ShortByteString)
getTargetTriple m :: Ptr Module
m = do
  ShortByteString
s <- CString -> IO ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (CString -> IO ShortByteString) -> IO CString -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CString -> IO CString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Module -> IO CString
FFI.getTargetTriple Ptr Module
m)
  Maybe ShortByteString -> IO (Maybe ShortByteString)
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 m :: Ptr Module
m dl :: DataLayout
dl = do
  CString
s <- ByteString -> EncodeAST CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM (DataLayout -> ByteString
dataLayoutToString DataLayout
dl)
  IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> CString -> IO ()
FFI.setDataLayout Ptr Module
m CString
s

getDataLayout :: Ptr FFI.Module -> IO (Maybe A.DataLayout)
getDataLayout :: Ptr Module -> IO (Maybe DataLayout)
getDataLayout m :: Ptr Module
m = do
  ByteString
dlString <- CString -> IO ByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (CString -> IO ByteString) -> IO CString -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Module -> IO CString
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 (m :: * -> *) a. MonadFail m => String -> m a
fail Maybe DataLayout -> IO (Maybe DataLayout)
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 :: Context -> Module -> (Module -> IO a) -> IO a
withModuleFromAST context :: Context
context@(Context c :: Ptr Context
c) (A.Module moduleId :: ShortByteString
moduleId sourceFileName :: ShortByteString
sourceFileName dataLayout :: Maybe DataLayout
dataLayout triple :: Maybe ShortByteString
triple definitions :: [Definition]
definitions) f :: Module -> IO a
f = Context -> EncodeAST a -> IO a
forall a. Context -> EncodeAST a -> IO a
runEncodeAST Context
context (EncodeAST a -> IO a) -> EncodeAST a -> IO a
forall a b. (a -> b) -> a -> b
$ do
  CString
moduleId <- ShortByteString -> EncodeAST CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
moduleId
  Module
m <- (forall r. (Module -> IO r) -> IO r) -> EncodeAST Module
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (Module -> IO r) -> IO r) -> EncodeAST Module)
-> (forall r. (Module -> IO r) -> IO r) -> EncodeAST 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
=<< CString -> Ptr Context -> IO (Ptr Module)
FFI.moduleCreateWithNameInContext CString
moduleId Ptr Context
c) (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
ffiMod <- Module -> EncodeAST (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  CString
sourceFileName' <- ShortByteString -> EncodeAST CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
sourceFileName
  IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> CString -> IO ()
FFI.setSourceFileName Ptr Module
ffiMod CString
sourceFileName'
  Context 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 l :: EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
l = (EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
l EncodeAST [EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
-> ([EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))]
    -> EncodeAST [()])
-> EncodeAST [()]
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)
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)
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)
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)
sequence)) EncodeAST [()] -> EncodeAST () -> EncodeAST ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (() -> EncodeAST ()
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
$ \d :: Definition
d -> case Definition
d of
   A.TypeDefinition n :: Name
n t :: Maybe Type
t -> do
     (t' :: Ptr Type
t', n' :: 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 (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 (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 (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 (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 (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 n :: ShortByteString
n csk :: SelectionKind
csk -> do
     CString
n' <- ShortByteString -> EncodeAST CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
n
     COMDATSelectionKind
csk <- SelectionKind -> EncodeAST COMDATSelectionKind
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM SelectionKind
csk
     Ptr COMDAT
cd <- IO (Ptr COMDAT) -> EncodeAST (Ptr COMDAT)
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 -> CString -> IO (Ptr COMDAT)
FFI.getOrInsertCOMDAT Ptr Module
ffiMod CString
n'
     IO () -> EncodeAST ()
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 (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 (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 (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 (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 (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 i :: MetadataNodeID
i md :: MDNode
md -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
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 (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 (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 (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 => h -> e c
encodeM MDNode
md
       IO () -> EncodeAST ()
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 (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST () -> EncodeAST (EncodeAST ()))
-> EncodeAST () -> EncodeAST (EncodeAST ())
forall a b. (a -> b) -> a -> b
$ () -> EncodeAST ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

   A.NamedMetadataDefinition n :: ShortByteString
n ids :: [MetadataNodeID]
ids -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
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 (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 (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 (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
     CString
n <- ShortByteString -> EncodeAST CString
forall (e :: * -> *) h c. EncodeM e h c => 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 => 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 (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 -> CString -> IO (Ptr NamedMetadata)
FFI.getOrAddNamedMetadata Ptr Module
ffiMod CString
n
     IO () -> EncodeAST ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()

   A.ModuleInlineAssembly s :: ByteString
s -> do
     (CString, CUInt)
s <- ByteString -> EncodeAST (CString, CUInt)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ByteString
s
     IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Module -> ModuleAsm (CString, CUInt) -> IO ()
FFI.moduleAppendInlineAsm Ptr Module
ffiMod ((CString, CUInt) -> ModuleAsm (CString, CUInt)
forall a. a -> ModuleAsm a
FFI.ModuleAsm (CString, CUInt)
s)
     EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
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 (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 (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 (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 (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 gid :: GroupID
gid attrs :: [FunctionAttribute]
attrs -> do
     FunctionAttributeSet
attrs <- [FunctionAttribute] -> EncodeAST FunctionAttributeSet
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM [FunctionAttribute]
attrs
     GroupID -> FunctionAttributeSet -> EncodeAST ()
defineAttributeGroup GroupID
gid FunctionAttributeSet
attrs
     EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
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 (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 (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 (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 (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 g :: Global
g -> EncodeAST (EncodeAST (EncodeAST (EncodeAST ())))
-> EncodeAST (EncodeAST (EncodeAST (EncodeAST (EncodeAST ()))))
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 => h -> e c
encodeM (Global -> Type
A.G.type' Global
g)
         Ptr GlobalVariable
g' <- IO (Ptr GlobalVariable) -> EncodeAST (Ptr GlobalVariable)
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
-> (CString -> IO (Ptr GlobalVariable)) -> IO (Ptr GlobalVariable)
forall a. Name -> (CString -> IO a) -> IO a
withName Name
n ((CString -> IO (Ptr GlobalVariable)) -> IO (Ptr GlobalVariable))
-> (CString -> IO (Ptr GlobalVariable)) -> IO (Ptr GlobalVariable)
forall a b. (a -> b) -> a -> b
$ \gName :: CString
gName ->
                   Ptr Module
-> Ptr Type -> CString -> CUInt -> IO (Ptr GlobalVariable)
FFI.addGlobalInAddressSpace Ptr Module
ffiMod Ptr Type
typ CString
gName
                          (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((\(A.AddrSpace a :: 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 (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 => 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 => 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 (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 (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 => 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 (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 => h -> e c
encodeM (Global -> Type
A.G.type' Global
a)
         AddrSpace
as <- AddrSpace -> EncodeAST AddrSpace
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM (Global -> AddrSpace
A.G.addrSpace Global
a)
         Ptr GlobalAlias
a' <- IO (Ptr GlobalAlias) -> EncodeAST (Ptr GlobalAlias)
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 -> (CString -> IO (Ptr GlobalAlias)) -> IO (Ptr GlobalAlias)
forall a. Name -> (CString -> IO a) -> IO a
withName Name
n ((CString -> IO (Ptr GlobalAlias)) -> IO (Ptr GlobalAlias))
-> (CString -> IO (Ptr GlobalAlias)) -> IO (Ptr GlobalAlias)
forall a b. (a -> b) -> a -> b
$ \name :: CString
name -> Ptr Module
-> Ptr Type -> AddrSpace -> CString -> IO (Ptr GlobalAlias)
FFI.justAddAlias Ptr Module
ffiMod Ptr Type
typ AddrSpace
as CString
name
         Name -> Ptr GlobalAlias -> EncodeAST ()
forall v.
DescendentOf GlobalValue v =>
Name -> Ptr v -> EncodeAST ()
defineGlobal Name
n Ptr GlobalAlias
a'
         IO () -> EncodeAST ()
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 => 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 (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 (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 => h -> e c
encodeM (Global -> Constant
A.G.aliasee Global
a)
           Ptr GlobalValue -> EncodeAST (Ptr GlobalValue)
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 _ _ _ cc :: CallingConvention
cc rAttrs :: [ParameterAttribute]
rAttrs resultType :: Type
resultType fName :: Name
fName (args :: [Parameter]
args, isVarArgs :: Bool
isVarArgs) attrs :: [Either GroupID FunctionAttribute]
attrs _ _ _ gc :: Maybe ShortByteString
gc prefix :: Maybe Constant
prefix blocks :: [BasicBlock]
blocks personality :: Maybe Constant
personality metadata :: [(ShortByteString, MDRef MDNode)]
metadata) -> do
         Ptr Type
typ <- Type -> EncodeAST (Ptr Type)
forall (e :: * -> *) h c. EncodeM e h c => 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 t :: Type
t _ _ <- [Parameter]
args] Bool
isVarArgs
         Ptr Function
f <- IO (Ptr Function) -> EncodeAST (Ptr Function)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Function) -> EncodeAST (Ptr Function))
-> ((CString -> IO (Ptr Function)) -> IO (Ptr Function))
-> (CString -> IO (Ptr Function))
-> EncodeAST (Ptr Function)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (CString -> IO (Ptr Function)) -> IO (Ptr Function)
forall a. Name -> (CString -> IO a) -> IO a
withName Name
fName ((CString -> IO (Ptr Function)) -> EncodeAST (Ptr Function))
-> (CString -> IO (Ptr Function)) -> EncodeAST (Ptr Function)
forall a b. (a -> b) -> a -> b
$ \fName :: CString
fName -> Ptr Module -> CString -> Ptr Type -> IO (Ptr Function)
FFI.addFunction Ptr Module
ffiMod CString
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 => h -> e c
encodeM CallingConvention
cc
         IO () -> EncodeAST ()
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 _ _ pa :: [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 bName :: Name
bName _ _) -> do
           Ptr BasicBlock
b <- IO (Ptr BasicBlock) -> EncodeAST (Ptr BasicBlock)
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 -> (CString -> IO (Ptr BasicBlock)) -> IO (Ptr BasicBlock)
forall a. Name -> (CString -> IO a) -> IO a
withName Name
bName ((CString -> IO (Ptr BasicBlock)) -> IO (Ptr BasicBlock))
-> (CString -> IO (Ptr BasicBlock)) -> IO (Ptr BasicBlock)
forall a b. (a -> b) -> a -> b
$ \bName :: CString
bName -> Ptr Context -> Ptr Function -> CString -> IO (Ptr BasicBlock)
FFI.appendBasicBlockInContext Ptr Context
context Ptr Function
f CString
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 (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 (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 _ n :: Name
n _, p :: Ptr Parameter
p) -> do
             Name -> Ptr Parameter -> EncodeAST ()
forall v. DescendentOf Value v => Name -> Ptr v -> EncodeAST ()
defineLocal Name
n Ptr Parameter
p
             CString
n <- Name -> EncodeAST CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM Name
n
             IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Value -> CString -> IO ()
FFI.setValueName (Ptr Parameter -> Ptr Value
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr Parameter
p) CString
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 bName :: Name
bName namedInstrs :: [Named Instruction]
namedInstrs term :: Named Terminator
term) -> do
             Ptr BasicBlock
b <- Name -> EncodeAST (Ptr BasicBlock)
forall (e :: * -> *) h c. EncodeM e h c => 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 (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)
mapM Named Instruction -> EncodeAST (EncodeAST ())
forall (e :: * -> *) h c. EncodeM e h c => 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 => h -> e c
encodeM Named Terminator
term :: EncodeAST (Ptr FFI.Instruction))
             EncodeAST () -> EncodeAST (EncodeAST ())
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 | (n :: Name
n, ForwardValue _) <- [(Name, LocalValue)]
locals ] ((Name -> EncodeAST Any) -> EncodeAST ())
-> (Name -> EncodeAST Any) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \n :: Name
n -> String -> Name -> EncodeAST Any
forall n a. Show n => String -> n -> EncodeAST a
undefinedReference "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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST () -> EncodeAST (EncodeAST ()))
-> EncodeAST () -> EncodeAST (EncodeAST ())
forall a b. (a -> b) -> a -> b
$ () -> EncodeAST ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  IO a -> EncodeAST a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> EncodeAST a) -> IO a -> EncodeAST a
forall a b. (a -> b) -> a -> b
$ Module -> IO a
f 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 mod :: Ptr Module
mod = do
  [Ptr GlobalVariable]
ffiGlobals <- IO [Ptr GlobalVariable] -> DecodeAST [Ptr GlobalVariable]
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 (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)
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
$ \g :: Ptr GlobalVariable
g -> do
    A.PointerType t :: Type
t as :: 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 (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 (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 (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 (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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (Maybe UnnamedAddr) -> DecodeAST (Maybe UnnamedAddr)
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 => 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO Bool -> DecodeAST Bool
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 => 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> DecodeAST Type
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddrSpace -> DecodeAST AddrSpace
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (do Ptr Constant
i <- IO (Ptr Constant) -> DecodeAST (Ptr Constant)
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 (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 => 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 (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 (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 (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 (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 mod :: Ptr Module
mod = do
  [Ptr GlobalAlias]
ffiAliases <- IO [Ptr GlobalAlias] -> DecodeAST [Ptr GlobalAlias]
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 (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)
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
$ \a :: 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 t :: Type
t as :: 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 (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 (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 (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 (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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (Maybe UnnamedAddr) -> DecodeAST (Maybe UnnamedAddr)
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 => 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> DecodeAST Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t
        DecodeAST (AddrSpace -> Constant -> Global)
-> DecodeAST AddrSpace -> DecodeAST (Constant -> Global)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddrSpace -> DecodeAST AddrSpace
forall (m :: * -> *) a. Monad m => a -> m a
return AddrSpace
as
        DecodeAST (Constant -> Global)
-> DecodeAST Constant -> DecodeAST Global
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 => 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 (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 o :: Ptr GlobalObject
o = DecodeAST [(ShortByteString, MDRef MDNode)]
-> DecodeAST [(ShortByteString, MDRef MDNode)]
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 (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 (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 => c -> d h
decodeM (CUInt
n, Ptr MDKindID
ks) DecodeAST ([MDRef MDNode] -> [(ShortByteString, MDRef MDNode)])
-> DecodeAST [MDRef MDNode]
-> DecodeAST [(ShortByteString, MDRef MDNode)]
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 => 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 o :: Ptr GlobalObject
o md :: [(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
$ \(kindName :: ShortByteString
kindName, node :: MDRef MDNode
node) -> do
    MDKindID
kindID <- ShortByteString -> EncodeAST MDKindID
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
kindName
    Ptr MDNode
node <- MDRef MDNode -> EncodeAST (Ptr MDNode)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM MDRef MDNode
node
    IO () -> EncodeAST ()
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 mod :: Ptr Module
mod = do
  [Ptr Function]
ffiFunctions <-
    IO [Ptr Function] -> DecodeAST [Ptr Function]
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 (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)
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
$ \f :: 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 returnType :: Type
returnType _ isVarArg :: Bool
isVarArg) _ <- 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 fAttrs :: [Either GroupID FunctionAttribute]
fAttrs rAttrs :: [ParameterAttribute]
rAttrs pAttrs :: [[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 (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 (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)
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
$ \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 (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 (m :: * -> *) a. Monad m => a -> m a
return Name
n
              DecodeAST ([Named Instruction] -> Named Terminator -> BasicBlock)
-> DecodeAST [Named Instruction]
-> DecodeAST (Named Terminator -> BasicBlock)
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DecodeAST (Named Terminator)
decodeTerminator
      DecodeAST Global -> DecodeAST (DecodeAST Global)
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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO CallingConvention -> DecodeAST CallingConvention
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 => 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ParameterAttribute] -> DecodeAST [ParameterAttribute]
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> DecodeAST Type
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> DecodeAST Name
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Parameter], Bool) -> DecodeAST ([Parameter], Bool)
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Either GroupID FunctionAttribute]
-> DecodeAST [Either GroupID FunctionAttribute]
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 (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 (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 (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 (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 (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 (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 (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 (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 mod :: Ptr Module
mod = do
  [Ptr NamedMetadata]
ffiNamedMetadataNodes <-
    IO [Ptr NamedMetadata] -> DecodeAST [Ptr NamedMetadata]
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
$ \nm :: Ptr NamedMetadata
nm ->
    DecodeAST Definition -> DecodeAST Definition
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 (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 (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 CString) -> DecodeAST ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM ((Ptr CUInt -> IO CString) -> DecodeAST ShortByteString)
-> (Ptr CUInt -> IO CString) -> DecodeAST ShortByteString
forall a b. (a -> b) -> a -> b
$ Ptr NamedMetadata -> Ptr CUInt -> IO CString
FFI.getNamedMetadataName Ptr NamedMetadata
nm)
        DecodeAST ([MetadataNodeID] -> Definition)
-> DecodeAST [MetadataNodeID] -> DecodeAST Definition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([MDRef MDNode] -> [MetadataNodeID])
-> DecodeAST [MDRef MDNode] -> DecodeAST [MetadataNodeID]
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 mid :: MetadataNodeID
mid) -> MetadataNodeID
mid))
              ((CUInt, Ptr (Ptr MDNode)) -> DecodeAST [MDRef MDNode]
forall (d :: * -> *) h c. DecodeM d h c => 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 m :: 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 (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 (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 (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 CString -> IO ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (OwnerTransfered CString -> IO ShortByteString)
-> IO (OwnerTransfered CString) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Module -> IO (OwnerTransfered CString)
FFI.getModuleIdentifier Ptr Module
mod)
    DecodeAST
  (ShortByteString
   -> Maybe DataLayout
   -> Maybe ShortByteString
   -> [Definition]
   -> Module)
-> DecodeAST ShortByteString
-> DecodeAST
     (Maybe DataLayout
      -> Maybe ShortByteString -> [Definition] -> Module)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO ShortByteString -> DecodeAST ShortByteString
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 CString -> IO ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (OwnerTransfered CString -> IO ShortByteString)
-> IO (OwnerTransfered CString) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Module -> IO (OwnerTransfered CString)
FFI.getSourceFileName Ptr Module
mod)
    DecodeAST
  (Maybe DataLayout
   -> Maybe ShortByteString -> [Definition] -> Module)
-> DecodeAST (Maybe DataLayout)
-> DecodeAST (Maybe ShortByteString -> [Definition] -> Module)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (Maybe DataLayout) -> DecodeAST (Maybe DataLayout)
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (Maybe ShortByteString) -> DecodeAST (Maybe ShortByteString)
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 <- CString -> IO ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (CString -> IO ShortByteString) -> IO CString -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Module -> IO CString
FFI.getTargetTriple Ptr Module
mod
           Maybe ShortByteString -> IO (Maybe ShortByteString)
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 (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 (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)
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)
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 CString -> DecodeAST [Definition]
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (ModuleAsm CString -> DecodeAST [Definition])
-> DecodeAST (ModuleAsm CString) -> DecodeAST [Definition]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (ModuleAsm CString) -> DecodeAST (ModuleAsm CString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Module -> IO (ModuleAsm CString)
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
$ \(as :: FunctionAttributeSet
as, gid :: 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 (m :: * -> *) a. Monad m => a -> m a
return GroupID
gid DecodeAST ([FunctionAttribute] -> Definition)
-> DecodeAST [FunctionAttribute] -> DecodeAST Definition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FunctionAttributeSet -> DecodeAST [FunctionAttribute]
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM FunctionAttributeSet
as
          IO () -> DecodeAST ()
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 (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 (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)