Mat4.hs

{-# LANGUAGE BlockArguments #-}

module Bench.Mat4 (benchmarks) where

import Test.Tasty.Bench

import Data.List (foldl1')
import qualified Foreign

import qualified Geomancy
import qualified Geomancy.Mat4

import qualified Linear
import qualified Linear.Matrix

import Bench.Common (clones)

benchmarks :: Benchmark
benchmarks = bgroup "mat4"
  [ bgroup "transpose" mat4transpose

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

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

mat4transpose :: [Benchmark]
mat4transpose =
  [ bench "geomancy" $ whnf Geomancy.Mat4.transpose mempty
  , bench "linear"   $ whnf Linear.Matrix.transpose (Linear.identity :: Linear.M44 Float)
  ]

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

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

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

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