DMat4.hs

{-# LANGUAGE BlockArguments #-}

module Bench.DMat4 (benchmarks) where

import Test.Tasty.Bench

import Data.List (foldl1')
import qualified Foreign

import qualified Geomancy
import qualified Geomancy.DMat4

import qualified Linear
import qualified Linear.Matrix

import Bench.Common (clones)

benchmarks :: Benchmark
benchmarks = bgroup "dmat4"
  [ bgroup "transpose" dmat4transpose

  , bgroup "multiply" $ flip map [2, 3, 10, 100, 1000] \size ->
      env (clones size mempty Linear.identity) $
        dmat4multiply size

  , bgroup "poke" $ flip map [10, 100, 1000, 10000] \size ->
      env (clones size mempty Linear.identity) $
        dmat4poke size
  ]

dmat4transpose :: [Benchmark]
dmat4transpose =
  [ bench "geomancy" $ whnf Geomancy.DMat4.transpose mempty
  , bench "linear"   $ whnf Linear.Matrix.transpose (Linear.identity :: Linear.M44 Double)
  ]

dmat4multiply
  :: Int
  -> ([Geomancy.DMat4], [Linear.M44 Double])
  -> Benchmark
dmat4multiply size ~(dmat4s, m44s) = bgroup (show size)
  [ bench "geomancy" $ whnf multGeomancy dmat4s
  , bench "linear"   $ whnf multLinear m44s
  ]
  where
    multGeomancy = foldl1' (<>)
    multLinear = foldl1' (Linear.!*!)

dmat4poke
  :: Int
  -> ([Geomancy.DMat4], [Linear.M44 Double])
  -> Benchmark
dmat4poke size ~(dmat4s, m44s) = bgroup (show size)
  [ bench "geomancy" $ nfIO pokeGeomancy
  , bench "linear"   $ nfIO pokeLinear
  , bench "linear/T" $ nfIO pokeLinearTranspose
  ]
  where
    pokeGeomancy =
      Foreign.withArray dmat4s \_ptr ->
        pure ()

    pokeLinear =
      Foreign.withArray m44s \_ptr ->
        pure ()

    pokeLinearTranspose =
      Foreign.withArray (map Linear.transpose m44s) \_ptr ->
        pure ()