{-# language CPP #-}
module Vulkan.Core10.Enums.MemoryPropertyFlagBits  ( MemoryPropertyFlagBits( MEMORY_PROPERTY_DEVICE_LOCAL_BIT
                                                                           , MEMORY_PROPERTY_HOST_VISIBLE_BIT
                                                                           , MEMORY_PROPERTY_HOST_COHERENT_BIT
                                                                           , MEMORY_PROPERTY_HOST_CACHED_BIT
                                                                           , MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT
                                                                           , MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD
                                                                           , MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD
                                                                           , MEMORY_PROPERTY_PROTECTED_BIT
                                                                           , ..
                                                                           )
                                                   , MemoryPropertyFlags
                                                   ) where

import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Data.Bits (Bits)
import Foreign.Storable (Storable)
import GHC.Read (Read(readPrec))
import Text.Read.Lex (Lexeme(Ident))
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Zero (Zero)
-- | VkMemoryPropertyFlagBits - Bitmask specifying properties for a memory
-- type
--
-- = Description
--
-- For any memory allocated with both the
-- 'MEMORY_PROPERTY_HOST_COHERENT_BIT' and the
-- 'MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD', host or device accesses also
-- perform automatic memory domain transfer operations, such that writes
-- are always automatically available and visible to both host and device
-- memory domains.
--
-- Note
--
-- Device coherence is a useful property for certain debugging use cases
-- (e.g. crash analysis, where performing separate coherence actions could
-- mean values are not reported correctly). However, device coherent
-- accesses may be slower than equivalent accesses without device
-- coherence, particularly if they are also device uncached. For device
-- uncached memory in particular, repeated accesses to the same or
-- neighbouring memory locations over a short time period (e.g. within a
-- frame) may be slower than it would be for the equivalent cached memory
-- type. As such, it is generally inadvisable to use device coherent or
-- device uncached memory except when really needed.
--
-- = See Also
--
-- 'MemoryPropertyFlags'
newtype MemoryPropertyFlagBits = MemoryPropertyFlagBits Flags
  deriving newtype (MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
(MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool)
-> (MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool)
-> Eq MemoryPropertyFlagBits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
$c/= :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
== :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
$c== :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
Eq, Eq MemoryPropertyFlagBits
Eq MemoryPropertyFlagBits =>
(MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Ordering)
-> (MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool)
-> (MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool)
-> (MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool)
-> (MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool)
-> (MemoryPropertyFlagBits
    -> MemoryPropertyFlagBits -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits
    -> MemoryPropertyFlagBits -> MemoryPropertyFlagBits)
-> Ord MemoryPropertyFlagBits
MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Ordering
MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
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 :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
$cmin :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
max :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
$cmax :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
>= :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
$c>= :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
> :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
$c> :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
<= :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
$c<= :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
< :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
$c< :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Bool
compare :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Ordering
$ccompare :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> Ordering
$cp1Ord :: Eq MemoryPropertyFlagBits
Ord, Ptr b -> Int -> IO MemoryPropertyFlagBits
Ptr b -> Int -> MemoryPropertyFlagBits -> IO ()
Ptr MemoryPropertyFlagBits -> IO MemoryPropertyFlagBits
Ptr MemoryPropertyFlagBits -> Int -> IO MemoryPropertyFlagBits
Ptr MemoryPropertyFlagBits
-> Int -> MemoryPropertyFlagBits -> IO ()
Ptr MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> IO ()
MemoryPropertyFlagBits -> Int
(MemoryPropertyFlagBits -> Int)
-> (MemoryPropertyFlagBits -> Int)
-> (Ptr MemoryPropertyFlagBits -> Int -> IO MemoryPropertyFlagBits)
-> (Ptr MemoryPropertyFlagBits
    -> Int -> MemoryPropertyFlagBits -> IO ())
-> (forall b. Ptr b -> Int -> IO MemoryPropertyFlagBits)
-> (forall b. Ptr b -> Int -> MemoryPropertyFlagBits -> IO ())
-> (Ptr MemoryPropertyFlagBits -> IO MemoryPropertyFlagBits)
-> (Ptr MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> IO ())
-> Storable MemoryPropertyFlagBits
forall b. Ptr b -> Int -> IO MemoryPropertyFlagBits
forall b. Ptr b -> Int -> MemoryPropertyFlagBits -> 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 MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> IO ()
$cpoke :: Ptr MemoryPropertyFlagBits -> MemoryPropertyFlagBits -> IO ()
peek :: Ptr MemoryPropertyFlagBits -> IO MemoryPropertyFlagBits
$cpeek :: Ptr MemoryPropertyFlagBits -> IO MemoryPropertyFlagBits
pokeByteOff :: Ptr b -> Int -> MemoryPropertyFlagBits -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> MemoryPropertyFlagBits -> IO ()
peekByteOff :: Ptr b -> Int -> IO MemoryPropertyFlagBits
$cpeekByteOff :: forall b. Ptr b -> Int -> IO MemoryPropertyFlagBits
pokeElemOff :: Ptr MemoryPropertyFlagBits
-> Int -> MemoryPropertyFlagBits -> IO ()
$cpokeElemOff :: Ptr MemoryPropertyFlagBits
-> Int -> MemoryPropertyFlagBits -> IO ()
peekElemOff :: Ptr MemoryPropertyFlagBits -> Int -> IO MemoryPropertyFlagBits
$cpeekElemOff :: Ptr MemoryPropertyFlagBits -> Int -> IO MemoryPropertyFlagBits
alignment :: MemoryPropertyFlagBits -> Int
$calignment :: MemoryPropertyFlagBits -> Int
sizeOf :: MemoryPropertyFlagBits -> Int
$csizeOf :: MemoryPropertyFlagBits -> Int
Storable, MemoryPropertyFlagBits
MemoryPropertyFlagBits -> Zero MemoryPropertyFlagBits
forall a. a -> Zero a
zero :: MemoryPropertyFlagBits
$czero :: MemoryPropertyFlagBits
Zero, Eq MemoryPropertyFlagBits
MemoryPropertyFlagBits
Eq MemoryPropertyFlagBits =>
(MemoryPropertyFlagBits
 -> MemoryPropertyFlagBits -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits
    -> MemoryPropertyFlagBits -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits
    -> MemoryPropertyFlagBits -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> MemoryPropertyFlagBits
-> (Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> Bool)
-> (MemoryPropertyFlagBits -> Maybe Int)
-> (MemoryPropertyFlagBits -> Int)
-> (MemoryPropertyFlagBits -> Bool)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits)
-> (MemoryPropertyFlagBits -> Int)
-> Bits MemoryPropertyFlagBits
Int -> MemoryPropertyFlagBits
MemoryPropertyFlagBits -> Bool
MemoryPropertyFlagBits -> Int
MemoryPropertyFlagBits -> Maybe Int
MemoryPropertyFlagBits -> MemoryPropertyFlagBits
MemoryPropertyFlagBits -> Int -> Bool
MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: MemoryPropertyFlagBits -> Int
$cpopCount :: MemoryPropertyFlagBits -> Int
rotateR :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$crotateR :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
rotateL :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$crotateL :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
unsafeShiftR :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$cunsafeShiftR :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
shiftR :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$cshiftR :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
unsafeShiftL :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$cunsafeShiftL :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
shiftL :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$cshiftL :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
isSigned :: MemoryPropertyFlagBits -> Bool
$cisSigned :: MemoryPropertyFlagBits -> Bool
bitSize :: MemoryPropertyFlagBits -> Int
$cbitSize :: MemoryPropertyFlagBits -> Int
bitSizeMaybe :: MemoryPropertyFlagBits -> Maybe Int
$cbitSizeMaybe :: MemoryPropertyFlagBits -> Maybe Int
testBit :: MemoryPropertyFlagBits -> Int -> Bool
$ctestBit :: MemoryPropertyFlagBits -> Int -> Bool
complementBit :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$ccomplementBit :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
clearBit :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$cclearBit :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
setBit :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$csetBit :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
bit :: Int -> MemoryPropertyFlagBits
$cbit :: Int -> MemoryPropertyFlagBits
zeroBits :: MemoryPropertyFlagBits
$czeroBits :: MemoryPropertyFlagBits
rotate :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$crotate :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
shift :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
$cshift :: MemoryPropertyFlagBits -> Int -> MemoryPropertyFlagBits
complement :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits
$ccomplement :: MemoryPropertyFlagBits -> MemoryPropertyFlagBits
xor :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
$cxor :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
.|. :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
$c.|. :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
.&. :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
$c.&. :: MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
$cp1Bits :: Eq MemoryPropertyFlagBits
Bits)

-- | 'MEMORY_PROPERTY_DEVICE_LOCAL_BIT' bit specifies that memory allocated
-- with this type is the most efficient for device access. This property
-- will be set if and only if the memory type belongs to a heap with the
-- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MEMORY_HEAP_DEVICE_LOCAL_BIT'
-- set.
pattern $bMEMORY_PROPERTY_DEVICE_LOCAL_BIT :: MemoryPropertyFlagBits
$mMEMORY_PROPERTY_DEVICE_LOCAL_BIT :: forall r.
MemoryPropertyFlagBits -> (Void# -> r) -> (Void# -> r) -> r
MEMORY_PROPERTY_DEVICE_LOCAL_BIT = MemoryPropertyFlagBits 0x00000001
-- | 'MEMORY_PROPERTY_HOST_VISIBLE_BIT' bit specifies that memory allocated
-- with this type /can/ be mapped for host access using
-- 'Vulkan.Core10.Memory.mapMemory'.
pattern $bMEMORY_PROPERTY_HOST_VISIBLE_BIT :: MemoryPropertyFlagBits
$mMEMORY_PROPERTY_HOST_VISIBLE_BIT :: forall r.
MemoryPropertyFlagBits -> (Void# -> r) -> (Void# -> r) -> r
MEMORY_PROPERTY_HOST_VISIBLE_BIT = MemoryPropertyFlagBits 0x00000002
-- | 'MEMORY_PROPERTY_HOST_COHERENT_BIT' bit specifies that the host cache
-- management commands 'Vulkan.Core10.Memory.flushMappedMemoryRanges' and
-- 'Vulkan.Core10.Memory.invalidateMappedMemoryRanges' are not needed to
-- flush host writes to the device or make device writes visible to the
-- host, respectively.
pattern $bMEMORY_PROPERTY_HOST_COHERENT_BIT :: MemoryPropertyFlagBits
$mMEMORY_PROPERTY_HOST_COHERENT_BIT :: forall r.
MemoryPropertyFlagBits -> (Void# -> r) -> (Void# -> r) -> r
MEMORY_PROPERTY_HOST_COHERENT_BIT = MemoryPropertyFlagBits 0x00000004
-- | 'MEMORY_PROPERTY_HOST_CACHED_BIT' bit specifies that memory allocated
-- with this type is cached on the host. Host memory accesses to uncached
-- memory are slower than to cached memory, however uncached memory is
-- always host coherent.
pattern $bMEMORY_PROPERTY_HOST_CACHED_BIT :: MemoryPropertyFlagBits
$mMEMORY_PROPERTY_HOST_CACHED_BIT :: forall r.
MemoryPropertyFlagBits -> (Void# -> r) -> (Void# -> r) -> r
MEMORY_PROPERTY_HOST_CACHED_BIT = MemoryPropertyFlagBits 0x00000008
-- | 'MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT' bit specifies that the memory
-- type only allows device access to the memory. Memory types /must/ not
-- have both 'MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT' and
-- 'MEMORY_PROPERTY_HOST_VISIBLE_BIT' set. Additionally, the object’s
-- backing memory /may/ be provided by the implementation lazily as
-- specified in
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-device-lazy_allocation Lazily Allocated Memory>.
pattern $bMEMORY_PROPERTY_LAZILY_ALLOCATED_BIT :: MemoryPropertyFlagBits
$mMEMORY_PROPERTY_LAZILY_ALLOCATED_BIT :: forall r.
MemoryPropertyFlagBits -> (Void# -> r) -> (Void# -> r) -> r
MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT = MemoryPropertyFlagBits 0x00000010
-- | 'MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD' bit specifies that memory
-- allocated with this type is not cached on the device. Uncached device
-- memory is always device coherent.
pattern $bMEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD :: MemoryPropertyFlagBits
$mMEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD :: forall r.
MemoryPropertyFlagBits -> (Void# -> r) -> (Void# -> r) -> r
MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD = MemoryPropertyFlagBits 0x00000080
-- | 'MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD' bit specifies that device
-- accesses to allocations of this memory type are automatically made
-- available and visible.
pattern $bMEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD :: MemoryPropertyFlagBits
$mMEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD :: forall r.
MemoryPropertyFlagBits -> (Void# -> r) -> (Void# -> r) -> r
MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD = MemoryPropertyFlagBits 0x00000040
-- | 'MEMORY_PROPERTY_PROTECTED_BIT' bit specifies that the memory type only
-- allows device access to the memory, and allows protected queue
-- operations to access the memory. Memory types /must/ not have
-- 'MEMORY_PROPERTY_PROTECTED_BIT' set and any of
-- 'MEMORY_PROPERTY_HOST_VISIBLE_BIT' set, or
-- 'MEMORY_PROPERTY_HOST_COHERENT_BIT' set, or
-- 'MEMORY_PROPERTY_HOST_CACHED_BIT' set.
pattern $bMEMORY_PROPERTY_PROTECTED_BIT :: MemoryPropertyFlagBits
$mMEMORY_PROPERTY_PROTECTED_BIT :: forall r.
MemoryPropertyFlagBits -> (Void# -> r) -> (Void# -> r) -> r
MEMORY_PROPERTY_PROTECTED_BIT = MemoryPropertyFlagBits 0x00000020

type MemoryPropertyFlags = MemoryPropertyFlagBits

instance Show MemoryPropertyFlagBits where
  showsPrec :: Int -> MemoryPropertyFlagBits -> ShowS
showsPrec p :: Int
p = \case
    MEMORY_PROPERTY_DEVICE_LOCAL_BIT -> String -> ShowS
showString "MEMORY_PROPERTY_DEVICE_LOCAL_BIT"
    MEMORY_PROPERTY_HOST_VISIBLE_BIT -> String -> ShowS
showString "MEMORY_PROPERTY_HOST_VISIBLE_BIT"
    MEMORY_PROPERTY_HOST_COHERENT_BIT -> String -> ShowS
showString "MEMORY_PROPERTY_HOST_COHERENT_BIT"
    MEMORY_PROPERTY_HOST_CACHED_BIT -> String -> ShowS
showString "MEMORY_PROPERTY_HOST_CACHED_BIT"
    MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT -> String -> ShowS
showString "MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT"
    MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD -> String -> ShowS
showString "MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD"
    MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD -> String -> ShowS
showString "MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD"
    MEMORY_PROPERTY_PROTECTED_BIT -> String -> ShowS
showString "MEMORY_PROPERTY_PROTECTED_BIT"
    MemoryPropertyFlagBits x :: Flags
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "MemoryPropertyFlagBits 0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)

instance Read MemoryPropertyFlagBits where
  readPrec :: ReadPrec MemoryPropertyFlagBits
readPrec = ReadPrec MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec MemoryPropertyFlagBits)]
-> ReadPrec MemoryPropertyFlagBits
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("MEMORY_PROPERTY_DEVICE_LOCAL_BIT", MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPropertyFlagBits
MEMORY_PROPERTY_DEVICE_LOCAL_BIT)
                            , ("MEMORY_PROPERTY_HOST_VISIBLE_BIT", MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPropertyFlagBits
MEMORY_PROPERTY_HOST_VISIBLE_BIT)
                            , ("MEMORY_PROPERTY_HOST_COHERENT_BIT", MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPropertyFlagBits
MEMORY_PROPERTY_HOST_COHERENT_BIT)
                            , ("MEMORY_PROPERTY_HOST_CACHED_BIT", MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPropertyFlagBits
MEMORY_PROPERTY_HOST_CACHED_BIT)
                            , ("MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT", MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPropertyFlagBits
MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT)
                            , ("MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD", MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPropertyFlagBits
MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD)
                            , ("MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD", MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPropertyFlagBits
MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD)
                            , ("MEMORY_PROPERTY_PROTECTED_BIT", MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPropertyFlagBits
MEMORY_PROPERTY_PROTECTED_BIT)]
                     ReadPrec MemoryPropertyFlagBits
-> ReadPrec MemoryPropertyFlagBits
-> ReadPrec MemoryPropertyFlagBits
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int
-> ReadPrec MemoryPropertyFlagBits
-> ReadPrec MemoryPropertyFlagBits
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "MemoryPropertyFlagBits")
                       Flags
v <- ReadPrec Flags -> ReadPrec Flags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Flags
forall a. Read a => ReadPrec a
readPrec
                       MemoryPropertyFlagBits -> ReadPrec MemoryPropertyFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flags -> MemoryPropertyFlagBits
MemoryPropertyFlagBits Flags
v)))