{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Memory (

	-- * ALLOCATE AND BIND

	allocateBind, unsafeReallocateBind, unsafeReallocateBind',

	-- ** Destruction Group

	Group, group, allocateBind', unsafeFree, lookup,

	-- ** MEMORY

	M, getBinded,
	ImageBuffer(..), ImageBufferBinded(..), ImageBufferArg(..),

	-- ** ALLOCATE INFO

	AllocateInfo(..), M.MType(..), M.TypeBits, M.TypeIndex, M.elemTypeIndex,
	M.Heap(..),

	-- ** BINDABLE AND REBINDABLE

	Bindable, Rebindable,

	-- * GET REQUREMENTS

	getRequirementsList, M.Requirements(..),

	-- * READ AND WRITE

	read, write, OffsetSize, M.MapFlags,

	-- * BARRIER

	M.Barrier(..),

	-- * OTHERS

	RawOffset(..),

	-- * ENUM

	module Gpu.Vulkan.Memory.Enum,

	) where

import Prelude hiding (map, read, lookup)

import Foreign.Ptr
import Foreign.Storable.PeekPoke
import Control.Concurrent.STM
import Control.Exception hiding (try)
import Gpu.Vulkan.Object qualified as VObj
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.TypeLevel.Tuple.Uncurry
import Data.Maybe
import Data.Map qualified as Map
import Data.HeteroParList qualified as HeteroParList
import Data.IORef

import qualified Gpu.Vulkan.AllocationCallbacks as AllocationCallbacks
import qualified Gpu.Vulkan.AllocationCallbacks.Type as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Type as Device
import qualified Gpu.Vulkan.Device.Middle as Device.M
import qualified Gpu.Vulkan.Memory.Middle as M
import Gpu.Vulkan.Memory.Enum

import Gpu.Vulkan.Memory.Bind
import Gpu.Vulkan.Memory.OffsetSize
import Gpu.Vulkan.Memory.Type
import Gpu.Vulkan.Memory.ImageBuffer

import Control.Monad
import Debug

-- ALLOCATE AND BIND

-- Allocate Bind

allocateBind :: (
	WithPoked (TMaybe.M mn), Bindable ibargs,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> HeteroParList.PL (U2 ImageBuffer) ibargs ->
	AllocateInfo mn -> TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	(forall s . HeteroParList.PL (U2 (ImageBufferBinded s)) ibargs ->
		M s ibargs -> IO a) -> IO a
allocateBind :: forall (mn :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd a.
(WithPoked (M mn), Bindable ibargs, ToMiddle mac) =>
D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo mn
-> M (U2 A) mac
-> (forall s.
    PL (U2 (ImageBufferBinded s)) ibargs -> M s ibargs -> IO a)
-> IO a
allocateBind D sd
dv PL (U2 ImageBuffer) ibargs
ibs AllocateInfo mn
ai M (U2 A) mac
mac forall s.
PL (U2 (ImageBufferBinded s)) ibargs -> M s ibargs -> IO a
f =
	D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo mn
-> M (U2 A) mac
-> (forall s. M s ibargs -> IO a)
-> IO a
forall (n :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd a.
(WithPoked (M n), Alignments ibargs, ToMiddle mac) =>
D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo n
-> M (U2 A) mac
-> (forall s. M s ibargs -> IO a)
-> IO a
allocate D sd
dv PL (U2 ImageBuffer) ibargs
ibs AllocateInfo mn
ai M (U2 A) mac
mac \M s ibargs
m -> (PL (U2 (ImageBufferBinded s)) ibargs -> M s ibargs -> IO a
forall s.
PL (U2 (ImageBufferBinded s)) ibargs -> M s ibargs -> IO a
`f` M s ibargs
m) (PL (U2 (ImageBufferBinded s)) ibargs -> IO a)
-> IO (PL (U2 (ImageBufferBinded s)) ibargs) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< D sd
-> PL (U2 ImageBuffer) ibargs
-> M s ibargs
-> Size
-> IO (PL (U2 (ImageBufferBinded s)) ibargs)
forall (ibargs :: [(*, ImageBufferArg)])
       (mibargs :: [(*, ImageBufferArg)]) sd sm.
BindAll ibargs mibargs =>
D sd
-> PL (U2 ImageBuffer) ibargs
-> M sm mibargs
-> Size
-> IO (PL (U2 (ImageBufferBinded sm)) ibargs)
forall sd sm.
D sd
-> PL (U2 ImageBuffer) ibargs
-> M sm ibargs
-> Size
-> IO (PL (U2 (ImageBufferBinded sm)) ibargs)
bindAll D sd
dv PL (U2 ImageBuffer) ibargs
ibs M s ibargs
m Size
0

allocate :: (
	WithPoked (TMaybe.M n), Alignments ibargs,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> HeteroParList.PL (U2 ImageBuffer) ibargs ->
	AllocateInfo n -> TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	(forall s . M s ibargs -> IO a) -> IO a
allocate :: forall (n :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd a.
(WithPoked (M n), Alignments ibargs, ToMiddle mac) =>
D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo n
-> M (U2 A) mac
-> (forall s. M s ibargs -> IO a)
-> IO a
allocate dv :: D sd
dv@(Device.D D
mdv) PL (U2 ImageBuffer) ibargs
ibs AllocateInfo n
ai
	(M (U2 A) mac -> M A (Snd mac)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd mac)
mac) forall s. M s ibargs -> IO a
f = IO M -> (M -> IO ()) -> (M -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
	do	AllocateInfo n
mai <- D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo n
-> IO (AllocateInfo n)
forall sd (ibargs :: [(*, ImageBufferArg)]) (mn :: Maybe (*)).
Alignments ibargs =>
D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo mn
-> IO (AllocateInfo mn)
allocateInfoToMiddle D sd
dv PL (U2 ImageBuffer) ibargs
ibs AllocateInfo n
ai
		D -> AllocateInfo n -> M A (Snd mac) -> IO M
forall (mn :: Maybe (*)) (ma :: Maybe (*)).
WithPoked (M mn) =>
D -> AllocateInfo mn -> M A ma -> IO M
M.allocate D
mdv AllocateInfo n
mai M A (Snd mac)
mac
	(\M
m -> D -> M -> M A (Snd mac) -> IO ()
forall (mf :: Maybe (*)). D -> M -> M A mf -> IO ()
M.free D
mdv M
m M A (Snd mac)
mac)
	\M
m -> M Any ibargs -> IO a
forall s. M s ibargs -> IO a
f (M Any ibargs -> IO a) -> IO (M Any ibargs) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PL (U2 ImageBuffer) ibargs -> M -> IO (M Any ibargs)
forall (ibargs :: [(*, ImageBufferArg)]) s.
PL (U2 ImageBuffer) ibargs -> M -> IO (M s ibargs)
newM PL (U2 ImageBuffer) ibargs
ibs M
m

group :: AllocationCallbacks.ToMiddle ma =>
	Device.D sd -> TPMaybe.M (U2 AllocationCallbacks.A) ma ->
	(forall s . Group sd ma s k ibargs -> IO a) -> IO a
group :: forall (ma :: Maybe (*, *)) sd k (ibargs :: [(*, ImageBufferArg)])
       a.
ToMiddle ma =>
D sd
-> M (U2 A) ma
-> (forall s. Group sd ma s k ibargs -> IO a)
-> IO a
group dvc :: D sd
dvc@(Device.D D
mdvc) ma :: M (U2 A) ma
ma@(M (U2 A) ma -> M A (Snd ma)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd ma)
mac) forall s. Group sd ma s k ibargs -> IO a
f =
	D -> M A (Snd ma) -> (forall s. Group s k -> IO a) -> IO a
forall (mf :: Maybe (*)) k a.
D -> M A mf -> (forall s. Group s k -> IO a) -> IO a
M.group D
mdvc M A (Snd ma)
mac \Group s k
mmng -> do
		TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
ibargs <- STM (TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs))))
-> IO (TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs))))
forall a. STM a -> IO a
atomically (STM (TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs))))
 -> IO (TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))))
-> STM (TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs))))
-> IO (TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs))))
forall a b. (a -> b) -> a -> b
$ Map k (IORef (PL (U2 ImageBuffer) ibargs))
-> STM (TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs))))
forall a. a -> STM (TVar a)
newTVar Map k (IORef (PL (U2 ImageBuffer) ibargs))
forall k a. Map k a
Map.empty
		Group sd ma s k ibargs -> IO a
forall s. Group sd ma s k ibargs -> IO a
f (Group sd ma s k ibargs -> IO a) -> Group sd ma s k ibargs -> IO a
forall a b. (a -> b) -> a -> b
$ D sd
-> M (U2 A) ma
-> TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
-> Group s k
-> Group sd ma s k ibargs
forall sd (ma :: Maybe (*, *)) s k
       (ibargs :: [(*, ImageBufferArg)]).
D sd
-> M (U2 A) ma
-> TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
-> Group s k
-> Group sd ma s k ibargs
Group D sd
dvc M (U2 A) ma
ma TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
ibargs Group s k
mmng

allocateBind' :: (
	Ord k,
	WithPoked (TMaybe.M mn), Bindable ibargs,
	AllocationCallbacks.ToMiddle ma ) =>
	Group sd ma sm k ibargs -> k ->
	HeteroParList.PL (U2 ImageBuffer) ibargs -> AllocateInfo mn ->
	IO (Either String (
		HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs,
		M sm ibargs))
allocateBind' :: forall k (mn :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (ma :: Maybe (*, *)) sd sm.
(Ord k, WithPoked (M mn), Bindable ibargs, ToMiddle ma) =>
Group sd ma sm k ibargs
-> k
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo mn
-> IO
     (Either
        String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs))
allocateBind' (Group D sd
dv M (U2 A) ma
mac TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
mib Group sm k
mng) k
k PL (U2 ImageBuffer) ibargs
ibs AllocateInfo mn
ai = do
	D sd
-> Group sm k
-> k
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo mn
-> M (U2 A) ma
-> IO (Either String (M sm ibargs))
forall k (n :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd sm.
(Ord k, WithPoked (M n), Alignments ibargs, ToMiddle mac) =>
D sd
-> Group sm k
-> k
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo n
-> M (U2 A) mac
-> IO (Either String (M sm ibargs))
allocate' D sd
dv Group sm k
mng k
k PL (U2 ImageBuffer) ibargs
ibs AllocateInfo mn
ai M (U2 A) ma
mac IO (Either String (M sm ibargs))
-> (Either String (M sm ibargs)
    -> IO
         (Either
            String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)))
-> IO
     (Either
        String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
		Left String
msg -> Either String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
-> IO
     (Either
        String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
 -> IO
      (Either
         String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)))
-> Either
     String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
-> IO
     (Either
        String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs))
forall a b. (a -> b) -> a -> b
$ String
-> Either
     String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
forall a b. a -> Either a b
Left String
msg
		Right M sm ibargs
m -> do
			rtn :: (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
rtn@(PL (U2 (ImageBufferBinded sm)) ibargs
_, M IORef (PL (U2 ImageBuffer) ibargs)
iibs M
_) <- (, M sm ibargs
m) (PL (U2 (ImageBufferBinded sm)) ibargs
 -> (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs))
-> IO (PL (U2 (ImageBufferBinded sm)) ibargs)
-> IO (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D sd
-> PL (U2 ImageBuffer) ibargs
-> M sm ibargs
-> Size
-> IO (PL (U2 (ImageBufferBinded sm)) ibargs)
forall (ibargs :: [(*, ImageBufferArg)])
       (mibargs :: [(*, ImageBufferArg)]) sd sm.
BindAll ibargs mibargs =>
D sd
-> PL (U2 ImageBuffer) ibargs
-> M sm mibargs
-> Size
-> IO (PL (U2 (ImageBufferBinded sm)) ibargs)
forall sd sm.
D sd
-> PL (U2 ImageBuffer) ibargs
-> M sm ibargs
-> Size
-> IO (PL (U2 (ImageBufferBinded sm)) ibargs)
bindAll D sd
dv PL (U2 ImageBuffer) ibargs
ibs M sm ibargs
m Size
0
			STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
-> (Map k (IORef (PL (U2 ImageBuffer) ibargs))
    -> Map k (IORef (PL (U2 ImageBuffer) ibargs)))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
mib (k
-> IORef (PL (U2 ImageBuffer) ibargs)
-> Map k (IORef (PL (U2 ImageBuffer) ibargs))
-> Map k (IORef (PL (U2 ImageBuffer) ibargs))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k IORef (PL (U2 ImageBuffer) ibargs)
iibs)
			Either String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
-> IO
     (Either
        String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
 -> IO
      (Either
         String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)))
-> Either
     String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
-> IO
     (Either
        String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs))
forall a b. (a -> b) -> a -> b
$ (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
-> Either
     String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
forall a b. b -> Either a b
Right (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)
rtn

allocate' :: (
	Ord k,
	WithPoked (TMaybe.M n), Alignments ibargs,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> M.Group sm k -> k ->
	HeteroParList.PL (U2 ImageBuffer) ibargs ->
	AllocateInfo n -> TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	IO (Either String (M sm ibargs))
allocate' :: forall k (n :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd sm.
(Ord k, WithPoked (M n), Alignments ibargs, ToMiddle mac) =>
D sd
-> Group sm k
-> k
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo n
-> M (U2 A) mac
-> IO (Either String (M sm ibargs))
allocate' dv :: D sd
dv@(Device.D D
mdv) Group sm k
mng k
k PL (U2 ImageBuffer) ibargs
ibs AllocateInfo n
ai (M (U2 A) mac -> M A (Snd mac)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd mac)
mac) = do
	AllocateInfo n
mai <- D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo n
-> IO (AllocateInfo n)
forall sd (ibargs :: [(*, ImageBufferArg)]) (mn :: Maybe (*)).
Alignments ibargs =>
D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo mn
-> IO (AllocateInfo mn)
allocateInfoToMiddle D sd
dv PL (U2 ImageBuffer) ibargs
ibs AllocateInfo n
ai
	(PL (U2 ImageBuffer) ibargs -> M -> IO (M sm ibargs)
forall (ibargs :: [(*, ImageBufferArg)]) s.
PL (U2 ImageBuffer) ibargs -> M -> IO (M s ibargs)
newM PL (U2 ImageBuffer) ibargs
ibs (M -> IO (M sm ibargs))
-> Either String M -> IO (Either String (M sm ibargs))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either String a -> m (Either String b)
`mapM`) (Either String M -> IO (Either String (M sm ibargs)))
-> IO (Either String M) -> IO (Either String (M sm ibargs))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< D
-> Group sm k
-> k
-> AllocateInfo n
-> M A (Snd mac)
-> IO (Either String M)
forall k (mn :: Maybe (*)) sm (ma :: Maybe (*)).
(Ord k, WithPoked (M mn)) =>
D
-> Group sm k
-> k
-> AllocateInfo mn
-> M A ma
-> IO (Either String M)
M.allocate' D
mdv Group sm k
mng k
k AllocateInfo n
mai M A (Snd mac)
mac

unsafeFree :: (Ord k, AllocationCallbacks.ToMiddle ma) =>
	Group sd ma smng k ibargs -> k -> IO (Either String ())
unsafeFree :: forall k (ma :: Maybe (*, *)) sd smng
       (ibargs :: [(*, ImageBufferArg)]).
(Ord k, ToMiddle ma) =>
Group sd ma smng k ibargs -> k -> IO (Either String ())
unsafeFree (Group (Device.D D
mdv) (M (U2 A) ma -> M A (Snd ma)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd ma)
mac) TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
_ Group smng k
mng) k
k =
	D -> Group smng k -> k -> M A (Snd ma) -> IO (Either String ())
forall k smng (mc :: Maybe (*)).
Ord k =>
D -> Group smng k -> k -> M A mc -> IO (Either String ())
M.free' D
mdv Group smng k
mng k
k M A (Snd ma)
mac

data Group sd ma s k ibargs = Group (Device.D sd)
	(TPMaybe.M (U2 AllocationCallbacks.A) ma)
	(TVar (Map.Map k (IORef (HeteroParList.PL (U2 ImageBuffer) ibargs))))
	(M.Group s k)

lookup :: Ord k =>
	Group sd ma sm k ibargs -> k -> IO (Maybe (M s ibargs))
lookup :: forall k sd (ma :: Maybe (*, *)) sm
       (ibargs :: [(*, ImageBufferArg)]) s.
Ord k =>
Group sd ma sm k ibargs -> k -> IO (Maybe (M s ibargs))
lookup (Group D sd
_ M (U2 A) ma
_ TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
ibargss Group sm k
mmng) k
k = do
	Maybe (IORef (PL (U2 ImageBuffer) ibargs))
mibargs <- STM (Maybe (IORef (PL (U2 ImageBuffer) ibargs)))
-> IO (Maybe (IORef (PL (U2 ImageBuffer) ibargs)))
forall a. STM a -> IO a
atomically (STM (Maybe (IORef (PL (U2 ImageBuffer) ibargs)))
 -> IO (Maybe (IORef (PL (U2 ImageBuffer) ibargs))))
-> STM (Maybe (IORef (PL (U2 ImageBuffer) ibargs)))
-> IO (Maybe (IORef (PL (U2 ImageBuffer) ibargs)))
forall a b. (a -> b) -> a -> b
$ k
-> Map k (IORef (PL (U2 ImageBuffer) ibargs))
-> Maybe (IORef (PL (U2 ImageBuffer) ibargs))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k (Map k (IORef (PL (U2 ImageBuffer) ibargs))
 -> Maybe (IORef (PL (U2 ImageBuffer) ibargs)))
-> STM (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
-> STM (Maybe (IORef (PL (U2 ImageBuffer) ibargs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
-> STM (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
forall a. TVar a -> STM a
readTVar TVar (Map k (IORef (PL (U2 ImageBuffer) ibargs)))
ibargss
	Maybe M
mmem <- Group sm k -> k -> IO (Maybe M)
forall k sm. Ord k => Group sm k -> k -> IO (Maybe M)
M.lookup Group sm k
mmng k
k
	Maybe (M s ibargs) -> IO (Maybe (M s ibargs))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (M s ibargs) -> IO (Maybe (M s ibargs)))
-> Maybe (M s ibargs) -> IO (Maybe (M s ibargs))
forall a b. (a -> b) -> a -> b
$ IORef (PL (U2 ImageBuffer) ibargs) -> M -> M s ibargs
forall s (ibargs :: [(*, ImageBufferArg)]).
IORef (PL (U2 ImageBuffer) ibargs) -> M -> M s ibargs
M (IORef (PL (U2 ImageBuffer) ibargs) -> M -> M s ibargs)
-> Maybe (IORef (PL (U2 ImageBuffer) ibargs))
-> Maybe (M -> M s ibargs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (IORef (PL (U2 ImageBuffer) ibargs))
mibargs Maybe (M -> M s ibargs) -> Maybe M -> Maybe (M s ibargs)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe M
mmem

-- Reallocate Bind

unsafeReallocateBind :: (
	WithPoked (TMaybe.M mn), Rebindable ibargs,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs ->
	AllocateInfo mn -> TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	M sm ibargs -> IO ()
unsafeReallocateBind :: forall (mn :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd sm.
(WithPoked (M mn), Rebindable ibargs, ToMiddle mac) =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo mn
-> M (U2 A) mac
-> M sm ibargs
-> IO ()
unsafeReallocateBind D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo mn
ai M (U2 A) mac
mac M sm ibargs
m =
	D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo mn
-> M (U2 A) mac
-> M sm ibargs
-> IO ()
forall (n :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd sm.
(WithPoked (M n), Alignments ibargs, ToMiddle mac) =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo n
-> M (U2 A) mac
-> M sm ibargs
-> IO ()
reallocate D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo mn
ai M (U2 A) mac
mac M sm ibargs
m IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> M sm ibargs
-> Size
-> IO ()
forall (ibargs :: [(*, ImageBufferArg)])
       (mibargs :: [(*, ImageBufferArg)]) sd sm.
RebindAll ibargs mibargs =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> M sm mibargs
-> Size
-> IO ()
forall sd sm.
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> M sm ibargs
-> Size
-> IO ()
rebindAll D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs M sm ibargs
m Size
0

unsafeReallocateBind' :: (
	WithPoked (TMaybe.M mn), Rebindable ibargs,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs ->
	AllocateInfo mn -> TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	M sm ibargs -> IO a -> IO ()
unsafeReallocateBind' :: forall (mn :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd sm a.
(WithPoked (M mn), Rebindable ibargs, ToMiddle mac) =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo mn
-> M (U2 A) mac
-> M sm ibargs
-> IO a
-> IO ()
unsafeReallocateBind' D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo mn
ai M (U2 A) mac
mac M sm ibargs
m IO a
act =
	D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo mn
-> M (U2 A) mac
-> M sm ibargs
-> IO a
-> IO ()
forall (n :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd sm a.
(WithPoked (M n), Alignments ibargs, ToMiddle mac) =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo n
-> M (U2 A) mac
-> M sm ibargs
-> IO a
-> IO ()
reallocate' D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo mn
ai M (U2 A) mac
mac M sm ibargs
m (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> M sm ibargs
-> Size
-> IO ()
forall (ibargs :: [(*, ImageBufferArg)])
       (mibargs :: [(*, ImageBufferArg)]) sd sm.
RebindAll ibargs mibargs =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> M sm mibargs
-> Size
-> IO ()
forall sd sm.
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> M sm ibargs
-> Size
-> IO ()
rebindAll D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs M sm ibargs
m Size
0 IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
act

reallocate :: (
	WithPoked (TMaybe.M n), Alignments ibargs,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs ->
	AllocateInfo n -> TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	M sm ibargs -> IO ()
reallocate :: forall (n :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd sm.
(WithPoked (M n), Alignments ibargs, ToMiddle mac) =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo n
-> M (U2 A) mac
-> M sm ibargs
-> IO ()
reallocate dv :: D sd
dv@(Device.D D
mdv) PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo n
ai (M (U2 A) mac -> M A (Snd mac)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd mac)
mac) M sm ibargs
m = do
	AllocateInfo n
mai <- D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo n
-> IO (AllocateInfo n)
forall sd sm (ibargs :: [(*, ImageBufferArg)]) (mn :: Maybe (*)).
Alignments ibargs =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo mn
-> IO (AllocateInfo mn)
reallocateInfoToMiddle D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo n
ai
	(PL (U2 ImageBuffer) ibargs
_, M
mm) <- M sm ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm ibargs
m
	D -> AllocateInfo n -> M A (Snd mac) -> M -> IO ()
forall (mn :: Maybe (*)) (ma :: Maybe (*)).
WithPoked (M mn) =>
D -> AllocateInfo mn -> M A ma -> M -> IO ()
M.reallocate D
mdv AllocateInfo n
mai M A (Snd mac)
mac M
mm
	M sm ibargs -> PL (U2 (ImageBufferBinded sm)) ibargs -> IO ()
forall s (ibargs :: [(*, ImageBufferArg)]) sm.
M s ibargs -> PL (U2 (ImageBufferBinded sm)) ibargs -> IO ()
writeMBinded M sm ibargs
m PL (U2 (ImageBufferBinded sm)) ibargs
ibs

reallocate' :: (
	WithPoked (TMaybe.M n), Alignments ibargs,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs ->
	AllocateInfo n -> TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	M sm ibargs -> IO a -> IO ()
reallocate' :: forall (n :: Maybe (*)) (ibargs :: [(*, ImageBufferArg)])
       (mac :: Maybe (*, *)) sd sm a.
(WithPoked (M n), Alignments ibargs, ToMiddle mac) =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo n
-> M (U2 A) mac
-> M sm ibargs
-> IO a
-> IO ()
reallocate' dv :: D sd
dv@(Device.D D
mdv) PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo n
ai (M (U2 A) mac -> M A (Snd mac)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd mac)
mac) M sm ibargs
m IO a
act = do
	AllocateInfo n
mai <- D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo n
-> IO (AllocateInfo n)
forall sd sm (ibargs :: [(*, ImageBufferArg)]) (mn :: Maybe (*)).
Alignments ibargs =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo mn
-> IO (AllocateInfo mn)
reallocateInfoToMiddle D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo n
ai
	(PL (U2 ImageBuffer) ibargs
_, M
mm) <- M sm ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm ibargs
m
	D -> AllocateInfo n -> M A (Snd mac) -> M -> IO a -> IO ()
forall (mn :: Maybe (*)) (ma :: Maybe (*)) a.
WithPoked (M mn) =>
D -> AllocateInfo mn -> M A ma -> M -> IO a -> IO ()
M.reallocate' D
mdv AllocateInfo n
mai M A (Snd mac)
mac M
mm (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ M sm ibargs -> PL (U2 (ImageBufferBinded sm)) ibargs -> IO ()
forall s (ibargs :: [(*, ImageBufferArg)]) sm.
M s ibargs -> PL (U2 (ImageBufferBinded sm)) ibargs -> IO ()
writeMBinded M sm ibargs
m PL (U2 (ImageBufferBinded sm)) ibargs
ibs IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
act

-- Allocate Info

data AllocateInfo mn = AllocateInfo {
	forall (mn :: Maybe (*)). AllocateInfo mn -> M mn
allocateInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). AllocateInfo mn -> TypeIndex
allocateInfoMemoryTypeIndex :: M.TypeIndex }

deriving instance Show (TMaybe.M mn) => Show (AllocateInfo mn)
deriving instance Eq (TMaybe.M mn) => Eq (AllocateInfo mn)

allocateInfoToMiddle :: forall sd ibargs mn . Alignments ibargs =>
	Device.D sd -> HeteroParList.PL (U2 ImageBuffer) ibargs ->
	AllocateInfo mn -> IO (M.AllocateInfo mn)
allocateInfoToMiddle :: forall sd (ibargs :: [(*, ImageBufferArg)]) (mn :: Maybe (*)).
Alignments ibargs =>
D sd
-> PL (U2 ImageBuffer) ibargs
-> AllocateInfo mn
-> IO (AllocateInfo mn)
allocateInfoToMiddle D sd
dv PL (U2 ImageBuffer) ibargs
ibs AllocateInfo {
	allocateInfoNext :: forall (mn :: Maybe (*)). AllocateInfo mn -> M mn
allocateInfoNext = M mn
mnxt,
	allocateInfoMemoryTypeIndex :: forall (mn :: Maybe (*)). AllocateInfo mn -> TypeIndex
allocateInfoMemoryTypeIndex = TypeIndex
mti } = do
	[Either AlgnSize Requirements]
reqss <- D sd
-> PL (U2 ImageBuffer) ibargs -> IO [Either AlgnSize Requirements]
forall sd (ibargs :: [(*, ImageBufferArg)]).
D sd
-> PL (U2 ImageBuffer) ibargs -> IO [Either AlgnSize Requirements]
getRequirementsList D sd
dv PL (U2 ImageBuffer) ibargs
ibs
	AllocateInfo mn -> IO (AllocateInfo mn)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure M.AllocateInfo {
		allocateInfoNext :: M mn
M.allocateInfoNext = M mn
mnxt,
		allocateInfoAllocationSize :: Size
M.allocateInfoAllocationSize = Size -> [Maybe Size] -> [Either AlgnSize Requirements] -> Size
memoryRequirementsListToSize
			Size
0 (forall (ibs :: [(*, ImageBufferArg)]).
Alignments ibs =>
[Maybe Size]
alignments @ibargs) [Either AlgnSize Requirements]
reqss,
		allocateInfoMemoryTypeIndex :: TypeIndex
M.allocateInfoMemoryTypeIndex = TypeIndex
mti }

reallocateInfoToMiddle :: forall sd sm ibargs mn . Alignments ibargs =>
	Device.D sd -> HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs ->
	AllocateInfo mn -> IO (M.AllocateInfo mn)
reallocateInfoToMiddle :: forall sd sm (ibargs :: [(*, ImageBufferArg)]) (mn :: Maybe (*)).
Alignments ibargs =>
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> AllocateInfo mn
-> IO (AllocateInfo mn)
reallocateInfoToMiddle D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs AllocateInfo {
	allocateInfoNext :: forall (mn :: Maybe (*)). AllocateInfo mn -> M mn
allocateInfoNext = M mn
mnxt,
	allocateInfoMemoryTypeIndex :: forall (mn :: Maybe (*)). AllocateInfo mn -> TypeIndex
allocateInfoMemoryTypeIndex = TypeIndex
mti } = do
	[Either AlgnSize Requirements]
reqss <- D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> IO [Either AlgnSize Requirements]
forall sd sm (ibargs :: [(*, ImageBufferArg)]).
D sd
-> PL (U2 (ImageBufferBinded sm)) ibargs
-> IO [Either AlgnSize Requirements]
getRequirementsListBinded D sd
dv PL (U2 (ImageBufferBinded sm)) ibargs
ibs
	AllocateInfo mn -> IO (AllocateInfo mn)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure M.AllocateInfo {
		allocateInfoNext :: M mn
M.allocateInfoNext = M mn
mnxt,
		allocateInfoAllocationSize :: Size
M.allocateInfoAllocationSize = Size -> [Maybe Size] -> [Either AlgnSize Requirements] -> Size
memoryRequirementsListToSize
			Size
0 (forall (ibs :: [(*, ImageBufferArg)]).
Alignments ibs =>
[Maybe Size]
alignments @ibargs) [Either AlgnSize Requirements]
reqss,
		allocateInfoMemoryTypeIndex :: TypeIndex
M.allocateInfoMemoryTypeIndex = TypeIndex
mti }

memoryRequirementsListToSize ::
	Device.M.Size -> [Maybe Device.M.Size] -> [Either AlgnSize M.Requirements] -> Device.M.Size
memoryRequirementsListToSize :: Size -> [Maybe Size] -> [Either AlgnSize Requirements] -> Size
memoryRequirementsListToSize Size
sz0 [Maybe Size]
_ [] = Size
sz0
memoryRequirementsListToSize Size
sz0 [] [Either AlgnSize Requirements]
_ = Size
sz0
memoryRequirementsListToSize Size
sz0 (Maybe Size
malgn : [Maybe Size]
malgns) (Either AlgnSize Requirements
ereqs : [Either AlgnSize Requirements]
reqss) =
	Size -> [Maybe Size] -> [Either AlgnSize Requirements] -> Size
memoryRequirementsListToSize
		(((Size
sz0 Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) Size -> Size -> Size
forall a. Integral a => a -> a -> a
`div` Size
algn Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
algn Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
sz) [Maybe Size]
malgns [Either AlgnSize Requirements]
reqss
	where
	sz :: Size
sz = case Either AlgnSize Requirements
ereqs of
		Left (Size
_, Size
s) -> Size
s
		Right Requirements
reqs -> Requirements -> Size
M.requirementsSize Requirements
reqs
	algn :: Size
algn = case Either AlgnSize Requirements
ereqs of
		Left (Size
a, Size
_) -> Size
a
		Right Requirements
reqs ->
			(Size -> Maybe Size -> Size
forall a. a -> Maybe a -> a
fromMaybe Size
1 Maybe Size
malgn) Size -> Size -> Size
forall a. Integral a => a -> a -> a
`lcm` Requirements -> Size
M.requirementsAlignment Requirements
reqs

-- READ AND WRITE

read :: forall nm obj i v sd sm ibargs .
	(VObj.Store v obj, OffsetSize nm obj ibargs i) =>
	Device.D sd -> M sm ibargs -> M.MapFlags -> IO v
read :: forall (nm :: Symbol) (obj :: O) (i :: Nat) v sd sm
       (ibargs :: [(*, ImageBufferArg)]).
(Store v obj, OffsetSize nm obj ibargs i) =>
D sd -> M sm ibargs -> MapFlags -> IO v
read D sd
dv M sm ibargs
m MapFlags
flgs = IO (Ptr (TypeOf obj))
-> (Ptr (TypeOf obj) -> IO ())
-> (Ptr (TypeOf obj) -> IO v)
-> IO v
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
	(forall (nm :: Symbol) (obj :: O) (i :: Nat) sd sm
       (ibargs :: [(*, ImageBufferArg)]).
OffsetSize nm obj ibargs i =>
D sd -> M sm ibargs -> MapFlags -> IO (Ptr (TypeOf obj))
map @nm @obj @i D sd
dv M sm ibargs
m MapFlags
flgs) (IO () -> Ptr (TypeOf obj) -> IO ()
forall a b. a -> b -> a
const (IO () -> Ptr (TypeOf obj) -> IO ())
-> IO () -> Ptr (TypeOf obj) -> IO ()
forall a b. (a -> b) -> a -> b
$ D sd -> M sm ibargs -> IO ()
forall sd sm (ibargs :: [(*, ImageBufferArg)]).
D sd -> M sm ibargs -> IO ()
unmap D sd
dv M sm ibargs
m)
	\(Ptr (TypeOf obj)
ptr :: Ptr (VObj.TypeOf obj)) ->
		forall v (obj :: O).
Store v obj =>
Ptr (TypeOf obj) -> Length obj -> IO v
VObj.load @_ @obj Ptr (TypeOf obj)
ptr (Length obj -> IO v) -> IO (Length obj) -> IO v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (nm :: Symbol) (obj :: O) (ibargs :: [(*, ImageBufferArg)])
       sm.
ObjectLength nm obj ibargs =>
M sm ibargs -> IO (Length obj)
objectLength @nm @obj M sm ibargs
m

write :: forall nm obj i sd sm ibargs v .
	(VObj.Store v obj, OffsetSize nm obj ibargs i) =>
	Device.D sd -> M sm ibargs -> M.MapFlags -> v -> IO ()
write :: forall (nm :: Symbol) (obj :: O) (i :: Nat) sd sm
       (ibargs :: [(*, ImageBufferArg)]) v.
(Store v obj, OffsetSize nm obj ibargs i) =>
D sd -> M sm ibargs -> MapFlags -> v -> IO ()
write D sd
dv M sm ibargs
m MapFlags
flgs v
v = IO (Ptr (TypeOf obj))
-> (Ptr (TypeOf obj) -> IO ())
-> (Ptr (TypeOf obj) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
	(forall (nm :: Symbol) (obj :: O) (i :: Nat) sd sm
       (ibargs :: [(*, ImageBufferArg)]).
OffsetSize nm obj ibargs i =>
D sd -> M sm ibargs -> MapFlags -> IO (Ptr (TypeOf obj))
map @nm @obj @i D sd
dv M sm ibargs
m MapFlags
flgs) (IO () -> Ptr (TypeOf obj) -> IO ()
forall a b. a -> b -> a
const (IO () -> Ptr (TypeOf obj) -> IO ())
-> IO () -> Ptr (TypeOf obj) -> IO ()
forall a b. (a -> b) -> a -> b
$ D sd -> M sm ibargs -> IO ()
forall sd sm (ibargs :: [(*, ImageBufferArg)]).
D sd -> M sm ibargs -> IO ()
unmap D sd
dv M sm ibargs
m)
	\(Ptr (TypeOf obj)
ptr :: Ptr (VObj.TypeOf obj)) -> do
		Length obj
ln <- forall (nm :: Symbol) (obj :: O) (ibargs :: [(*, ImageBufferArg)])
       sm.
ObjectLength nm obj ibargs =>
M sm ibargs -> IO (Length obj)
objectLength @nm @obj M sm ibargs
m
		forall v (obj :: O).
Store v obj =>
Ptr (TypeOf obj) -> Length obj -> v -> IO ()
VObj.store @_ @obj Ptr (TypeOf obj)
ptr Length obj
ln v
v

map :: forall nm obj i sd sm ibargs . OffsetSize nm obj ibargs i =>
	Device.D sd -> M sm ibargs -> M.MapFlags ->
	IO (Ptr (VObj.TypeOf obj))
map :: forall (nm :: Symbol) (obj :: O) (i :: Nat) sd sm
       (ibargs :: [(*, ImageBufferArg)]).
OffsetSize nm obj ibargs i =>
D sd -> M sm ibargs -> MapFlags -> IO (Ptr (TypeOf obj))
map dv :: D sd
dv@(Device.D D
mdv) M sm ibargs
m MapFlags
flgs = M sm ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm ibargs
m IO (PL (U2 ImageBuffer) ibargs, M)
-> ((PL (U2 ImageBuffer) ibargs, M) -> IO (Ptr (TypeOf obj)))
-> IO (Ptr (TypeOf obj))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(PL (U2 ImageBuffer) ibargs
_, M
mm) -> do
	(Size
ost, Size
sz) <- forall (nm :: Symbol) (obj :: O) (ibargs :: [(*, ImageBufferArg)])
       (i :: Nat) sd sm.
OffsetSize nm obj ibargs i =>
D sd -> M sm ibargs -> Size -> IO AlgnSize
offsetSize @nm @obj @_ @i D sd
dv M sm ibargs
m Size
0
	Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AlgnSize -> IO ()
forall a. Show a => a -> IO ()
print (Size
ost, Size
sz)
	D -> M -> Size -> Size -> MapFlags -> IO (Ptr (TypeOf obj))
forall a. D -> M -> Size -> Size -> MapFlags -> IO (Ptr a)
M.map D
mdv M
mm Size
ost Size
sz MapFlags
flgs

unmap :: Device.D sd -> M sm ibargs -> IO ()
unmap :: forall sd sm (ibargs :: [(*, ImageBufferArg)]).
D sd -> M sm ibargs -> IO ()
unmap (Device.D D
mdv) M sm ibargs
m = D -> M -> IO ()
M.unmap D
mdv (M -> IO ())
-> ((PL (U2 ImageBuffer) ibargs, M) -> M)
-> (PL (U2 ImageBuffer) ibargs, M)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PL (U2 ImageBuffer) ibargs, M) -> M
forall a b. (a, b) -> b
snd ((PL (U2 ImageBuffer) ibargs, M) -> IO ())
-> IO (PL (U2 ImageBuffer) ibargs, M) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< M sm ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm ibargs
m