module LLVM.Internal.Function where

import LLVM.Prelude

import Control.Monad.Trans
import Control.Monad.AnyCont

import Foreign.Ptr

import qualified LLVM.Internal.FFI.Function as FFI
import qualified LLVM.Internal.FFI.PtrHierarchy as FFI
import qualified LLVM.Internal.FFI.Attribute as FFI

import LLVM.Internal.DecodeAST
import LLVM.Internal.EncodeAST
import LLVM.Internal.Value
import LLVM.Internal.Coding
import LLVM.Internal.Constant ()
import LLVM.Internal.Attribute

import qualified LLVM.AST as A
import qualified LLVM.AST.Constant as A
import qualified LLVM.AST.ParameterAttribute as A.PA

getAttributeList :: Ptr FFI.Function -> DecodeAST AttributeList
getAttributeList :: Ptr Function -> DecodeAST AttributeList
getAttributeList f :: Ptr Function
f = do
  (AttrSetDecoder (Ptr Function), Ptr Function)
-> DecodeAST AttributeList
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM ((forall b. Ptr Function -> AttributeIndex -> IO (AttributeSet b))
-> (Ptr Function -> IO CUInt) -> AttrSetDecoder (Ptr Function)
forall a.
(forall b. a -> AttributeIndex -> IO (AttributeSet b))
-> (a -> IO CUInt) -> AttrSetDecoder a
FFI.AttrSetDecoder forall b. Ptr Function -> AttributeIndex -> IO (AttributeSet b)
FFI.attributesAtIndex Ptr Function -> IO CUInt
FFI.countParams, Ptr Function
f)

setFunctionAttributes :: Ptr FFI.Function -> AttributeList -> EncodeAST ()
setFunctionAttributes :: Ptr Function -> AttributeList -> EncodeAST ()
setFunctionAttributes f :: Ptr Function
f = IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ())
-> (AttributeList -> IO ()) -> AttributeList -> EncodeAST ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Function -> AttributeList -> IO ()
FFI.setAttributeList Ptr Function
f (AttributeList -> EncodeAST ())
-> (AttributeList -> EncodeAST AttributeList)
-> AttributeList
-> EncodeAST ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AttributeList -> EncodeAST AttributeList
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM

getParameters :: Ptr FFI.Function -> [[A.PA.ParameterAttribute]] -> DecodeAST [A.Parameter]
getParameters :: Ptr Function -> [[ParameterAttribute]] -> DecodeAST [Parameter]
getParameters f :: Ptr Function
f attrs :: [[ParameterAttribute]]
attrs = DecodeAST [Parameter] -> DecodeAST [Parameter]
forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a
scopeAnyCont (DecodeAST [Parameter] -> DecodeAST [Parameter])
-> DecodeAST [Parameter] -> DecodeAST [Parameter]
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 Function -> IO CUInt
FFI.countParams Ptr Function
f)
  Ptr (Ptr Parameter)
ps <- CUInt -> DecodeAST (Ptr (Ptr Parameter))
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 Function -> Ptr (Ptr Parameter) -> IO ()
FFI.getParams Ptr Function
f Ptr (Ptr Parameter)
ps
  [Ptr Parameter]
params <- CUInt -> Ptr (Ptr Parameter) -> DecodeAST [Ptr Parameter]
forall i a (m :: * -> *).
(Integral i, Storable a, MonadIO m) =>
i -> Ptr a -> m [a]
peekArray CUInt
n Ptr (Ptr Parameter)
ps
  [(Ptr Parameter, Maybe [ParameterAttribute])]
-> ((Ptr Parameter, Maybe [ParameterAttribute])
    -> DecodeAST Parameter)
-> DecodeAST [Parameter]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Ptr Parameter]
-> [[ParameterAttribute]]
-> [(Ptr Parameter, Maybe [ParameterAttribute])]
forall a b. [a] -> [b] -> [(a, Maybe b)]
leftBiasedZip [Ptr Parameter]
params [[ParameterAttribute]]
attrs) (((Ptr Parameter, Maybe [ParameterAttribute])
  -> DecodeAST Parameter)
 -> DecodeAST [Parameter])
-> ((Ptr Parameter, Maybe [ParameterAttribute])
    -> DecodeAST Parameter)
-> DecodeAST [Parameter]
forall a b. (a -> b) -> a -> b
$ \(param :: Ptr Parameter
param, pAttrs :: Maybe [ParameterAttribute]
pAttrs) ->
    Type -> Name -> [ParameterAttribute] -> Parameter
A.Parameter
      (Type -> Name -> [ParameterAttribute] -> Parameter)
-> DecodeAST Type
-> DecodeAST (Name -> [ParameterAttribute] -> Parameter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Parameter -> DecodeAST Type
forall v. DescendentOf Value v => Ptr v -> DecodeAST Type
typeOf Ptr Parameter
param
      DecodeAST (Name -> [ParameterAttribute] -> Parameter)
-> DecodeAST Name -> DecodeAST ([ParameterAttribute] -> Parameter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Parameter -> DecodeAST Name
forall v. DescendentOf Value v => Ptr v -> DecodeAST Name
getLocalName Ptr Parameter
param
      DecodeAST ([ParameterAttribute] -> Parameter)
-> DecodeAST [ParameterAttribute] -> DecodeAST Parameter
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] -> DecodeAST [ParameterAttribute])
-> [ParameterAttribute] -> DecodeAST [ParameterAttribute]
forall a b. (a -> b) -> a -> b
$ [ParameterAttribute]
-> Maybe [ParameterAttribute] -> [ParameterAttribute]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ParameterAttribute]
pAttrs)
  
getGC :: Ptr FFI.Function -> DecodeAST (Maybe ShortByteString)
getGC :: Ptr Function -> DecodeAST (Maybe ShortByteString)
getGC f :: Ptr Function
f = DecodeAST (Maybe ShortByteString)
-> DecodeAST (Maybe ShortByteString)
forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a
scopeAnyCont (DecodeAST (Maybe ShortByteString)
 -> DecodeAST (Maybe ShortByteString))
-> DecodeAST (Maybe ShortByteString)
-> DecodeAST (Maybe ShortByteString)
forall a b. (a -> b) -> a -> b
$ CString -> DecodeAST (Maybe ShortByteString)
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (CString -> DecodeAST (Maybe ShortByteString))
-> DecodeAST CString -> DecodeAST (Maybe ShortByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CString -> DecodeAST CString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Function -> IO CString
FFI.getGC Ptr Function
f)

setGC :: Ptr FFI.Function -> Maybe ShortByteString -> EncodeAST ()
setGC :: Ptr Function -> Maybe ShortByteString -> EncodeAST ()
setGC f :: Ptr Function
f gc :: Maybe ShortByteString
gc = EncodeAST () -> EncodeAST ()
forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a
scopeAnyCont (EncodeAST () -> EncodeAST ()) -> EncodeAST () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ())
-> (CString -> IO ()) -> CString -> EncodeAST ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Function -> CString -> IO ()
FFI.setGC Ptr Function
f (CString -> EncodeAST ()) -> EncodeAST CString -> EncodeAST ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ShortByteString -> EncodeAST CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM Maybe ShortByteString
gc 

getPrefixData :: Ptr FFI.Function -> DecodeAST (Maybe A.Constant)
getPrefixData :: Ptr Function -> DecodeAST (Maybe Constant)
getPrefixData f :: Ptr Function
f = do
  Bool
has <- LLVMBool -> DecodeAST Bool
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (LLVMBool -> DecodeAST Bool)
-> DecodeAST LLVMBool -> DecodeAST Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO LLVMBool -> DecodeAST LLVMBool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LLVMBool -> DecodeAST LLVMBool)
-> IO LLVMBool -> DecodeAST LLVMBool
forall a b. (a -> b) -> a -> b
$ Ptr Function -> IO LLVMBool
FFI.hasPrefixData Ptr Function
f)
  if Bool
has
   then Ptr Constant -> DecodeAST (Maybe Constant)
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (Ptr Constant -> DecodeAST (Maybe Constant))
-> DecodeAST (Ptr Constant) -> DecodeAST (Maybe 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 Function -> IO (Ptr Constant)
FFI.getPrefixData Ptr Function
f)
   else Maybe Constant -> DecodeAST (Maybe Constant)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Constant
forall a. Maybe a
Nothing

setPrefixData :: Ptr FFI.Function -> Maybe A.Constant -> EncodeAST ()
setPrefixData :: Ptr Function -> Maybe Constant -> EncodeAST ()
setPrefixData f :: Ptr Function
f = (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 Function -> Ptr Constant -> IO ()
FFI.setPrefixData Ptr Function
f (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)

getPersonalityFn :: Ptr FFI.Function -> DecodeAST (Maybe A.Constant)
getPersonalityFn :: Ptr Function -> DecodeAST (Maybe Constant)
getPersonalityFn f :: Ptr Function
f = do
  Bool
has <- LLVMBool -> DecodeAST Bool
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (LLVMBool -> DecodeAST Bool)
-> DecodeAST LLVMBool -> DecodeAST Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO LLVMBool -> DecodeAST LLVMBool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Function -> IO LLVMBool
FFI.hasPersonalityFn Ptr Function
f)
  if Bool
has
     then Ptr Constant -> DecodeAST (Maybe Constant)
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (Ptr Constant -> DecodeAST (Maybe Constant))
-> DecodeAST (Ptr Constant) -> DecodeAST (Maybe 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 (Ptr Function -> IO (Ptr Constant)
FFI.getPersonalityFn Ptr Function
f)
     else Maybe Constant -> DecodeAST (Maybe Constant)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Constant
forall a. Maybe a
Nothing

setPersonalityFn :: Ptr FFI.Function -> Maybe A.Constant -> EncodeAST ()
setPersonalityFn :: Ptr Function -> Maybe Constant -> EncodeAST ()
setPersonalityFn f :: Ptr Function
f personality :: Maybe Constant
personality = (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 Function -> Ptr Constant -> IO ()
FFI.setPersonalityFn Ptr Function
f (Ptr Constant -> EncodeAST ())
-> EncodeAST (Ptr Constant) -> EncodeAST ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Constant -> EncodeAST (Ptr Constant)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM Maybe Constant
personality)