{-# LANGUAGE
MultiParamTypeClasses
#-}
module LLVM.Internal.Metadata where
import LLVM.Prelude
import Control.Monad.State hiding (mapM, forM)
import Control.Monad.AnyCont
import Foreign.Ptr
import qualified Foreign.Marshal.Array as FMA
import qualified Data.Array as Array
import qualified LLVM.Internal.FFI.LLVMCTypes as FFI
import qualified LLVM.Internal.FFI.Metadata as FFI
import qualified LLVM.Internal.FFI.PtrHierarchy as FFI
import LLVM.Internal.Context
import LLVM.Internal.Coding
import LLVM.Internal.EncodeAST
import LLVM.Internal.DecodeAST
import LLVM.Internal.Value ()
import Foreign.C
instance EncodeM EncodeAST ShortByteString FFI.MDKindID where
encodeM :: ShortByteString -> EncodeAST MDKindID
encodeM s :: ShortByteString
s = do
Context c :: Ptr Context
c <- (EncodeState -> Context) -> EncodeAST Context
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EncodeState -> Context
encodeStateContext
(Ptr CChar, CUInt)
s <- ShortByteString -> EncodeAST (Ptr CChar, CUInt)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
s
IO MDKindID -> EncodeAST MDKindID
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MDKindID -> EncodeAST MDKindID)
-> IO MDKindID -> EncodeAST MDKindID
forall a b. (a -> b) -> a -> b
$ Ptr Context -> (Ptr CChar, CUInt) -> IO MDKindID
FFI.getMDKindIDInContext Ptr Context
c (Ptr CChar, CUInt)
s
getMetadataKindNames :: Context -> DecodeAST ()
getMetadataKindNames :: Context -> DecodeAST ()
getMetadataKindNames (Context c :: Ptr Context
c) = DecodeAST () -> DecodeAST ()
forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a
scopeAnyCont (DecodeAST () -> DecodeAST ()) -> DecodeAST () -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ do
let g :: CUInt -> m [b]
g n :: CUInt
n = do
Ptr (Ptr CChar)
ps <- CUInt -> m (Ptr (Ptr CChar))
forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray CUInt
n
Ptr CUInt
ls <- CUInt -> m (Ptr CUInt)
forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray CUInt
n
CUInt
n' <- IO CUInt -> m CUInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CUInt -> m CUInt) -> IO CUInt -> m CUInt
forall a b. (a -> b) -> a -> b
$ Ptr Context -> Ptr (Ptr CChar) -> Ptr CUInt -> CUInt -> IO CUInt
FFI.getMDKindNames Ptr Context
c Ptr (Ptr CChar)
ps Ptr CUInt
ls CUInt
n
if CUInt
n' CUInt -> CUInt -> Bool
forall a. Ord a => a -> a -> Bool
> CUInt
n
then CUInt -> m [b]
g CUInt
n'
else do
[(Ptr CChar, CUInt)]
csls <- ([Ptr CChar] -> [CUInt] -> [(Ptr CChar, CUInt)])
-> m ([Ptr CChar] -> [CUInt] -> [(Ptr CChar, CUInt)])
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr CChar] -> [CUInt] -> [(Ptr CChar, CUInt)]
forall a b. [a] -> [b] -> [(a, b)]
zip
m ([Ptr CChar] -> [CUInt] -> [(Ptr CChar, CUInt)])
-> m [Ptr CChar] -> m ([CUInt] -> [(Ptr CChar, CUInt)])
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO [Ptr CChar] -> m [Ptr CChar]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
FMA.peekArray (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
n') Ptr (Ptr CChar)
ps)
m ([CUInt] -> [(Ptr CChar, CUInt)])
-> m [CUInt] -> m [(Ptr CChar, CUInt)]
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO [CUInt] -> m [CUInt]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Ptr CUInt -> IO [CUInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
FMA.peekArray (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
n') Ptr CUInt
ls)
((Ptr CChar, CUInt) -> m b) -> [(Ptr CChar, CUInt)] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr CChar, CUInt) -> m b
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM [(Ptr CChar, CUInt)]
csls
[ShortByteString]
strs <- CUInt -> DecodeAST [ShortByteString]
forall (m :: * -> *) b.
(MonadAnyCont IO m, MonadIO m, DecodeM m b (Ptr CChar, CUInt)) =>
CUInt -> m [b]
g 16
(DecodeState -> DecodeState) -> DecodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DecodeState -> DecodeState) -> DecodeAST ())
-> (DecodeState -> DecodeState) -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> DecodeState
s { metadataKinds :: Array Word ShortByteString
metadataKinds = (Word, Word) -> [ShortByteString] -> Array Word ShortByteString
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (0, Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([ShortByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ShortByteString]
strs) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1) [ShortByteString]
strs }
instance DecodeM DecodeAST ShortByteString FFI.MDKindID where
decodeM :: MDKindID -> DecodeAST ShortByteString
decodeM (FFI.MDKindID k :: CUInt
k) = (DecodeState -> ShortByteString) -> DecodeAST ShortByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((DecodeState -> ShortByteString) -> DecodeAST ShortByteString)
-> (DecodeState -> ShortByteString) -> DecodeAST ShortByteString
forall a b. (a -> b) -> a -> b
$ (Array Word ShortByteString -> Word -> ShortByteString
forall i e. Ix i => Array i e -> i -> e
Array.! (CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
k)) (Array Word ShortByteString -> ShortByteString)
-> (DecodeState -> Array Word ShortByteString)
-> DecodeState
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeState -> Array Word ShortByteString
metadataKinds
instance DecodeM DecodeAST ShortByteString (Ptr FFI.MDString) where
decodeM :: Ptr MDString -> DecodeAST ShortByteString
decodeM = (Ptr MDString -> Ptr CUInt -> IO (Ptr CChar))
-> Ptr MDString -> DecodeAST ShortByteString
forall a.
(Ptr a -> Ptr CUInt -> IO (Ptr CChar))
-> Ptr a -> DecodeAST ShortByteString
getByteStringFromFFI Ptr MDString -> Ptr CUInt -> IO (Ptr CChar)
FFI.getMDStringValue
getByteStringFromFFI :: (Ptr a -> Ptr CUInt -> IO CString) -> Ptr a -> DecodeAST ShortByteString
getByteStringFromFFI :: (Ptr a -> Ptr CUInt -> IO (Ptr CChar))
-> Ptr a -> DecodeAST ShortByteString
getByteStringFromFFI _ p :: Ptr a
p | Ptr a
forall a. Ptr a
nullPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
p = ShortByteString -> DecodeAST ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ShortByteString
forall a. Monoid a => a
mempty
getByteStringFromFFI f :: Ptr a -> Ptr CUInt -> IO (Ptr CChar)
f p :: Ptr a
p = do
Ptr CUInt
np <- DecodeAST (Ptr CUInt)
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
Ptr CChar
s <- IO (Ptr CChar) -> DecodeAST (Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CChar) -> DecodeAST (Ptr CChar))
-> IO (Ptr CChar) -> DecodeAST (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr a -> Ptr CUInt -> IO (Ptr CChar)
f Ptr a
p Ptr CUInt
np
CUInt
n <- Ptr CUInt -> DecodeAST CUInt
forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a
peek Ptr CUInt
np
(Ptr CChar, CUInt) -> DecodeAST ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (Ptr CChar
s, CUInt
n)