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

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

-- * assert
-- $assert
-- 
-- Assert operation at runtime with single boolean operand and an error
-- message attribute.
-- If the argument is @true@ this operation has no effect. Otherwise, the
-- program execution will abort. The provided error message may be used by a
-- runtime to propagate the error to the user.
-- 
-- Example:
-- 
-- @
-- cf.assert %b, \"Expected ... to be true\"
-- @
--   

pattern InternalAssertOpAttributes :: () => () => BS.ByteString -> NamedAttributes
pattern $bInternalAssertOpAttributes :: ByteString -> NamedAttributes
$mInternalAssertOpAttributes :: forall r. NamedAttributes -> (ByteString -> r) -> (Void# -> r) -> r
InternalAssertOpAttributes msg_ <- ((\m -> (M.lookup "msg" m)) -> (Just (StringAttr msg_)))
  where InternalAssertOpAttributes ByteString
msg_ = [(ByteString, Attribute)] -> NamedAttributes
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ByteString, Attribute)] -> NamedAttributes)
-> [(ByteString, Attribute)] -> NamedAttributes
forall a b. (a -> b) -> a -> b
$ [(ByteString
"msg", ByteString -> Attribute
StringAttr ByteString
msg_)]

-- | A pattern for @cf.assert@.
pattern Assert :: () => () => Location -> operand -> BS.ByteString -> AbstractOperation operand
pattern $bAssert :: Location -> operand -> ByteString -> AbstractOperation operand
$mAssert :: forall r operand.
AbstractOperation operand
-> (Location -> operand -> ByteString -> r) -> (Void# -> r) -> r
Assert loc  arg_ msg_ = Operation
          { opName = "cf.assert"
          , opLocation = loc
          , opResultTypes = Explicit []
          , opOperands = [arg_]
          , opRegions = []
          , opSuccessors = []
          , opAttributes = (InternalAssertOpAttributes msg_)
          }

-- | A builder for @cf.assert@.
assert :: () => MonadBlockBuilder m => Value -> BS.ByteString -> m ()
assert :: Value -> ByteString -> m ()
assert  Value
arg_ ByteString
msg_  = 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.
ByteString
-> Location
-> ResultTypes
-> [operand]
-> [Region]
-> [ByteString]
-> NamedAttributes
-> AbstractOperation operand
Operation
          { opName :: ByteString
opName = ByteString
"cf.assert"
          , opLocation :: Location
opLocation = Location
UnknownLocation
          , opResultTypes :: ResultTypes
opResultTypes = [Type] -> ResultTypes
Explicit []
          , opOperands :: [ByteString]
opOperands = [(Value -> ByteString
AST.operand Value
arg_)]
          , opRegions :: [Region]
opRegions = []
          , opSuccessors :: [ByteString]
opSuccessors = []
          , opAttributes :: NamedAttributes
opAttributes = (ByteString -> NamedAttributes
InternalAssertOpAttributes ByteString
msg_)
          }))

-- * br
-- $br
-- 
-- The @cf.br@ operation represents a direct branch operation to a given
-- block. The operands of this operation are forwarded to the successor block,
-- and the number and type of the operands must match the arguments of the
-- target block.
-- 
-- Example:
-- 
-- @
-- ^bb2:
--   %2 = call \@someFn()
--   cf.br ^bb3(%2 : tensor\<*xf32>)
-- ^bb3(%3: tensor\<*xf32>):
-- @
--   

-- * cond_br
-- $cond_br
-- 
-- The @cf.cond_br@ terminator operation represents a conditional branch on a
-- boolean (1-bit integer) value. If the bit is set, then the first destination
-- is jumped to; if it is false, the second destination is chosen. The count
-- and types of operands must align with the arguments in the corresponding
-- target blocks.
-- 
-- The MLIR conditional branch operation is not allowed to target the entry
-- block for a region. The two destinations of the conditional branch operation
-- are allowed to be the same.
-- 
-- The following example illustrates a function with a conditional branch
-- operation that targets the same block.
-- 
-- Example:
-- 
-- @
-- func.func \@select(%a: i32, %b: i32, %flag: i1) -> i32 {
--   // Both targets are the same, operands differ
--   cf.cond_br %flag, ^bb1(%a : i32), ^bb1(%b : i32)
-- 
-- ^bb1(%x : i32) :
--   return %x : i32
-- }
-- @
--   

-- * switch
-- $switch
-- 
-- The @cf.switch@ terminator operation represents a switch on a signless integer
-- value. If the flag matches one of the specified cases, then the
-- corresponding destination is jumped to. If the flag does not match any of
-- the cases, the default destination is jumped to. The count and types of
-- operands must align with the arguments in the corresponding target blocks.
-- 
-- Example:
-- 
-- @
-- cf.switch %flag : i32, [
--   default: ^bb1(%a : i32),
--   42: ^bb1(%b : i32),
--   43: ^bb3(%c : i32)
-- ]
-- @
--   

pattern InternalSwitchOpAttributes :: () => () => [Int] -> NamedAttributes
pattern $bInternalSwitchOpAttributes :: [Int] -> NamedAttributes
$mInternalSwitchOpAttributes :: forall r. NamedAttributes -> ([Int] -> r) -> (Void# -> r) -> r
InternalSwitchOpAttributes case_operand_segments_ <- ((\m -> (M.lookup "case_operand_segments" m)) -> (Just (PatternUtil.I32ArrayAttr case_operand_segments_)))
  where InternalSwitchOpAttributes [Int]
case_operand_segments_ = [(ByteString, Attribute)] -> NamedAttributes
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ByteString, Attribute)] -> NamedAttributes)
-> [(ByteString, Attribute)] -> NamedAttributes
forall a b. (a -> b) -> a -> b
$ [(ByteString
"case_operand_segments", [Int] -> Attribute
PatternUtil.I32ArrayAttr [Int]
case_operand_segments_)]