{-# LANGUAGE
  MultiParamTypeClasses,
  ConstraintKinds,
  QuasiQuotes,
  ScopedTypeVariables,
  UndecidableInstances,
  RankNTypes
  #-}
module LLVM.Internal.Attribute where

import LLVM.Prelude

import Control.Monad.AnyCont
import Control.Monad.IO.Class
import Control.Monad.State (gets)

import Control.Exception
import Foreign.C (CUInt)
import Foreign.Ptr
import Data.Maybe

import qualified LLVM.Internal.FFI.Attribute as FFI
import qualified LLVM.Internal.FFI.LLVMCTypes as FFI
import LLVM.Internal.FFI.LLVMCTypes (parameterAttributeKindP, functionAttributeKindP)  

import qualified LLVM.AST.ParameterAttribute as A.PA  
import qualified LLVM.AST.FunctionAttribute as A.FA  

import LLVM.Internal.Coding
import LLVM.Internal.Context  
import LLVM.Internal.EncodeAST
import LLVM.Internal.DecodeAST

inconsistentCases :: Show a => String -> a -> b
inconsistentCases :: String -> a -> b
inconsistentCases name :: String
name attr :: a
attr =
  String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ "llvm-hs internal error: cases inconstistent in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ " encoding for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
attr

instance Monad m => EncodeM m A.PA.ParameterAttribute (Ptr FFI.ParameterAttrBuilder -> EncodeAST ()) where
  encodeM :: ParameterAttribute -> m (Ptr ParameterAttrBuilder -> EncodeAST ())
encodeM (A.PA.StringAttribute kind :: ShortByteString
kind value :: ShortByteString
value) = (Ptr ParameterAttrBuilder -> EncodeAST ())
-> m (Ptr ParameterAttrBuilder -> EncodeAST ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr ParameterAttrBuilder -> EncodeAST ())
 -> m (Ptr ParameterAttrBuilder -> EncodeAST ()))
-> (Ptr ParameterAttrBuilder -> EncodeAST ())
-> m (Ptr ParameterAttrBuilder -> EncodeAST ())
forall a b. (a -> b) -> a -> b
$ \b :: Ptr ParameterAttrBuilder
b -> do
    (kindP :: Ptr CChar
kindP, kindLen :: CSize
kindLen) <- ShortByteString -> EncodeAST (Ptr CChar, CSize)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
kind
    (valueP :: Ptr CChar
valueP, valueLen :: CSize
valueLen) <- ShortByteString -> EncodeAST (Ptr CChar, CSize)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
value
    IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr ParameterAttrBuilder
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()
forall a.
Ptr (AttrBuilder a)
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()
FFI.attrBuilderAddStringAttribute Ptr ParameterAttrBuilder
b Ptr CChar
kindP CSize
kindLen Ptr CChar
valueP CSize
valueLen
  encodeM a :: ParameterAttribute
a = (Ptr ParameterAttrBuilder -> EncodeAST ())
-> m (Ptr ParameterAttrBuilder -> EncodeAST ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr ParameterAttrBuilder -> EncodeAST ())
 -> m (Ptr ParameterAttrBuilder -> EncodeAST ()))
-> (Ptr ParameterAttrBuilder -> EncodeAST ())
-> m (Ptr ParameterAttrBuilder -> EncodeAST ())
forall a b. (a -> b) -> a -> b
$ \b :: Ptr ParameterAttrBuilder
b -> IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ case ParameterAttribute
a of
    A.PA.Alignment v :: Word64
v -> Ptr ParameterAttrBuilder -> Word64 -> IO ()
FFI.attrBuilderAddAlignment Ptr ParameterAttrBuilder
b Word64
v
    A.PA.Dereferenceable v :: Word64
v -> Ptr ParameterAttrBuilder -> Word64 -> IO ()
FFI.attrBuilderAddDereferenceable Ptr ParameterAttrBuilder
b Word64
v
    A.PA.DereferenceableOrNull v :: Word64
v -> Ptr ParameterAttrBuilder -> Word64 -> IO ()
FFI.attrBuilderAddDereferenceableOrNull Ptr ParameterAttrBuilder
b Word64
v
    _ -> Ptr ParameterAttrBuilder -> ParameterAttributeKind -> IO ()
FFI.attrBuilderAddParameterAttributeKind Ptr ParameterAttrBuilder
b (ParameterAttributeKind -> IO ())
-> ParameterAttributeKind -> IO ()
forall a b. (a -> b) -> a -> b
$ case ParameterAttribute
a of
      A.PA.ZeroExt -> ParameterAttributeKind
FFI.parameterAttributeKindZExt
      A.PA.SignExt -> ParameterAttributeKind
FFI.parameterAttributeKindSExt
      A.PA.InReg -> ParameterAttributeKind
FFI.parameterAttributeKindInReg
      A.PA.SRet -> ParameterAttributeKind
FFI.parameterAttributeKindStructRet
      A.PA.NoAlias -> ParameterAttributeKind
FFI.parameterAttributeKindNoAlias
      A.PA.ByVal -> ParameterAttributeKind
FFI.parameterAttributeKindByVal
      A.PA.NoCapture -> ParameterAttributeKind
FFI.parameterAttributeKindNoCapture
      A.PA.Nest -> ParameterAttributeKind
FFI.parameterAttributeKindNest
      A.PA.ReadOnly -> ParameterAttributeKind
FFI.parameterAttributeKindReadOnly
      A.PA.ReadNone -> ParameterAttributeKind
FFI.parameterAttributeKindReadNone
      A.PA.ImmArg -> ParameterAttributeKind
FFI.parameterAttributeKindImmArg
      A.PA.InAlloca -> ParameterAttributeKind
FFI.parameterAttributeKindInAlloca
      A.PA.NonNull -> ParameterAttributeKind
FFI.parameterAttributeKindNonNull
      A.PA.Returned -> ParameterAttributeKind
FFI.parameterAttributeKindReturned
      A.PA.SwiftSelf -> ParameterAttributeKind
FFI.parameterAttributeKindSwiftSelf
      A.PA.SwiftError -> ParameterAttributeKind
FFI.parameterAttributeKindSwiftError
      A.PA.WriteOnly -> ParameterAttributeKind
FFI.parameterAttributeKindWriteOnly
      A.PA.Alignment _ -> String -> ParameterAttribute -> ParameterAttributeKind
forall a b. Show a => String -> a -> b
inconsistentCases "ParameterAttribute" ParameterAttribute
a
      A.PA.Dereferenceable _ -> String -> ParameterAttribute -> ParameterAttributeKind
forall a b. Show a => String -> a -> b
inconsistentCases "ParameterAttribute" ParameterAttribute
a
      A.PA.DereferenceableOrNull _ -> String -> ParameterAttribute -> ParameterAttributeKind
forall a b. Show a => String -> a -> b
inconsistentCases "ParameterAttribute" ParameterAttribute
a
      A.PA.StringAttribute _ _ -> String -> ParameterAttribute -> ParameterAttributeKind
forall a b. Show a => String -> a -> b
inconsistentCases "ParameterAttribute" ParameterAttribute
a

instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilder -> EncodeAST ()) where
  encodeM :: FunctionAttribute -> m (Ptr FunctionAttrBuilder -> EncodeAST ())
encodeM (A.FA.StringAttribute kind :: ShortByteString
kind value :: ShortByteString
value) = (Ptr FunctionAttrBuilder -> EncodeAST ())
-> m (Ptr FunctionAttrBuilder -> EncodeAST ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr FunctionAttrBuilder -> EncodeAST ())
 -> m (Ptr FunctionAttrBuilder -> EncodeAST ()))
-> (Ptr FunctionAttrBuilder -> EncodeAST ())
-> m (Ptr FunctionAttrBuilder -> EncodeAST ())
forall a b. (a -> b) -> a -> b
$ \b :: Ptr FunctionAttrBuilder
b -> do
    (kindP :: Ptr CChar
kindP, kindLen :: CSize
kindLen) <- ShortByteString -> EncodeAST (Ptr CChar, CSize)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
kind
    (valueP :: Ptr CChar
valueP, valueLen :: CSize
valueLen) <- ShortByteString -> EncodeAST (Ptr CChar, CSize)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
value
    IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr FunctionAttrBuilder
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()
forall a.
Ptr (AttrBuilder a)
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()
FFI.attrBuilderAddStringAttribute Ptr FunctionAttrBuilder
b Ptr CChar
kindP CSize
kindLen Ptr CChar
valueP CSize
valueLen
  encodeM a :: FunctionAttribute
a = (Ptr FunctionAttrBuilder -> EncodeAST ())
-> m (Ptr FunctionAttrBuilder -> EncodeAST ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr FunctionAttrBuilder -> EncodeAST ())
 -> m (Ptr FunctionAttrBuilder -> EncodeAST ()))
-> (Ptr FunctionAttrBuilder -> EncodeAST ())
-> m (Ptr FunctionAttrBuilder -> EncodeAST ())
forall a b. (a -> b) -> a -> b
$ \b :: Ptr FunctionAttrBuilder
b -> case FunctionAttribute
a of
    A.FA.StackAlignment v :: Word64
v -> IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr FunctionAttrBuilder -> Word64 -> IO ()
FFI.attrBuilderAddStackAlignment Ptr FunctionAttrBuilder
b Word64
v
    A.FA.AllocSize x :: Word32
x y :: Maybe Word32
y -> do
      CUInt
x' <- Word32 -> EncodeAST CUInt
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM Word32
x
      (CUInt, LLVMBool)
y' <- Maybe Word32 -> EncodeAST (CUInt, LLVMBool)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM Maybe Word32
y
      IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr FunctionAttrBuilder -> CUInt -> (CUInt, LLVMBool) -> IO ()
FFI.attrBuilderAddAllocSize Ptr FunctionAttrBuilder
b CUInt
x' (CUInt, LLVMBool)
y'
    _ -> IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr FunctionAttrBuilder -> FunctionAttributeKind -> IO ()
FFI.attrBuilderAddFunctionAttributeKind Ptr FunctionAttrBuilder
b (FunctionAttributeKind -> IO ()) -> FunctionAttributeKind -> IO ()
forall a b. (a -> b) -> a -> b
$ case FunctionAttribute
a of
      A.FA.Convergent -> FunctionAttributeKind
FFI.functionAttributeKindConvergent
      A.FA.InaccessibleMemOnly -> FunctionAttributeKind
FFI.functionAttributeKindInaccessibleMemOnly
      A.FA.InaccessibleMemOrArgMemOnly -> FunctionAttributeKind
FFI.functionAttributeKindInaccessibleMemOrArgMemOnly
      A.FA.NoReturn -> FunctionAttributeKind
FFI.functionAttributeKindNoReturn
      A.FA.NoUnwind -> FunctionAttributeKind
FFI.functionAttributeKindNoUnwind
      A.FA.ReadNone -> FunctionAttributeKind
FFI.functionAttributeKindReadNone
      A.FA.ReadOnly -> FunctionAttributeKind
FFI.functionAttributeKindReadOnly
      A.FA.NoInline -> FunctionAttributeKind
FFI.functionAttributeKindNoInline
      A.FA.NoRecurse -> FunctionAttributeKind
FFI.functionAttributeKindNoRecurse
      A.FA.AlwaysInline -> FunctionAttributeKind
FFI.functionAttributeKindAlwaysInline
      A.FA.MinimizeSize -> FunctionAttributeKind
FFI.functionAttributeKindMinSize
      A.FA.OptimizeForSize -> FunctionAttributeKind
FFI.functionAttributeKindOptimizeForSize
      A.FA.OptimizeNone -> FunctionAttributeKind
FFI.functionAttributeKindOptimizeNone
      A.FA.WriteOnly -> FunctionAttributeKind
FFI.functionAttributeKindWriteOnly
      A.FA.ArgMemOnly -> FunctionAttributeKind
FFI.functionAttributeKindArgMemOnly
      A.FA.StackProtect -> FunctionAttributeKind
FFI.functionAttributeKindStackProtect
      A.FA.StackProtectReq -> FunctionAttributeKind
FFI.functionAttributeKindStackProtectReq
      A.FA.StackProtectStrong -> FunctionAttributeKind
FFI.functionAttributeKindStackProtectStrong
      A.FA.StrictFP -> FunctionAttributeKind
FFI.functionAttributeKindStrictFP
      A.FA.NoRedZone -> FunctionAttributeKind
FFI.functionAttributeKindNoRedZone
      A.FA.NoImplicitFloat -> FunctionAttributeKind
FFI.functionAttributeKindNoImplicitFloat
      A.FA.Naked -> FunctionAttributeKind
FFI.functionAttributeKindNaked
      A.FA.InlineHint -> FunctionAttributeKind
FFI.functionAttributeKindInlineHint
      A.FA.ReturnsTwice -> FunctionAttributeKind
FFI.functionAttributeKindReturnsTwice
      A.FA.UWTable -> FunctionAttributeKind
FFI.functionAttributeKindUWTable
      A.FA.NonLazyBind -> FunctionAttributeKind
FFI.functionAttributeKindNonLazyBind
      A.FA.Builtin -> FunctionAttributeKind
FFI.functionAttributeKindBuiltin
      A.FA.NoBuiltin -> FunctionAttributeKind
FFI.functionAttributeKindNoBuiltin
      A.FA.Cold -> FunctionAttributeKind
FFI.functionAttributeKindCold
      A.FA.JumpTable -> FunctionAttributeKind
FFI.functionAttributeKindJumpTable
      A.FA.NoDuplicate -> FunctionAttributeKind
FFI.functionAttributeKindNoDuplicate
      A.FA.SanitizeAddress -> FunctionAttributeKind
FFI.functionAttributeKindSanitizeAddress
      A.FA.SanitizeHWAddress -> FunctionAttributeKind
FFI.functionAttributeKindSanitizeHWAddress
      A.FA.SanitizeThread -> FunctionAttributeKind
FFI.functionAttributeKindSanitizeThread
      A.FA.SanitizeMemory -> FunctionAttributeKind
FFI.functionAttributeKindSanitizeMemory
      A.FA.SafeStack -> FunctionAttributeKind
FFI.functionAttributeKindSafeStack
      A.FA.Speculatable -> FunctionAttributeKind
FFI.functionAttributeKindSpeculatable
      A.FA.StackAlignment _ -> String -> FunctionAttribute -> FunctionAttributeKind
forall a b. Show a => String -> a -> b
inconsistentCases "FunctionAttribute" FunctionAttribute
a
      A.FA.AllocSize _ _ -> String -> FunctionAttribute -> FunctionAttributeKind
forall a b. Show a => String -> a -> b
inconsistentCases "FunctionAttribute" FunctionAttribute
a
      A.FA.StringAttribute _ _ -> String -> FunctionAttribute -> FunctionAttributeKind
forall a b. Show a => String -> a -> b
inconsistentCases "FunctionAttribute" FunctionAttribute
a

instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where
  decodeM :: ParameterAttribute -> DecodeAST ParameterAttribute
decodeM a :: ParameterAttribute
a = do
    Bool
isString <- 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 (ParameterAttribute -> IO LLVMBool
forall a. Attribute a -> IO LLVMBool
FFI.isStringAttribute ParameterAttribute
a)
    if Bool
isString
      then
        ShortByteString -> ShortByteString -> ParameterAttribute
A.PA.StringAttribute
          (ShortByteString -> ShortByteString -> ParameterAttribute)
-> DecodeAST ShortByteString
-> DecodeAST (ShortByteString -> ParameterAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CSize -> IO (Ptr CChar)) -> DecodeAST ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (ParameterAttribute -> Ptr CSize -> IO (Ptr CChar)
forall a. Attribute a -> Ptr CSize -> IO (Ptr CChar)
FFI.attributeKindAsString ParameterAttribute
a)
          DecodeAST (ShortByteString -> ParameterAttribute)
-> DecodeAST ShortByteString -> DecodeAST ParameterAttribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr CSize -> IO (Ptr CChar)) -> DecodeAST ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (ParameterAttribute -> Ptr CSize -> IO (Ptr CChar)
forall a. Attribute a -> Ptr CSize -> IO (Ptr CChar)
FFI.attributeValueAsString ParameterAttribute
a)
      else do
        ParameterAttributeKind
enum <- IO ParameterAttributeKind -> DecodeAST ParameterAttributeKind
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ParameterAttributeKind -> DecodeAST ParameterAttributeKind)
-> IO ParameterAttributeKind -> DecodeAST ParameterAttributeKind
forall a b. (a -> b) -> a -> b
$ ParameterAttribute -> IO ParameterAttributeKind
FFI.parameterAttributeKindAsEnum ParameterAttribute
a
        case ParameterAttributeKind
enum of
          [parameterAttributeKindP|ZExt|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.ZeroExt
          [parameterAttributeKindP|SExt|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.SignExt
          [parameterAttributeKindP|InReg|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.InReg
          [parameterAttributeKindP|StructRet|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.SRet
          [parameterAttributeKindP|Alignment|] -> (Word64 -> ParameterAttribute)
-> DecodeAST (Word64 -> ParameterAttribute)
forall (m :: * -> *) a. Monad m => a -> m a
return Word64 -> ParameterAttribute
A.PA.Alignment DecodeAST (Word64 -> ParameterAttribute)
-> DecodeAST Word64 -> DecodeAST ParameterAttribute
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (IO Word64 -> DecodeAST Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> DecodeAST Word64) -> IO Word64 -> DecodeAST Word64
forall a b. (a -> b) -> a -> b
$ ParameterAttribute -> IO Word64
forall a. Attribute a -> IO Word64
FFI.attributeValueAsInt ParameterAttribute
a)
          [parameterAttributeKindP|NoAlias|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.NoAlias
          [parameterAttributeKindP|ByVal|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.ByVal
          [parameterAttributeKindP|NoCapture|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.NoCapture
          [parameterAttributeKindP|Nest|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.Nest
          [parameterAttributeKindP|ReadOnly|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.ReadOnly
          [parameterAttributeKindP|ReadNone|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.ReadNone
          [parameterAttributeKindP|WriteOnly|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.WriteOnly
          [parameterAttributeKindP|InAlloca|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.InAlloca
          [parameterAttributeKindP|NonNull|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.NonNull
          [parameterAttributeKindP|Dereferenceable|] -> (Word64 -> ParameterAttribute)
-> DecodeAST (Word64 -> ParameterAttribute)
forall (m :: * -> *) a. Monad m => a -> m a
return Word64 -> ParameterAttribute
A.PA.Dereferenceable DecodeAST (Word64 -> ParameterAttribute)
-> DecodeAST Word64 -> DecodeAST ParameterAttribute
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (IO Word64 -> DecodeAST Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> DecodeAST Word64) -> IO Word64 -> DecodeAST Word64
forall a b. (a -> b) -> a -> b
$ ParameterAttribute -> IO Word64
forall a. Attribute a -> IO Word64
FFI.attributeValueAsInt ParameterAttribute
a)
          [parameterAttributeKindP|DereferenceableOrNull|] -> (Word64 -> ParameterAttribute)
-> DecodeAST (Word64 -> ParameterAttribute)
forall (m :: * -> *) a. Monad m => a -> m a
return Word64 -> ParameterAttribute
A.PA.DereferenceableOrNull DecodeAST (Word64 -> ParameterAttribute)
-> DecodeAST Word64 -> DecodeAST ParameterAttribute
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (IO Word64 -> DecodeAST Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> DecodeAST Word64) -> IO Word64 -> DecodeAST Word64
forall a b. (a -> b) -> a -> b
$ ParameterAttribute -> IO Word64
forall a. Attribute a -> IO Word64
FFI.attributeValueAsInt ParameterAttribute
a)
          [parameterAttributeKindP|Returned|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.Returned
          [parameterAttributeKindP|SwiftSelf|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.SwiftSelf
          [parameterAttributeKindP|SwiftError|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.SwiftError
          [parameterAttributeKindP|ImmArg|] -> ParameterAttribute -> DecodeAST ParameterAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterAttribute
A.PA.ImmArg
          _ -> String -> DecodeAST ParameterAttribute
forall a. HasCallStack => String -> a
error (String -> DecodeAST ParameterAttribute)
-> String -> DecodeAST ParameterAttribute
forall a b. (a -> b) -> a -> b
$ "unhandled parameter attribute enum value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParameterAttributeKind -> String
forall a. Show a => a -> String
show ParameterAttributeKind
enum

instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where
  decodeM :: FunctionAttribute -> DecodeAST FunctionAttribute
decodeM a :: FunctionAttribute
a = do
    Bool
isString <- 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
$ FunctionAttribute -> IO LLVMBool
forall a. Attribute a -> IO LLVMBool
FFI.isStringAttribute FunctionAttribute
a)
    if Bool
isString
       then
         (ShortByteString -> ShortByteString -> FunctionAttribute)
-> DecodeAST
     (ShortByteString -> ShortByteString -> FunctionAttribute)
forall (m :: * -> *) a. Monad m => a -> m a
return ShortByteString -> ShortByteString -> FunctionAttribute
A.FA.StringAttribute
                  DecodeAST (ShortByteString -> ShortByteString -> FunctionAttribute)
-> DecodeAST ShortByteString
-> DecodeAST (ShortByteString -> FunctionAttribute)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((Ptr CSize -> IO (Ptr CChar)) -> DecodeAST ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM ((Ptr CSize -> IO (Ptr CChar)) -> DecodeAST ShortByteString)
-> (Ptr CSize -> IO (Ptr CChar)) -> DecodeAST ShortByteString
forall a b. (a -> b) -> a -> b
$ FunctionAttribute -> Ptr CSize -> IO (Ptr CChar)
forall a. Attribute a -> Ptr CSize -> IO (Ptr CChar)
FFI.attributeKindAsString FunctionAttribute
a)
                  DecodeAST (ShortByteString -> FunctionAttribute)
-> DecodeAST ShortByteString -> DecodeAST FunctionAttribute
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((Ptr CSize -> IO (Ptr CChar)) -> DecodeAST ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM ((Ptr CSize -> IO (Ptr CChar)) -> DecodeAST ShortByteString)
-> (Ptr CSize -> IO (Ptr CChar)) -> DecodeAST ShortByteString
forall a b. (a -> b) -> a -> b
$ FunctionAttribute -> Ptr CSize -> IO (Ptr CChar)
forall a. Attribute a -> Ptr CSize -> IO (Ptr CChar)
FFI.attributeValueAsString FunctionAttribute
a)                   
       else do
         FunctionAttributeKind
enum <- IO FunctionAttributeKind -> DecodeAST FunctionAttributeKind
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FunctionAttributeKind -> DecodeAST FunctionAttributeKind)
-> IO FunctionAttributeKind -> DecodeAST FunctionAttributeKind
forall a b. (a -> b) -> a -> b
$ FunctionAttribute -> IO FunctionAttributeKind
FFI.functionAttributeKindAsEnum FunctionAttribute
a
         case FunctionAttributeKind
enum of
           [functionAttributeKindP|AllocSize|] -> do
             Ptr CUInt
x <- DecodeAST (Ptr CUInt)
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
             Maybe Word32
y <- (Ptr CUInt -> IO LLVMBool) -> DecodeAST (Maybe Word32)
forall (m :: * -> *) b a.
(DecodeM m b a, Storable a, MonadAnyCont IO m, MonadIO m) =>
(Ptr a -> IO LLVMBool) -> m (Maybe b)
decodeOptional (FunctionAttribute -> Ptr CUInt -> Ptr CUInt -> IO LLVMBool
FFI.attributeGetAllocSizeArgs FunctionAttribute
a Ptr CUInt
x)
             Word32
x' <- CUInt -> DecodeAST Word32
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (CUInt -> DecodeAST Word32) -> DecodeAST CUInt -> DecodeAST Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CUInt -> DecodeAST CUInt
forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a
peek Ptr CUInt
x
             FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Maybe Word32 -> FunctionAttribute
A.FA.AllocSize Word32
x' Maybe Word32
y)
           [functionAttributeKindP|NoReturn|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NoReturn
           [functionAttributeKindP|NoUnwind|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NoUnwind
           [functionAttributeKindP|ReadNone|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.ReadNone
           [functionAttributeKindP|ReadOnly|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.ReadOnly
           [functionAttributeKindP|NoInline|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NoInline
           [functionAttributeKindP|NoRecurse|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NoRecurse
           [functionAttributeKindP|AlwaysInline|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.AlwaysInline
           [functionAttributeKindP|MinSize|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.MinimizeSize
           [functionAttributeKindP|OptimizeForSize|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.OptimizeForSize
           [functionAttributeKindP|OptimizeNone|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.OptimizeNone
           [functionAttributeKindP|StackProtect|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.StackProtect
           [functionAttributeKindP|StackProtectReq|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.StackProtectReq
           [functionAttributeKindP|StackProtectStrong|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.StackProtectStrong
           [functionAttributeKindP|StrictFP|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.StrictFP
           [functionAttributeKindP|NoRedZone|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NoRedZone
           [functionAttributeKindP|NoImplicitFloat|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NoImplicitFloat
           [functionAttributeKindP|Naked|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.Naked
           [functionAttributeKindP|InlineHint|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.InlineHint
           [functionAttributeKindP|StackAlignment|] -> (Word64 -> FunctionAttribute)
-> DecodeAST (Word64 -> FunctionAttribute)
forall (m :: * -> *) a. Monad m => a -> m a
return Word64 -> FunctionAttribute
A.FA.StackAlignment DecodeAST (Word64 -> FunctionAttribute)
-> DecodeAST Word64 -> DecodeAST FunctionAttribute
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (IO Word64 -> DecodeAST Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> DecodeAST Word64) -> IO Word64 -> DecodeAST Word64
forall a b. (a -> b) -> a -> b
$ FunctionAttribute -> IO Word64
forall a. Attribute a -> IO Word64
FFI.attributeValueAsInt FunctionAttribute
a)
           [functionAttributeKindP|ReturnsTwice|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.ReturnsTwice
           [functionAttributeKindP|UWTable|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.UWTable
           [functionAttributeKindP|NonLazyBind|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NonLazyBind
           [functionAttributeKindP|Builtin|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.Builtin
           [functionAttributeKindP|NoBuiltin|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NoBuiltin
           [functionAttributeKindP|Cold|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.Cold
           [functionAttributeKindP|JumpTable|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.JumpTable
           [functionAttributeKindP|NoDuplicate|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.NoDuplicate
           [functionAttributeKindP|SanitizeAddress|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.SanitizeAddress
           [functionAttributeKindP|SanitizeHWAddress|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.SanitizeHWAddress
           [functionAttributeKindP|SanitizeThread|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.SanitizeThread
           [functionAttributeKindP|SanitizeMemory|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.SanitizeMemory
           [functionAttributeKindP|ArgMemOnly|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.ArgMemOnly
           [functionAttributeKindP|Convergent|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.Convergent
           [functionAttributeKindP|InaccessibleMemOnly|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.InaccessibleMemOnly
           [functionAttributeKindP|InaccessibleMemOrArgMemOnly|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.InaccessibleMemOrArgMemOnly
           [functionAttributeKindP|SafeStack|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.SafeStack
           [functionAttributeKindP|WriteOnly|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.WriteOnly
           [functionAttributeKindP|Speculatable|] -> FunctionAttribute -> DecodeAST FunctionAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionAttribute
A.FA.Speculatable
           _ -> String -> DecodeAST FunctionAttribute
forall a. HasCallStack => String -> a
error (String -> DecodeAST FunctionAttribute)
-> String -> DecodeAST FunctionAttribute
forall a b. (a -> b) -> a -> b
$ "unhandled function attribute enum value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionAttributeKind -> String
forall a. Show a => a -> String
show FunctionAttributeKind
enum

allocaAttrBuilder :: (Monad m, MonadAnyCont IO m) => m (Ptr (FFI.AttrBuilder a))
allocaAttrBuilder :: m (Ptr (AttrBuilder a))
allocaAttrBuilder = do
  Ptr Word8
p <- CSize -> m (Ptr Word8)
forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray CSize
FFI.getAttrBuilderSize
  (forall r. (Ptr (AttrBuilder a) -> IO r) -> IO r)
-> m (Ptr (AttrBuilder a))
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (Ptr (AttrBuilder a) -> IO r) -> IO r)
 -> m (Ptr (AttrBuilder a)))
-> (forall r. (Ptr (AttrBuilder a) -> IO r) -> IO r)
-> m (Ptr (AttrBuilder a))
forall a b. (a -> b) -> a -> b
$ \f :: Ptr (AttrBuilder a) -> IO r
f -> do
    Ptr (AttrBuilder a)
ab <- Ptr Word8 -> IO (Ptr (AttrBuilder a))
forall a. Ptr Word8 -> IO (Ptr (AttrBuilder a))
FFI.constructAttrBuilder Ptr Word8
p
    r
r <- Ptr (AttrBuilder a) -> IO r
f Ptr (AttrBuilder a)
ab
    Ptr (AttrBuilder a) -> IO ()
forall a. Ptr (AttrBuilder a) -> IO ()
FFI.destroyAttrBuilder Ptr (AttrBuilder a)
ab
    r -> IO r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r

instance forall a b. EncodeM EncodeAST a (Ptr (FFI.AttrBuilder b) -> EncodeAST ()) =>
         EncodeM EncodeAST [a] (FFI.AttributeSet b) where
  encodeM :: [a] -> EncodeAST (AttributeSet b)
encodeM as :: [a]
as = do
    Ptr (AttrBuilder b)
ab <- EncodeAST (Ptr (AttrBuilder b))
forall (m :: * -> *) a.
(Monad m, MonadAnyCont IO m) =>
m (Ptr (AttrBuilder a))
allocaAttrBuilder
    [Ptr (AttrBuilder b) -> EncodeAST ()]
builds <- (a -> EncodeAST (Ptr (AttrBuilder b) -> EncodeAST ()))
-> [a] -> EncodeAST [Ptr (AttrBuilder b) -> EncodeAST ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> EncodeAST (Ptr (AttrBuilder b) -> EncodeAST ())
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM [a]
as
    EncodeAST [()] -> EncodeAST ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Ptr (AttrBuilder b) -> EncodeAST ()]
-> ((Ptr (AttrBuilder b) -> EncodeAST ()) -> EncodeAST ())
-> EncodeAST [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ptr (AttrBuilder b) -> EncodeAST ()]
builds ((Ptr (AttrBuilder b) -> EncodeAST ())
-> Ptr (AttrBuilder b) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr (AttrBuilder b)
ab) :: EncodeAST [()])
    Context context :: Ptr Context
context <- (EncodeState -> Context) -> EncodeAST Context
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EncodeState -> Context
encodeStateContext
    (forall r. (AttributeSet b -> IO r) -> IO r)
-> EncodeAST (AttributeSet b)
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM
      (IO (AttributeSet b)
-> (AttributeSet b -> IO ()) -> (AttributeSet b -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Ptr Context -> Ptr (AttrBuilder b) -> IO (AttributeSet b)
forall a. Ptr Context -> Ptr (AttrBuilder a) -> IO (AttributeSet a)
FFI.getAttributeSet Ptr Context
context Ptr (AttrBuilder b)
ab) AttributeSet b -> IO ()
forall a. AttributeSet a -> IO ()
FFI.disposeAttributeSet)

instance forall a b. DecodeM DecodeAST a (FFI.Attribute b) => DecodeM DecodeAST [a] (FFI.AttributeSet b) where
  decodeM :: AttributeSet b -> DecodeAST [a]
decodeM as :: AttributeSet b
as = do
    CUInt
numAttributes <- IO CUInt -> DecodeAST CUInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (AttributeSet b -> IO CUInt
forall a. AttributeSet a -> IO CUInt
FFI.getNumAttributes AttributeSet b
as)
    Ptr (Attribute b)
attrs <- CUInt -> DecodeAST (Ptr (Attribute b))
forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray CUInt
numAttributes
    IO () -> DecodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (AttributeSet b -> Ptr (Attribute b) -> IO ()
forall a. AttributeSet a -> Ptr (Attribute a) -> IO ()
FFI.getAttributes AttributeSet b
as Ptr (Attribute b)
attrs)
    (CUInt, Ptr (Attribute b)) -> DecodeAST [a]
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (CUInt
numAttributes, Ptr (Attribute b)
attrs :: Ptr (FFI.Attribute b))
            
data AttributeList = AttributeList {
    AttributeList -> [Either GroupID FunctionAttribute]
functionAttributes :: [Either A.FA.GroupID A.FA.FunctionAttribute],
    AttributeList -> [ParameterAttribute]
returnAttributes :: [A.PA.ParameterAttribute],
    AttributeList -> [[ParameterAttribute]]
parameterAttributes :: [[A.PA.ParameterAttribute]]
  }
  deriving (AttributeList -> AttributeList -> Bool
(AttributeList -> AttributeList -> Bool)
-> (AttributeList -> AttributeList -> Bool) -> Eq AttributeList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeList -> AttributeList -> Bool
$c/= :: AttributeList -> AttributeList -> Bool
== :: AttributeList -> AttributeList -> Bool
$c== :: AttributeList -> AttributeList -> Bool
Eq, Int -> AttributeList -> String -> String
[AttributeList] -> String -> String
AttributeList -> String
(Int -> AttributeList -> String -> String)
-> (AttributeList -> String)
-> ([AttributeList] -> String -> String)
-> Show AttributeList
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AttributeList] -> String -> String
$cshowList :: [AttributeList] -> String -> String
show :: AttributeList -> String
$cshow :: AttributeList -> String
showsPrec :: Int -> AttributeList -> String -> String
$cshowsPrec :: Int -> AttributeList -> String -> String
Show)

data PreSlot
  = IndirectFunctionAttributes A.FA.GroupID
  | DirectFunctionAttributes [A.FA.FunctionAttribute]
  | ReturnAttributes [A.PA.ParameterAttribute]
  | ParameterAttributes CUInt [A.PA.ParameterAttribute]    

instance {-# OVERLAPPING #-} EncodeM EncodeAST [Either A.FA.GroupID A.FA.FunctionAttribute] FFI.FunctionAttributeSet where
  encodeM :: [Either GroupID FunctionAttribute]
-> EncodeAST FunctionAttributeSet
encodeM attrs :: [Either GroupID FunctionAttribute]
attrs = do
    Ptr FunctionAttrBuilder
ab <- EncodeAST (Ptr FunctionAttrBuilder)
forall (m :: * -> *) a.
(Monad m, MonadAnyCont IO m) =>
m (Ptr (AttrBuilder a))
allocaAttrBuilder
    [Either GroupID FunctionAttribute]
-> (Either GroupID FunctionAttribute -> EncodeAST ())
-> EncodeAST ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Either GroupID FunctionAttribute]
attrs ((Either GroupID FunctionAttribute -> EncodeAST ())
 -> EncodeAST ())
-> (Either GroupID FunctionAttribute -> EncodeAST ())
-> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \attr :: Either GroupID FunctionAttribute
attr ->
      case Either GroupID FunctionAttribute
attr of
        Left groupId :: GroupID
groupId -> do
          FunctionAttributeSet
attrSet <- GroupID -> EncodeAST FunctionAttributeSet
referAttributeGroup GroupID
groupId
          Ptr FunctionAttrBuilder
ab' <- (forall r. (Ptr FunctionAttrBuilder -> IO r) -> IO r)
-> EncodeAST (Ptr FunctionAttrBuilder)
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (IO (Ptr FunctionAttrBuilder)
-> (Ptr FunctionAttrBuilder -> IO ())
-> (Ptr FunctionAttrBuilder -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FunctionAttributeSet -> IO (Ptr FunctionAttrBuilder)
forall a. AttributeSet a -> IO (Ptr (AttrBuilder a))
FFI.attrBuilderFromSet FunctionAttributeSet
attrSet) Ptr FunctionAttrBuilder -> IO ()
forall a. Ptr (AttrBuilder a) -> IO ()
FFI.disposeAttrBuilder)
          IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr FunctionAttrBuilder -> Ptr FunctionAttrBuilder -> IO ()
forall a. Ptr (AttrBuilder a) -> Ptr (AttrBuilder a) -> IO ()
FFI.mergeAttrBuilder Ptr FunctionAttrBuilder
ab Ptr FunctionAttrBuilder
ab')
        Right attr :: FunctionAttribute
attr -> do
          Ptr FunctionAttrBuilder -> EncodeAST ()
addAttr <- FunctionAttribute
-> EncodeAST (Ptr FunctionAttrBuilder -> EncodeAST ())
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM FunctionAttribute
attr
          Ptr FunctionAttrBuilder -> EncodeAST ()
addAttr Ptr FunctionAttrBuilder
ab :: EncodeAST ()
    Context context :: Ptr Context
context <- (EncodeState -> Context) -> EncodeAST Context
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EncodeState -> Context
encodeStateContext
    (forall r. (FunctionAttributeSet -> IO r) -> IO r)
-> EncodeAST FunctionAttributeSet
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM
      (IO FunctionAttributeSet
-> (FunctionAttributeSet -> IO ())
-> (FunctionAttributeSet -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Ptr Context -> Ptr FunctionAttrBuilder -> IO FunctionAttributeSet
forall a. Ptr Context -> Ptr (AttrBuilder a) -> IO (AttributeSet a)
FFI.getAttributeSet Ptr Context
context Ptr FunctionAttrBuilder
ab) FunctionAttributeSet -> IO ()
forall a. AttributeSet a -> IO ()
FFI.disposeAttributeSet)

instance EncodeM EncodeAST AttributeList FFI.AttributeList where
  encodeM :: AttributeList -> EncodeAST AttributeList
encodeM (AttributeList fAttrs :: [Either GroupID FunctionAttribute]
fAttrs rAttrs :: [ParameterAttribute]
rAttrs pAttrs :: [[ParameterAttribute]]
pAttrs) = do
    FunctionAttributeSet
fAttrSet <- [Either GroupID FunctionAttribute]
-> EncodeAST FunctionAttributeSet
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM [Either GroupID FunctionAttribute]
fAttrs
    ParameterAttributeSet
rAttrSet <- [ParameterAttribute] -> EncodeAST ParameterAttributeSet
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM [ParameterAttribute]
rAttrs :: EncodeAST FFI.ParameterAttributeSet
    (numPAttrs :: CUInt
numPAttrs, pAttrSets :: Ptr ParameterAttributeSet
pAttrSets) <- [[ParameterAttribute]]
-> EncodeAST (CUInt, Ptr ParameterAttributeSet)
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM [[ParameterAttribute]]
pAttrs
    Context context :: Ptr Context
context <- (EncodeState -> Context) -> EncodeAST Context
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EncodeState -> Context
encodeStateContext
    (forall r. (AttributeList -> IO r) -> IO r)
-> EncodeAST AttributeList
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM
      (IO AttributeList
-> (AttributeList -> IO ()) -> (AttributeList -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
         (Ptr Context
-> FunctionAttributeSet
-> ParameterAttributeSet
-> Ptr ParameterAttributeSet
-> CUInt
-> IO AttributeList
FFI.buildAttributeList Ptr Context
context FunctionAttributeSet
fAttrSet ParameterAttributeSet
rAttrSet Ptr ParameterAttributeSet
pAttrSets CUInt
numPAttrs)
         AttributeList -> IO ()
FFI.disposeAttributeList)

instance DecodeM DecodeAST AttributeList (FFI.AttrSetDecoder a, a) where
  decodeM :: (AttrSetDecoder a, a) -> DecodeAST AttributeList
decodeM (FFI.AttrSetDecoder attrsAtIndex :: forall b. a -> AttributeIndex -> IO (AttributeSet b)
attrsAtIndex countParams :: a -> IO CUInt
countParams, a :: a
a) = do
    Maybe (Either GroupID FunctionAttribute)
functionAttrSet <-
      do Maybe FunctionAttributeSet
mAttrSet <-
           -- function attributes are grouped and decoded later. Since
           -- we are sometimes decoding inside of scopeAnyConT, we
           -- cannot use withAttrsAtIndex to allocate the attribute
           -- set since it will be freed before we decode it.
           IO (Maybe FunctionAttributeSet)
-> DecodeAST (Maybe FunctionAttributeSet)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FunctionAttributeSet)
 -> DecodeAST (Maybe FunctionAttributeSet))
-> (IO (Maybe FunctionAttributeSet)
    -> IO (Maybe FunctionAttributeSet))
-> IO (Maybe FunctionAttributeSet)
-> DecodeAST (Maybe FunctionAttributeSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe FunctionAttributeSet) -> IO (Maybe FunctionAttributeSet)
forall a. IO a -> IO a
mask_ (IO (Maybe FunctionAttributeSet)
 -> DecodeAST (Maybe FunctionAttributeSet))
-> IO (Maybe FunctionAttributeSet)
-> DecodeAST (Maybe FunctionAttributeSet)
forall a b. (a -> b) -> a -> b
$ do
             FunctionAttributeSet
attrSet <-
               a -> AttributeIndex -> IO FunctionAttributeSet
forall b. a -> AttributeIndex -> IO (AttributeSet b)
attrsAtIndex a
a AttributeIndex
FFI.functionIndex :: IO FFI.FunctionAttributeSet
             Bool
hasAttributes <- 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
=<< FunctionAttributeSet -> IO LLVMBool
forall a. AttributeSet a -> IO LLVMBool
FFI.attributeSetHasAttributes FunctionAttributeSet
attrSet
             if Bool
hasAttributes
               then Maybe FunctionAttributeSet -> IO (Maybe FunctionAttributeSet)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunctionAttributeSet -> Maybe FunctionAttributeSet
forall a. a -> Maybe a
Just FunctionAttributeSet
attrSet)
               else FunctionAttributeSet -> IO ()
forall a. AttributeSet a -> IO ()
FFI.disposeAttributeSet FunctionAttributeSet
attrSet IO ()
-> IO (Maybe FunctionAttributeSet)
-> IO (Maybe FunctionAttributeSet)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe FunctionAttributeSet -> IO (Maybe FunctionAttributeSet)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FunctionAttributeSet
forall a. Maybe a
Nothing
         case Maybe FunctionAttributeSet
mAttrSet of
           Nothing -> Maybe (Either GroupID FunctionAttribute)
-> DecodeAST (Maybe (Either GroupID FunctionAttribute))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either GroupID FunctionAttribute)
forall a. Maybe a
Nothing
           Just attrSet :: FunctionAttributeSet
attrSet -> Either GroupID FunctionAttribute
-> Maybe (Either GroupID FunctionAttribute)
forall a. a -> Maybe a
Just (Either GroupID FunctionAttribute
 -> Maybe (Either GroupID FunctionAttribute))
-> (GroupID -> Either GroupID FunctionAttribute)
-> GroupID
-> Maybe (Either GroupID FunctionAttribute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupID -> Either GroupID FunctionAttribute
forall a b. a -> Either a b
Left (GroupID -> Maybe (Either GroupID FunctionAttribute))
-> DecodeAST GroupID
-> DecodeAST (Maybe (Either GroupID FunctionAttribute))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FunctionAttributeSet -> DecodeAST GroupID
getAttributeGroupID FunctionAttributeSet
attrSet
    [ParameterAttribute]
returnAttrs <-
      do ParameterAttributeSet
attrSet <-
           AttributeIndex -> DecodeAST ParameterAttributeSet
forall b. AttributeIndex -> DecodeAST (AttributeSet b)
withAttrsAtIndex AttributeIndex
FFI.returnIndex :: DecodeAST FFI.ParameterAttributeSet
         ParameterAttributeSet -> DecodeAST [ParameterAttribute]
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM ParameterAttributeSet
attrSet
    CUInt
numParams <- IO CUInt -> DecodeAST CUInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO CUInt
countParams a
a)
    [[ParameterAttribute]]
paramAttrs <-
      [CUInt]
-> (CUInt -> DecodeAST [ParameterAttribute])
-> DecodeAST [[ParameterAttribute]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [1 .. CUInt
numParams] ((CUInt -> DecodeAST [ParameterAttribute])
 -> DecodeAST [[ParameterAttribute]])
-> (CUInt -> DecodeAST [ParameterAttribute])
-> DecodeAST [[ParameterAttribute]]
forall a b. (a -> b) -> a -> b
$ \i :: CUInt
i ->
        ParameterAttributeSet -> DecodeAST [ParameterAttribute]
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (ParameterAttributeSet -> DecodeAST [ParameterAttribute])
-> DecodeAST ParameterAttributeSet
-> DecodeAST [ParameterAttribute]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        (AttributeIndex -> DecodeAST ParameterAttributeSet
forall b. AttributeIndex -> DecodeAST (AttributeSet b)
withAttrsAtIndex (CUInt -> AttributeIndex
FFI.AttributeIndex CUInt
i) :: DecodeAST FFI.ParameterAttributeSet)
    AttributeList -> DecodeAST AttributeList
forall (m :: * -> *) a. Monad m => a -> m a
return
      (AttributeList :: [Either GroupID FunctionAttribute]
-> [ParameterAttribute] -> [[ParameterAttribute]] -> AttributeList
AttributeList
       { functionAttributes :: [Either GroupID FunctionAttribute]
functionAttributes = Maybe (Either GroupID FunctionAttribute)
-> [Either GroupID FunctionAttribute]
forall a. Maybe a -> [a]
maybeToList Maybe (Either GroupID FunctionAttribute)
functionAttrSet
       , returnAttributes :: [ParameterAttribute]
returnAttributes = [ParameterAttribute]
returnAttrs
       , parameterAttributes :: [[ParameterAttribute]]
parameterAttributes = [[ParameterAttribute]]
paramAttrs
       })
    where
      withAttrsAtIndex :: FFI.AttributeIndex -> DecodeAST (FFI.AttributeSet b)
      withAttrsAtIndex :: AttributeIndex -> DecodeAST (AttributeSet b)
withAttrsAtIndex index :: AttributeIndex
index =
        (forall r. (AttributeSet b -> IO r) -> IO r)
-> DecodeAST (AttributeSet b)
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (IO (AttributeSet b)
-> (AttributeSet b -> IO ()) -> (AttributeSet b -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (a -> AttributeIndex -> IO (AttributeSet b)
forall b. a -> AttributeIndex -> IO (AttributeSet b)
attrsAtIndex a
a AttributeIndex
index) (AttributeSet b -> IO ()
forall a. AttributeSet a -> IO ()
FFI.disposeAttributeSet))