Skip to content

Commit

Permalink
Make benchmark compatible with older primitive
Browse files Browse the repository at this point in the history
This is necessary to allow testing with lts-9 snapshot, since stack is
still capable of installing ghc-8.0 and ghc-8.2, while ghcup is having
issues in achieving that on CI
  • Loading branch information
lehins committed Dec 14, 2024
1 parent 93c9250 commit b573ff3
Show file tree
Hide file tree
Showing 3 changed files with 13 additions and 6 deletions.
16 changes: 12 additions & 4 deletions bench/Main.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main (main) where
Expand All @@ -13,9 +14,11 @@ import Foreign.C.Types
import Numeric.Natural (Natural)
import System.Random.SplitMix as SM
import Test.Tasty.Bench
#if MIN_VERSION_primitive(0,7,1)
import Control.Monad.Primitive
import Data.Primitive.PrimArray
import Data.Primitive.Types
import Data.Primitive.PrimArray
#endif

import System.Random.Stateful

Expand Down Expand Up @@ -200,7 +203,9 @@ main = do
in pureUniformRBench (Proxy :: Proxy Natural) range sz
]
, bgroup "floating"
[ bgroup "IO"
[
#if MIN_VERSION_primitive(0,7,1)
bgroup "IO"
[ env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) ->
bench "uniformFloat01M" $
nfIO (runStateGenT gen (fillMutablePrimArrayM uniformFloat01M ma))
Expand All @@ -214,7 +219,9 @@ main = do
bench "uniformDoublePositive01M" $
nfIO (runStateGenT gen (fillMutablePrimArrayM uniformDoublePositive01M ma))
]
, bgroup "State"
,
#endif
bgroup "State"
[ env getStdGen $
bench "uniformFloat01M" . nf (`runStateGen` (replicateM_ sz . uniformFloat01M))
, env getStdGen $
Expand Down Expand Up @@ -329,7 +336,7 @@ genMany f g0 n = go 0 $ f g0
| i < n = go (i + 1) $ f g
| otherwise = y


#if MIN_VERSION_primitive(0,7,1)
fillMutablePrimArrayM ::
(Prim a, PrimMonad m)
=> (gen -> m a)
Expand All @@ -343,3 +350,4 @@ fillMutablePrimArrayM f ma g = do
| otherwise = pure ()
go 0
unsafeFreezePrimArray ma
#endif
2 changes: 1 addition & 1 deletion random.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -192,7 +192,7 @@ benchmark bench
build-depends:
base,
mtl,
primitive >= 0.7.1,
primitive,
random,
splitmix >=0.1 && <0.2,
tasty-bench
1 change: 0 additions & 1 deletion stack-custom.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ extra-deps:
- tasty-bench-0.2.3@sha256:daa2221a1b1c65990633a51236f1cb4a52cba8ef0f0731f653e712a8bab07616,1319
- inspection-testing-0.4.5.0@sha256:938e7ce2ef42033071a5e60198c6e19ab61c411f5879b85821247a504f131768,8058
- tasty-inspection-testing-0.1@sha256:9c5e76345168fd3a59b43d305eebf8df3c792ce324c66bbdee45b54aa7d2c0ad,1214
- primitive-0.7.4.0@sha256:89b88a3e08493b7727fa4089b0692bfbdf7e1e666ef54635f458644eb8358764,2857
- vector-0.12.3.1@sha256:fffbd00912d69ed7be9bc7eeb09f4f475e0d243ec43f916a9fd5bbd219ce7f3e,8238
- data-array-byte-0.1.0.1@sha256:ad89e28b2b046175698fbf542af2ce43e5d2af50aae9f48d12566b1bb3de1d3c,1989
- optparse-applicative-0.14.2.0@sha256:cfbc2df0d9e144d343ccea6d25ab27543c15ea17d2abcbabcdf76030a2236383,4359

0 comments on commit b573ff3

Please sign in to comment.