{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE Strict                     #-}
{-# LANGUAGE TypeSynonymInstances       #-}
module Graphics.Vulkan.Types.Enum.Pipeline
       (VkPipelineBindPoint(VkPipelineBindPoint,
                            VK_PIPELINE_BIND_POINT_GRAPHICS, VK_PIPELINE_BIND_POINT_COMPUTE),
        VkPipelineCacheCreateBitmask(VkPipelineCacheCreateBitmask,
                                     VkPipelineCacheCreateFlags, VkPipelineCacheCreateFlagBits),
        VkPipelineCacheCreateFlags, VkPipelineCacheCreateFlagBits,
        VkPipelineCacheHeaderVersion(VkPipelineCacheHeaderVersion,
                                     VK_PIPELINE_CACHE_HEADER_VERSION_ONE),
        VkPipelineCompilerControlBitmaskAMD(VkPipelineCompilerControlBitmaskAMD,
                                            VkPipelineCompilerControlFlagsAMD,
                                            VkPipelineCompilerControlFlagBitsAMD),
        VkPipelineCompilerControlFlagsAMD,
        VkPipelineCompilerControlFlagBitsAMD,
        VkPipelineCreateBitmask(VkPipelineCreateBitmask,
                                VkPipelineCreateFlags, VkPipelineCreateFlagBits,
                                VK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT,
                                VK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT,
                                VK_PIPELINE_CREATE_DERIVATIVE_BIT),
        VkPipelineCreateFlags, VkPipelineCreateFlagBits,
        VkPipelineCreationFeedbackBitmaskEXT(VkPipelineCreationFeedbackBitmaskEXT,
                                             VkPipelineCreationFeedbackFlagsEXT,
                                             VkPipelineCreationFeedbackFlagBitsEXT,
                                             VK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT,
                                             VK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT,
                                             VK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT),
        VkPipelineCreationFeedbackFlagsEXT,
        VkPipelineCreationFeedbackFlagBitsEXT,
        VkPipelineExecutableStatisticFormatKHR(VkPipelineExecutableStatisticFormatKHR,
                                               VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR,
                                               VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR,
                                               VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR,
                                               VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR),
        VkPipelineShaderStageCreateBitmask(VkPipelineShaderStageCreateBitmask,
                                           VkPipelineShaderStageCreateFlags,
                                           VkPipelineShaderStageCreateFlagBits),
        VkPipelineShaderStageCreateFlags,
        VkPipelineShaderStageCreateFlagBits,
        VkPipelineStageBitmask(VkPipelineStageBitmask,
                               VkPipelineStageFlags, VkPipelineStageFlagBits,
                               VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT,
                               VK_PIPELINE_STAGE_DRAW_INDIRECT_BIT,
                               VK_PIPELINE_STAGE_VERTEX_INPUT_BIT,
                               VK_PIPELINE_STAGE_VERTEX_SHADER_BIT,
                               VK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT,
                               VK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT,
                               VK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT,
                               VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT,
                               VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT,
                               VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT,
                               VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT,
                               VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT,
                               VK_PIPELINE_STAGE_TRANSFER_BIT,
                               VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT, VK_PIPELINE_STAGE_HOST_BIT,
                               VK_PIPELINE_STAGE_ALL_GRAPHICS_BIT,
                               VK_PIPELINE_STAGE_ALL_COMMANDS_BIT),
        VkPipelineStageFlags, VkPipelineStageFlagBits)
       where
import Data.Bits                       (Bits, FiniteBits)
import Foreign.Storable                (Storable)
import GHC.Read                        (choose, expectP)
import Graphics.Vulkan.Marshal         (FlagBit, FlagMask, FlagType, Int32)
import Graphics.Vulkan.Types.BaseTypes (VkFlags (..))
import Text.ParserCombinators.ReadPrec (prec, step, (+++))
import Text.Read                       (Read (..), parens)
import Text.Read.Lex                   (Lexeme (..))

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkPipelineBindPoint VkPipelineBindPoint registry at www.khronos.org>
newtype VkPipelineBindPoint = VkPipelineBindPoint Int32
                              deriving (VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
(VkPipelineBindPoint -> VkPipelineBindPoint -> Bool)
-> (VkPipelineBindPoint -> VkPipelineBindPoint -> Bool)
-> Eq VkPipelineBindPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
$c/= :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
== :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
$c== :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
Eq, Eq VkPipelineBindPoint
Eq VkPipelineBindPoint
-> (VkPipelineBindPoint -> VkPipelineBindPoint -> Ordering)
-> (VkPipelineBindPoint -> VkPipelineBindPoint -> Bool)
-> (VkPipelineBindPoint -> VkPipelineBindPoint -> Bool)
-> (VkPipelineBindPoint -> VkPipelineBindPoint -> Bool)
-> (VkPipelineBindPoint -> VkPipelineBindPoint -> Bool)
-> (VkPipelineBindPoint
    -> VkPipelineBindPoint -> VkPipelineBindPoint)
-> (VkPipelineBindPoint
    -> VkPipelineBindPoint -> VkPipelineBindPoint)
-> Ord VkPipelineBindPoint
VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
VkPipelineBindPoint -> VkPipelineBindPoint -> Ordering
VkPipelineBindPoint -> VkPipelineBindPoint -> VkPipelineBindPoint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VkPipelineBindPoint -> VkPipelineBindPoint -> VkPipelineBindPoint
$cmin :: VkPipelineBindPoint -> VkPipelineBindPoint -> VkPipelineBindPoint
max :: VkPipelineBindPoint -> VkPipelineBindPoint -> VkPipelineBindPoint
$cmax :: VkPipelineBindPoint -> VkPipelineBindPoint -> VkPipelineBindPoint
>= :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
$c>= :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
> :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
$c> :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
<= :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
$c<= :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
< :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
$c< :: VkPipelineBindPoint -> VkPipelineBindPoint -> Bool
compare :: VkPipelineBindPoint -> VkPipelineBindPoint -> Ordering
$ccompare :: VkPipelineBindPoint -> VkPipelineBindPoint -> Ordering
Ord, Int -> VkPipelineBindPoint
VkPipelineBindPoint -> Int
VkPipelineBindPoint -> [VkPipelineBindPoint]
VkPipelineBindPoint -> VkPipelineBindPoint
VkPipelineBindPoint -> VkPipelineBindPoint -> [VkPipelineBindPoint]
VkPipelineBindPoint
-> VkPipelineBindPoint
-> VkPipelineBindPoint
-> [VkPipelineBindPoint]
(VkPipelineBindPoint -> VkPipelineBindPoint)
-> (VkPipelineBindPoint -> VkPipelineBindPoint)
-> (Int -> VkPipelineBindPoint)
-> (VkPipelineBindPoint -> Int)
-> (VkPipelineBindPoint -> [VkPipelineBindPoint])
-> (VkPipelineBindPoint
    -> VkPipelineBindPoint -> [VkPipelineBindPoint])
-> (VkPipelineBindPoint
    -> VkPipelineBindPoint -> [VkPipelineBindPoint])
-> (VkPipelineBindPoint
    -> VkPipelineBindPoint
    -> VkPipelineBindPoint
    -> [VkPipelineBindPoint])
-> Enum VkPipelineBindPoint
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkPipelineBindPoint
-> VkPipelineBindPoint
-> VkPipelineBindPoint
-> [VkPipelineBindPoint]
$cenumFromThenTo :: VkPipelineBindPoint
-> VkPipelineBindPoint
-> VkPipelineBindPoint
-> [VkPipelineBindPoint]
enumFromTo :: VkPipelineBindPoint -> VkPipelineBindPoint -> [VkPipelineBindPoint]
$cenumFromTo :: VkPipelineBindPoint -> VkPipelineBindPoint -> [VkPipelineBindPoint]
enumFromThen :: VkPipelineBindPoint -> VkPipelineBindPoint -> [VkPipelineBindPoint]
$cenumFromThen :: VkPipelineBindPoint -> VkPipelineBindPoint -> [VkPipelineBindPoint]
enumFrom :: VkPipelineBindPoint -> [VkPipelineBindPoint]
$cenumFrom :: VkPipelineBindPoint -> [VkPipelineBindPoint]
fromEnum :: VkPipelineBindPoint -> Int
$cfromEnum :: VkPipelineBindPoint -> Int
toEnum :: Int -> VkPipelineBindPoint
$ctoEnum :: Int -> VkPipelineBindPoint
pred :: VkPipelineBindPoint -> VkPipelineBindPoint
$cpred :: VkPipelineBindPoint -> VkPipelineBindPoint
succ :: VkPipelineBindPoint -> VkPipelineBindPoint
$csucc :: VkPipelineBindPoint -> VkPipelineBindPoint
Enum, Ptr VkPipelineBindPoint -> IO VkPipelineBindPoint
Ptr VkPipelineBindPoint -> Int -> IO VkPipelineBindPoint
Ptr VkPipelineBindPoint -> Int -> VkPipelineBindPoint -> IO ()
Ptr VkPipelineBindPoint -> VkPipelineBindPoint -> IO ()
VkPipelineBindPoint -> Int
(VkPipelineBindPoint -> Int)
-> (VkPipelineBindPoint -> Int)
-> (Ptr VkPipelineBindPoint -> Int -> IO VkPipelineBindPoint)
-> (Ptr VkPipelineBindPoint -> Int -> VkPipelineBindPoint -> IO ())
-> (forall b. Ptr b -> Int -> IO VkPipelineBindPoint)
-> (forall b. Ptr b -> Int -> VkPipelineBindPoint -> IO ())
-> (Ptr VkPipelineBindPoint -> IO VkPipelineBindPoint)
-> (Ptr VkPipelineBindPoint -> VkPipelineBindPoint -> IO ())
-> Storable VkPipelineBindPoint
forall b. Ptr b -> Int -> IO VkPipelineBindPoint
forall b. Ptr b -> Int -> VkPipelineBindPoint -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr VkPipelineBindPoint -> VkPipelineBindPoint -> IO ()
$cpoke :: Ptr VkPipelineBindPoint -> VkPipelineBindPoint -> IO ()
peek :: Ptr VkPipelineBindPoint -> IO VkPipelineBindPoint
$cpeek :: Ptr VkPipelineBindPoint -> IO VkPipelineBindPoint
pokeByteOff :: forall b. Ptr b -> Int -> VkPipelineBindPoint -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkPipelineBindPoint -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkPipelineBindPoint
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkPipelineBindPoint
pokeElemOff :: Ptr VkPipelineBindPoint -> Int -> VkPipelineBindPoint -> IO ()
$cpokeElemOff :: Ptr VkPipelineBindPoint -> Int -> VkPipelineBindPoint -> IO ()
peekElemOff :: Ptr VkPipelineBindPoint -> Int -> IO VkPipelineBindPoint
$cpeekElemOff :: Ptr VkPipelineBindPoint -> Int -> IO VkPipelineBindPoint
alignment :: VkPipelineBindPoint -> Int
$calignment :: VkPipelineBindPoint -> Int
sizeOf :: VkPipelineBindPoint -> Int
$csizeOf :: VkPipelineBindPoint -> Int
Storable)

instance Show VkPipelineBindPoint where
    showsPrec :: Int -> VkPipelineBindPoint -> ShowS
showsPrec Int
_ VkPipelineBindPoint
VK_PIPELINE_BIND_POINT_GRAPHICS
      = String -> ShowS
showString String
"VK_PIPELINE_BIND_POINT_GRAPHICS"
    showsPrec Int
_ VkPipelineBindPoint
VK_PIPELINE_BIND_POINT_COMPUTE
      = String -> ShowS
showString String
"VK_PIPELINE_BIND_POINT_COMPUTE"
    showsPrec Int
p (VkPipelineBindPoint Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineBindPoint " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int32
x)

instance Read VkPipelineBindPoint where
    readPrec :: ReadPrec VkPipelineBindPoint
readPrec
      = ReadPrec VkPipelineBindPoint -> ReadPrec VkPipelineBindPoint
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkPipelineBindPoint)]
-> ReadPrec VkPipelineBindPoint
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_PIPELINE_BIND_POINT_GRAPHICS",
               VkPipelineBindPoint -> ReadPrec VkPipelineBindPoint
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineBindPoint
VK_PIPELINE_BIND_POINT_GRAPHICS),
              (String
"VK_PIPELINE_BIND_POINT_COMPUTE",
               VkPipelineBindPoint -> ReadPrec VkPipelineBindPoint
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineBindPoint
VK_PIPELINE_BIND_POINT_COMPUTE)]
             ReadPrec VkPipelineBindPoint
-> ReadPrec VkPipelineBindPoint -> ReadPrec VkPipelineBindPoint
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int -> ReadPrec VkPipelineBindPoint -> ReadPrec VkPipelineBindPoint
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineBindPoint") ReadPrec ()
-> ReadPrec VkPipelineBindPoint -> ReadPrec VkPipelineBindPoint
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (Int32 -> VkPipelineBindPoint
VkPipelineBindPoint (Int32 -> VkPipelineBindPoint)
-> ReadPrec Int32 -> ReadPrec VkPipelineBindPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

pattern VK_PIPELINE_BIND_POINT_GRAPHICS :: VkPipelineBindPoint

pattern $bVK_PIPELINE_BIND_POINT_GRAPHICS :: VkPipelineBindPoint
$mVK_PIPELINE_BIND_POINT_GRAPHICS :: forall {r}.
VkPipelineBindPoint -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_BIND_POINT_GRAPHICS = VkPipelineBindPoint 0

pattern VK_PIPELINE_BIND_POINT_COMPUTE :: VkPipelineBindPoint

pattern $bVK_PIPELINE_BIND_POINT_COMPUTE :: VkPipelineBindPoint
$mVK_PIPELINE_BIND_POINT_COMPUTE :: forall {r}.
VkPipelineBindPoint -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_BIND_POINT_COMPUTE = VkPipelineBindPoint 1

newtype VkPipelineCacheCreateBitmask (a ::
                                        FlagType) = VkPipelineCacheCreateBitmask VkFlags
                                                    deriving (VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
(VkPipelineCacheCreateBitmask a
 -> VkPipelineCacheCreateBitmask a -> Bool)
-> (VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a -> Bool)
-> Eq (VkPipelineCacheCreateBitmask a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
/= :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
$c/= :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
== :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
$c== :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
Eq, Eq (VkPipelineCacheCreateBitmask a)
Eq (VkPipelineCacheCreateBitmask a)
-> (VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a -> Ordering)
-> (VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a -> Bool)
-> (VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a -> Bool)
-> (VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a -> Bool)
-> (VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a -> Bool)
-> (VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a)
-> (VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a
    -> VkPipelineCacheCreateBitmask a)
-> Ord (VkPipelineCacheCreateBitmask a)
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Ordering
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> VkPipelineCacheCreateBitmask a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkPipelineCacheCreateBitmask a)
forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Ordering
forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> VkPipelineCacheCreateBitmask a
min :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> VkPipelineCacheCreateBitmask a
$cmin :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> VkPipelineCacheCreateBitmask a
max :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> VkPipelineCacheCreateBitmask a
$cmax :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> VkPipelineCacheCreateBitmask a
>= :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
$c>= :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
> :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
$c> :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
<= :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
$c<= :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
< :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
$c< :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Bool
compare :: VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Ordering
$ccompare :: forall (a :: FlagType).
VkPipelineCacheCreateBitmask a
-> VkPipelineCacheCreateBitmask a -> Ordering
Ord, Ptr (VkPipelineCacheCreateBitmask a)
-> IO (VkPipelineCacheCreateBitmask a)
Ptr (VkPipelineCacheCreateBitmask a)
-> Int -> IO (VkPipelineCacheCreateBitmask a)
Ptr (VkPipelineCacheCreateBitmask a)
-> Int -> VkPipelineCacheCreateBitmask a -> IO ()
Ptr (VkPipelineCacheCreateBitmask a)
-> VkPipelineCacheCreateBitmask a -> IO ()
VkPipelineCacheCreateBitmask a -> Int
(VkPipelineCacheCreateBitmask a -> Int)
-> (VkPipelineCacheCreateBitmask a -> Int)
-> (Ptr (VkPipelineCacheCreateBitmask a)
    -> Int -> IO (VkPipelineCacheCreateBitmask a))
-> (Ptr (VkPipelineCacheCreateBitmask a)
    -> Int -> VkPipelineCacheCreateBitmask a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkPipelineCacheCreateBitmask a))
-> (forall b.
    Ptr b -> Int -> VkPipelineCacheCreateBitmask a -> IO ())
-> (Ptr (VkPipelineCacheCreateBitmask a)
    -> IO (VkPipelineCacheCreateBitmask a))
-> (Ptr (VkPipelineCacheCreateBitmask a)
    -> VkPipelineCacheCreateBitmask a -> IO ())
-> Storable (VkPipelineCacheCreateBitmask a)
forall b. Ptr b -> Int -> IO (VkPipelineCacheCreateBitmask a)
forall b. Ptr b -> Int -> VkPipelineCacheCreateBitmask a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkPipelineCacheCreateBitmask a)
-> IO (VkPipelineCacheCreateBitmask a)
forall (a :: FlagType).
Ptr (VkPipelineCacheCreateBitmask a)
-> Int -> IO (VkPipelineCacheCreateBitmask a)
forall (a :: FlagType).
Ptr (VkPipelineCacheCreateBitmask a)
-> Int -> VkPipelineCacheCreateBitmask a -> IO ()
forall (a :: FlagType).
Ptr (VkPipelineCacheCreateBitmask a)
-> VkPipelineCacheCreateBitmask a -> IO ()
forall (a :: FlagType). VkPipelineCacheCreateBitmask a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineCacheCreateBitmask a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineCacheCreateBitmask a -> IO ()
poke :: Ptr (VkPipelineCacheCreateBitmask a)
-> VkPipelineCacheCreateBitmask a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkPipelineCacheCreateBitmask a)
-> VkPipelineCacheCreateBitmask a -> IO ()
peek :: Ptr (VkPipelineCacheCreateBitmask a)
-> IO (VkPipelineCacheCreateBitmask a)
$cpeek :: forall (a :: FlagType).
Ptr (VkPipelineCacheCreateBitmask a)
-> IO (VkPipelineCacheCreateBitmask a)
pokeByteOff :: forall b. Ptr b -> Int -> VkPipelineCacheCreateBitmask a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineCacheCreateBitmask a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkPipelineCacheCreateBitmask a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineCacheCreateBitmask a)
pokeElemOff :: Ptr (VkPipelineCacheCreateBitmask a)
-> Int -> VkPipelineCacheCreateBitmask a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkPipelineCacheCreateBitmask a)
-> Int -> VkPipelineCacheCreateBitmask a -> IO ()
peekElemOff :: Ptr (VkPipelineCacheCreateBitmask a)
-> Int -> IO (VkPipelineCacheCreateBitmask a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkPipelineCacheCreateBitmask a)
-> Int -> IO (VkPipelineCacheCreateBitmask a)
alignment :: VkPipelineCacheCreateBitmask a -> Int
$calignment :: forall (a :: FlagType). VkPipelineCacheCreateBitmask a -> Int
sizeOf :: VkPipelineCacheCreateBitmask a -> Int
$csizeOf :: forall (a :: FlagType). VkPipelineCacheCreateBitmask a -> Int
Storable)

type VkPipelineCacheCreateFlags =
     VkPipelineCacheCreateBitmask FlagMask

type VkPipelineCacheCreateFlagBits =
     VkPipelineCacheCreateBitmask FlagBit

pattern VkPipelineCacheCreateFlagBits ::
        VkFlags -> VkPipelineCacheCreateBitmask FlagBit

pattern $bVkPipelineCacheCreateFlagBits :: VkFlags -> VkPipelineCacheCreateBitmask FlagBit
$mVkPipelineCacheCreateFlagBits :: forall {r}.
VkPipelineCacheCreateBitmask FlagBit
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineCacheCreateFlagBits n =
        VkPipelineCacheCreateBitmask n

pattern VkPipelineCacheCreateFlags ::
        VkFlags -> VkPipelineCacheCreateBitmask FlagMask

pattern $bVkPipelineCacheCreateFlags :: VkFlags -> VkPipelineCacheCreateBitmask FlagMask
$mVkPipelineCacheCreateFlags :: forall {r}.
VkPipelineCacheCreateBitmask FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineCacheCreateFlags n =
        VkPipelineCacheCreateBitmask n

deriving instance Bits (VkPipelineCacheCreateBitmask FlagMask)

deriving instance
         FiniteBits (VkPipelineCacheCreateBitmask FlagMask)

instance Show (VkPipelineCacheCreateBitmask a) where
    showsPrec :: Int -> VkPipelineCacheCreateBitmask a -> ShowS
showsPrec Int
p (VkPipelineCacheCreateBitmask VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineCacheCreateBitmask " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkPipelineCacheCreateBitmask a) where
    readPrec :: ReadPrec (VkPipelineCacheCreateBitmask a)
readPrec
      = ReadPrec (VkPipelineCacheCreateBitmask a)
-> ReadPrec (VkPipelineCacheCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkPipelineCacheCreateBitmask a))]
-> ReadPrec (VkPipelineCacheCreateBitmask a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [] ReadPrec (VkPipelineCacheCreateBitmask a)
-> ReadPrec (VkPipelineCacheCreateBitmask a)
-> ReadPrec (VkPipelineCacheCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkPipelineCacheCreateBitmask a)
-> ReadPrec (VkPipelineCacheCreateBitmask a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineCacheCreateBitmask") ReadPrec ()
-> ReadPrec (VkPipelineCacheCreateBitmask a)
-> ReadPrec (VkPipelineCacheCreateBitmask a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkPipelineCacheCreateBitmask a
forall (a :: FlagType). VkFlags -> VkPipelineCacheCreateBitmask a
VkPipelineCacheCreateBitmask (VkFlags -> VkPipelineCacheCreateBitmask a)
-> ReadPrec VkFlags -> ReadPrec (VkPipelineCacheCreateBitmask a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkPipelineCacheHeaderVersion VkPipelineCacheHeaderVersion registry at www.khronos.org>
newtype VkPipelineCacheHeaderVersion = VkPipelineCacheHeaderVersion Int32
                                       deriving (VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
(VkPipelineCacheHeaderVersion
 -> VkPipelineCacheHeaderVersion -> Bool)
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> Bool)
-> Eq VkPipelineCacheHeaderVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
$c/= :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
== :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
$c== :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
Eq, Eq VkPipelineCacheHeaderVersion
Eq VkPipelineCacheHeaderVersion
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> Ordering)
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> Bool)
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> Bool)
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> Bool)
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> Bool)
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion)
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion)
-> Ord VkPipelineCacheHeaderVersion
VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Ordering
VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
$cmin :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
max :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
$cmax :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
>= :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
$c>= :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
> :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
$c> :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
<= :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
$c<= :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
< :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
$c< :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Bool
compare :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Ordering
$ccompare :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> Ordering
Ord, Int -> VkPipelineCacheHeaderVersion
VkPipelineCacheHeaderVersion -> Int
VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion]
VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion]
VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion
-> [VkPipelineCacheHeaderVersion]
(VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion)
-> (VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion)
-> (Int -> VkPipelineCacheHeaderVersion)
-> (VkPipelineCacheHeaderVersion -> Int)
-> (VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion])
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion])
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion])
-> (VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion
    -> [VkPipelineCacheHeaderVersion])
-> Enum VkPipelineCacheHeaderVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion
-> [VkPipelineCacheHeaderVersion]
$cenumFromThenTo :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion
-> [VkPipelineCacheHeaderVersion]
enumFromTo :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion]
$cenumFromTo :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion]
enumFromThen :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion]
$cenumFromThen :: VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion]
enumFrom :: VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion]
$cenumFrom :: VkPipelineCacheHeaderVersion -> [VkPipelineCacheHeaderVersion]
fromEnum :: VkPipelineCacheHeaderVersion -> Int
$cfromEnum :: VkPipelineCacheHeaderVersion -> Int
toEnum :: Int -> VkPipelineCacheHeaderVersion
$ctoEnum :: Int -> VkPipelineCacheHeaderVersion
pred :: VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
$cpred :: VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
succ :: VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
$csucc :: VkPipelineCacheHeaderVersion -> VkPipelineCacheHeaderVersion
Enum, Ptr VkPipelineCacheHeaderVersion -> IO VkPipelineCacheHeaderVersion
Ptr VkPipelineCacheHeaderVersion
-> Int -> IO VkPipelineCacheHeaderVersion
Ptr VkPipelineCacheHeaderVersion
-> Int -> VkPipelineCacheHeaderVersion -> IO ()
Ptr VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> IO ()
VkPipelineCacheHeaderVersion -> Int
(VkPipelineCacheHeaderVersion -> Int)
-> (VkPipelineCacheHeaderVersion -> Int)
-> (Ptr VkPipelineCacheHeaderVersion
    -> Int -> IO VkPipelineCacheHeaderVersion)
-> (Ptr VkPipelineCacheHeaderVersion
    -> Int -> VkPipelineCacheHeaderVersion -> IO ())
-> (forall b. Ptr b -> Int -> IO VkPipelineCacheHeaderVersion)
-> (forall b.
    Ptr b -> Int -> VkPipelineCacheHeaderVersion -> IO ())
-> (Ptr VkPipelineCacheHeaderVersion
    -> IO VkPipelineCacheHeaderVersion)
-> (Ptr VkPipelineCacheHeaderVersion
    -> VkPipelineCacheHeaderVersion -> IO ())
-> Storable VkPipelineCacheHeaderVersion
forall b. Ptr b -> Int -> IO VkPipelineCacheHeaderVersion
forall b. Ptr b -> Int -> VkPipelineCacheHeaderVersion -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> IO ()
$cpoke :: Ptr VkPipelineCacheHeaderVersion
-> VkPipelineCacheHeaderVersion -> IO ()
peek :: Ptr VkPipelineCacheHeaderVersion -> IO VkPipelineCacheHeaderVersion
$cpeek :: Ptr VkPipelineCacheHeaderVersion -> IO VkPipelineCacheHeaderVersion
pokeByteOff :: forall b. Ptr b -> Int -> VkPipelineCacheHeaderVersion -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkPipelineCacheHeaderVersion -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkPipelineCacheHeaderVersion
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkPipelineCacheHeaderVersion
pokeElemOff :: Ptr VkPipelineCacheHeaderVersion
-> Int -> VkPipelineCacheHeaderVersion -> IO ()
$cpokeElemOff :: Ptr VkPipelineCacheHeaderVersion
-> Int -> VkPipelineCacheHeaderVersion -> IO ()
peekElemOff :: Ptr VkPipelineCacheHeaderVersion
-> Int -> IO VkPipelineCacheHeaderVersion
$cpeekElemOff :: Ptr VkPipelineCacheHeaderVersion
-> Int -> IO VkPipelineCacheHeaderVersion
alignment :: VkPipelineCacheHeaderVersion -> Int
$calignment :: VkPipelineCacheHeaderVersion -> Int
sizeOf :: VkPipelineCacheHeaderVersion -> Int
$csizeOf :: VkPipelineCacheHeaderVersion -> Int
Storable)

instance Show VkPipelineCacheHeaderVersion where
    showsPrec :: Int -> VkPipelineCacheHeaderVersion -> ShowS
showsPrec Int
_ VkPipelineCacheHeaderVersion
VK_PIPELINE_CACHE_HEADER_VERSION_ONE
      = String -> ShowS
showString String
"VK_PIPELINE_CACHE_HEADER_VERSION_ONE"
    showsPrec Int
p (VkPipelineCacheHeaderVersion Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineCacheHeaderVersion " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int32
x)

instance Read VkPipelineCacheHeaderVersion where
    readPrec :: ReadPrec VkPipelineCacheHeaderVersion
readPrec
      = ReadPrec VkPipelineCacheHeaderVersion
-> ReadPrec VkPipelineCacheHeaderVersion
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkPipelineCacheHeaderVersion)]
-> ReadPrec VkPipelineCacheHeaderVersion
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_PIPELINE_CACHE_HEADER_VERSION_ONE",
               VkPipelineCacheHeaderVersion
-> ReadPrec VkPipelineCacheHeaderVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineCacheHeaderVersion
VK_PIPELINE_CACHE_HEADER_VERSION_ONE)]
             ReadPrec VkPipelineCacheHeaderVersion
-> ReadPrec VkPipelineCacheHeaderVersion
-> ReadPrec VkPipelineCacheHeaderVersion
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec VkPipelineCacheHeaderVersion
-> ReadPrec VkPipelineCacheHeaderVersion
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineCacheHeaderVersion") ReadPrec ()
-> ReadPrec VkPipelineCacheHeaderVersion
-> ReadPrec VkPipelineCacheHeaderVersion
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (Int32 -> VkPipelineCacheHeaderVersion
VkPipelineCacheHeaderVersion (Int32 -> VkPipelineCacheHeaderVersion)
-> ReadPrec Int32 -> ReadPrec VkPipelineCacheHeaderVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

pattern VK_PIPELINE_CACHE_HEADER_VERSION_ONE ::
        VkPipelineCacheHeaderVersion

pattern $bVK_PIPELINE_CACHE_HEADER_VERSION_ONE :: VkPipelineCacheHeaderVersion
$mVK_PIPELINE_CACHE_HEADER_VERSION_ONE :: forall {r}.
VkPipelineCacheHeaderVersion -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_CACHE_HEADER_VERSION_ONE =
        VkPipelineCacheHeaderVersion 1

newtype VkPipelineCompilerControlBitmaskAMD (a ::
                                               FlagType) = VkPipelineCompilerControlBitmaskAMD VkFlags
                                                           deriving (VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
(VkPipelineCompilerControlBitmaskAMD a
 -> VkPipelineCompilerControlBitmaskAMD a -> Bool)
-> (VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a -> Bool)
-> Eq (VkPipelineCompilerControlBitmaskAMD a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
/= :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
$c/= :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
== :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
$c== :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
Eq, Eq (VkPipelineCompilerControlBitmaskAMD a)
Eq (VkPipelineCompilerControlBitmaskAMD a)
-> (VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a -> Ordering)
-> (VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a -> Bool)
-> (VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a -> Bool)
-> (VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a -> Bool)
-> (VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a -> Bool)
-> (VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a)
-> (VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a
    -> VkPipelineCompilerControlBitmaskAMD a)
-> Ord (VkPipelineCompilerControlBitmaskAMD a)
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Ordering
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkPipelineCompilerControlBitmaskAMD a)
forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Ordering
forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
min :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
$cmin :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
max :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
$cmax :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a
>= :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
$c>= :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
> :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
$c> :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
<= :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
$c<= :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
< :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
$c< :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Bool
compare :: VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Ordering
$ccompare :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a
-> VkPipelineCompilerControlBitmaskAMD a -> Ordering
Ord, Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> IO (VkPipelineCompilerControlBitmaskAMD a)
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> Int -> IO (VkPipelineCompilerControlBitmaskAMD a)
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ()
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> VkPipelineCompilerControlBitmaskAMD a -> IO ()
VkPipelineCompilerControlBitmaskAMD a -> Int
(VkPipelineCompilerControlBitmaskAMD a -> Int)
-> (VkPipelineCompilerControlBitmaskAMD a -> Int)
-> (Ptr (VkPipelineCompilerControlBitmaskAMD a)
    -> Int -> IO (VkPipelineCompilerControlBitmaskAMD a))
-> (Ptr (VkPipelineCompilerControlBitmaskAMD a)
    -> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ())
-> (forall b.
    Ptr b -> Int -> IO (VkPipelineCompilerControlBitmaskAMD a))
-> (forall b.
    Ptr b -> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ())
-> (Ptr (VkPipelineCompilerControlBitmaskAMD a)
    -> IO (VkPipelineCompilerControlBitmaskAMD a))
-> (Ptr (VkPipelineCompilerControlBitmaskAMD a)
    -> VkPipelineCompilerControlBitmaskAMD a -> IO ())
-> Storable (VkPipelineCompilerControlBitmaskAMD a)
forall b.
Ptr b -> Int -> IO (VkPipelineCompilerControlBitmaskAMD a)
forall b.
Ptr b -> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> IO (VkPipelineCompilerControlBitmaskAMD a)
forall (a :: FlagType).
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> Int -> IO (VkPipelineCompilerControlBitmaskAMD a)
forall (a :: FlagType).
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ()
forall (a :: FlagType).
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> VkPipelineCompilerControlBitmaskAMD a -> IO ()
forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineCompilerControlBitmaskAMD a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ()
poke :: Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> VkPipelineCompilerControlBitmaskAMD a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> VkPipelineCompilerControlBitmaskAMD a -> IO ()
peek :: Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> IO (VkPipelineCompilerControlBitmaskAMD a)
$cpeek :: forall (a :: FlagType).
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> IO (VkPipelineCompilerControlBitmaskAMD a)
pokeByteOff :: forall b.
Ptr b -> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ()
peekByteOff :: forall b.
Ptr b -> Int -> IO (VkPipelineCompilerControlBitmaskAMD a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineCompilerControlBitmaskAMD a)
pokeElemOff :: Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> Int -> VkPipelineCompilerControlBitmaskAMD a -> IO ()
peekElemOff :: Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> Int -> IO (VkPipelineCompilerControlBitmaskAMD a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkPipelineCompilerControlBitmaskAMD a)
-> Int -> IO (VkPipelineCompilerControlBitmaskAMD a)
alignment :: VkPipelineCompilerControlBitmaskAMD a -> Int
$calignment :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a -> Int
sizeOf :: VkPipelineCompilerControlBitmaskAMD a -> Int
$csizeOf :: forall (a :: FlagType).
VkPipelineCompilerControlBitmaskAMD a -> Int
Storable)

type VkPipelineCompilerControlFlagsAMD =
     VkPipelineCompilerControlBitmaskAMD FlagMask

type VkPipelineCompilerControlFlagBitsAMD =
     VkPipelineCompilerControlBitmaskAMD FlagBit

pattern VkPipelineCompilerControlFlagBitsAMD ::
        VkFlags -> VkPipelineCompilerControlBitmaskAMD FlagBit

pattern $bVkPipelineCompilerControlFlagBitsAMD :: VkFlags -> VkPipelineCompilerControlBitmaskAMD FlagBit
$mVkPipelineCompilerControlFlagBitsAMD :: forall {r}.
VkPipelineCompilerControlBitmaskAMD FlagBit
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineCompilerControlFlagBitsAMD n =
        VkPipelineCompilerControlBitmaskAMD n

pattern VkPipelineCompilerControlFlagsAMD ::
        VkFlags -> VkPipelineCompilerControlBitmaskAMD FlagMask

pattern $bVkPipelineCompilerControlFlagsAMD :: VkFlags -> VkPipelineCompilerControlBitmaskAMD FlagMask
$mVkPipelineCompilerControlFlagsAMD :: forall {r}.
VkPipelineCompilerControlBitmaskAMD FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineCompilerControlFlagsAMD n =
        VkPipelineCompilerControlBitmaskAMD n

deriving instance
         Bits (VkPipelineCompilerControlBitmaskAMD FlagMask)

deriving instance
         FiniteBits (VkPipelineCompilerControlBitmaskAMD FlagMask)

instance Show (VkPipelineCompilerControlBitmaskAMD a) where
    showsPrec :: Int -> VkPipelineCompilerControlBitmaskAMD a -> ShowS
showsPrec Int
p (VkPipelineCompilerControlBitmaskAMD VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineCompilerControlBitmaskAMD " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkPipelineCompilerControlBitmaskAMD a) where
    readPrec :: ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
readPrec
      = ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkPipelineCompilerControlBitmaskAMD a))]
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [] ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineCompilerControlBitmaskAMD") ReadPrec ()
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkPipelineCompilerControlBitmaskAMD a
forall (a :: FlagType).
VkFlags -> VkPipelineCompilerControlBitmaskAMD a
VkPipelineCompilerControlBitmaskAMD (VkFlags -> VkPipelineCompilerControlBitmaskAMD a)
-> ReadPrec VkFlags
-> ReadPrec (VkPipelineCompilerControlBitmaskAMD a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

newtype VkPipelineCreateBitmask (a ::
                                   FlagType) = VkPipelineCreateBitmask VkFlags
                                               deriving (VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
(VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool)
-> (VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool)
-> Eq (VkPipelineCreateBitmask a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
/= :: VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
$c/= :: forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
== :: VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
$c== :: forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
Eq, Eq (VkPipelineCreateBitmask a)
Eq (VkPipelineCreateBitmask a)
-> (VkPipelineCreateBitmask a
    -> VkPipelineCreateBitmask a -> Ordering)
-> (VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool)
-> (VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool)
-> (VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool)
-> (VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool)
-> (VkPipelineCreateBitmask a
    -> VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a)
-> (VkPipelineCreateBitmask a
    -> VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a)
-> Ord (VkPipelineCreateBitmask a)
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Ordering
VkPipelineCreateBitmask a
-> VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkPipelineCreateBitmask a)
forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Ordering
forall (a :: FlagType).
VkPipelineCreateBitmask a
-> VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a
min :: VkPipelineCreateBitmask a
-> VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a
$cmin :: forall (a :: FlagType).
VkPipelineCreateBitmask a
-> VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a
max :: VkPipelineCreateBitmask a
-> VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a
$cmax :: forall (a :: FlagType).
VkPipelineCreateBitmask a
-> VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a
>= :: VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
$c>= :: forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
> :: VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
$c> :: forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
<= :: VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
$c<= :: forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
< :: VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
$c< :: forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Bool
compare :: VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Ordering
$ccompare :: forall (a :: FlagType).
VkPipelineCreateBitmask a -> VkPipelineCreateBitmask a -> Ordering
Ord, Ptr (VkPipelineCreateBitmask a) -> IO (VkPipelineCreateBitmask a)
Ptr (VkPipelineCreateBitmask a)
-> Int -> IO (VkPipelineCreateBitmask a)
Ptr (VkPipelineCreateBitmask a)
-> Int -> VkPipelineCreateBitmask a -> IO ()
Ptr (VkPipelineCreateBitmask a)
-> VkPipelineCreateBitmask a -> IO ()
VkPipelineCreateBitmask a -> Int
(VkPipelineCreateBitmask a -> Int)
-> (VkPipelineCreateBitmask a -> Int)
-> (Ptr (VkPipelineCreateBitmask a)
    -> Int -> IO (VkPipelineCreateBitmask a))
-> (Ptr (VkPipelineCreateBitmask a)
    -> Int -> VkPipelineCreateBitmask a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkPipelineCreateBitmask a))
-> (forall b. Ptr b -> Int -> VkPipelineCreateBitmask a -> IO ())
-> (Ptr (VkPipelineCreateBitmask a)
    -> IO (VkPipelineCreateBitmask a))
-> (Ptr (VkPipelineCreateBitmask a)
    -> VkPipelineCreateBitmask a -> IO ())
-> Storable (VkPipelineCreateBitmask a)
forall b. Ptr b -> Int -> IO (VkPipelineCreateBitmask a)
forall b. Ptr b -> Int -> VkPipelineCreateBitmask a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkPipelineCreateBitmask a) -> IO (VkPipelineCreateBitmask a)
forall (a :: FlagType).
Ptr (VkPipelineCreateBitmask a)
-> Int -> IO (VkPipelineCreateBitmask a)
forall (a :: FlagType).
Ptr (VkPipelineCreateBitmask a)
-> Int -> VkPipelineCreateBitmask a -> IO ()
forall (a :: FlagType).
Ptr (VkPipelineCreateBitmask a)
-> VkPipelineCreateBitmask a -> IO ()
forall (a :: FlagType). VkPipelineCreateBitmask a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineCreateBitmask a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineCreateBitmask a -> IO ()
poke :: Ptr (VkPipelineCreateBitmask a)
-> VkPipelineCreateBitmask a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkPipelineCreateBitmask a)
-> VkPipelineCreateBitmask a -> IO ()
peek :: Ptr (VkPipelineCreateBitmask a) -> IO (VkPipelineCreateBitmask a)
$cpeek :: forall (a :: FlagType).
Ptr (VkPipelineCreateBitmask a) -> IO (VkPipelineCreateBitmask a)
pokeByteOff :: forall b. Ptr b -> Int -> VkPipelineCreateBitmask a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineCreateBitmask a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkPipelineCreateBitmask a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineCreateBitmask a)
pokeElemOff :: Ptr (VkPipelineCreateBitmask a)
-> Int -> VkPipelineCreateBitmask a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkPipelineCreateBitmask a)
-> Int -> VkPipelineCreateBitmask a -> IO ()
peekElemOff :: Ptr (VkPipelineCreateBitmask a)
-> Int -> IO (VkPipelineCreateBitmask a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkPipelineCreateBitmask a)
-> Int -> IO (VkPipelineCreateBitmask a)
alignment :: VkPipelineCreateBitmask a -> Int
$calignment :: forall (a :: FlagType). VkPipelineCreateBitmask a -> Int
sizeOf :: VkPipelineCreateBitmask a -> Int
$csizeOf :: forall (a :: FlagType). VkPipelineCreateBitmask a -> Int
Storable)

type VkPipelineCreateFlags = VkPipelineCreateBitmask FlagMask

type VkPipelineCreateFlagBits = VkPipelineCreateBitmask FlagBit

pattern VkPipelineCreateFlagBits ::
        VkFlags -> VkPipelineCreateBitmask FlagBit

pattern $bVkPipelineCreateFlagBits :: VkFlags -> VkPipelineCreateBitmask FlagBit
$mVkPipelineCreateFlagBits :: forall {r}.
VkPipelineCreateBitmask FlagBit
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineCreateFlagBits n = VkPipelineCreateBitmask n

pattern VkPipelineCreateFlags ::
        VkFlags -> VkPipelineCreateBitmask FlagMask

pattern $bVkPipelineCreateFlags :: VkFlags -> VkPipelineCreateBitmask FlagMask
$mVkPipelineCreateFlags :: forall {r}.
VkPipelineCreateBitmask FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineCreateFlags n = VkPipelineCreateBitmask n

deriving instance Bits (VkPipelineCreateBitmask FlagMask)

deriving instance FiniteBits (VkPipelineCreateBitmask FlagMask)

instance Show (VkPipelineCreateBitmask a) where
    showsPrec :: Int -> VkPipelineCreateBitmask a -> ShowS
showsPrec Int
_ VkPipelineCreateBitmask a
VK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT"
    showsPrec Int
_ VkPipelineCreateBitmask a
VK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT"
    showsPrec Int
_ VkPipelineCreateBitmask a
VK_PIPELINE_CREATE_DERIVATIVE_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_CREATE_DERIVATIVE_BIT"
    showsPrec Int
p (VkPipelineCreateBitmask VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineCreateBitmask " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkPipelineCreateBitmask a) where
    readPrec :: ReadPrec (VkPipelineCreateBitmask a)
readPrec
      = ReadPrec (VkPipelineCreateBitmask a)
-> ReadPrec (VkPipelineCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkPipelineCreateBitmask a))]
-> ReadPrec (VkPipelineCreateBitmask a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT",
               VkPipelineCreateBitmask a -> ReadPrec (VkPipelineCreateBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineCreateBitmask a
forall (a :: FlagType). VkPipelineCreateBitmask a
VK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT),
              (String
"VK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT",
               VkPipelineCreateBitmask a -> ReadPrec (VkPipelineCreateBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineCreateBitmask a
forall (a :: FlagType). VkPipelineCreateBitmask a
VK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT),
              (String
"VK_PIPELINE_CREATE_DERIVATIVE_BIT",
               VkPipelineCreateBitmask a -> ReadPrec (VkPipelineCreateBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineCreateBitmask a
forall (a :: FlagType). VkPipelineCreateBitmask a
VK_PIPELINE_CREATE_DERIVATIVE_BIT)]
             ReadPrec (VkPipelineCreateBitmask a)
-> ReadPrec (VkPipelineCreateBitmask a)
-> ReadPrec (VkPipelineCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkPipelineCreateBitmask a)
-> ReadPrec (VkPipelineCreateBitmask a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineCreateBitmask") ReadPrec ()
-> ReadPrec (VkPipelineCreateBitmask a)
-> ReadPrec (VkPipelineCreateBitmask a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkPipelineCreateBitmask a
forall (a :: FlagType). VkFlags -> VkPipelineCreateBitmask a
VkPipelineCreateBitmask (VkFlags -> VkPipelineCreateBitmask a)
-> ReadPrec VkFlags -> ReadPrec (VkPipelineCreateBitmask a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

-- | bitpos = @0@
pattern VK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT ::
        VkPipelineCreateBitmask a

pattern $bVK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT :: forall (a :: FlagType). VkPipelineCreateBitmask a
$mVK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT :: forall {r} {a :: FlagType}.
VkPipelineCreateBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_CREATE_DISABLE_OPTIMIZATION_BIT =
        VkPipelineCreateBitmask 1

-- | bitpos = @1@
pattern VK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT ::
        VkPipelineCreateBitmask a

pattern $bVK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT :: forall (a :: FlagType). VkPipelineCreateBitmask a
$mVK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT :: forall {r} {a :: FlagType}.
VkPipelineCreateBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT =
        VkPipelineCreateBitmask 2

-- | bitpos = @2@
pattern VK_PIPELINE_CREATE_DERIVATIVE_BIT ::
        VkPipelineCreateBitmask a

pattern $bVK_PIPELINE_CREATE_DERIVATIVE_BIT :: forall (a :: FlagType). VkPipelineCreateBitmask a
$mVK_PIPELINE_CREATE_DERIVATIVE_BIT :: forall {r} {a :: FlagType}.
VkPipelineCreateBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_CREATE_DERIVATIVE_BIT =
        VkPipelineCreateBitmask 4

newtype VkPipelineCreationFeedbackBitmaskEXT (a ::
                                                FlagType) = VkPipelineCreationFeedbackBitmaskEXT VkFlags
                                                            deriving (VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
(VkPipelineCreationFeedbackBitmaskEXT a
 -> VkPipelineCreationFeedbackBitmaskEXT a -> Bool)
-> (VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a -> Bool)
-> Eq (VkPipelineCreationFeedbackBitmaskEXT a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
/= :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
$c/= :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
== :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
$c== :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
Eq, Eq (VkPipelineCreationFeedbackBitmaskEXT a)
Eq (VkPipelineCreationFeedbackBitmaskEXT a)
-> (VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a -> Ordering)
-> (VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a -> Bool)
-> (VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a -> Bool)
-> (VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a -> Bool)
-> (VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a -> Bool)
-> (VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a)
-> (VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a
    -> VkPipelineCreationFeedbackBitmaskEXT a)
-> Ord (VkPipelineCreationFeedbackBitmaskEXT a)
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Ordering
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkPipelineCreationFeedbackBitmaskEXT a)
forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Ordering
forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
min :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
$cmin :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
max :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
$cmax :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a
>= :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
$c>= :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
> :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
$c> :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
<= :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
$c<= :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
< :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
$c< :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Bool
compare :: VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Ordering
$ccompare :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a
-> VkPipelineCreationFeedbackBitmaskEXT a -> Ordering
Ord, Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> IO (VkPipelineCreationFeedbackBitmaskEXT a)
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a)
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
VkPipelineCreationFeedbackBitmaskEXT a -> Int
(VkPipelineCreationFeedbackBitmaskEXT a -> Int)
-> (VkPipelineCreationFeedbackBitmaskEXT a -> Int)
-> (Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
    -> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a))
-> (Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
    -> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ())
-> (forall b.
    Ptr b -> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a))
-> (forall b.
    Ptr b -> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ())
-> (Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
    -> IO (VkPipelineCreationFeedbackBitmaskEXT a))
-> (Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
    -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ())
-> Storable (VkPipelineCreationFeedbackBitmaskEXT a)
forall b.
Ptr b -> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a)
forall b.
Ptr b -> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> IO (VkPipelineCreationFeedbackBitmaskEXT a)
forall (a :: FlagType).
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a)
forall (a :: FlagType).
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
forall (a :: FlagType).
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
poke :: Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
peek :: Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> IO (VkPipelineCreationFeedbackBitmaskEXT a)
$cpeek :: forall (a :: FlagType).
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> IO (VkPipelineCreationFeedbackBitmaskEXT a)
pokeByteOff :: forall b.
Ptr b -> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
peekByteOff :: forall b.
Ptr b -> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a)
pokeElemOff :: Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> Int -> VkPipelineCreationFeedbackBitmaskEXT a -> IO ()
peekElemOff :: Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkPipelineCreationFeedbackBitmaskEXT a)
-> Int -> IO (VkPipelineCreationFeedbackBitmaskEXT a)
alignment :: VkPipelineCreationFeedbackBitmaskEXT a -> Int
$calignment :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a -> Int
sizeOf :: VkPipelineCreationFeedbackBitmaskEXT a -> Int
$csizeOf :: forall (a :: FlagType).
VkPipelineCreationFeedbackBitmaskEXT a -> Int
Storable)

type VkPipelineCreationFeedbackFlagsEXT =
     VkPipelineCreationFeedbackBitmaskEXT FlagMask

type VkPipelineCreationFeedbackFlagBitsEXT =
     VkPipelineCreationFeedbackBitmaskEXT FlagBit

pattern VkPipelineCreationFeedbackFlagBitsEXT ::
        VkFlags -> VkPipelineCreationFeedbackBitmaskEXT FlagBit

pattern $bVkPipelineCreationFeedbackFlagBitsEXT :: VkFlags -> VkPipelineCreationFeedbackBitmaskEXT FlagBit
$mVkPipelineCreationFeedbackFlagBitsEXT :: forall {r}.
VkPipelineCreationFeedbackBitmaskEXT FlagBit
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineCreationFeedbackFlagBitsEXT n =
        VkPipelineCreationFeedbackBitmaskEXT n

pattern VkPipelineCreationFeedbackFlagsEXT ::
        VkFlags -> VkPipelineCreationFeedbackBitmaskEXT FlagMask

pattern $bVkPipelineCreationFeedbackFlagsEXT :: VkFlags -> VkPipelineCreationFeedbackBitmaskEXT FlagMask
$mVkPipelineCreationFeedbackFlagsEXT :: forall {r}.
VkPipelineCreationFeedbackBitmaskEXT FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineCreationFeedbackFlagsEXT n =
        VkPipelineCreationFeedbackBitmaskEXT n

deriving instance
         Bits (VkPipelineCreationFeedbackBitmaskEXT FlagMask)

deriving instance
         FiniteBits (VkPipelineCreationFeedbackBitmaskEXT FlagMask)

instance Show (VkPipelineCreationFeedbackBitmaskEXT a) where
    showsPrec :: Int -> VkPipelineCreationFeedbackBitmaskEXT a -> ShowS
showsPrec Int
_ VkPipelineCreationFeedbackBitmaskEXT a
VK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT
      = String -> ShowS
showString String
"VK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT"
    showsPrec Int
_
      VkPipelineCreationFeedbackBitmaskEXT a
VK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT
      = String -> ShowS
showString
          String
"VK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT"
    showsPrec Int
_
      VkPipelineCreationFeedbackBitmaskEXT a
VK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT
      = String -> ShowS
showString
          String
"VK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT"
    showsPrec Int
p (VkPipelineCreationFeedbackBitmaskEXT VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineCreationFeedbackBitmaskEXT " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkPipelineCreationFeedbackBitmaskEXT a) where
    readPrec :: ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
readPrec
      = ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a))]
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT",
               VkPipelineCreationFeedbackBitmaskEXT a
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineCreationFeedbackBitmaskEXT a
forall (a :: FlagType). VkPipelineCreationFeedbackBitmaskEXT a
VK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT),
              (String
"VK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT",
               VkPipelineCreationFeedbackBitmaskEXT a
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                 VkPipelineCreationFeedbackBitmaskEXT a
forall (a :: FlagType). VkPipelineCreationFeedbackBitmaskEXT a
VK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT),
              (String
"VK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT",
               VkPipelineCreationFeedbackBitmaskEXT a
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                 VkPipelineCreationFeedbackBitmaskEXT a
forall (a :: FlagType). VkPipelineCreationFeedbackBitmaskEXT a
VK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT)]
             ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineCreationFeedbackBitmaskEXT") ReadPrec ()
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkPipelineCreationFeedbackBitmaskEXT a
forall (a :: FlagType).
VkFlags -> VkPipelineCreationFeedbackBitmaskEXT a
VkPipelineCreationFeedbackBitmaskEXT (VkFlags -> VkPipelineCreationFeedbackBitmaskEXT a)
-> ReadPrec VkFlags
-> ReadPrec (VkPipelineCreationFeedbackBitmaskEXT a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

-- | bitpos = @0@
pattern VK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT ::
        VkPipelineCreationFeedbackBitmaskEXT a

pattern $bVK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT :: forall (a :: FlagType). VkPipelineCreationFeedbackBitmaskEXT a
$mVK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT :: forall {r} {a :: FlagType}.
VkPipelineCreationFeedbackBitmaskEXT a
-> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_CREATION_FEEDBACK_VALID_BIT_EXT =
        VkPipelineCreationFeedbackBitmaskEXT 1

-- | bitpos = @1@
pattern VK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT
        :: VkPipelineCreationFeedbackBitmaskEXT a

pattern $bVK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT :: forall (a :: FlagType). VkPipelineCreationFeedbackBitmaskEXT a
$mVK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT :: forall {r} {a :: FlagType}.
VkPipelineCreationFeedbackBitmaskEXT a
-> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_CREATION_FEEDBACK_APPLICATION_PIPELINE_CACHE_HIT_BIT_EXT
        = VkPipelineCreationFeedbackBitmaskEXT 2

-- | bitpos = @2@
pattern VK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT
        :: VkPipelineCreationFeedbackBitmaskEXT a

pattern $bVK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT :: forall (a :: FlagType). VkPipelineCreationFeedbackBitmaskEXT a
$mVK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT :: forall {r} {a :: FlagType}.
VkPipelineCreationFeedbackBitmaskEXT a
-> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_CREATION_FEEDBACK_BASE_PIPELINE_ACCELERATION_BIT_EXT
        = VkPipelineCreationFeedbackBitmaskEXT 4

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkPipelineExecutableStatisticFormatKHR VkPipelineExecutableStatisticFormatKHR registry at www.khronos.org>
newtype VkPipelineExecutableStatisticFormatKHR = VkPipelineExecutableStatisticFormatKHR Int32
                                                 deriving (VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
(VkPipelineExecutableStatisticFormatKHR
 -> VkPipelineExecutableStatisticFormatKHR -> Bool)
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR -> Bool)
-> Eq VkPipelineExecutableStatisticFormatKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
$c/= :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
== :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
$c== :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
Eq, Eq VkPipelineExecutableStatisticFormatKHR
Eq VkPipelineExecutableStatisticFormatKHR
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR -> Ordering)
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR -> Bool)
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR -> Bool)
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR -> Bool)
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR -> Bool)
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR)
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR)
-> Ord VkPipelineExecutableStatisticFormatKHR
VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Ordering
VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
$cmin :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
max :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
$cmax :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
>= :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
$c>= :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
> :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
$c> :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
<= :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
$c<= :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
< :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
$c< :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Bool
compare :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Ordering
$ccompare :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> Ordering
Ord, Int -> VkPipelineExecutableStatisticFormatKHR
VkPipelineExecutableStatisticFormatKHR -> Int
VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
(VkPipelineExecutableStatisticFormatKHR
 -> VkPipelineExecutableStatisticFormatKHR)
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR)
-> (Int -> VkPipelineExecutableStatisticFormatKHR)
-> (VkPipelineExecutableStatisticFormatKHR -> Int)
-> (VkPipelineExecutableStatisticFormatKHR
    -> [VkPipelineExecutableStatisticFormatKHR])
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR
    -> [VkPipelineExecutableStatisticFormatKHR])
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR
    -> [VkPipelineExecutableStatisticFormatKHR])
-> (VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR
    -> [VkPipelineExecutableStatisticFormatKHR])
-> Enum VkPipelineExecutableStatisticFormatKHR
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
$cenumFromThenTo :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
enumFromTo :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
$cenumFromTo :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
enumFromThen :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
$cenumFromThen :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
enumFrom :: VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
$cenumFrom :: VkPipelineExecutableStatisticFormatKHR
-> [VkPipelineExecutableStatisticFormatKHR]
fromEnum :: VkPipelineExecutableStatisticFormatKHR -> Int
$cfromEnum :: VkPipelineExecutableStatisticFormatKHR -> Int
toEnum :: Int -> VkPipelineExecutableStatisticFormatKHR
$ctoEnum :: Int -> VkPipelineExecutableStatisticFormatKHR
pred :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
$cpred :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
succ :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
$csucc :: VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR
Enum, Ptr VkPipelineExecutableStatisticFormatKHR
-> IO VkPipelineExecutableStatisticFormatKHR
Ptr VkPipelineExecutableStatisticFormatKHR
-> Int -> IO VkPipelineExecutableStatisticFormatKHR
Ptr VkPipelineExecutableStatisticFormatKHR
-> Int -> VkPipelineExecutableStatisticFormatKHR -> IO ()
Ptr VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> IO ()
VkPipelineExecutableStatisticFormatKHR -> Int
(VkPipelineExecutableStatisticFormatKHR -> Int)
-> (VkPipelineExecutableStatisticFormatKHR -> Int)
-> (Ptr VkPipelineExecutableStatisticFormatKHR
    -> Int -> IO VkPipelineExecutableStatisticFormatKHR)
-> (Ptr VkPipelineExecutableStatisticFormatKHR
    -> Int -> VkPipelineExecutableStatisticFormatKHR -> IO ())
-> (forall b.
    Ptr b -> Int -> IO VkPipelineExecutableStatisticFormatKHR)
-> (forall b.
    Ptr b -> Int -> VkPipelineExecutableStatisticFormatKHR -> IO ())
-> (Ptr VkPipelineExecutableStatisticFormatKHR
    -> IO VkPipelineExecutableStatisticFormatKHR)
-> (Ptr VkPipelineExecutableStatisticFormatKHR
    -> VkPipelineExecutableStatisticFormatKHR -> IO ())
-> Storable VkPipelineExecutableStatisticFormatKHR
forall b. Ptr b -> Int -> IO VkPipelineExecutableStatisticFormatKHR
forall b.
Ptr b -> Int -> VkPipelineExecutableStatisticFormatKHR -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> IO ()
$cpoke :: Ptr VkPipelineExecutableStatisticFormatKHR
-> VkPipelineExecutableStatisticFormatKHR -> IO ()
peek :: Ptr VkPipelineExecutableStatisticFormatKHR
-> IO VkPipelineExecutableStatisticFormatKHR
$cpeek :: Ptr VkPipelineExecutableStatisticFormatKHR
-> IO VkPipelineExecutableStatisticFormatKHR
pokeByteOff :: forall b.
Ptr b -> Int -> VkPipelineExecutableStatisticFormatKHR -> IO ()
$cpokeByteOff :: forall b.
Ptr b -> Int -> VkPipelineExecutableStatisticFormatKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkPipelineExecutableStatisticFormatKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkPipelineExecutableStatisticFormatKHR
pokeElemOff :: Ptr VkPipelineExecutableStatisticFormatKHR
-> Int -> VkPipelineExecutableStatisticFormatKHR -> IO ()
$cpokeElemOff :: Ptr VkPipelineExecutableStatisticFormatKHR
-> Int -> VkPipelineExecutableStatisticFormatKHR -> IO ()
peekElemOff :: Ptr VkPipelineExecutableStatisticFormatKHR
-> Int -> IO VkPipelineExecutableStatisticFormatKHR
$cpeekElemOff :: Ptr VkPipelineExecutableStatisticFormatKHR
-> Int -> IO VkPipelineExecutableStatisticFormatKHR
alignment :: VkPipelineExecutableStatisticFormatKHR -> Int
$calignment :: VkPipelineExecutableStatisticFormatKHR -> Int
sizeOf :: VkPipelineExecutableStatisticFormatKHR -> Int
$csizeOf :: VkPipelineExecutableStatisticFormatKHR -> Int
Storable)

instance Show VkPipelineExecutableStatisticFormatKHR where
    showsPrec :: Int -> VkPipelineExecutableStatisticFormatKHR -> ShowS
showsPrec Int
_ VkPipelineExecutableStatisticFormatKHR
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR
      = String -> ShowS
showString String
"VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR"
    showsPrec Int
_ VkPipelineExecutableStatisticFormatKHR
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR
      = String -> ShowS
showString String
"VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR"
    showsPrec Int
_ VkPipelineExecutableStatisticFormatKHR
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR
      = String -> ShowS
showString String
"VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR"
    showsPrec Int
_ VkPipelineExecutableStatisticFormatKHR
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR
      = String -> ShowS
showString String
"VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR"
    showsPrec Int
p (VkPipelineExecutableStatisticFormatKHR Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineExecutableStatisticFormatKHR " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int32
x)

instance Read VkPipelineExecutableStatisticFormatKHR where
    readPrec :: ReadPrec VkPipelineExecutableStatisticFormatKHR
readPrec
      = ReadPrec VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkPipelineExecutableStatisticFormatKHR)]
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR",
               VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineExecutableStatisticFormatKHR
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR),
              (String
"VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR",
               VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineExecutableStatisticFormatKHR
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR),
              (String
"VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR",
               VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineExecutableStatisticFormatKHR
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR),
              (String
"VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR",
               VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineExecutableStatisticFormatKHR
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR)]
             ReadPrec VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineExecutableStatisticFormatKHR") ReadPrec ()
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (Int32 -> VkPipelineExecutableStatisticFormatKHR
VkPipelineExecutableStatisticFormatKHR (Int32 -> VkPipelineExecutableStatisticFormatKHR)
-> ReadPrec Int32
-> ReadPrec VkPipelineExecutableStatisticFormatKHR
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

pattern VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR ::
        VkPipelineExecutableStatisticFormatKHR

pattern $bVK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR :: VkPipelineExecutableStatisticFormatKHR
$mVK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR :: forall {r}.
VkPipelineExecutableStatisticFormatKHR
-> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR =
        VkPipelineExecutableStatisticFormatKHR 0

pattern VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR ::
        VkPipelineExecutableStatisticFormatKHR

pattern $bVK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR :: VkPipelineExecutableStatisticFormatKHR
$mVK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR :: forall {r}.
VkPipelineExecutableStatisticFormatKHR
-> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR =
        VkPipelineExecutableStatisticFormatKHR 1

pattern VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR ::
        VkPipelineExecutableStatisticFormatKHR

pattern $bVK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR :: VkPipelineExecutableStatisticFormatKHR
$mVK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR :: forall {r}.
VkPipelineExecutableStatisticFormatKHR
-> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR =
        VkPipelineExecutableStatisticFormatKHR 2

pattern VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR ::
        VkPipelineExecutableStatisticFormatKHR

pattern $bVK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR :: VkPipelineExecutableStatisticFormatKHR
$mVK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR :: forall {r}.
VkPipelineExecutableStatisticFormatKHR
-> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR =
        VkPipelineExecutableStatisticFormatKHR 3

newtype VkPipelineShaderStageCreateBitmask (a ::
                                              FlagType) = VkPipelineShaderStageCreateBitmask VkFlags
                                                          deriving (VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
(VkPipelineShaderStageCreateBitmask a
 -> VkPipelineShaderStageCreateBitmask a -> Bool)
-> (VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a -> Bool)
-> Eq (VkPipelineShaderStageCreateBitmask a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
/= :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
$c/= :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
== :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
$c== :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
Eq, Eq (VkPipelineShaderStageCreateBitmask a)
Eq (VkPipelineShaderStageCreateBitmask a)
-> (VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a -> Ordering)
-> (VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a -> Bool)
-> (VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a -> Bool)
-> (VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a -> Bool)
-> (VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a -> Bool)
-> (VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a)
-> (VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a
    -> VkPipelineShaderStageCreateBitmask a)
-> Ord (VkPipelineShaderStageCreateBitmask a)
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Ordering
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkPipelineShaderStageCreateBitmask a)
forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Ordering
forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
min :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
$cmin :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
max :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
$cmax :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a
>= :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
$c>= :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
> :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
$c> :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
<= :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
$c<= :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
< :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
$c< :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Bool
compare :: VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Ordering
$ccompare :: forall (a :: FlagType).
VkPipelineShaderStageCreateBitmask a
-> VkPipelineShaderStageCreateBitmask a -> Ordering
Ord, Ptr (VkPipelineShaderStageCreateBitmask a)
-> IO (VkPipelineShaderStageCreateBitmask a)
Ptr (VkPipelineShaderStageCreateBitmask a)
-> Int -> IO (VkPipelineShaderStageCreateBitmask a)
Ptr (VkPipelineShaderStageCreateBitmask a)
-> Int -> VkPipelineShaderStageCreateBitmask a -> IO ()
Ptr (VkPipelineShaderStageCreateBitmask a)
-> VkPipelineShaderStageCreateBitmask a -> IO ()
VkPipelineShaderStageCreateBitmask a -> Int
(VkPipelineShaderStageCreateBitmask a -> Int)
-> (VkPipelineShaderStageCreateBitmask a -> Int)
-> (Ptr (VkPipelineShaderStageCreateBitmask a)
    -> Int -> IO (VkPipelineShaderStageCreateBitmask a))
-> (Ptr (VkPipelineShaderStageCreateBitmask a)
    -> Int -> VkPipelineShaderStageCreateBitmask a -> IO ())
-> (forall b.
    Ptr b -> Int -> IO (VkPipelineShaderStageCreateBitmask a))
-> (forall b.
    Ptr b -> Int -> VkPipelineShaderStageCreateBitmask a -> IO ())
-> (Ptr (VkPipelineShaderStageCreateBitmask a)
    -> IO (VkPipelineShaderStageCreateBitmask a))
-> (Ptr (VkPipelineShaderStageCreateBitmask a)
    -> VkPipelineShaderStageCreateBitmask a -> IO ())
-> Storable (VkPipelineShaderStageCreateBitmask a)
forall b. Ptr b -> Int -> IO (VkPipelineShaderStageCreateBitmask a)
forall b.
Ptr b -> Int -> VkPipelineShaderStageCreateBitmask a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkPipelineShaderStageCreateBitmask a)
-> IO (VkPipelineShaderStageCreateBitmask a)
forall (a :: FlagType).
Ptr (VkPipelineShaderStageCreateBitmask a)
-> Int -> IO (VkPipelineShaderStageCreateBitmask a)
forall (a :: FlagType).
Ptr (VkPipelineShaderStageCreateBitmask a)
-> Int -> VkPipelineShaderStageCreateBitmask a -> IO ()
forall (a :: FlagType).
Ptr (VkPipelineShaderStageCreateBitmask a)
-> VkPipelineShaderStageCreateBitmask a -> IO ()
forall (a :: FlagType). VkPipelineShaderStageCreateBitmask a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineShaderStageCreateBitmask a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineShaderStageCreateBitmask a -> IO ()
poke :: Ptr (VkPipelineShaderStageCreateBitmask a)
-> VkPipelineShaderStageCreateBitmask a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkPipelineShaderStageCreateBitmask a)
-> VkPipelineShaderStageCreateBitmask a -> IO ()
peek :: Ptr (VkPipelineShaderStageCreateBitmask a)
-> IO (VkPipelineShaderStageCreateBitmask a)
$cpeek :: forall (a :: FlagType).
Ptr (VkPipelineShaderStageCreateBitmask a)
-> IO (VkPipelineShaderStageCreateBitmask a)
pokeByteOff :: forall b.
Ptr b -> Int -> VkPipelineShaderStageCreateBitmask a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineShaderStageCreateBitmask a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkPipelineShaderStageCreateBitmask a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineShaderStageCreateBitmask a)
pokeElemOff :: Ptr (VkPipelineShaderStageCreateBitmask a)
-> Int -> VkPipelineShaderStageCreateBitmask a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkPipelineShaderStageCreateBitmask a)
-> Int -> VkPipelineShaderStageCreateBitmask a -> IO ()
peekElemOff :: Ptr (VkPipelineShaderStageCreateBitmask a)
-> Int -> IO (VkPipelineShaderStageCreateBitmask a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkPipelineShaderStageCreateBitmask a)
-> Int -> IO (VkPipelineShaderStageCreateBitmask a)
alignment :: VkPipelineShaderStageCreateBitmask a -> Int
$calignment :: forall (a :: FlagType). VkPipelineShaderStageCreateBitmask a -> Int
sizeOf :: VkPipelineShaderStageCreateBitmask a -> Int
$csizeOf :: forall (a :: FlagType). VkPipelineShaderStageCreateBitmask a -> Int
Storable)

type VkPipelineShaderStageCreateFlags =
     VkPipelineShaderStageCreateBitmask FlagMask

type VkPipelineShaderStageCreateFlagBits =
     VkPipelineShaderStageCreateBitmask FlagBit

pattern VkPipelineShaderStageCreateFlagBits ::
        VkFlags -> VkPipelineShaderStageCreateBitmask FlagBit

pattern $bVkPipelineShaderStageCreateFlagBits :: VkFlags -> VkPipelineShaderStageCreateBitmask FlagBit
$mVkPipelineShaderStageCreateFlagBits :: forall {r}.
VkPipelineShaderStageCreateBitmask FlagBit
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineShaderStageCreateFlagBits n =
        VkPipelineShaderStageCreateBitmask n

pattern VkPipelineShaderStageCreateFlags ::
        VkFlags -> VkPipelineShaderStageCreateBitmask FlagMask

pattern $bVkPipelineShaderStageCreateFlags :: VkFlags -> VkPipelineShaderStageCreateBitmask FlagMask
$mVkPipelineShaderStageCreateFlags :: forall {r}.
VkPipelineShaderStageCreateBitmask FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineShaderStageCreateFlags n =
        VkPipelineShaderStageCreateBitmask n

deriving instance
         Bits (VkPipelineShaderStageCreateBitmask FlagMask)

deriving instance
         FiniteBits (VkPipelineShaderStageCreateBitmask FlagMask)

instance Show (VkPipelineShaderStageCreateBitmask a) where
    showsPrec :: Int -> VkPipelineShaderStageCreateBitmask a -> ShowS
showsPrec Int
p (VkPipelineShaderStageCreateBitmask VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineShaderStageCreateBitmask " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkPipelineShaderStageCreateBitmask a) where
    readPrec :: ReadPrec (VkPipelineShaderStageCreateBitmask a)
readPrec
      = ReadPrec (VkPipelineShaderStageCreateBitmask a)
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkPipelineShaderStageCreateBitmask a))]
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [] ReadPrec (VkPipelineShaderStageCreateBitmask a)
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineShaderStageCreateBitmask") ReadPrec ()
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkPipelineShaderStageCreateBitmask a
forall (a :: FlagType).
VkFlags -> VkPipelineShaderStageCreateBitmask a
VkPipelineShaderStageCreateBitmask (VkFlags -> VkPipelineShaderStageCreateBitmask a)
-> ReadPrec VkFlags
-> ReadPrec (VkPipelineShaderStageCreateBitmask a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

newtype VkPipelineStageBitmask (a ::
                                  FlagType) = VkPipelineStageBitmask VkFlags
                                              deriving (VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
(VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool)
-> (VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool)
-> Eq (VkPipelineStageBitmask a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
/= :: VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
$c/= :: forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
== :: VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
$c== :: forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
Eq, Eq (VkPipelineStageBitmask a)
Eq (VkPipelineStageBitmask a)
-> (VkPipelineStageBitmask a
    -> VkPipelineStageBitmask a -> Ordering)
-> (VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool)
-> (VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool)
-> (VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool)
-> (VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool)
-> (VkPipelineStageBitmask a
    -> VkPipelineStageBitmask a -> VkPipelineStageBitmask a)
-> (VkPipelineStageBitmask a
    -> VkPipelineStageBitmask a -> VkPipelineStageBitmask a)
-> Ord (VkPipelineStageBitmask a)
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Ordering
VkPipelineStageBitmask a
-> VkPipelineStageBitmask a -> VkPipelineStageBitmask a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkPipelineStageBitmask a)
forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Ordering
forall (a :: FlagType).
VkPipelineStageBitmask a
-> VkPipelineStageBitmask a -> VkPipelineStageBitmask a
min :: VkPipelineStageBitmask a
-> VkPipelineStageBitmask a -> VkPipelineStageBitmask a
$cmin :: forall (a :: FlagType).
VkPipelineStageBitmask a
-> VkPipelineStageBitmask a -> VkPipelineStageBitmask a
max :: VkPipelineStageBitmask a
-> VkPipelineStageBitmask a -> VkPipelineStageBitmask a
$cmax :: forall (a :: FlagType).
VkPipelineStageBitmask a
-> VkPipelineStageBitmask a -> VkPipelineStageBitmask a
>= :: VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
$c>= :: forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
> :: VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
$c> :: forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
<= :: VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
$c<= :: forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
< :: VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
$c< :: forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Bool
compare :: VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Ordering
$ccompare :: forall (a :: FlagType).
VkPipelineStageBitmask a -> VkPipelineStageBitmask a -> Ordering
Ord, Ptr (VkPipelineStageBitmask a) -> IO (VkPipelineStageBitmask a)
Ptr (VkPipelineStageBitmask a)
-> Int -> IO (VkPipelineStageBitmask a)
Ptr (VkPipelineStageBitmask a)
-> Int -> VkPipelineStageBitmask a -> IO ()
Ptr (VkPipelineStageBitmask a) -> VkPipelineStageBitmask a -> IO ()
VkPipelineStageBitmask a -> Int
(VkPipelineStageBitmask a -> Int)
-> (VkPipelineStageBitmask a -> Int)
-> (Ptr (VkPipelineStageBitmask a)
    -> Int -> IO (VkPipelineStageBitmask a))
-> (Ptr (VkPipelineStageBitmask a)
    -> Int -> VkPipelineStageBitmask a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkPipelineStageBitmask a))
-> (forall b. Ptr b -> Int -> VkPipelineStageBitmask a -> IO ())
-> (Ptr (VkPipelineStageBitmask a)
    -> IO (VkPipelineStageBitmask a))
-> (Ptr (VkPipelineStageBitmask a)
    -> VkPipelineStageBitmask a -> IO ())
-> Storable (VkPipelineStageBitmask a)
forall b. Ptr b -> Int -> IO (VkPipelineStageBitmask a)
forall b. Ptr b -> Int -> VkPipelineStageBitmask a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkPipelineStageBitmask a) -> IO (VkPipelineStageBitmask a)
forall (a :: FlagType).
Ptr (VkPipelineStageBitmask a)
-> Int -> IO (VkPipelineStageBitmask a)
forall (a :: FlagType).
Ptr (VkPipelineStageBitmask a)
-> Int -> VkPipelineStageBitmask a -> IO ()
forall (a :: FlagType).
Ptr (VkPipelineStageBitmask a) -> VkPipelineStageBitmask a -> IO ()
forall (a :: FlagType). VkPipelineStageBitmask a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineStageBitmask a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineStageBitmask a -> IO ()
poke :: Ptr (VkPipelineStageBitmask a) -> VkPipelineStageBitmask a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkPipelineStageBitmask a) -> VkPipelineStageBitmask a -> IO ()
peek :: Ptr (VkPipelineStageBitmask a) -> IO (VkPipelineStageBitmask a)
$cpeek :: forall (a :: FlagType).
Ptr (VkPipelineStageBitmask a) -> IO (VkPipelineStageBitmask a)
pokeByteOff :: forall b. Ptr b -> Int -> VkPipelineStageBitmask a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkPipelineStageBitmask a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkPipelineStageBitmask a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkPipelineStageBitmask a)
pokeElemOff :: Ptr (VkPipelineStageBitmask a)
-> Int -> VkPipelineStageBitmask a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkPipelineStageBitmask a)
-> Int -> VkPipelineStageBitmask a -> IO ()
peekElemOff :: Ptr (VkPipelineStageBitmask a)
-> Int -> IO (VkPipelineStageBitmask a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkPipelineStageBitmask a)
-> Int -> IO (VkPipelineStageBitmask a)
alignment :: VkPipelineStageBitmask a -> Int
$calignment :: forall (a :: FlagType). VkPipelineStageBitmask a -> Int
sizeOf :: VkPipelineStageBitmask a -> Int
$csizeOf :: forall (a :: FlagType). VkPipelineStageBitmask a -> Int
Storable)

type VkPipelineStageFlags = VkPipelineStageBitmask FlagMask

type VkPipelineStageFlagBits = VkPipelineStageBitmask FlagBit

pattern VkPipelineStageFlagBits ::
        VkFlags -> VkPipelineStageBitmask FlagBit

pattern $bVkPipelineStageFlagBits :: VkFlags -> VkPipelineStageBitmask FlagBit
$mVkPipelineStageFlagBits :: forall {r}.
VkPipelineStageBitmask FlagBit
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineStageFlagBits n = VkPipelineStageBitmask n

pattern VkPipelineStageFlags ::
        VkFlags -> VkPipelineStageBitmask FlagMask

pattern $bVkPipelineStageFlags :: VkFlags -> VkPipelineStageBitmask FlagMask
$mVkPipelineStageFlags :: forall {r}.
VkPipelineStageBitmask FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkPipelineStageFlags n = VkPipelineStageBitmask n

deriving instance Bits (VkPipelineStageBitmask FlagMask)

deriving instance FiniteBits (VkPipelineStageBitmask FlagMask)

instance Show (VkPipelineStageBitmask a) where
    showsPrec :: Int -> VkPipelineStageBitmask a -> ShowS
showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_DRAW_INDIRECT_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_DRAW_INDIRECT_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_VERTEX_INPUT_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_VERTEX_INPUT_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_VERTEX_SHADER_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_VERTEX_SHADER_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_TRANSFER_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_TRANSFER_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_HOST_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_HOST_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_ALL_GRAPHICS_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_ALL_GRAPHICS_BIT"
    showsPrec Int
_ VkPipelineStageBitmask a
VK_PIPELINE_STAGE_ALL_COMMANDS_BIT
      = String -> ShowS
showString String
"VK_PIPELINE_STAGE_ALL_COMMANDS_BIT"
    showsPrec Int
p (VkPipelineStageBitmask VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkPipelineStageBitmask " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkPipelineStageBitmask a) where
    readPrec :: ReadPrec (VkPipelineStageBitmask a)
readPrec
      = ReadPrec (VkPipelineStageBitmask a)
-> ReadPrec (VkPipelineStageBitmask a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkPipelineStageBitmask a))]
-> ReadPrec (VkPipelineStageBitmask a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT),
              (String
"VK_PIPELINE_STAGE_DRAW_INDIRECT_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_DRAW_INDIRECT_BIT),
              (String
"VK_PIPELINE_STAGE_VERTEX_INPUT_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_VERTEX_INPUT_BIT),
              (String
"VK_PIPELINE_STAGE_VERTEX_SHADER_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_VERTEX_SHADER_BIT),
              (String
"VK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT),
              (String
"VK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT),
              (String
"VK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT),
              (String
"VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT),
              (String
"VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT),
              (String
"VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT),
              (String
"VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT),
              (String
"VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT),
              (String
"VK_PIPELINE_STAGE_TRANSFER_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_TRANSFER_BIT),
              (String
"VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT),
              (String
"VK_PIPELINE_STAGE_HOST_BIT", VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_HOST_BIT),
              (String
"VK_PIPELINE_STAGE_ALL_GRAPHICS_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_ALL_GRAPHICS_BIT),
              (String
"VK_PIPELINE_STAGE_ALL_COMMANDS_BIT",
               VkPipelineStageBitmask a -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPipelineStageBitmask a
forall (a :: FlagType). VkPipelineStageBitmask a
VK_PIPELINE_STAGE_ALL_COMMANDS_BIT)]
             ReadPrec (VkPipelineStageBitmask a)
-> ReadPrec (VkPipelineStageBitmask a)
-> ReadPrec (VkPipelineStageBitmask a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkPipelineStageBitmask a)
-> ReadPrec (VkPipelineStageBitmask a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPipelineStageBitmask") ReadPrec ()
-> ReadPrec (VkPipelineStageBitmask a)
-> ReadPrec (VkPipelineStageBitmask a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkPipelineStageBitmask a
forall (a :: FlagType). VkFlags -> VkPipelineStageBitmask a
VkPipelineStageBitmask (VkFlags -> VkPipelineStageBitmask a)
-> ReadPrec VkFlags -> ReadPrec (VkPipelineStageBitmask a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

-- | Before subsequent commands are processed
--
--   bitpos = @0@
pattern VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_TOP_OF_PIPE_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_TOP_OF_PIPE_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT =
        VkPipelineStageBitmask 1

-- | Draw/DispatchIndirect command fetch
--
--   bitpos = @1@
pattern VK_PIPELINE_STAGE_DRAW_INDIRECT_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_DRAW_INDIRECT_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_DRAW_INDIRECT_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_DRAW_INDIRECT_BIT =
        VkPipelineStageBitmask 2

-- | Vertex/index fetch
--
--   bitpos = @2@
pattern VK_PIPELINE_STAGE_VERTEX_INPUT_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_VERTEX_INPUT_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_VERTEX_INPUT_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_VERTEX_INPUT_BIT =
        VkPipelineStageBitmask 4

-- | Vertex shading
--
--   bitpos = @3@
pattern VK_PIPELINE_STAGE_VERTEX_SHADER_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_VERTEX_SHADER_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_VERTEX_SHADER_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_VERTEX_SHADER_BIT =
        VkPipelineStageBitmask 8

-- | Tessellation control shading
--
--   bitpos = @4@
pattern VK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT =
        VkPipelineStageBitmask 16

-- | Tessellation evaluation shading
--
--   bitpos = @5@
pattern VK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT =
        VkPipelineStageBitmask 32

-- | Geometry shading
--
--   bitpos = @6@
pattern VK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_GEOMETRY_SHADER_BIT =
        VkPipelineStageBitmask 64

-- | Fragment shading
--
--   bitpos = @7@
pattern VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT =
        VkPipelineStageBitmask 128

-- | Early fragment (depth and stencil) tests
--
--   bitpos = @8@
pattern VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT =
        VkPipelineStageBitmask 256

-- | Late fragment (depth and stencil) tests
--
--   bitpos = @9@
pattern VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT =
        VkPipelineStageBitmask 512

-- | Color attachment writes
--
--   bitpos = @10@
pattern VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT =
        VkPipelineStageBitmask 1024

-- | Compute shading
--
--   bitpos = @11@
pattern VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_COMPUTE_SHADER_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_COMPUTE_SHADER_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT =
        VkPipelineStageBitmask 2048

-- | Transfer/copy operations
--
--   bitpos = @12@
pattern VK_PIPELINE_STAGE_TRANSFER_BIT :: VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_TRANSFER_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_TRANSFER_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_TRANSFER_BIT =
        VkPipelineStageBitmask 4096

-- | After previous commands have completed
--
--   bitpos = @13@
pattern VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT =
        VkPipelineStageBitmask 8192

-- | Indicates host (CPU) is a source/sink of the dependency
--
--   bitpos = @14@
pattern VK_PIPELINE_STAGE_HOST_BIT :: VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_HOST_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_HOST_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_HOST_BIT = VkPipelineStageBitmask 16384

-- | All stages of the graphics pipeline
--
--   bitpos = @15@
pattern VK_PIPELINE_STAGE_ALL_GRAPHICS_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_ALL_GRAPHICS_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_ALL_GRAPHICS_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_ALL_GRAPHICS_BIT =
        VkPipelineStageBitmask 32768

-- | All stages supported on the queue
--
--   bitpos = @16@
pattern VK_PIPELINE_STAGE_ALL_COMMANDS_BIT ::
        VkPipelineStageBitmask a

pattern $bVK_PIPELINE_STAGE_ALL_COMMANDS_BIT :: forall (a :: FlagType). VkPipelineStageBitmask a
$mVK_PIPELINE_STAGE_ALL_COMMANDS_BIT :: forall {r} {a :: FlagType}.
VkPipelineStageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_PIPELINE_STAGE_ALL_COMMANDS_BIT =
        VkPipelineStageBitmask 65536