{-# LINE 1 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.AllocationCallbacks.Core (
	-- * TYPE
	A, pattern A,
	aPUserData, aPfnAllocation, aPfnReallocation, aPfnFree,
	aPfnInternalAllocation, aPfnInternalFree,

	-- * FUNCTIONS
	-- ** ALLOCATION
	wrapAllocationFunction,
	FnAllocationFunction, PfnAllocationFunction,

	-- ** REALLOCATION
	wrapReallocationFunction,
	FnReallocationFunction, PfnReallocationFunction,
	
	-- ** FREE
	wrapFreeFunction,
	FnFreeFunction, PfnFreeFunction,
	
	-- * INTERNAL NOTIFICATION
	-- ** ALLOCATION
	wrapInternalAllocationNotification,
	FnInternalAllocationNotification, PfnInternalAllocationNotification,
	
	-- ** FREE
	wrapInternalFreeNotification,
	FnInternalFreeNotification, PfnInternalFreeNotification

	) where

import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Struct
import Foreign.C.Struct.TypeSynonyms
import Data.Word



---------------------------------------------------------------------------
-- ALLOCATION FUNCTION
-- REALLOCATION FUNCTION
-- FREE FUNCTION
-- INTERNAL ALLOCATION NOTIFICATION
-- INTERNAL FREE NOTIFICATION
---------------------------------------------------------------------------

-- * ALLOCATION FUNCTION

type FnAllocationFunction a = Ptr a -> Word64 ->
{-# LINE 55 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	Word64 -> Word32 -> IO (Ptr ())
{-# LINE 56 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}

type PfnAllocationFunction = FunPtr (FnAllocationFunction ())

wrapAllocationFunction :: FnAllocationFunction a -> IO PfnAllocationFunction
wrapAllocationFunction :: forall a. FnAllocationFunction a -> IO PfnAllocationFunction
wrapAllocationFunction = FnAllocationFunction () -> IO PfnAllocationFunction
wrapAllocationFunctionGen (FnAllocationFunction () -> IO PfnAllocationFunction)
-> (FnAllocationFunction a -> FnAllocationFunction ())
-> FnAllocationFunction a
-> IO PfnAllocationFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FnAllocationFunction a
-> (PtrVoid -> Ptr a) -> FnAllocationFunction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PtrVoid -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)

foreign import ccall "wrapper" wrapAllocationFunctionGen ::
	FnAllocationFunction () -> IO PfnAllocationFunction

-- * REALLOCATION FUNCTION

type FnReallocationFunction a = Ptr a -> Ptr () -> Word64 ->
{-# LINE 68 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	Word64 -> Word32 -> IO (Ptr ())
{-# LINE 69 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}

type PfnReallocationFunction = FunPtr (FnReallocationFunction ())

wrapReallocationFunction ::
	FnReallocationFunction a -> IO PfnReallocationFunction
wrapReallocationFunction :: forall a. FnReallocationFunction a -> IO PfnReallocationFunction
wrapReallocationFunction = FnReallocationFunction () -> IO PfnReallocationFunction
wrapReallocationFunctionGen (FnReallocationFunction () -> IO PfnReallocationFunction)
-> (FnReallocationFunction a -> FnReallocationFunction ())
-> FnReallocationFunction a
-> IO PfnReallocationFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FnReallocationFunction a
-> (PtrVoid -> Ptr a) -> FnReallocationFunction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PtrVoid -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)

foreign import ccall "wrapper" wrapReallocationFunctionGen ::
	FnReallocationFunction () -> IO PfnReallocationFunction

-- * FREE FUNCTION

type FnFreeFunction a = Ptr a -> Ptr () -> IO ()

type PfnFreeFunction = FunPtr (FnFreeFunction ())

wrapFreeFunction :: FnFreeFunction a -> IO PfnFreeFunction
wrapFreeFunction :: forall a. FnFreeFunction a -> IO PfnFreeFunction
wrapFreeFunction = FnFreeFunction () -> IO PfnFreeFunction
wrapFreeFunctionGen (FnFreeFunction () -> IO PfnFreeFunction)
-> (FnFreeFunction a -> FnFreeFunction ())
-> FnFreeFunction a
-> IO PfnFreeFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FnFreeFunction a -> (PtrVoid -> Ptr a) -> FnFreeFunction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PtrVoid -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)

foreign import ccall "wrapper" wrapFreeFunctionGen ::
	FnFreeFunction () -> IO (PfnFreeFunction)

-- * INTERNAL ALLOCATION NOTIFICATION

type FnInternalAllocationNotification a = Ptr a -> Word64 ->
{-# LINE 94 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	Word32 -> Word32 ->
{-# LINE 95 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	IO ()

type PfnInternalAllocationNotification =
	FunPtr (FnInternalAllocationNotification ())

wrapInternalAllocationNotification ::
	FnInternalAllocationNotification a ->
	IO PfnInternalAllocationNotification
wrapInternalAllocationNotification :: forall a.
FnInternalAllocationNotification a
-> IO PfnInternalAllocationNotification
wrapInternalAllocationNotification =
	FnInternalAllocationNotification ()
-> IO PfnInternalAllocationNotification
wrapInternalAllocationNotificationGen (FnInternalAllocationNotification ()
 -> IO PfnInternalAllocationNotification)
-> (FnInternalAllocationNotification a
    -> FnInternalAllocationNotification ())
-> FnInternalAllocationNotification a
-> IO PfnInternalAllocationNotification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FnInternalAllocationNotification a
-> (PtrVoid -> Ptr a) -> FnInternalAllocationNotification ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PtrVoid -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)

foreign import ccall "wrapper" wrapInternalAllocationNotificationGen ::
	FnInternalAllocationNotification () ->
	IO PfnInternalAllocationNotification

-- * INTERNAL FREE NOTIFICATION

type FnInternalFreeNotification a = Ptr a -> Word64 ->
{-# LINE 113 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	Word32 -> Word32 ->
{-# LINE 114 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	IO ()

type PfnInternalFreeNotification = FunPtr (FnInternalFreeNotification ())

wrapInternalFreeNotification ::
	FnInternalFreeNotification a -> IO PfnInternalFreeNotification
wrapInternalFreeNotification :: forall a.
FnInternalAllocationNotification a
-> IO PfnInternalAllocationNotification
wrapInternalFreeNotification = FnInternalAllocationNotification ()
-> IO PfnInternalAllocationNotification
wrapInternalFreeNotificationGen (FnInternalAllocationNotification ()
 -> IO PfnInternalAllocationNotification)
-> (FnInternalFreeNotification a
    -> FnInternalAllocationNotification ())
-> FnInternalFreeNotification a
-> IO PfnInternalAllocationNotification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FnInternalFreeNotification a
-> (PtrVoid -> Ptr a) -> FnInternalAllocationNotification ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PtrVoid -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)

foreign import ccall "wrapper" wrapInternalFreeNotificationGen ::
	FnInternalFreeNotification () -> IO PfnInternalFreeNotification

-- * ALLOCATION CALLBACKS

struct "A" (48)
{-# LINE 128 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
		8 [
{-# LINE 129 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	("pUserData", ''PtrVoid,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 131 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 132 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	("pfnAllocation", ''PfnAllocationFunction,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 134 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 135 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	("pfnReallocation", ''PfnReallocationFunction,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 137 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 138 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	("pfnFree", ''PfnFreeFunction,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 140 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 141 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	("pfnInternalAllocation", ''PfnInternalAllocationNotification,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 143 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 144 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	("pfnInternalFree", ''PfnInternalFreeNotification,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 146 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]) ]
{-# LINE 147 "src/Gpu/Vulkan/AllocationCallbacks/Core.hsc" #-}
	[''Show, ''Storable]