{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds   #-}
module Benchmark.Primitive where

import Control.Monad
import GHC.TypeLits

import Raaz.Core
import Implementation
import Benchmark.Types

-- | Number of blocks.
nblocks :: BlockCount Prim
nblocks :: BlockCount Prim
nblocks = BYTES Int -> BlockCount Prim
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atLeast BYTES Int
nBytes

allocAndRun  :: (BufferPtr -> IO ()) -> IO ()
allocAndRun :: (BufferPtr -> IO ()) -> IO ()
allocAndRun  = BlockCount Prim -> (BufferPtr -> IO ()) -> IO ()
forall l (ptr :: * -> *) something b.
(LengthUnit l, Pointer ptr) =>
l -> (ptr something -> IO b) -> IO b
allocaBuffer (BlockCount Prim
nblocks BlockCount Prim -> BlockCount Prim -> BlockCount Prim
forall a. Semigroup a => a -> a -> a
<> BlockCount Prim
additionalBlocks)

bench :: KnownNat BufferAlignment => RaazBench
bench :: RaazBench
bench = (String
nm, (Int64 -> IO ()) -> Benchmarkable
toBenchmarkable ((Int64 -> IO ()) -> Benchmarkable)
-> (Int64 -> IO ()) -> Benchmarkable
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
action (Int -> IO ()) -> (Int64 -> Int) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  where action :: Int -> IO ()
action Int
count = (BufferPtr -> IO ()) -> IO ()
allocAndRun ((BufferPtr -> IO ()) -> IO ()) -> (BufferPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferPtr -> IO ()
doit Int
count
        nm :: String
nm = String
name
        doit :: Int -> BufferPtr -> IO ()
doit Int
count BufferPtr
ptr = (Internals -> IO ()) -> IO ()
forall mem a. Memory mem => (mem -> IO a) -> IO a
withMemory ((Internals -> IO ()) -> IO ()) -> (Internals -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Internals
mem -> Int -> IO () -> IO ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
count (BufferPtr -> BlockCount Prim -> Internals -> IO ()
processBlocks BufferPtr
ptr BlockCount Prim
nblocks Internals
mem)