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

module MLIR.AST.Dialect.Generated.Shape 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

-- * add
-- $add
-- 
-- Adds two sizes or indices. If either operand is an error it will be
-- propagated to the result. The operands can be of type @size@ or @index@. If
-- at least one of the operands can hold an error, i.e. if it is of type
-- @size@, the result must be of type @size@. If error propagation is not
-- possible because both operands are of type @index@ then the result may be
-- of type @size@ or @index@.
--   

-- | A pattern for @shape.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 ty0 lhs_ rhs_  = Operation
          { opName = "shape.add"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.add@.
add :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
add :: Type -> Value -> Value -> m Value
add Type
ty0 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
"shape.add"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , 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)
          }))

-- * any
-- $any
-- 
-- This operation takes multiple input shapes or extent tensors and returns
-- some combination of their dimensions. This can be best seen with examples
-- below.
-- 
-- The result is undefined, but still side-effect free, in cases where the
-- inputs have differing ranks or differ in extents of shared dimensions.
-- 
-- Example:
-- @
-- %s0 = shape.any [2,?], [?,3] // [2,3]
-- %s1 = shape.any [?,?], [1,2] // [1,2]
-- @
--   

-- | A pattern for @shape.any@.
pattern Any :: () => () => Location -> Type -> [operand] -> AbstractOperation operand
pattern $bAny :: Location -> Type -> [operand] -> AbstractOperation operand
$mAny :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> r) -> (Void# -> r) -> r
Any loc ty0 inputs_  = Operation
          { opName = "shape.any"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = inputs_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.any@.
any :: () => MonadBlockBuilder m => Type -> [Value] -> m Value
any :: Type -> [Value] -> m Value
any Type
ty0 [Value]
inputs_   = 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
"shape.any"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
inputs_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * assuming_all
-- $assuming_all
-- 
-- Used to simplify constraints as any single failing precondition is enough
-- to prevent execution.
-- 
-- \"assuming\" operations represent an execution order restriction to the
-- compiler, information for dependent code to rely on (by assuming), and
-- nothing else. They should not exist after a program is fully lowered and
-- ready to execute.
-- 
-- Example:
-- @
-- %w0 = shape.cstr_broadcastable [2,2], [3,1,2] // Passing
-- %w1 = shape.cstr_broadcastable [2,2], [3,2] // Failure
-- %w2 = shape.cstr_eq [1,2], [1,2], [1,2] // Passing
-- %wf = shape.assuming_all %w0, %w1 // Failure
-- %wt = shape.assuming_all %w0, %w2 // Passing
-- @
--   

-- | A pattern for @shape.assuming_all@.
pattern AssumingAll :: () => () => Location -> Type -> [operand] -> AbstractOperation operand
pattern $bAssumingAll :: Location -> Type -> [operand] -> AbstractOperation operand
$mAssumingAll :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> r) -> (Void# -> r) -> r
AssumingAll loc ty0 inputs_  = Operation
          { opName = "shape.assuming_all"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = inputs_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.assuming_all@.
assuming_all :: () => MonadBlockBuilder m => Type -> [Value] -> m Value
assuming_all :: Type -> [Value] -> m Value
assuming_all Type
ty0 [Value]
inputs_   = 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
"shape.assuming_all"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
inputs_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * assuming
-- $assuming
-- 
-- Executes the region assuming all witnesses are true.
-- 
-- \"assuming\" operations represent an execution order restriction to the
-- compiler, information for dependent code to rely on (by assuming), and
-- nothing else. They should not exist after a program is fully lowered and
-- ready to execute.
--   

-- | A builder for @shape.assuming@.
assuming :: () => MonadBlockBuilder m => [Type] -> Value -> RegionBuilderT m () -> m Value
assuming :: [Type] -> Value -> RegionBuilderT m () -> m Value
assuming [Type]
ty0 Value
witness_  RegionBuilderT m ()
doRegion_Builder = do
  Region
doRegion_ <- RegionBuilderT m () -> m Region
forall (m :: * -> *). Monad m => RegionBuilderT m () -> m Region
AST.buildRegion RegionBuilderT m ()
doRegion_Builder
  ([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
"shape.assuming"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit ([Type]
ty0)
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
witness_)]
          , opRegions :: [Region]
opRegions = [Region
doRegion_]
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * assuming_yield
-- $assuming_yield
-- 
-- This yield operation represents a return operation within the
-- @shape.assuming@ operation region. The operation takes variable number of
-- operands and produces no results. The operand number and types must match
-- the number and types of parent @shape.assuming@ results.
--   

-- | A pattern for @shape.assuming_yield@.
pattern AssumingYield :: () => () => Location -> [operand] -> AbstractOperation operand
pattern $bAssumingYield :: Location -> [operand] -> AbstractOperation operand
$mAssumingYield :: forall r operand.
AbstractOperation operand
-> (Location -> [operand] -> r) -> (Void# -> r) -> r
AssumingYield loc  operands_  = Operation
          { opName = "shape.assuming_yield"
          , opLocation = loc
          , opResultTypes = Explicit []
          , opOperands = operands_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.assuming_yield@.
assuming_yield :: () => MonadBlockBuilder m => [Value] -> m EndOfBlock
assuming_yield :: [Value] -> m EndOfBlock
assuming_yield  [Value]
operands_   = 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
"shape.assuming_yield"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit []
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
operands_)
          , 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

-- * broadcast
-- $broadcast
-- 
-- Returns the broadcasted shape for input shapes or extent tensors. The rest
-- of this description is simplified for the 2 input case but can be extended
-- to more inputs. Both operands can be of type @shape.shape@ or
-- @tensor\<?xindex>@. The result is of type @shape.shape@ and, if both
-- operands are tensors, may be of type @tensor\<?xindex>@.
-- 
-- If the two operand shapes are of different rank the smaller one is padded
-- with 1\'s from the left. The resulting broadcasted shape is then defined as
-- 
--     result[i] = lhs[i] if lhs[i] == rhs[i]
--               = lhs[i] if rhs[i] == 1
--               = rhs[i] if lhs[i] == 1.
-- 
-- In case the resulting shape is undefined, i.e. if corresponding extents are
-- different from each other but none is 1, the result is an error shape.
-- Likewise error values are propagated if any of the operands holds an error
-- value. If the result type is an extent tensor (and can therefore not hold
-- the error value) the behavior may be undefined. The optional string
-- attribute can be used to describe the error case.
--   

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 InternalBroadcastOpAttributes :: () => () => Maybe BS.ByteString -> NamedAttributes
pattern $bInternalBroadcastOpAttributes :: Maybe Name -> Map Name Attribute
$mInternalBroadcastOpAttributes :: forall r.
Map Name Attribute -> (Maybe Name -> r) -> (Void# -> r) -> r
InternalBroadcastOpAttributes error_ <- ((\m -> (M.lookup "error" m)) -> (OptionalStrAttr error_))
  where InternalBroadcastOpAttributes Maybe Name
error_ = [(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
"error",) (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
error_)

-- | A pattern for @shape.broadcast@.
pattern Broadcast :: () => () => Location -> Type -> [operand] -> Maybe BS.ByteString -> AbstractOperation operand
pattern $bBroadcast :: Location
-> Type -> [operand] -> Maybe Name -> AbstractOperation operand
$mBroadcast :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> Maybe Name -> r)
-> (Void# -> r)
-> r
Broadcast loc ty0 shapes_ error_ = Operation
          { opName = "shape.broadcast"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = shapes_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalBroadcastOpAttributes error_)
          }

-- | A builder for @shape.broadcast@.
broadcast :: () => MonadBlockBuilder m => Type -> [Value] -> Maybe BS.ByteString -> m Value
broadcast :: Type -> [Value] -> Maybe Name -> m Value
broadcast Type
ty0 [Value]
shapes_ Maybe Name
error_  = 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
"shape.broadcast"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
shapes_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Maybe Name -> Map Name Attribute
InternalBroadcastOpAttributes Maybe Name
error_)
          }))

-- * concat
-- $concat
-- 
-- Creates a shape whose dimensions consist of first the dimensions from @lhs@
-- followed by the dimensions of @rhs@.
-- 
-- Example:
-- concat([2,3], [4,5]) -> [2,3,4,5]
-- concat([], []) -> []
-- concat([], [4,5,6]) -> [4,5,6]
--   

-- | A pattern for @shape.concat@.
pattern Concat :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bConcat :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mConcat :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Concat loc ty0 lhs_ rhs_  = Operation
          { opName = "shape.concat"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.concat@.
concat :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
concat :: Type -> Value -> Value -> m Value
concat Type
ty0 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
"shape.concat"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , 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)
          }))

-- * const_shape
-- $const_shape
-- 
-- Creates a constant shape or extent tensor. The individual extents are given
-- as the @shape@ attribute. The number of these values equals the shape\'s
-- rank.
-- 
-- @
-- %0 = shape.const_shape [] : !shape.shape
-- %1 = shape.const_shape [1, 2, 3] : !shape.shape
-- %2 = shape.const_shape [4, 5, 6] : tensor\<3xindex>
-- @
--   

-- * const_size
-- $const_size
-- 
-- Creates a @shape.size@ type representing the constant size given by @value@.
-- 
-- @
-- %x = shape.const_size 10
-- @
--   

pattern InternalConstSizeOpAttributes :: () => () => Int -> NamedAttributes
pattern $bInternalConstSizeOpAttributes :: Int -> Map Name Attribute
$mInternalConstSizeOpAttributes :: forall r. Map Name Attribute -> (Int -> r) -> (Void# -> r) -> r
InternalConstSizeOpAttributes value_ <- ((\m -> (M.lookup "value" m)) -> (Just (IntegerAttr IndexType value_)))
  where InternalConstSizeOpAttributes Int
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", Type -> Int -> Attribute
IntegerAttr Type
IndexType Int
value_)]

-- | A pattern for @shape.const_size@.
pattern ConstSize :: () => () => Location -> Type -> Int -> AbstractOperation operand
pattern $bConstSize :: Location -> Type -> Int -> AbstractOperation operand
$mConstSize :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> Int -> r) -> (Void# -> r) -> r
ConstSize loc ty0  value_ = Operation
          { opName = "shape.const_size"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = []
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalConstSizeOpAttributes value_)
          }

-- | A builder for @shape.const_size@.
const_size :: () => MonadBlockBuilder m => Type -> Int -> m Value
const_size :: Type -> Int -> m Value
const_size Type
ty0  Int
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
"shape.const_size"
          , 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 = (Int -> Map Name Attribute
InternalConstSizeOpAttributes Int
value_)
          }))

-- * const_witness
-- $const_witness
-- 
-- This operation represents a statically known witness result. This can be
-- often used to canonicalize/fold constraint and assuming code that will always
-- pass.
-- 
-- @
-- %0 = shape.const_shape [1,2,3]
-- %1 = shape.const_shape [1,2,3]
-- %w0 = shape.cstr_eq(%0, %1) // Can be folded to \"const_witness true\"
-- %w1 = shape.const_witness true
-- %w2 = shape.assuming_all(%w0, %w2) // Can be folded to \"const_witness true\"
-- @
-- 

pattern InternalConstWitnessOpAttributes :: () => () => Bool -> NamedAttributes
pattern $bInternalConstWitnessOpAttributes :: Bool -> Map Name Attribute
$mInternalConstWitnessOpAttributes :: forall r. Map Name Attribute -> (Bool -> r) -> (Void# -> r) -> r
InternalConstWitnessOpAttributes passing_ <- ((\m -> (M.lookup "passing" m)) -> (Just (BoolAttr passing_)))
  where InternalConstWitnessOpAttributes Bool
passing_ = [(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
"passing", Bool -> Attribute
BoolAttr Bool
passing_)]

-- | A pattern for @shape.const_witness@.
pattern ConstWitness :: () => () => Location -> Type -> Bool -> AbstractOperation operand
pattern $bConstWitness :: Location -> Type -> Bool -> AbstractOperation operand
$mConstWitness :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> Bool -> r) -> (Void# -> r) -> r
ConstWitness loc ty0  passing_ = Operation
          { opName = "shape.const_witness"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = []
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalConstWitnessOpAttributes passing_)
          }

-- | A builder for @shape.const_witness@.
const_witness :: () => MonadBlockBuilder m => Type -> Bool -> m Value
const_witness :: Type -> Bool -> m Value
const_witness Type
ty0  Bool
passing_  = 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
"shape.const_witness"
          , 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 = (Bool -> Map Name Attribute
InternalConstWitnessOpAttributes Bool
passing_)
          }))

-- * cstr_broadcastable
-- $cstr_broadcastable
-- 
-- Given input shapes or extent tensors, return a witness specifying if they
-- are broadcastable. This broadcastable follows the same logic as what
-- shape.broadcast documents.
-- 
-- \"cstr\" operations represent runtime assertions.
-- 
-- Example:
-- @
-- %w0 = shape.cstr_broadcastable [2,2], [3,1,2] // Passing
-- %w1 = shape.cstr_broadcastable [2,2], [3,2] // Failure
-- @
--   

-- | A pattern for @shape.cstr_broadcastable@.
pattern CstrBroadcastable :: () => () => Location -> Type -> [operand] -> AbstractOperation operand
pattern $bCstrBroadcastable :: Location -> Type -> [operand] -> AbstractOperation operand
$mCstrBroadcastable :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> r) -> (Void# -> r) -> r
CstrBroadcastable loc ty0 shapes_  = Operation
          { opName = "shape.cstr_broadcastable"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = shapes_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.cstr_broadcastable@.
cstr_broadcastable :: () => MonadBlockBuilder m => Type -> [Value] -> m Value
cstr_broadcastable :: Type -> [Value] -> m Value
cstr_broadcastable Type
ty0 [Value]
shapes_   = 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
"shape.cstr_broadcastable"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
shapes_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * cstr_eq
-- $cstr_eq
-- 
-- Given 1 or more input shapes, determine if all shapes are the exact same.
-- 
-- \"cstr\" operations represent runtime assertions.
-- 
-- Example:
-- @
-- %w0 = shape.cstr_eq [1,2], [1,2], [1,2] // Passing
-- %w1 = shape.cstr_eq [2,2], [1,2] // Failure
-- @
--   

-- | A pattern for @shape.cstr_eq@.
pattern CstrEq :: () => () => Location -> Type -> [operand] -> AbstractOperation operand
pattern $bCstrEq :: Location -> Type -> [operand] -> AbstractOperation operand
$mCstrEq :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> r) -> (Void# -> r) -> r
CstrEq loc ty0 shapes_  = Operation
          { opName = "shape.cstr_eq"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = shapes_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.cstr_eq@.
cstr_eq :: () => MonadBlockBuilder m => Type -> [Value] -> m Value
cstr_eq :: Type -> [Value] -> m Value
cstr_eq Type
ty0 [Value]
shapes_   = 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
"shape.cstr_eq"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
shapes_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * cstr_require
-- $cstr_require
-- 
-- Represents a runtime assertion that an i1 is true. It returns a
-- !shape.witness to order this assertion.
-- 
-- For simplicity, prefer using other cstr_* ops if they are available for a
-- given constraint.
-- 
-- Example:
-- @
-- %bool = ...
-- %w0 = shape.cstr_require %bool, \"msg\" // Passing if @%bool@ is true.
-- @
-- 
-- Since this op can be used to express many different possible assertions
-- (depending on whatever computation calculated @pred@), the @msg@
-- should clarify the nature of the assertion for users.
--   

pattern InternalCstrRequireOpAttributes :: () => () => BS.ByteString -> NamedAttributes
pattern $bInternalCstrRequireOpAttributes :: Name -> Map Name Attribute
$mInternalCstrRequireOpAttributes :: forall r. Map Name Attribute -> (Name -> r) -> (Void# -> r) -> r
InternalCstrRequireOpAttributes msg_ <- ((\m -> (M.lookup "msg" m)) -> (Just (StringAttr msg_)))
  where InternalCstrRequireOpAttributes Name
msg_ = [(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
"msg", Name -> Attribute
StringAttr Name
msg_)]

-- | A pattern for @shape.cstr_require@.
pattern CstrRequire :: () => () => Location -> Type -> operand -> BS.ByteString -> AbstractOperation operand
pattern $bCstrRequire :: Location -> Type -> operand -> Name -> AbstractOperation operand
$mCstrRequire :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> Name -> r) -> (Void# -> r) -> r
CstrRequire loc ty0 pred_ msg_ = Operation
          { opName = "shape.cstr_require"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [pred_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalCstrRequireOpAttributes msg_)
          }

-- | A builder for @shape.cstr_require@.
cstr_require :: () => MonadBlockBuilder m => Type -> Value -> BS.ByteString -> m Value
cstr_require :: Type -> Value -> Name -> m Value
cstr_require Type
ty0 Value
pred_ Name
msg_  = 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
"shape.cstr_require"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
pred_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Name -> Map Name Attribute
InternalCstrRequireOpAttributes Name
msg_)
          }))

-- * debug_print
-- $debug_print
-- 
-- Prints the input dim or shape and passes through input.
-- 
-- Note: This is intended for testing and debugging only.
--   

-- | A pattern for @shape.debug_print@.
pattern DebugPrint :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bDebugPrint :: Location -> Type -> operand -> AbstractOperation operand
$mDebugPrint :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
DebugPrint loc ty0 input_  = Operation
          { opName = "shape.debug_print"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [input_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.debug_print@.
debug_print :: () => MonadBlockBuilder m => Type -> Value -> m Value
debug_print :: Type -> Value -> m Value
debug_print Type
ty0 Value
input_   = 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
"shape.debug_print"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
input_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * dim
-- $dim
-- 
-- Gets the extent indexed by @dim@ from the shape of the @value@ operand. If
-- the index is error or out-of-bound then it returns an invalid size if the
-- return type carries error information else the behavior is undefined.
-- 
-- This is a convenience op that performs the equivalent of getting the extent
-- of a shape (e.g., @dim(x, i) == get_extent(shape_of(x), i)@).
--   

-- | A pattern for @shape.dim@.
pattern Dim :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bDim :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mDim :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Dim loc ty0 value_ index_  = Operation
          { opName = "shape.dim"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [value_, index_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.dim@.
dim :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
dim :: Type -> Value -> Value -> m Value
dim Type
ty0 Value
value_ Value
index_   = 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
"shape.dim"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
value_), (Value -> Name
AST.operand Value
index_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * div
-- $div
-- 
-- Divides two sizes or indices. If either operand is an error it will be
-- propagated to the result. The operands can be of type @size@ or @index@.
-- If at least one of the operands can hold an error, i.e. if it is of type
-- @size@, the result must be of type @size@. If error propagation is not
-- possible because both operands are of type @index@ then the result may be
-- of type  @size@ or @index@. If both operands and result are of type
-- @index@, their runtime values could be negative. The result is rounded
-- toward negative infinity, i.e. floor(lhs / rhs), such that
-- 
--     div(lhs, rhs) * rhs + mod(lhs, rhs) = lhs
-- 
-- always holds. If any of the values is of type @size@, the behavior for
-- negative value is undefined.
--   

-- | A pattern for @shape.div@.
pattern Div :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bDiv :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mDiv :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Div loc ty0 lhs_ rhs_  = Operation
          { opName = "shape.div"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.div@.
div :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
div :: Type -> Value -> Value -> m Value
div Type
ty0 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
"shape.div"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , 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)
          }))

-- * from_extent_tensor
-- $from_extent_tensor
-- 
-- Creates a shape from a 1D integral tensor of extents. The rank of the
-- resulting shape equals the number of elements in the tensor, and the
-- extents match the values of the elements.
--   

-- | A pattern for @shape.from_extent_tensor@.
pattern FromExtentTensor :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bFromExtentTensor :: Location -> Type -> operand -> AbstractOperation operand
$mFromExtentTensor :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
FromExtentTensor loc ty0 input_  = Operation
          { opName = "shape.from_extent_tensor"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [input_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.from_extent_tensor@.
from_extent_tensor :: () => MonadBlockBuilder m => Type -> Value -> m Value
from_extent_tensor :: Type -> Value -> m Value
from_extent_tensor Type
ty0 Value
input_   = 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
"shape.from_extent_tensor"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
input_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * from_extents
-- $from_extents
-- 
-- Creates a shape from multiple SSA values representing the extents of
-- the shape.
-- 
-- @
-- // Rank 2 shape.
-- %s0 = shape.from_extents %a, %b
-- // Rank 0 shape.
-- %s1 = shape.from_extents
-- @
--   

-- | A pattern for @shape.from_extents@.
pattern FromExtents :: () => () => Location -> Type -> [operand] -> AbstractOperation operand
pattern $bFromExtents :: Location -> Type -> [operand] -> AbstractOperation operand
$mFromExtents :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> r) -> (Void# -> r) -> r
FromExtents loc ty0 extents_  = Operation
          { opName = "shape.from_extents"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = extents_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.from_extents@.
from_extents :: () => MonadBlockBuilder m => Type -> [Value] -> m Value
from_extents :: Type -> [Value] -> m Value
from_extents Type
ty0 [Value]
extents_   = 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
"shape.from_extents"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
extents_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * func
-- $func
-- 
-- An operation with a name containing a single @SSACFG@ region which
-- represents a shape transfer function or helper function for shape transfer
-- function.
--   

-- * function_library
-- $function_library
-- 
-- Represents a list of shape functions and the ops whose shape transfer
-- functions they represent.
-- 
-- Example:
-- 
-- @
-- shape.function_library {
--   func \@same_result_shape(%arg: !shape.value_shape) -> !shape.shape {
--     %0 = shape_of %arg : !shape.value_shape -> !shape.shape
--     return %0 : !shape.shape
--   }
-- } mapping {
--   std.atan = \@same_result_shape
-- }
-- @
--   

-- * get_extent
-- $get_extent
-- 
-- Gets the extent indexed by @dim@ from the @shape@ operand. If the shape is
-- an error then it returns an invalid size.
--   

-- | A pattern for @shape.get_extent@.
pattern GetExtent :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bGetExtent :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mGetExtent :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
GetExtent loc ty0 shape_ dim_  = Operation
          { opName = "shape.get_extent"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [shape_, dim_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.get_extent@.
get_extent :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
get_extent :: Type -> Value -> Value -> m Value
get_extent Type
ty0 Value
shape_ Value
dim_   = 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
"shape.get_extent"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
shape_), (Value -> Name
AST.operand Value
dim_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * index_to_size
-- $index_to_size
-- 
-- Converts a standard index to a @shape.size@. This operation and its
-- inverse, @size_to_index@, facilitate index conversion between the standard
-- and the shape dialect.
-- 
-- The behavior is undefined for negative indices.
--   

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

-- | A builder for @shape.index_to_size@.
index_to_size :: () => MonadBlockBuilder m => Type -> Value -> m Value
index_to_size :: Type -> Value -> m Value
index_to_size 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
"shape.index_to_size"
          , 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)
          }))

-- * is_broadcastable
-- $is_broadcastable
-- 
-- Given multiple input shapes or extent tensors, return a predicate
-- specifying if they are broadcastable. This broadcastable follows the same
-- logic as what shape.broadcast documents.
-- 
-- Concretely, shape.is_broadcastable returning true implies that
-- shape.broadcast will not give an error, and shape.cstr_broadcastable will
-- not result in an assertion failure. Similarly, false implies an error or
-- assertion failure.
-- 
-- Example:
-- @
-- %true = shape.is_broadcastable [2,2], [3,1,2]
-- %false = shape.is_broadcastable [2,2], [3,2]
-- @
--   

-- | A pattern for @shape.is_broadcastable@.
pattern IsBroadcastable :: () => () => Location -> Type -> [operand] -> AbstractOperation operand
pattern $bIsBroadcastable :: Location -> Type -> [operand] -> AbstractOperation operand
$mIsBroadcastable :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> r) -> (Void# -> r) -> r
IsBroadcastable loc ty0 shapes_  = Operation
          { opName = "shape.is_broadcastable"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = shapes_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.is_broadcastable@.
is_broadcastable :: () => MonadBlockBuilder m => Type -> [Value] -> m Value
is_broadcastable :: Type -> [Value] -> m Value
is_broadcastable Type
ty0 [Value]
shapes_   = 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
"shape.is_broadcastable"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
shapes_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * max
-- $max
-- 
-- Computes the elementwise maximum of two sizes or shapes with equal ranks.
-- If either operand is an error, then an error will be propagated to the
-- result. If the input types mismatch or the ranks do not match, then the
-- result is an error.
--   

-- | A pattern for @shape.max@.
pattern Max :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bMax :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mMax :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Max loc ty0 lhs_ rhs_  = Operation
          { opName = "shape.max"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.max@.
max :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
max :: Type -> Value -> Value -> m Value
max Type
ty0 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
"shape.max"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , 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)
          }))

-- * meet
-- $meet
-- 
-- An operation that computes the least general shape or dim of input operands.
-- This effectively asserts that corresponding static dimensions are equal.
-- The behavior is to match each element of the shape/size and propagate the
-- most restrictive information, returning an invalid shape if there are
-- contradictory requirements. E.g., using pseudo code
-- 
-- @
-- shape.meet([*], [*]) -> [*]
-- shape.meet([*], [1, ?]) -> [1, ?]
-- shape.meet([1, 2], [1, ?]) -> [1, 2]
-- shape.meet([*], [1, 2]) -> [1, 2]
-- shape.meet([], []) -> []
-- shape.meet([], [*]) -> []
-- shape.meet([], [?, ?]) -> [invalid]
-- shape.meet([1, ?], [2, ?, ?]) -> [invalid]
-- @
-- 
-- @shape.meet@ also allows specifying an optional error string, that may be
-- used to return an error to the user upon mismatch of dimensions.
-- 
-- @
-- %c = shape.meet %a, %b, error=\"\<reason>\" : !shape.shape, !shape.shape -> !shape.shape
-- @
--   

pattern InternalMeetOpAttributes :: () => () => Maybe BS.ByteString -> NamedAttributes
pattern $bInternalMeetOpAttributes :: Maybe Name -> Map Name Attribute
$mInternalMeetOpAttributes :: forall r.
Map Name Attribute -> (Maybe Name -> r) -> (Void# -> r) -> r
InternalMeetOpAttributes error_ <- ((\m -> (M.lookup "error" m)) -> (OptionalStrAttr error_))
  where InternalMeetOpAttributes Maybe Name
error_ = [(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
"error",) (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
error_)

-- | A pattern for @shape.meet@.
pattern Meet :: () => () => Location -> Type -> operand -> operand -> Maybe BS.ByteString -> AbstractOperation operand
pattern $bMeet :: Location
-> Type
-> operand
-> operand
-> Maybe Name
-> AbstractOperation operand
$mMeet :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> Maybe Name -> r)
-> (Void# -> r)
-> r
Meet loc ty0 arg0_ arg1_ error_ = Operation
          { opName = "shape.meet"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [arg0_, arg1_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalMeetOpAttributes error_)
          }

-- | A builder for @shape.meet@.
meet :: () => MonadBlockBuilder m => Type -> Value -> Value -> Maybe BS.ByteString -> m Value
meet :: Type -> Value -> Value -> Maybe Name -> m Value
meet Type
ty0 Value
arg0_ Value
arg1_ Maybe Name
error_  = 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
"shape.meet"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
arg0_), (Value -> Name
AST.operand Value
arg1_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Maybe Name -> Map Name Attribute
InternalMeetOpAttributes Maybe Name
error_)
          }))

-- * min
-- $min
-- 
-- Computes the elementwise minimum of two sizes or shapes with equal ranks.
-- If either operand is an error, then an error will be propagated to the
-- result. If the input types mismatch or the ranks do not match, then the
-- result is an error.
--   

-- | A pattern for @shape.min@.
pattern Min :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bMin :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mMin :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
Min loc ty0 lhs_ rhs_  = Operation
          { opName = "shape.min"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.min@.
min :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
min :: Type -> Value -> Value -> m Value
min Type
ty0 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
"shape.min"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , 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)
          }))

-- * mul
-- $mul
-- 
-- Multiplies two sizes or indices. If either operand is an error it will be
-- propagated to the result. The operands can be of type @size@ or @index@. If
-- at least one of the operands can hold an error, i.e. if it is of type
-- @size@, the result must be of type @size@. If error propagation is not
-- possible because both operands are of type @index@ then the result may be
-- of type @size@ or @index@.
--   

-- | A pattern for @shape.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 ty0 lhs_ rhs_  = Operation
          { opName = "shape.mul"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [lhs_, rhs_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.mul@.
mul :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
mul :: Type -> Value -> Value -> m Value
mul Type
ty0 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
"shape.mul"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , 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)
          }))

-- * num_elements
-- $num_elements
-- 
-- Returns the number of elements for a given shape which is the product of
-- its extents. If the argument is of type @shape@ then the result will be of
-- type @size@ and potential errors will be propagated. Otherwise, if the
-- argument is and extent tensor @tensor\<?xindex>@ then the result will be of
-- type @index@.
--   

-- | A pattern for @shape.num_elements@.
pattern NumElements :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bNumElements :: Location -> Type -> operand -> AbstractOperation operand
$mNumElements :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
NumElements loc ty0 shape_  = Operation
          { opName = "shape.num_elements"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [shape_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.num_elements@.
num_elements :: () => MonadBlockBuilder m => Type -> Value -> m Value
num_elements :: Type -> Value -> m Value
num_elements Type
ty0 Value
shape_   = 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
"shape.num_elements"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
shape_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * rank
-- $rank
-- 
-- Returns the rank of the shape or extent tensor, i.e. the number of extents.
--   

-- | A pattern for @shape.rank@.
pattern Rank :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bRank :: Location -> Type -> operand -> AbstractOperation operand
$mRank :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
Rank loc ty0 shape_  = Operation
          { opName = "shape.rank"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [shape_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.rank@.
rank :: () => MonadBlockBuilder m => Type -> Value -> m Value
rank :: Type -> Value -> m Value
rank Type
ty0 Value
shape_   = 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
"shape.rank"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
shape_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * reduce
-- $reduce
-- 
-- An operation that takes as input a shape or extent tensor, and a number of
-- initial values. This operation has a region that is applied repeatedly for
-- every extent of the input. Starting with the initial values, the individual
-- extents are then aggregated as defined by the associated region.
-- 
-- Conceptually this op performs the following reduction:
-- 
-- @
-- res[] = init;
-- for (int i = 0, i \< shape.rank(); i++) {
--   res = reduce(i, shape[i], res[0], ..., res[n]);
-- }
-- @
-- 
-- Where @reduce@ represents the region attached and the result of the reduce
-- op is the last computed output of the reduce region. As an example, the
-- number of elements can be computed as follows:
-- 
-- @
-- func.func \@reduce(%shape : !shape.shape, %init : !shape.size) ->
--     !shape.size {
--   %num_elements = shape.reduce(%shape, %init) -> !shape.size  {
--     ^bb0(%index: index, %dim: !shape.size, %acc: !shape.size):
--       %updated_acc = \"shape.mul\"(%acc, %dim) :
--         (!shape.size, !shape.size) -> !shape.size
--       shape.yield %updated_acc : !shape.size
--   }
--   return %num_elements : !shape.size
-- }
-- @
--   

-- | A builder for @shape.reduce@.
reduce :: () => MonadBlockBuilder m => [Type] -> Value -> [Value] -> RegionBuilderT m () -> m Value
reduce :: [Type] -> Value -> [Value] -> RegionBuilderT m () -> m Value
reduce [Type]
ty0 Value
shape_ [Value]
initVals_  RegionBuilderT m ()
region_Builder = do
  Region
region_ <- RegionBuilderT m () -> m Region
forall (m :: * -> *). Monad m => RegionBuilderT m () -> m Region
AST.buildRegion RegionBuilderT m ()
region_Builder
  ([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
"shape.reduce"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit ([Type]
ty0)
          , opOperands :: [Name]
opOperands = ([(Value -> Name
AST.operand Value
shape_)] [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Value] -> [Name]
AST.operands [Value]
initVals_))
          , opRegions :: [Region]
opRegions = [Region
region_]
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * return
-- $return
-- 
-- The @shape.return@ operation represents a return operation within a
-- function.  The operation takes variable number of operands and produces no
-- results.
--   

-- | A pattern for @shape.return@.
pattern Return :: () => () => Location -> [operand] -> AbstractOperation operand
pattern $bReturn :: Location -> [operand] -> AbstractOperation operand
$mReturn :: forall r operand.
AbstractOperation operand
-> (Location -> [operand] -> r) -> (Void# -> r) -> r
Return loc  operands_  = Operation
          { opName = "shape.return"
          , opLocation = loc
          , opResultTypes = Explicit []
          , opOperands = operands_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.return@.
return :: () => MonadBlockBuilder m => [Value] -> m EndOfBlock
return :: [Value] -> m EndOfBlock
return  [Value]
operands_   = 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
"shape.return"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit []
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
operands_)
          , 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

-- * shape_eq
-- $shape_eq
-- 
-- Takes one or more shape or extent tensor operands and determines whether
-- they are equal. When extent tensors are compared to shapes they are
-- regarded as their equivalent non-error shapes. Error shapes can be tested
-- for equality like any other shape value, meaning that the error value is
-- equal to itself.
--   

-- | A pattern for @shape.shape_eq@.
pattern ShapeEq :: () => () => Location -> Type -> [operand] -> AbstractOperation operand
pattern $bShapeEq :: Location -> Type -> [operand] -> AbstractOperation operand
$mShapeEq :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> [operand] -> r) -> (Void# -> r) -> r
ShapeEq loc ty0 shapes_  = Operation
          { opName = "shape.shape_eq"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = shapes_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.shape_eq@.
shape_eq :: () => MonadBlockBuilder m => Type -> [Value] -> m Value
shape_eq :: Type -> [Value] -> m Value
shape_eq Type
ty0 [Value]
shapes_   = 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
"shape.shape_eq"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
shapes_)
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * shape_of
-- $shape_of
-- 
-- The operation takes a value or a shaped operand as an argument and it
-- returns a shape or extent tensor.
--   

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

-- | A builder for @shape.shape_of@.
shape_of :: () => MonadBlockBuilder m => Type -> Value -> m Value
shape_of :: Type -> Value -> m Value
shape_of 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
"shape.shape_of"
          , 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)
          }))

-- * size_to_index
-- $size_to_index
-- 
-- Converts a @shape.size@ to a standard index. This operation and its
-- inverse, @index_to_size@, facilitate index conversion between the standard
-- and the shape dialect. The behavior is undefined for unknown and invalid
-- arguments.
--   

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

-- | A builder for @shape.size_to_index@.
size_to_index :: () => MonadBlockBuilder m => Type -> Value -> m Value
size_to_index :: Type -> Value -> m Value
size_to_index 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
"shape.size_to_index"
          , 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)
          }))

-- * split_at
-- $split_at
-- 
-- Splits a shape at a given dimension @index@, returning two shapes. If
-- @index@ is negative, it is treated as indexing from the back of the shape.
-- This negative-handling behavior is important when handling unranked shapes,
-- where the positive index is not necessarily knowable due to a dynamic
-- number of leading dimensions. If the result is in extent tensor form out of
-- bounds indices result in undefined behavior.
-- 
-- Examples:
-- - split_at([4,5,6], index=0) -> [], [4,5,6]
-- - split_at([4,5,6], index=1) -> [4], [5,6]
-- - split_at([4,5,6], index=2) -> [4,5], [6]
-- - split_at([4,5,6], index=3) -> [4,5,6], []
-- - split_at([4,5,6], index=4) -> error
-- - split_at([4,5,6], index=-1) -> [4,5], [6]
-- - split_at([4,5,6], index=-2) -> [4], [5,6]
-- - split_at([4,5,6], index=-3) -> [], [4,5,6]
-- - split_at([4,5,6], index=-4) -> error
-- 
-- Requires:
-- - @index@ is in the range [-rank(operand),rank(operand)]
--   

-- | A pattern for @shape.split_at@.
pattern SplitAt :: () => () => Location -> Type -> Type -> operand -> operand -> AbstractOperation operand
pattern $bSplitAt :: Location
-> Type -> Type -> operand -> operand -> AbstractOperation operand
$mSplitAt :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
SplitAt loc ty0 ty1 operand_ index_  = Operation
          { opName = "shape.split_at"
          , opLocation = loc
          , opResultTypes = Explicit [ty0, ty1]
          , opOperands = [operand_, index_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.split_at@.
split_at :: () => MonadBlockBuilder m => Type -> Type -> Value -> Value -> m [Value]
split_at :: Type -> Type -> Value -> Value -> m [Value]
split_at Type
ty0 Type
ty1 Value
operand_ Value
index_   = do
  (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
"shape.split_at"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0, Type
ty1]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
operand_), (Value -> Name
AST.operand Value
index_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * to_extent_tensor
-- $to_extent_tensor
-- 
-- Converts a shape to a 1D integral tensor of extents. The number of elements
-- in the tensor equals the rank of the shape, and the elements equal the
-- extents of the shape.
-- 
-- If the shape represents an error, this op\'s behavior is undefined.
--   

-- | A pattern for @shape.to_extent_tensor@.
pattern ToExtentTensor :: () => () => Location -> Type -> operand -> AbstractOperation operand
pattern $bToExtentTensor :: Location -> Type -> operand -> AbstractOperation operand
$mToExtentTensor :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> r) -> (Void# -> r) -> r
ToExtentTensor loc ty0 input_  = Operation
          { opName = "shape.to_extent_tensor"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [input_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.to_extent_tensor@.
to_extent_tensor :: () => MonadBlockBuilder m => Type -> Value -> m Value
to_extent_tensor :: Type -> Value -> m Value
to_extent_tensor Type
ty0 Value
input_   = 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
"shape.to_extent_tensor"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
input_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- * value_as_shape
-- $value_as_shape
-- 
-- The operations takes a ValueShape and returns a Shape corresponding to the
-- value.  If the input value cannot be shape (e.g., not a 1D tensor of
-- integral value representing sizes) then this propagages the error shape.
-- E.g.,
-- 
-- @
-- // The following
-- %0 = arith.constant dense\<[1,2]> : tensor\<2xi32>
-- %shape = shape.value_as_shape %0 : tensor\<2xi32> -> !shape.shape
-- // is equivalent to
-- %shape\' = shape.const_shape [1, 2] : !shape.shape
-- @
-- 
-- This operation is the complement of @shape_of@ wrt ValueShape values.
--   

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

-- | A builder for @shape.value_as_shape@.
value_as_shape :: () => MonadBlockBuilder m => Type -> Value -> m Value
value_as_shape :: Type -> Value -> m Value
value_as_shape 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
"shape.value_as_shape"
          , 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)
          }))

-- * value_of
-- $value_of
-- 
-- The operation takes !shape.value_shape, a.k.a. (value, shape) tuple as an
-- argument, and returns its value. The behavior is undefined for unknown and
-- invalid arguments.
--   

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

-- | A builder for @shape.value_of@.
value_of :: () => MonadBlockBuilder m => Type -> Value -> m Value
value_of :: Type -> Value -> m Value
value_of 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
"shape.value_of"
          , 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)
          }))

-- * with_shape
-- $with_shape
-- 
-- Returns ValueShape with the shape updated to match the shape operand. That
-- is a new ValueShape tuple is created with value equal to @operand@\'s
-- value and shape equal to @shape@. If the ValueShape and given @shape@ are
-- non-conformant, then the returned ValueShape will represent an error of
-- this mismatch. Similarly if either inputs are in an error state, then an
-- error is propagated.
-- 
-- Usage:
--   %0 = shape.with_shape %1, %2 : tensor\<...>, !shape.shape
-- 
-- This is used, for example, where one combines shape function calculations
-- and/or call one shape function from another. E.g.,
-- 
-- @
-- func.func \@shape_foobah(%a: !shape.value_shape,
--                    %b: !shape.value_shape,
--                    %c: !shape.value_shape) -> !shape.shape {
--   %0 = call \@shape_foo(%a, %b) :
--     (!shape.value_shape, !shape.value_shape) -> !shape.shape
--   %1 = shape.with_shape %b, %0 : !shape.value_shape, !shape.shape
--   %2 = call \@shape_bah(%c, %1) :
--     (!shape.value_shape, !shape.value_shape) -> !shape.shape
--   return %2 : !shape.shape
-- }
-- @
-- 
-- This op need not be a refinement of the shape. In non-error cases the input
-- ValueShape\'s value and shape are conformant and so too for the output, but
-- the result may be less specified than @operand@\'s shape as @shape@ is
-- merely used to construct the new ValueShape. If join behavior is desired
-- then a join op should be used.
--   

-- | A pattern for @shape.with_shape@.
pattern With :: () => () => Location -> Type -> operand -> operand -> AbstractOperation operand
pattern $bWith :: Location -> Type -> operand -> operand -> AbstractOperation operand
$mWith :: forall r operand.
AbstractOperation operand
-> (Location -> Type -> operand -> operand -> r)
-> (Void# -> r)
-> r
With loc ty0 operand_ shape_  = Operation
          { opName = "shape.with_shape"
          , opLocation = loc
          , opResultTypes = Explicit [ty0]
          , opOperands = [operand_, shape_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.with_shape@.
with_shape :: () => MonadBlockBuilder m => Type -> Value -> Value -> m Value
with_shape :: Type -> Value -> Value -> m Value
with_shape Type
ty0 Value
operand_ Value
shape_   = 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
"shape.with_shape"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit [Type
ty0]
          , opOperands :: [Name]
opOperands = [(Value -> Name
AST.operand Value
operand_), (Value -> Name
AST.operand Value
shape_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [Name]
opSuccessors = []
          , opAttributes :: Map Name Attribute
opAttributes = (Map Name Attribute
NoAttrs)
          }))

-- | A pattern for @shape.yield@.
pattern Yield :: () => () => Location -> [operand] -> AbstractOperation operand
pattern $bYield :: Location -> [operand] -> AbstractOperation operand
$mYield :: forall r operand.
AbstractOperation operand
-> (Location -> [operand] -> r) -> (Void# -> r) -> r
Yield loc  operands_  = Operation
          { opName = "shape.yield"
          , opLocation = loc
          , opResultTypes = Explicit []
          , opOperands = operands_
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (NoAttrs)
          }

-- | A builder for @shape.yield@.
yield :: () => MonadBlockBuilder m => [Value] -> m EndOfBlock
yield :: [Value] -> m EndOfBlock
yield  [Value]
operands_   = 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
"shape.yield"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit []
          , opOperands :: [Name]
opOperands = ([Value] -> [Name]
AST.operands [Value]
operands_)
          , 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