{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Specialization.Middle.Internal (infoToCore) where

import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable.HeteroList hiding (alignments)
import qualified Data.HeteroParList as HeteroParList

import qualified Gpu.Vulkan.Specialization.Core as C

type Parameters = (Int, [(Int, Int, Int)], Int, Int)

parameters :: [(Int, Int)] -> Parameters
parameters :: [(Int, Int)] -> Parameters
parameters [(Int, Int)]
szals = (
	[(Int, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
szals, [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 ..] [Int]
ofs ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Int)]
szals), Int
tsz, [(Int, Int)] -> Int
alignments [(Int, Int)]
szals )
	where
	ofs :: [Int]
ofs = [(Int, Int)] -> [Int]
offsets [(Int, Int)]
szals; szs :: [Int]
szs = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Int)]
szals; tsz :: Int
tsz = [Int] -> Int
forall a. HasCallStack => [a] -> a
last [Int]
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. HasCallStack => [a] -> a
last [Int]
szs

offsets :: [(Int, Int)] -> [Int]
offsets :: [(Int, Int)] -> [Int]
offsets = [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail ([Int] -> [Int])
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Int, Int)] -> [Int])
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (Int, Int) -> (Int, Int) -> (Int, Int)
step (Int
0, Int
0)

step :: (Int, Int) -> (Int, Int) -> (Int, Int)
step :: (Int, Int) -> (Int, Int) -> (Int, Int)
step (Int
_st, Int
ed) (Int
sz, Int
al) = (Int
st', Int
st' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz)
	where st' :: Int
st' = ((Int
ed Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
al Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
al

alignments :: [(Int, Int)] -> Int
alignments :: [(Int, Int)] -> Int
alignments = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Integral a => a -> a -> a
lcm Int
1 ([Int] -> Int) -> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

mapEntries :: Parameters -> [C.MapEntry]
mapEntries :: Parameters -> [MapEntry]
mapEntries (Int
_, [(Int, Int, Int)]
ps, Int
_, Int
_) = (((Int, Int, Int) -> MapEntry) -> [(Int, Int, Int)] -> [MapEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Int, Int)]
ps) \(Int
i, Int
o, Int
s) -> C.MapEntry {
	mapEntryConstantId :: Word32
C.mapEntryConstantId = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i,
	mapEntryOffset :: Word32
C.mapEntryOffset = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o,
	mapEntrySize :: Word64
C.mapEntrySize = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s }

infoToCore :: forall vs a . PokableList vs =>
	HeteroParList.L vs -> (C.Info -> IO a) -> IO a
infoToCore :: forall (vs :: [*]) a.
PokableList vs =>
L vs -> (Info -> IO a) -> IO a
infoToCore L vs
xs Info -> IO a
f =
	Int -> (Ptr MapEntry -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n \Ptr MapEntry
pmes ->
	Ptr MapEntry -> [MapEntry] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr MapEntry
pmes (Parameters -> [MapEntry]
mapEntries Parameters
ps) 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
>>
	Int -> Int -> (Ptr () -> IO a) -> IO a
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned Int
tsz Int
tal \Ptr ()
pd ->
	Ptr () -> L vs -> IO ()
forall (as :: [*]) x. PokableList as => Ptr x -> L as -> IO ()
forall x. Ptr x -> L vs -> IO ()
pokeList Ptr ()
pd L vs
xs 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
>>
	Info -> IO a
f C.Info {
		infoMapEntryCount :: Word32
C.infoMapEntryCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n,
		infoPMapEntries :: Ptr MapEntry
C.infoPMapEntries = Ptr MapEntry
pmes,
		infoDataSize :: Word64
C.infoDataSize = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tsz,
		infoPData :: Ptr ()
C.infoPData = Ptr ()
pd }
	where
	szals :: [(Int, Int)]
szals = forall (as :: [*]). SizeAlignmentList as => [(Int, Int)]
sizeAlignments @vs
	ps :: Parameters
ps@(Int
n, [(Int, Int, Int)]
_, Int
tsz, Int
tal) = [(Int, Int)] -> Parameters
parameters [(Int, Int)]
szals