{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_HADDOCK hide, prune, not-home #-}

module MLIR.AST.Dialect.Generated.LLVM where

import Prelude (Int, Double, Maybe(..), Bool(..), (++), (<$>), ($), (<>), Show)
import qualified Prelude
import Data.Int (Int64)
import qualified Data.Maybe
import Data.Array (Ix)
import qualified Data.Array.IArray as IArray
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as M
import qualified Control.Monad

import MLIR.AST ( Attribute(..), Type(..), AbstractOperation(..), ResultTypes(..)
                , Location(..), Signedness(..), DenseElements(..)
                , NamedAttributes, Name
                , pattern NoAttrs )
import qualified MLIR.AST as AST
import MLIR.AST.Builder (Value, EndOfBlock, MonadBlockBuilder, RegionBuilderT)
import qualified MLIR.AST.Builder as AST
import qualified MLIR.AST.IStorableArray as AST
import qualified MLIR.AST.PatternUtil as PatternUtil
import qualified MLIR.AST.Dialect.Affine as Affine

-- | A pattern for @llvm.ashr@.
pattern AShr :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bAShr :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mAShr :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
AShr loc ty lhs_ rhs_  = Operation
          { opName = "llvm.ashr"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.ashr@.
ashr :: () => MonadBlockBuilder m => Value -> Value -> m Value
ashr :: Value -> Value -> m Value
ashr  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.ashr"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.add@.
pattern Add :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bAdd :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mAdd :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Add loc ty lhs_ rhs_  = Operation
          { opName = "llvm.add"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.add@.
add :: () => MonadBlockBuilder m => Value -> Value -> m Value
add :: Value -> Value -> m Value
add  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.add"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.addrspacecast@.
pattern AddrSpaceCast :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bAddrSpaceCast :: Location -> Type -> operand -> AbstractOperation operand
$mAddrSpaceCast :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
AddrSpaceCast loc ty0 arg_  = Operation
          { opName = "llvm.addrspacecast"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.addrspacecast@.
addrspacecast :: () => MonadBlockBuilder m => Type -> Value -> m Value
addrspacecast :: Type -> Value -> m Value
addrspacecast Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.addrspacecast"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * mlir.addressof
-- $mlir.addressof
-- 
-- Creates an SSA value containing a pointer to a global value (function,
-- variable or alias). The global value can be defined after its first
-- referenced. If the global value is a constant, storing into it is not
-- allowed.
-- 
-- Examples:
-- 
-- @
-- func \@foo() {
--   // Get the address of a global variable.
--   %0 = llvm.mlir.addressof \@const : !llvm.ptr
-- 
--   // Use it as a regular pointer.
--   %1 = llvm.load %0 : !llvm.ptr -> i32
-- 
--   // Get the address of a function.
--   %2 = llvm.mlir.addressof \@foo : !llvm.ptr
-- 
--   // The function address can be used for indirect calls.
--   llvm.call %2() : !llvm.ptr, () -> ()
-- 
--   // Get the address of an aliased global.
--   %3 = llvm.mlir.addressof \@const_alias : !llvm.ptr
-- }
-- 
-- // Define the global.
-- llvm.mlir.global \@const(42 : i32) : i32
-- 
-- // Define an alias.
-- llvm.mlir.alias \@const_alias : i32 {
--   %0 = llvm.mlir.addressof \@const : !llvm.ptr
--   llvm.return %0 : !llvm.ptr
-- }
-- @
--   

-- * mlir.alias
-- $mlir.alias
-- 
-- @llvm.mlir.alias@ is a top level operation that defines a global alias for
-- global variables and functions. The operation is always initialized by
-- using a initializer region which could be a direct map to another global
-- value or contain some address computation on top of it.
-- 
-- It uses a symbol for its value, which will be uniqued by the module
-- with respect to other symbols in it.
-- 
-- Similarly to functions and globals, they can also have a linkage attribute.
-- This attribute is placed between @llvm.mlir.alias@ and the symbol name. If
-- the attribute is omitted, @external@ linkage is assumed by default.
-- 
-- Examples:
-- 
-- @
-- // Global alias use \@-identifiers.
-- llvm.mlir.alias external \@foo_alias {addr_space = 0 : i32} : !llvm.ptr {
--   %0 = llvm.mlir.addressof \@some_function : !llvm.ptr
--   llvm.return %0 : !llvm.ptr
-- }
-- 
-- // More complex initialization.
-- llvm.mlir.alias linkonce_odr hidden \@glob
-- {addr_space = 0 : i32, dso_local} : !llvm.array\<32 x i32> {
--   %0 = llvm.mlir.constant(1234 : i64) : i64
--   %1 = llvm.mlir.addressof \@glob.private : !llvm.ptr
--   %2 = llvm.ptrtoint %1 : !llvm.ptr to i64
--   %3 = llvm.add %2, %0 : i64
--   %4 = llvm.inttoptr %3 : i64 to !llvm.ptr
--   llvm.return %4 : !llvm.ptr
-- }
-- @
--   

-- | A pattern for @llvm.and@.
pattern And :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bAnd :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mAnd :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
And loc ty lhs_ rhs_  = Operation
          { opName = "llvm.and"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.and@.
and :: () => MonadBlockBuilder m => Value -> Value -> m Value
and :: Value -> Value -> m Value
and  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.and"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.bitcast@.
pattern Bitcast :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bBitcast :: Location -> Type -> operand -> AbstractOperation operand
$mBitcast :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
Bitcast loc ty0 arg_  = Operation
          { opName = "llvm.bitcast"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.bitcast@.
bitcast :: () => MonadBlockBuilder m => Type -> Value -> m Value
bitcast :: Type -> Value -> m Value
bitcast Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.bitcast"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * call_intrinsic
-- $call_intrinsic
-- 
-- Call the specified llvm intrinsic. If the intrinsic is overloaded, use
-- the MLIR function type of this op to determine which intrinsic to call.
--   

pattern OptionalArrayAttr :: Maybe [Attribute] -> Maybe Attribute
pattern $bOptionalArrayAttr :: Maybe [Attribute] -> Maybe Attribute
$mOptionalArrayAttr :: forall r.
Maybe Attribute -> (Maybe [Attribute] -> r) -> (Void# -> r) -> r
OptionalArrayAttr x <- ((\case Just (ArrayAttr y) -> Just y; Nothing -> Nothing) -> x)
  where OptionalArrayAttr Maybe [Attribute]
x = case Maybe [Attribute]
x of Just [Attribute]
y -> Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just ([Attribute] -> Attribute
ArrayAttr [Attribute]
y); Maybe [Attribute]
Nothing -> Maybe Attribute
forall a. Maybe a
Nothing

pattern InternalCallIntrinsicOpAttributes :: () => () => BS.ByteString -> [Int] -> Maybe [Attribute] -> NamedAttributes
pattern $bInternalCallIntrinsicOpAttributes :: Name -> [Int] -> Maybe [Attribute] -> Map Name Attribute
$mInternalCallIntrinsicOpAttributes :: forall r.
Map Name Attribute
-> (Name -> [Int] -> Maybe [Attribute] -> r) -> (Void# -> r) -> r
InternalCallIntrinsicOpAttributes intrin_ op_bundle_sizes_ op_bundle_tags_ <- ((\m -> (M.lookup "intrin" m, M.lookup "op_bundle_sizes" m, M.lookup "op_bundle_tags" m)) -> (Just (StringAttr intrin_), Just (PatternUtil.I32ArrayAttr op_bundle_sizes_), OptionalArrayAttr op_bundle_tags_))
  where InternalCallIntrinsicOpAttributes Name
intrin_ [Int]
op_bundle_sizes_ Maybe [Attribute]
op_bundle_tags_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ [(Name
"intrin", Name -> Attribute
StringAttr Name
intrin_)] [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ [(Name
"op_bundle_sizes", [Int] -> Attribute
PatternUtil.I32ArrayAttr [Int]
op_bundle_sizes_)] [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"op_bundle_tags",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Attribute] -> Maybe Attribute
OptionalArrayAttr Maybe [Attribute]
op_bundle_tags_)

-- | A builder for @llvm.call_intrinsic@.
call_intrinsic :: () => MonadBlockBuilder m => Maybe Type -> [Value] -> [Value] -> BS.ByteString -> [Int] -> Maybe [Attribute] -> m Value
call_intrinsic :: Maybe Type
-> [Value]
-> [Value]
-> Name
-> [Int]
-> Maybe [Attribute]
-> m Value
call_intrinsic Maybe Type
ty0 [Value]
args_ [Value]
op_bundle_operands_ Name
intrin_ [Int]
op_bundle_sizes_ Maybe [Attribute]
op_bundle_tags_  = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.call_intrinsic"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit ((Maybe Type -> [Type]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList Maybe Type
ty0))
          , opOperands :: [Name]
opOperands = (([Value] -> [Name]
AST.operands [Value]
args_) [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Value] -> [Name]
AST.operands [Value]
op_bundle_operands_))
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Name -> [Int] -> Maybe [Attribute] -> Map Name Attribute
InternalCallIntrinsicOpAttributes Name
intrin_ [Int]
op_bundle_sizes_ Maybe [Attribute]
op_bundle_tags_)
              Map Name Attribute -> Map Name Attribute -> Map Name Attribute
forall a. Semigroup a => a -> a -> a
<> Name -> Attribute -> Map Name Attribute
AST.namedAttribute Name
"operand_segment_sizes"
                   (Type -> DenseElements -> Attribute
DenseElementsAttr ([Int] -> Type -> Type
VectorType [Int
2] (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Signedness -> UInt -> Type
IntegerType Signedness
Unsigned UInt
32) (DenseElements -> Attribute) -> DenseElements -> Attribute
forall a b. (a -> b) -> a -> b
$
                      IStorableArray Int Word32 -> DenseElements
forall i.
(Show i, Ix i) =>
IStorableArray i Word32 -> DenseElements
DenseUInt32 (IStorableArray Int Word32 -> DenseElements)
-> IStorableArray Int Word32 -> DenseElements
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Word32] -> IStorableArray Int Word32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
IArray.listArray (Int
1 :: Int, Int
2) ([Word32] -> IStorableArray Int Word32)
-> [Word32] -> IStorableArray Int Word32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Word32) -> [Int] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length ([Value] -> [Name]
AST.operands [Value]
args_), [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length ([Value] -> [Name]
AST.operands [Value]
op_bundle_operands_)])

          }))

-- * call
-- $call
-- 
-- In LLVM IR, functions may return either 0 or 1 value. LLVM IR dialect
-- implements this behavior by providing a variadic @call@ operation for 0- and
-- 1-result functions. Even though MLIR supports multi-result functions, LLVM
-- IR dialect disallows them.
-- 
-- The @call@ instruction supports both direct and indirect calls. Direct calls
-- start with a function name (@\@@-prefixed) and indirect calls start with an
-- SSA value (@%@-prefixed). The direct callee, if present, is stored as a
-- function attribute @callee@. For indirect calls, the callee is of @!llvm.ptr@ type
-- and is stored as the first value in @callee_operands@. If and only if the
-- callee is a variadic function, the @var_callee_type@ attribute must carry
-- the variadic LLVM function type. The trailing type list contains the
-- optional indirect callee type and the MLIR function type, which differs from
-- the LLVM function type that uses an explicit void type to model functions
-- that do not return a value.
-- 
-- Examples:
-- 
-- @
-- // Direct call without arguments and with one result.
-- %0 = llvm.call \@foo() : () -> (f32)
-- 
-- // Direct call with arguments and without a result.
-- llvm.call \@bar(%0) : (f32) -> ()
-- 
-- // Indirect call with an argument and without a result.
-- %1 = llvm.mlir.addressof \@foo : !llvm.ptr
-- llvm.call %1(%0) : !llvm.ptr, (f32) -> ()
-- 
-- // Direct variadic call.
-- llvm.call \@printf(%0, %1) vararg(!llvm.func\<i32 (ptr, ...)>) : (!llvm.ptr, i32) -> i32
-- 
-- // Indirect variadic call
-- llvm.call %1(%0) vararg(!llvm.func\<void (...)>) : !llvm.ptr, (i32) -> ()
-- @
--   

pattern OptionalDenseI32ArrayAttr :: Maybe [Int] -> Maybe Attribute
pattern $bOptionalDenseI32ArrayAttr :: Maybe [Int] -> Maybe Attribute
$mOptionalDenseI32ArrayAttr :: forall r.
Maybe Attribute -> (Maybe [Int] -> r) -> (Void# -> r) -> r
OptionalDenseI32ArrayAttr x <- ((\case Just (PatternUtil.I32ArrayAttr y) -> Just y; Nothing -> Nothing) -> x)
  where OptionalDenseI32ArrayAttr Maybe [Int]
x = case Maybe [Int]
x of Just [Int]
y -> Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just ([Int] -> Attribute
PatternUtil.I32ArrayAttr [Int]
y); Maybe [Int]
Nothing -> Maybe Attribute
forall a. Maybe a
Nothing

pattern InternalCallOpAttributes :: () => () => Maybe [Int] -> [Int] -> Maybe [Attribute] -> NamedAttributes
pattern $bInternalCallOpAttributes :: Maybe [Int] -> [Int] -> Maybe [Attribute] -> Map Name Attribute
$mInternalCallOpAttributes :: forall r.
Map Name Attribute
-> (Maybe [Int] -> [Int] -> Maybe [Attribute] -> r)
-> (Void# -> r)
-> r
InternalCallOpAttributes branch_weights_ op_bundle_sizes_ op_bundle_tags_ <- ((\m -> (M.lookup "branch_weights" m, M.lookup "op_bundle_sizes" m, M.lookup "op_bundle_tags" m)) -> (OptionalDenseI32ArrayAttr branch_weights_, Just (PatternUtil.I32ArrayAttr op_bundle_sizes_), OptionalArrayAttr op_bundle_tags_))
  where InternalCallOpAttributes Maybe [Int]
branch_weights_ [Int]
op_bundle_sizes_ Maybe [Attribute]
op_bundle_tags_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"branch_weights",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int] -> Maybe Attribute
OptionalDenseI32ArrayAttr Maybe [Int]
branch_weights_) [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ [(Name
"op_bundle_sizes", [Int] -> Attribute
PatternUtil.I32ArrayAttr [Int]
op_bundle_sizes_)] [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"op_bundle_tags",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Attribute] -> Maybe Attribute
OptionalArrayAttr Maybe [Attribute]
op_bundle_tags_)

-- | A builder for @llvm.call@.
call :: () => MonadBlockBuilder m => Maybe Type -> [Value] -> [Value] -> Maybe [Int] -> [Int] -> Maybe [Attribute] -> m Value
call :: Maybe Type
-> [Value]
-> [Value]
-> Maybe [Int]
-> [Int]
-> Maybe [Attribute]
-> m Value
call Maybe Type
ty0 [Value]
callee_operands_ [Value]
op_bundle_operands_ Maybe [Int]
branch_weights_ [Int]
op_bundle_sizes_ Maybe [Attribute]
op_bundle_tags_  = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.call"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit ((Maybe Type -> [Type]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList Maybe Type
ty0))
          , opOperands :: [Name]
opOperands = (([Value] -> [Name]
AST.operands [Value]
callee_operands_) [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Value] -> [Name]
AST.operands [Value]
op_bundle_operands_))
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Maybe [Int] -> [Int] -> Maybe [Attribute] -> Map Name Attribute
InternalCallOpAttributes Maybe [Int]
branch_weights_ [Int]
op_bundle_sizes_ Maybe [Attribute]
op_bundle_tags_)
              Map Name Attribute -> Map Name Attribute -> Map Name Attribute
forall a. Semigroup a => a -> a -> a
<> Name -> Attribute -> Map Name Attribute
AST.namedAttribute Name
"operand_segment_sizes"
                   (Type -> DenseElements -> Attribute
DenseElementsAttr ([Int] -> Type -> Type
VectorType [Int
2] (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Signedness -> UInt -> Type
IntegerType Signedness
Unsigned UInt
32) (DenseElements -> Attribute) -> DenseElements -> Attribute
forall a b. (a -> b) -> a -> b
$
                      IStorableArray Int Word32 -> DenseElements
forall i.
(Show i, Ix i) =>
IStorableArray i Word32 -> DenseElements
DenseUInt32 (IStorableArray Int Word32 -> DenseElements)
-> IStorableArray Int Word32 -> DenseElements
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Word32] -> IStorableArray Int Word32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
IArray.listArray (Int
1 :: Int, Int
2) ([Word32] -> IStorableArray Int Word32)
-> [Word32] -> IStorableArray Int Word32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Word32) -> [Int] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length ([Value] -> [Name]
AST.operands [Value]
callee_operands_), [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length ([Value] -> [Name]
AST.operands [Value]
op_bundle_operands_)])

          }))

-- * comdat
-- $comdat
-- 
-- Provides access to object file COMDAT section/group functionality.
-- 
-- Examples:
-- @
-- llvm.comdat \@__llvm_comdat {
--   llvm.comdat_selector \@any any
-- }
-- llvm.mlir.global internal constant \@has_any_comdat(1 : i64) comdat(\@__llvm_comdat::\@any) : i64
-- @
--   

-- * comdat_selector
-- $comdat_selector
-- 
-- Provides access to object file COMDAT section/group functionality.
-- 
-- Examples:
-- @
-- llvm.comdat \@__llvm_comdat {
--   llvm.comdat_selector \@any any
-- }
-- llvm.mlir.global internal constant \@has_any_comdat(1 : i64) comdat(\@__llvm_comdat::\@any) : i64
-- @
--   

pattern InternalCondBrOpAttributes :: () => () => Maybe [Int] -> NamedAttributes
pattern $bInternalCondBrOpAttributes :: Maybe [Int] -> Map Name Attribute
$mInternalCondBrOpAttributes :: forall r.
Map Name Attribute -> (Maybe [Int] -> r) -> (Void# -> r) -> r
InternalCondBrOpAttributes branch_weights_ <- ((\m -> (M.lookup "branch_weights" m)) -> (OptionalDenseI32ArrayAttr branch_weights_))
  where InternalCondBrOpAttributes Maybe [Int]
branch_weights_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"branch_weights",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int] -> Maybe Attribute
OptionalDenseI32ArrayAttr Maybe [Int]
branch_weights_)

-- * mlir.constant
-- $mlir.constant
-- 
-- Unlike LLVM IR, MLIR does not have first-class constant values. Therefore,
-- all constants must be created as SSA values before being used in other
-- operations. @llvm.mlir.constant@ creates such values for scalars, vectors,
-- strings, and structs. It has a mandatory @value@ attribute whose type
-- depends on the type of the constant value. The type of the constant value
-- must correspond to the attribute type converted to LLVM IR type.
-- 
-- When creating constant scalars, the @value@ attribute must be either an
-- integer attribute or a floating point attribute. The type of the attribute
-- may be omitted for @i64@ and @f64@ types that are implied.
-- 
-- When creating constant vectors, the @value@ attribute must be either an
-- array attribute, a dense attribute, or a sparse attribute that contains
-- integers or floats. The number of elements in the result vector must match
-- the number of elements in the attribute.
-- 
-- When creating constant strings, the @value@ attribute must be a string
-- attribute. The type of the constant must be an LLVM array of @i8@s, and the
-- length of the array must match the length of the attribute.
-- 
-- When creating constant structs, the @value@ attribute must be an array
-- attribute that contains integers or floats. The type of the constant must be
-- an LLVM struct type. The number of fields in the struct must match the
-- number of elements in the attribute, and the type of each LLVM struct field
-- must correspond to the type of the corresponding attribute element converted
-- to LLVM IR.
-- 
-- Examples:
-- 
-- @
-- // Integer constant, internal i32 is mandatory
-- %0 = llvm.mlir.constant(42 : i32) : i32
-- 
-- // It\'s okay to omit i64.
-- %1 = llvm.mlir.constant(42) : i64
-- 
-- // Floating point constant.
-- %2 = llvm.mlir.constant(42.0 : f32) : f32
-- 
-- // Splat dense vector constant.
-- %3 = llvm.mlir.constant(dense\<1.0> : vector\<4xf32>) : vector\<4xf32>
-- @
--   

pattern InternalConstantOpAttributes :: () => () => Attribute -> NamedAttributes
pattern $bInternalConstantOpAttributes :: Attribute -> Map Name Attribute
$mInternalConstantOpAttributes :: forall r.
Map Name Attribute -> (Attribute -> r) -> (Void# -> r) -> r
InternalConstantOpAttributes value_ <- ((\m -> (M.lookup "value" m)) -> (Just (value_)))
  where InternalConstantOpAttributes Attribute
value_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ [(Name
"value", Attribute
value_)]

-- | A pattern for @llvm.mlir.constant@.
pattern Constant :: () => () => Location -> Type -> Attribute -> AbstractOperation operand
pattern $bConstant :: Location -> Type -> Attribute -> AbstractOperation operand
$mConstant :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> Attribute -> r) -> (Void# -> r) -> r
Constant loc ty0  value_ = Operation
          { opName = "llvm.mlir.constant"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = []
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalConstantOpAttributes value_)
          }

-- | A builder for @llvm.mlir.constant@.
mlir_constant :: () => MonadBlockBuilder m => Type -> Attribute -> m Value
mlir_constant :: Type -> Attribute -> m Value
mlir_constant Type
ty0  Attribute
value_  = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.mlir.constant"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = []
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Attribute -> Map Name Attribute
InternalConstantOpAttributes Attribute
value_)
          }))

-- | A pattern for @llvm.extractelement@.
pattern ExtractElement :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bExtractElement :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mExtractElement :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
ExtractElement loc ty0 vector_ position_  = Operation
          { opName = "llvm.extractelement"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [vector_, position_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.extractelement@.
extractelement :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
extractelement :: Type -> Value -> Value -> m Value
extractelement Type
ty0 Value
vector_ Value
position_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.extractelement"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
vector_), (Value -> Name
AST.operand Value
position_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fadd@.
pattern FAdd :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bFAdd :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mFAdd :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
FAdd loc ty lhs_ rhs_  = Operation
          { opName = "llvm.fadd"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fadd@.
fadd :: () => MonadBlockBuilder m => Value -> Value -> m Value
fadd :: Value -> Value -> m Value
fadd  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fadd"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fdiv@.
pattern FDiv :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bFDiv :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mFDiv :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
FDiv loc ty lhs_ rhs_  = Operation
          { opName = "llvm.fdiv"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fdiv@.
fdiv :: () => MonadBlockBuilder m => Value -> Value -> m Value
fdiv :: Value -> Value -> m Value
fdiv  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fdiv"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fmul@.
pattern FMul :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bFMul :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mFMul :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
FMul loc ty lhs_ rhs_  = Operation
          { opName = "llvm.fmul"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fmul@.
fmul :: () => MonadBlockBuilder m => Value -> Value -> m Value
fmul :: Value -> Value -> m Value
fmul  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fmul"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fneg@.
pattern FNeg :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bFNeg :: Location -> Type -> operand -> AbstractOperation operand
$mFNeg :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
FNeg loc ty operand_  = Operation
          { opName = "llvm.fneg"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [operand_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fneg@.
fneg :: () => MonadBlockBuilder m => Value -> m Value
fneg :: Value -> m Value
fneg  Value
operand_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fneg"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
operand_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
operand_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fpext@.
pattern FPExt :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bFPExt :: Location -> Type -> operand -> AbstractOperation operand
$mFPExt :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
FPExt loc ty0 arg_  = Operation
          { opName = "llvm.fpext"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fpext@.
fpext :: () => MonadBlockBuilder m => Type -> Value -> m Value
fpext :: Type -> Value -> m Value
fpext Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fpext"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fptosi@.
pattern FPToSI :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bFPToSI :: Location -> Type -> operand -> AbstractOperation operand
$mFPToSI :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
FPToSI loc ty0 arg_  = Operation
          { opName = "llvm.fptosi"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fptosi@.
fptosi :: () => MonadBlockBuilder m => Type -> Value -> m Value
fptosi :: Type -> Value -> m Value
fptosi Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fptosi"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fptoui@.
pattern FPToUI :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bFPToUI :: Location -> Type -> operand -> AbstractOperation operand
$mFPToUI :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
FPToUI loc ty0 arg_  = Operation
          { opName = "llvm.fptoui"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fptoui@.
fptoui :: () => MonadBlockBuilder m => Type -> Value -> m Value
fptoui :: Type -> Value -> m Value
fptoui Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fptoui"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fptrunc@.
pattern FPTrunc :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bFPTrunc :: Location -> Type -> operand -> AbstractOperation operand
$mFPTrunc :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
FPTrunc loc ty0 arg_  = Operation
          { opName = "llvm.fptrunc"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fptrunc@.
fptrunc :: () => MonadBlockBuilder m => Type -> Value -> m Value
fptrunc :: Type -> Value -> m Value
fptrunc Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fptrunc"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.frem@.
pattern FRem :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bFRem :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mFRem :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
FRem loc ty lhs_ rhs_  = Operation
          { opName = "llvm.frem"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.frem@.
frem :: () => MonadBlockBuilder m => Value -> Value -> m Value
frem :: Value -> Value -> m Value
frem  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.frem"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.fsub@.
pattern FSub :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bFSub :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mFSub :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
FSub loc ty lhs_ rhs_  = Operation
          { opName = "llvm.fsub"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.fsub@.
fsub :: () => MonadBlockBuilder m => Value -> Value -> m Value
fsub :: Value -> Value -> m Value
fsub  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.fsub"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.freeze@.
pattern Freeze :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bFreeze :: Location -> Type -> operand -> AbstractOperation operand
$mFreeze :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
Freeze loc ty val_  = Operation
          { opName = "llvm.freeze"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [val_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.freeze@.
freeze :: () => MonadBlockBuilder m => Value -> m Value
freeze :: Value -> m Value
freeze  Value
val_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.freeze"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
val_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
val_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * getelementptr
-- $getelementptr
-- 
-- This operation mirrors LLVM IRs \'getelementptr\' operation that is used to
-- perform pointer arithmetic.
-- 
-- Like in LLVM IR, it is possible to use both constants as well as SSA values
-- as indices. In the case of indexing within a structure, it is required to
-- either use constant indices directly, or supply a constant SSA value.
-- 
-- An optional \'inbounds\' attribute specifies the low-level pointer arithmetic
-- overflow behavior that LLVM uses after lowering the operation to LLVM IR.
-- 
-- Examples:
-- 
-- @
-- // GEP with an SSA value offset
-- %0 = llvm.getelementptr %1[%2] : (!llvm.ptr, i64) -> !llvm.ptr, f32
-- 
-- // GEP with a constant offset and the inbounds attribute set
-- %0 = llvm.getelementptr inbounds %1[3] : (!llvm.ptr) -> !llvm.ptr, f32
-- 
-- // GEP with constant offsets into a structure
-- %0 = llvm.getelementptr %1[0, 1]
--    : (!llvm.ptr) -> !llvm.ptr, !llvm.struct\<(i32, f32)>
-- @
--   

-- * mlir.global_ctors
-- $mlir.global_ctors
-- 
-- Specifies a list of constructor functions and priorities. The functions
-- referenced by this array will be called in ascending order of priority (i.e.
-- lowest first) when the module is loaded. The order of functions with the
-- same priority is not defined. This operation is translated to LLVM\'s
-- global_ctors global variable. The initializer functions are run at load
-- time. The @data@ field present in LLVM\'s global_ctors variable is not
-- modeled here.
-- 
-- Examples:
-- 
-- @
-- llvm.mlir.global_ctors {\@ctor}
-- 
-- llvm.func \@ctor() {
--   ...
--   llvm.return
-- }
-- @
-- 
--   

-- * mlir.global_dtors
-- $mlir.global_dtors
-- 
-- Specifies a list of destructor functions and priorities. The functions
-- referenced by this array will be called in descending order of priority (i.e.
-- highest first) when the module is unloaded. The order of functions with the
-- same priority is not defined. This operation is translated to LLVM\'s
-- global_dtors global variable. The @data@ field present in LLVM\'s
-- global_dtors variable is not modeled here.
-- 
-- Examples:
-- 
-- @
-- llvm.func \@dtor() {
--   llvm.return
-- }
-- llvm.mlir.global_dtors {\@dtor}
-- @
-- 
--   

-- * mlir.global
-- $mlir.global
-- 
-- Since MLIR allows for arbitrary operations to be present at the top level,
-- global variables are defined using the @llvm.mlir.global@ operation. Both
-- global constants and variables can be defined, and the value may also be
-- initialized in both cases.
-- 
-- There are two forms of initialization syntax. Simple constants that can be
-- represented as MLIR attributes can be given in-line:
-- 
-- @
-- llvm.mlir.global \@variable(32.0 : f32) : f32
-- @
-- 
-- This initialization and type syntax is similar to @llvm.mlir.constant@ and
-- may use two types: one for MLIR attribute and another for the LLVM value.
-- These types must be compatible.
-- 
-- More complex constants that cannot be represented as MLIR attributes can be
-- given in an initializer region:
-- 
-- @
-- // This global is initialized with the equivalent of:
-- //   i32* getelementptr (i32* \@g2, i32 2)
-- llvm.mlir.global constant \@int_gep() : !llvm.ptr {
--   %0 = llvm.mlir.addressof \@g2 : !llvm.ptr
--   %1 = llvm.mlir.constant(2 : i32) : i32
--   %2 = llvm.getelementptr %0[%1]
--      : (!llvm.ptr, i32) -> !llvm.ptr, i32
--   // The initializer region must end with @llvm.return@.
--   llvm.return %2 : !llvm.ptr
-- }
-- @
-- 
-- Only one of the initializer attribute or initializer region may be provided.
-- 
-- @llvm.mlir.global@ must appear at top-level of the enclosing module. It uses
-- an \@-identifier for its value, which will be uniqued by the module with
-- respect to other \@-identifiers in it.
-- 
-- Examples:
-- 
-- @
-- // Global values use \@-identifiers.
-- llvm.mlir.global constant \@cst(42 : i32) : i32
-- 
-- // Non-constant values must also be initialized.
-- llvm.mlir.global \@variable(32.0 : f32) : f32
-- 
-- // Strings are expected to be of wrapped LLVM i8 array type and do not
-- // automatically include the trailing zero.
-- llvm.mlir.global \@string(\"abc\") : !llvm.array\<3 x i8>
-- 
-- // For strings globals, the trailing type may be omitted.
-- llvm.mlir.global constant \@no_trailing_type(\"foo bar\")
-- 
-- // A complex initializer is constructed with an initializer region.
-- llvm.mlir.global constant \@int_gep() : !llvm.ptr {
--   %0 = llvm.mlir.addressof \@g2 : !llvm.ptr
--   %1 = llvm.mlir.constant(2 : i32) : i32
--   %2 = llvm.getelementptr %0[%1]
--      : (!llvm.ptr, i32) -> !llvm.ptr, i32
--   llvm.return %2 : !llvm.ptr
-- }
-- @
-- 
-- Similarly to functions, globals have a linkage attribute. In the custom
-- syntax, this attribute is placed between @llvm.mlir.global@ and the optional
-- @constant@ keyword. If the attribute is omitted, @external@ linkage is
-- assumed by default.
-- 
-- Examples:
-- 
-- @
-- // A constant with internal linkage will not participate in linking.
-- llvm.mlir.global internal constant \@cst(42 : i32) : i32
-- 
-- // By default, \"external\" linkage is assumed and the global participates in
-- // symbol resolution at link-time.
-- llvm.mlir.global \@glob(0 : f32) : f32
-- 
-- // Alignment is optional
-- llvm.mlir.global private constant \@y(dense\<1.0> : tensor\<8xf32>) : !llvm.array\<8 x f32>
-- @
-- 
-- Like global variables in LLVM IR, globals can have an (optional)
-- alignment attribute using keyword @alignment@. The integer value of the
-- alignment must be a positive integer that is a power of 2.
-- 
-- Examples:
-- 
-- @
-- // Alignment is optional
-- llvm.mlir.global private constant \@y(dense\<1.0> : tensor\<8xf32>) { alignment = 32 : i64 } : !llvm.array\<8 x f32>
-- @
-- 
--   

-- * inline_asm
-- $inline_asm
-- 
-- The InlineAsmOp mirrors the underlying LLVM semantics with a notable
-- exception: the embedded @asm_string@ is not allowed to define or reference
-- any symbol or any global variable: only the operands of the op may be read,
-- written, or referenced.
-- Attempting to define or reference any symbol or any global behavior is
-- considered undefined behavior at this time.
--   

pattern InternalInlineAsmOpAttributes :: () => () => BS.ByteString -> BS.ByteString -> Maybe [Attribute] -> NamedAttributes
pattern $bInternalInlineAsmOpAttributes :: Name -> Name -> Maybe [Attribute] -> Map Name Attribute
$mInternalInlineAsmOpAttributes :: forall r.
Map Name Attribute
-> (Name -> Name -> Maybe [Attribute] -> r) -> (Void# -> r) -> r
InternalInlineAsmOpAttributes asm_string_ constraints_ operand_attrs_ <- ((\m -> (M.lookup "asm_string" m, M.lookup "constraints" m, M.lookup "operand_attrs" m)) -> (Just (StringAttr asm_string_), Just (StringAttr constraints_), OptionalArrayAttr operand_attrs_))
  where InternalInlineAsmOpAttributes Name
asm_string_ Name
constraints_ Maybe [Attribute]
operand_attrs_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ [(Name
"asm_string", Name -> Attribute
StringAttr Name
asm_string_)] [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ [(Name
"constraints", Name -> Attribute
StringAttr Name
constraints_)] [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"operand_attrs",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Attribute] -> Maybe Attribute
OptionalArrayAttr Maybe [Attribute]
operand_attrs_)

-- | A builder for @llvm.inline_asm@.
inline_asm :: () => MonadBlockBuilder m => Maybe Type -> [Value] -> BS.ByteString -> BS.ByteString -> Maybe [Attribute] -> m Value
inline_asm :: Maybe Type
-> [Value] -> Name -> Name -> Maybe [Attribute] -> m Value
inline_asm Maybe Type
ty0 [Value]
operands_ Name
asm_string_ Name
constraints_ Maybe [Attribute]
operand_attrs_  = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.inline_asm"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit ((Maybe Type -> [Type]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList Maybe Type
ty0))
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
operands_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Name -> Name -> Maybe [Attribute] -> Map Name Attribute
InternalInlineAsmOpAttributes Name
asm_string_ Name
constraints_ Maybe [Attribute]
operand_attrs_)
          }))

-- | A pattern for @llvm.insertelement@.
pattern InsertElement :: () => () => Location -> Type -> operand -> operand -> operand -> AbstractOperation operand
pattern $bInsertElement :: Location
-> Type
-> operand
-> operand
-> operand
-> AbstractOperation operand
$mInsertElement :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> operand -> r)
-> (Void# -> r)
-> r
InsertElement loc ty0 vector_ value_ position_  = Operation
          { opName = "llvm.insertelement"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [vector_, value_, position_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.insertelement@.
insertelement :: () => MonadBlockBuilder m => Type -> Value -> Value -> Value -> m Value
insertelement :: Type -> Value -> Value -> Value -> m Value
insertelement Type
ty0 Value
vector_ Value
value_ Value
position_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.insertelement"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
vector_), (Value -> Name
AST.operand Value
value_), (Value -> Name
AST.operand Value
position_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.inttoptr@.
pattern IntToPtr :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bIntToPtr :: Location -> Type -> operand -> AbstractOperation operand
$mIntToPtr :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
IntToPtr loc ty0 arg_  = Operation
          { opName = "llvm.inttoptr"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.inttoptr@.
inttoptr :: () => MonadBlockBuilder m => Type -> Value -> m Value
inttoptr :: Type -> Value -> m Value
inttoptr Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.inttoptr"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

pattern InternalInvokeOpAttributes :: () => () => Maybe [Int] -> [Int] -> Maybe [Attribute] -> NamedAttributes
pattern $bInternalInvokeOpAttributes :: Maybe [Int] -> [Int] -> Maybe [Attribute] -> Map Name Attribute
$mInternalInvokeOpAttributes :: forall r.
Map Name Attribute
-> (Maybe [Int] -> [Int] -> Maybe [Attribute] -> r)
-> (Void# -> r)
-> r
InternalInvokeOpAttributes branch_weights_ op_bundle_sizes_ op_bundle_tags_ <- ((\m -> (M.lookup "branch_weights" m, M.lookup "op_bundle_sizes" m, M.lookup "op_bundle_tags" m)) -> (OptionalDenseI32ArrayAttr branch_weights_, Just (PatternUtil.I32ArrayAttr op_bundle_sizes_), OptionalArrayAttr op_bundle_tags_))
  where InternalInvokeOpAttributes Maybe [Int]
branch_weights_ [Int]
op_bundle_sizes_ Maybe [Attribute]
op_bundle_tags_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"branch_weights",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int] -> Maybe Attribute
OptionalDenseI32ArrayAttr Maybe [Int]
branch_weights_) [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ [(Name
"op_bundle_sizes", [Int] -> Attribute
PatternUtil.I32ArrayAttr [Int]
op_bundle_sizes_)] [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"op_bundle_tags",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Attribute] -> Maybe Attribute
OptionalArrayAttr Maybe [Attribute]
op_bundle_tags_)

-- * func
-- $func
-- 
-- MLIR functions are defined by an operation that is not built into the IR
-- itself. The LLVM dialect provides an @llvm.func@ operation to define
-- functions compatible with LLVM IR. These functions have LLVM dialect
-- function type but use MLIR syntax to express it. They are required to have
-- exactly one result type. LLVM function operation is intended to capture
-- additional properties of LLVM functions, such as linkage and calling
-- convention, that may be modeled differently by the built-in MLIR function.
-- 
-- @
-- // The type of \@bar is !llvm\<\"i64 (i64)\">
-- llvm.func \@bar(%arg0: i64) -> i64 {
--   llvm.return %arg0 : i64
-- }
-- 
-- // Type type of \@foo is !llvm\<\"void (i64)\">
-- // !llvm.void type is omitted
-- llvm.func \@foo(%arg0: i64) {
--   llvm.return
-- }
-- 
-- // A function with @internal@ linkage.
-- llvm.func internal \@internal_func() {
--   llvm.return
-- }
-- @
--   

-- | A pattern for @llvm.lshr@.
pattern LShr :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bLShr :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mLShr :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
LShr loc ty lhs_ rhs_  = Operation
          { opName = "llvm.lshr"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.lshr@.
lshr :: () => MonadBlockBuilder m => Value -> Value -> m Value
lshr :: Value -> Value -> m Value
lshr  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.lshr"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.landingpad@.
pattern Landingpad :: () => () => Location -> Type -> [operand] -> AbstractOperation operand
pattern $bLandingpad :: Location -> Type -> [operand] -> AbstractOperation operand
$mLandingpad :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> r) -> (Void# -> r) -> r
Landingpad loc ty0 _unnamed0_  = Operation
          { opName = "llvm.landingpad"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = _unnamed0_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.landingpad@.
landingpad :: () => MonadBlockBuilder m => Type -> [Value] -> m Value
landingpad :: Type -> [Value] -> m Value
landingpad Type
ty0 [Value]
_unnamed0_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.landingpad"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
_unnamed0_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * linker_options
-- $linker_options
-- 
-- Pass the given options to the linker when the resulting object file is linked.
-- This is used extensively on Windows to determine the C runtime that the object
-- files should link against.
-- 
-- Examples:
-- @
-- // Link against the MSVC static threaded CRT.
-- llvm.linker_options [\"/DEFAULTLIB:\", \"libcmt\"]
-- 
-- // Link against aarch64 compiler-rt builtins
-- llvm.linker_options [\"-l\", \"clang_rt.builtins-aarch64\"]
-- @
--   

-- * load
-- $load
-- 
-- The @load@ operation is used to read from memory. A load may be marked as
-- atomic, volatile, and/or nontemporal, and takes a number of optional
-- attributes that specify aliasing information.
-- 
-- An atomic load only supports a limited set of pointer, integer, and
-- floating point types, and requires an explicit alignment.
-- 
-- Examples:
-- @
-- // A volatile load of a float variable.
-- %0 = llvm.load volatile %ptr : !llvm.ptr -> f32
-- 
-- // A nontemporal load of a float variable.
-- %0 = llvm.load %ptr {nontemporal} : !llvm.ptr -> f32
-- 
-- // An atomic load of an integer variable.
-- %0 = llvm.load %ptr atomic monotonic {alignment = 8 : i64}
--     : !llvm.ptr -> i64
-- @
-- 
-- See the following link for more details:
-- https://llvm.org/docs/LangRef.html\#load-instruction
--   

pattern OptionalI64Attr :: Maybe Int -> Maybe Attribute
pattern $bOptionalI64Attr :: Maybe Int -> Maybe Attribute
$mOptionalI64Attr :: forall r. Maybe Attribute -> (Maybe Int -> r) -> (Void# -> r) -> r
OptionalI64Attr x <- ((\case Just (IntegerAttr (IntegerType Signless 64) y) -> Just y; Nothing -> Nothing) -> x)
  where OptionalI64Attr Maybe Int
x = case Maybe Int
x of Just Int
y -> Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just (Type -> Int -> Attribute
IntegerAttr (Signedness -> UInt -> Type
IntegerType Signedness
Signless UInt
64) Int
y); Maybe Int
Nothing -> Maybe Attribute
forall a. Maybe a
Nothing

pattern OptionalStrAttr :: Maybe BS.ByteString -> Maybe Attribute
pattern $bOptionalStrAttr :: Maybe Name -> Maybe Attribute
$mOptionalStrAttr :: forall r. Maybe Attribute -> (Maybe Name -> r) -> (Void# -> r) -> r
OptionalStrAttr x <- ((\case Just (StringAttr y) -> Just y; Nothing -> Nothing) -> x)
  where OptionalStrAttr Maybe Name
x = case Maybe Name
x of Just Name
y -> Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just (Name -> Attribute
StringAttr Name
y); Maybe Name
Nothing -> Maybe Attribute
forall a. Maybe a
Nothing

pattern InternalLoadOpAttributes :: () => () => Maybe Int -> Maybe BS.ByteString -> NamedAttributes
pattern $bInternalLoadOpAttributes :: Maybe Int -> Maybe Name -> Map Name Attribute
$mInternalLoadOpAttributes :: forall r.
Map Name Attribute
-> (Maybe Int -> Maybe Name -> r) -> (Void# -> r) -> r
InternalLoadOpAttributes alignment_ syncscope_ <- ((\m -> (M.lookup "alignment" m, M.lookup "syncscope" m)) -> (OptionalI64Attr alignment_, OptionalStrAttr syncscope_))
  where InternalLoadOpAttributes Maybe Int
alignment_ Maybe Name
syncscope_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"alignment",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int -> Maybe Attribute
OptionalI64Attr Maybe Int
alignment_) [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"syncscope",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name -> Maybe Attribute
OptionalStrAttr Maybe Name
syncscope_)

-- | A pattern for @llvm.load@.
pattern Load :: () => () => Location -> Type -> operand -> Maybe Int -> Maybe BS.ByteString -> AbstractOperation operand
pattern $bLoad :: Location
-> Type
-> operand
-> Maybe Int
-> Maybe Name
-> AbstractOperation operand
$mLoad :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> Maybe Int -> Maybe Name -> r)
-> (Void# -> r)
-> r
Load loc ty0 addr_ alignment_ syncscope_ = Operation
          { opName = "llvm.load"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [addr_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalLoadOpAttributes alignment_ syncscope_)
          }

-- | A builder for @llvm.load@.
load :: () => MonadBlockBuilder m => Type -> Value -> Maybe Int -> Maybe BS.ByteString -> m Value
load :: Type -> Value -> Maybe Int -> Maybe Name -> m Value
load Type
ty0 Value
addr_ Maybe Int
alignment_ Maybe Name
syncscope_  = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.load"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
addr_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Maybe Int -> Maybe Name -> Map Name Attribute
InternalLoadOpAttributes Maybe Int
alignment_ Maybe Name
syncscope_)
          }))

-- | A pattern for @llvm.mul@.
pattern Mul :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bMul :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mMul :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Mul loc ty lhs_ rhs_  = Operation
          { opName = "llvm.mul"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.mul@.
mul :: () => MonadBlockBuilder m => Value -> Value -> m Value
mul :: Value -> Value -> m Value
mul  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.mul"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * mlir.none
-- $mlir.none
-- 
-- Unlike LLVM IR, MLIR does not have first-class token values. They must be
-- explicitly created as SSA values using @llvm.mlir.none@. This operation has
-- no operands or attributes, and returns a none token value of a wrapped LLVM IR
-- pointer type.
-- 
-- Examples:
-- 
-- @
-- %0 = llvm.mlir.none : !llvm.token
-- @
--   

-- | A pattern for @llvm.mlir.none@.
pattern NoneToken :: () => () => Location -> Type -> AbstractOperation operand
pattern $bNoneToken :: Location -> Type -> AbstractOperation operand
$mNoneToken :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> r) -> (Void# -> r) -> r
NoneToken loc ty0   = Operation
          { opName = "llvm.mlir.none"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = []
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.mlir.none@.
mlir_none :: () => MonadBlockBuilder m => Type -> m Value
mlir_none :: Type -> m Value
mlir_none Type
ty0    = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.mlir.none"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = []
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.or@.
pattern Or :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bOr :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mOr :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Or loc ty lhs_ rhs_  = Operation
          { opName = "llvm.or"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.or@.
or :: () => MonadBlockBuilder m => Value -> Value -> m Value
or :: Value -> Value -> m Value
or  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.or"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * mlir.poison
-- $mlir.poison
-- 
-- Unlike LLVM IR, MLIR does not have first-class poison values. Such values
-- must be created as SSA values using @llvm.mlir.poison@. This operation has
-- no operands or attributes. It creates a poison value of the specified LLVM
-- IR dialect type.
-- 
-- Example:
-- 
-- @
-- // Create a poison value for a structure with a 32-bit integer followed
-- // by a float.
-- %0 = llvm.mlir.poison : !llvm.struct\<(i32, f32)>
-- @
--   

-- | A pattern for @llvm.mlir.poison@.
pattern Poison :: () => () => Location -> Type -> AbstractOperation operand
pattern $bPoison :: Location -> Type -> AbstractOperation operand
$mPoison :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> r) -> (Void# -> r) -> r
Poison loc ty0   = Operation
          { opName = "llvm.mlir.poison"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = []
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.mlir.poison@.
mlir_poison :: () => MonadBlockBuilder m => Type -> m Value
mlir_poison :: Type -> m Value
mlir_poison Type
ty0    = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.mlir.poison"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = []
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.ptrtoint@.
pattern PtrToInt :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bPtrToInt :: Location -> Type -> operand -> AbstractOperation operand
$mPtrToInt :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
PtrToInt loc ty0 arg_  = Operation
          { opName = "llvm.ptrtoint"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.ptrtoint@.
ptrtoint :: () => MonadBlockBuilder m => Type -> Value -> m Value
ptrtoint :: Type -> Value -> m Value
ptrtoint Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.ptrtoint"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.resume@.
pattern Resume :: () => () => Location -> operand -> AbstractOperation operand
pattern $bResume :: Location -> operand -> AbstractOperation operand
$mResume :: forall r operand.
AbstractOperation operand
-> (Location -> operand -> r) -> (Void# -> r) -> r
Resume loc  value_  = Operation
          { opName = "llvm.resume"
          , opLocation = loc
          , opResultTypes = Explicit []
          , opOperands = [value_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.resume@.
resume :: () => MonadBlockBuilder m => Value -> m EndOfBlock
resume :: Value -> m EndOfBlock
resume  Value
value_   = do
  m [Value] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Control.Monad.void (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.resume"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit []
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
value_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))
  m EndOfBlock
forall (m :: * -> *). Monad m => m EndOfBlock
AST.terminateBlock

-- | A builder for @llvm.return@.
return :: () => MonadBlockBuilder m => Maybe Value -> m EndOfBlock
return :: Maybe Value -> m EndOfBlock
return  Maybe Value
arg_   = do
  m [Value] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Control.Monad.void (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.return"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit []
          , opOperands :: [Name]
opOperands = ((Maybe Name -> [Name]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Value -> Name
AST.operand (Value -> Name) -> Maybe Value -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
arg_)))
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))
  m EndOfBlock
forall (m :: * -> *). Monad m => m EndOfBlock
AST.terminateBlock

-- | A pattern for @llvm.sdiv@.
pattern SDiv :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bSDiv :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mSDiv :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
SDiv loc ty lhs_ rhs_  = Operation
          { opName = "llvm.sdiv"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.sdiv@.
sdiv :: () => MonadBlockBuilder m => Value -> Value -> m Value
sdiv :: Value -> Value -> m Value
sdiv  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.sdiv"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.sext@.
pattern SExt :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bSExt :: Location -> Type -> operand -> AbstractOperation operand
$mSExt :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
SExt loc ty0 arg_  = Operation
          { opName = "llvm.sext"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.sext@.
sext :: () => MonadBlockBuilder m => Type -> Value -> m Value
sext :: Type -> Value -> m Value
sext Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.sext"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.sitofp@.
pattern SIToFP :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bSIToFP :: Location -> Type -> operand -> AbstractOperation operand
$mSIToFP :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
SIToFP loc ty0 arg_  = Operation
          { opName = "llvm.sitofp"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.sitofp@.
sitofp :: () => MonadBlockBuilder m => Type -> Value -> m Value
sitofp :: Type -> Value -> m Value
sitofp Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.sitofp"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.srem@.
pattern SRem :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bSRem :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mSRem :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
SRem loc ty lhs_ rhs_  = Operation
          { opName = "llvm.srem"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.srem@.
srem :: () => MonadBlockBuilder m => Value -> Value -> m Value
srem :: Value -> Value -> m Value
srem  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.srem"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.select@.
pattern Select :: () => () => Location -> Type -> operand -> operand -> operand -> AbstractOperation operand
pattern $bSelect :: Location
-> Type
-> operand
-> operand
-> operand
-> AbstractOperation operand
$mSelect :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> operand -> r)
-> (Void# -> r)
-> r
Select loc ty0 condition_ trueValue_ falseValue_  = Operation
          { opName = "llvm.select"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [condition_, trueValue_, falseValue_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.select@.
select :: () => MonadBlockBuilder m => Type -> Value -> Value -> Value -> m Value
select :: Type -> Value -> Value -> Value -> m Value
select Type
ty0 Value
condition_ Value
trueValue_ Value
falseValue_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.select"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
condition_), (Value -> Name
AST.operand Value
trueValue_), (Value -> Name
AST.operand Value
falseValue_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.shl@.
pattern Shl :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bShl :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mShl :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Shl loc ty lhs_ rhs_  = Operation
          { opName = "llvm.shl"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.shl@.
shl :: () => MonadBlockBuilder m => Value -> Value -> m Value
shl :: Value -> Value -> m Value
shl  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.shl"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

pattern InternalShuffleVectorOpAttributes :: () => () => [Int] -> NamedAttributes
pattern $bInternalShuffleVectorOpAttributes :: [Int] -> Map Name Attribute
$mInternalShuffleVectorOpAttributes :: forall r. Map Name Attribute -> ([Int] -> r) -> (Void# -> r) -> r
InternalShuffleVectorOpAttributes mask_ <- ((\m -> (M.lookup "mask" m)) -> (Just (PatternUtil.I32ArrayAttr mask_)))
  where InternalShuffleVectorOpAttributes [Int]
mask_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ [(Name
"mask", [Int] -> Attribute
PatternUtil.I32ArrayAttr [Int]
mask_)]

-- | A pattern for @llvm.shufflevector@.
pattern ShuffleVector :: () => () => Location -> Type -> operand -> operand -> [Int] -> AbstractOperation operand
pattern $bShuffleVector :: Location
-> Type -> operand -> operand -> [Int] -> AbstractOperation operand
$mShuffleVector :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> [Int] -> r)
-> (Void# -> r)
-> r
ShuffleVector loc ty0 v1_ v2_ mask_ = Operation
          { opName = "llvm.shufflevector"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [v1_, v2_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalShuffleVectorOpAttributes mask_)
          }

-- | A builder for @llvm.shufflevector@.
shufflevector :: () => MonadBlockBuilder m => Type -> Value -> Value -> [Int] -> m Value
shufflevector :: Type -> Value -> Value -> [Int] -> m Value
shufflevector Type
ty0 Value
v1_ Value
v2_ [Int]
mask_  = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.shufflevector"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
v1_), (Value -> Name
AST.operand Value
v2_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = ([Int] -> Map Name Attribute
InternalShuffleVectorOpAttributes [Int]
mask_)
          }))

-- * store
-- $store
-- 
-- The @store@ operation is used to write to memory. A store may be marked as
-- atomic, volatile, and/or nontemporal, and takes a number of optional
-- attributes that specify aliasing information.
-- 
-- An atomic store only supports a limited set of pointer, integer, and
-- floating point types, and requires an explicit alignment.
-- 
-- Examples:
-- @
-- // A volatile store of a float variable.
-- llvm.store volatile %val, %ptr : f32, !llvm.ptr
-- 
-- // A nontemporal store of a float variable.
-- llvm.store %val, %ptr {nontemporal} : f32, !llvm.ptr
-- 
-- // An atomic store of an integer variable.
-- llvm.store %val, %ptr atomic monotonic {alignment = 8 : i64}
--     : i64, !llvm.ptr
-- @
-- 
-- See the following link for more details:
-- https://llvm.org/docs/LangRef.html\#store-instruction
--   

pattern InternalStoreOpAttributes :: () => () => Maybe Int -> Maybe BS.ByteString -> NamedAttributes
pattern $bInternalStoreOpAttributes :: Maybe Int -> Maybe Name -> Map Name Attribute
$mInternalStoreOpAttributes :: forall r.
Map Name Attribute
-> (Maybe Int -> Maybe Name -> r) -> (Void# -> r) -> r
InternalStoreOpAttributes alignment_ syncscope_ <- ((\m -> (M.lookup "alignment" m, M.lookup "syncscope" m)) -> (OptionalI64Attr alignment_, OptionalStrAttr syncscope_))
  where InternalStoreOpAttributes Maybe Int
alignment_ Maybe Name
syncscope_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"alignment",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int -> Maybe Attribute
OptionalI64Attr Maybe Int
alignment_) [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"syncscope",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name -> Maybe Attribute
OptionalStrAttr Maybe Name
syncscope_)

-- | A pattern for @llvm.store@.
pattern Store :: () => () => Location -> operand -> operand -> Maybe Int -> Maybe BS.ByteString -> AbstractOperation operand
pattern $bStore :: Location
-> operand
-> operand
-> Maybe Int
-> Maybe Name
-> AbstractOperation operand
$mStore :: forall r operand.
AbstractOperation operand
-> (Location -> operand -> operand -> Maybe Int -> Maybe Name -> r)
-> (Void# -> r)
-> r
Store loc  value_ addr_ alignment_ syncscope_ = Operation
          { opName = "llvm.store"
          , opLocation = loc
          , opResultTypes = Explicit []
          , opOperands = [value_, addr_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalStoreOpAttributes alignment_ syncscope_)
          }

-- | A builder for @llvm.store@.
store :: () => MonadBlockBuilder m => Value -> Value -> Maybe Int -> Maybe BS.ByteString -> m ()
store :: Value -> Value -> Maybe Int -> Maybe Name -> m ()
store  Value
value_ Value
addr_ Maybe Int
alignment_ Maybe Name
syncscope_  = do
  m [Value] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Control.Monad.void (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.store"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit []
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
value_), (Value -> Name
AST.operand Value
addr_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Maybe Int -> Maybe Name -> Map Name Attribute
InternalStoreOpAttributes Maybe Int
alignment_ Maybe Name
syncscope_)
          }))

-- | A pattern for @llvm.sub@.
pattern Sub :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bSub :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mSub :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Sub loc ty lhs_ rhs_  = Operation
          { opName = "llvm.sub"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.sub@.
sub :: () => MonadBlockBuilder m => Value -> Value -> m Value
sub :: Value -> Value -> m Value
sub  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.sub"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

pattern InternalSwitchOpAttributes :: () => () => [Int] -> Maybe [Int] -> NamedAttributes
pattern $bInternalSwitchOpAttributes :: [Int] -> Maybe [Int] -> Map Name Attribute
$mInternalSwitchOpAttributes :: forall r.
Map Name Attribute
-> ([Int] -> Maybe [Int] -> r) -> (Void# -> r) -> r
InternalSwitchOpAttributes case_operand_segments_ branch_weights_ <- ((\m -> (M.lookup "case_operand_segments" m, M.lookup "branch_weights" m)) -> (Just (PatternUtil.I32ArrayAttr case_operand_segments_), OptionalDenseI32ArrayAttr branch_weights_))
  where InternalSwitchOpAttributes [Int]
case_operand_segments_ Maybe [Int]
branch_weights_ = [(Name, Attribute)] -> Map Name Attribute
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Attribute)] -> Map Name Attribute)
-> [(Name, Attribute)] -> Map Name Attribute
forall a b. (a -> b) -> a -> b
$ [(Name
"case_operand_segments", [Int] -> Attribute
PatternUtil.I32ArrayAttr [Int]
case_operand_segments_)] [(Name, Attribute)] -> [(Name, Attribute)] -> [(Name, Attribute)]
forall a. [a] -> [a] -> [a]
++ (Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Name, Attribute) -> [(Name, Attribute)])
-> Maybe (Name, Attribute) -> [(Name, Attribute)]
forall a b. (a -> b) -> a -> b
$ (Name
"branch_weights",) (Attribute -> (Name, Attribute))
-> Maybe Attribute -> Maybe (Name, Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int] -> Maybe Attribute
OptionalDenseI32ArrayAttr Maybe [Int]
branch_weights_)

-- | A pattern for @llvm.trunc@.
pattern Trunc :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bTrunc :: Location -> Type -> operand -> AbstractOperation operand
$mTrunc :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
Trunc loc ty0 arg_  = Operation
          { opName = "llvm.trunc"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.trunc@.
trunc :: () => MonadBlockBuilder m => Type -> Value -> m Value
trunc :: Type -> Value -> m Value
trunc Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.trunc"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.udiv@.
pattern UDiv :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bUDiv :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mUDiv :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
UDiv loc ty lhs_ rhs_  = Operation
          { opName = "llvm.udiv"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.udiv@.
udiv :: () => MonadBlockBuilder m => Value -> Value -> m Value
udiv :: Value -> Value -> m Value
udiv  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.udiv"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.uitofp@.
pattern UIToFP :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bUIToFP :: Location -> Type -> operand -> AbstractOperation operand
$mUIToFP :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
UIToFP loc ty0 arg_  = Operation
          { opName = "llvm.uitofp"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.uitofp@.
uitofp :: () => MonadBlockBuilder m => Type -> Value -> m Value
uitofp :: Type -> Value -> m Value
uitofp Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.uitofp"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.urem@.
pattern URem :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bURem :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mURem :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
URem loc ty lhs_ rhs_  = Operation
          { opName = "llvm.urem"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.urem@.
urem :: () => MonadBlockBuilder m => Value -> Value -> m Value
urem :: Value -> Value -> m Value
urem  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.urem"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * mlir.undef
-- $mlir.undef
-- 
-- Unlike LLVM IR, MLIR does not have first-class undefined values. Such values
-- must be created as SSA values using @llvm.mlir.undef@. This operation has no
-- operands or attributes. It creates an undefined value of the specified LLVM
-- IR dialect type.
-- 
-- Example:
-- 
-- @
-- // Create a structure with a 32-bit integer followed by a float.
-- %0 = llvm.mlir.undef : !llvm.struct\<(i32, f32)>
-- @
--   

-- | A pattern for @llvm.mlir.undef@.
pattern Undef :: () => () => Location -> Type -> AbstractOperation operand
pattern $bUndef :: Location -> Type -> AbstractOperation operand
$mUndef :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> r) -> (Void# -> r) -> r
Undef loc ty0   = Operation
          { opName = "llvm.mlir.undef"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = []
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.mlir.undef@.
mlir_undef :: () => MonadBlockBuilder m => Type -> m Value
mlir_undef :: Type -> m Value
mlir_undef Type
ty0    = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.mlir.undef"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = []
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.unreachable@.
pattern Unreachable :: () => () => Location -> AbstractOperation operand
pattern $bUnreachable :: Location -> AbstractOperation operand
$mUnreachable :: forall r operand.
AbstractOperation operand -> (Location -> r) -> (Void# -> r) -> r
Unreachable loc    = Operation
          { opName = "llvm.unreachable"
          , opLocation = loc
          , opResultTypes = Explicit []
          , opOperands = []
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.unreachable@.
unreachable :: () => MonadBlockBuilder m => m EndOfBlock
unreachable :: m EndOfBlock
unreachable     = do
  m [Value] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Control.Monad.void (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.unreachable"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit []
          , opOperands :: [Name]
opOperands = []
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))
  m EndOfBlock
forall (m :: * -> *). Monad m => m EndOfBlock
AST.terminateBlock

-- | A pattern for @llvm.va_arg@.
pattern VaArg :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bVaArg :: Location -> Type -> operand -> AbstractOperation operand
$mVaArg :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
VaArg loc ty0 arg_  = Operation
          { opName = "llvm.va_arg"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.va_arg@.
va_arg :: () => MonadBlockBuilder m => Type -> Value -> m Value
va_arg :: Type -> Value -> m Value
va_arg Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.va_arg"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.xor@.
pattern XOr :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bXOr :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mXOr :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
XOr loc ty lhs_ rhs_  = Operation
          { opName = "llvm.xor"
          , opLocation = loc
          , opResultTypes = Explicit [ty]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.xor@.
xor :: () => MonadBlockBuilder m => Value -> Value -> m Value
xor :: Value -> Value -> m Value
xor  Value
lhs_ Value
rhs_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.xor"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [(Value -> Type
AST.typeOf Value
lhs_)]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
lhs_), (Value -> Name
AST.operand Value
rhs_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @llvm.zext@.
pattern ZExt :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bZExt :: Location -> Type -> operand -> AbstractOperation operand
$mZExt :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
ZExt loc ty0 arg_  = Operation
          { opName = "llvm.zext"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.zext@.
zext :: () => MonadBlockBuilder m => Type -> Value -> m Value
zext :: Type -> Value -> m Value
zext Type
ty0 Value
arg_   = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.zext"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * mlir.zero
-- $mlir.zero
-- 
-- Unlike LLVM IR, MLIR does not have first-class zero-initialized values.
-- Such values must be created as SSA values using @llvm.mlir.zero@. This
-- operation has no operands or attributes. It creates a zero-initialized
-- value of the specified LLVM IR dialect type.
-- 
-- Example:
-- 
-- @
-- // Create a zero-initialized value for a structure with a 32-bit integer
-- // followed by a float.
-- %0 = llvm.mlir.zero : !llvm.struct\<(i32, f32)>
-- @
--   

-- | A pattern for @llvm.mlir.zero@.
pattern Zero :: () => () => Location -> Type -> AbstractOperation operand
pattern $bZero :: Location -> Type -> AbstractOperation operand
$mZero :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> r) -> (Void# -> r) -> r
Zero loc ty0   = Operation
          { opName = "llvm.mlir.zero"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = []
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @llvm.mlir.zero@.
mlir_zero :: () => MonadBlockBuilder m => Type -> m Value
mlir_zero :: Type -> m Value
mlir_zero Type
ty0    = do
  ([Value] -> Value) -> m [Value] -> m Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Control.Monad.liftM [Value] -> Value
forall a. [a] -> a
Prelude.head (Operation -> m [Value]
forall (m :: * -> *). MonadBlockBuilder m => Operation -> m [Value]
AST.emitOp (Operation :: forall operand.
Name
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [Name]
-> Map Name Attribute
-> AbstractOperation operand
Operation
          { opName :: Name
opName = Name
"llvm.mlir.zero"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = []
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))