{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}
module Main (main) where
import Prelude hiding
( Foldable (..)
, map
, null
, read
)
import Control.Monad
import Data.Functor.Identity (Identity (..))
import Data.Monoid (Sum (..))
import Data.Primitive.Contiguous
import GHC.Exts (RealWorld)
import System.Random
import System.Random.Shuffle
import Weigh
main :: IO ()
main = do
array10 <- randomC @Array 10
array100 <- randomC @Array 100
array1000 <- randomC @Array 1000
smallArray10 <- randomC @SmallArray 10
smallArray100 <- randomC @SmallArray 100
smallArray1000 <- randomC @SmallArray 1000
primArray10 <- randomC @PrimArray 10
primArray100 <- randomC @PrimArray 100
primArray1000 <- randomC @PrimArray 1000
marray10 <- randomCM @Array 10
marray100 <- randomCM @Array 100
marray1000 <- randomCM @Array 1000
msmallArray10 <- randomCM @SmallArray 10
msmallArray100 <- randomCM @SmallArray 100
msmallArray1000 <- randomCM @SmallArray 1000
mprimArray10 <- randomCM @PrimArray 10
mprimArray100 <- randomCM @PrimArray 100
mprimArray1000 <- randomCM @PrimArray 1000
mainWith $ do
wgroup "0-allocation" $ do
wgroup "size" $ do
func "array10" size array10
func "array100" size array100
func "array1000" size array1000
func "smallArray10" size smallArray10
func "smallArray100" size smallArray100
func "smallArray1000" size smallArray1000
func "primArray10" size primArray10
func "primArray100" size primArray100
func "primArray1000" size primArray1000
io "marray10" sizeMut marray10
io "marray100" sizeMut marray100
io "marray1000" sizeMut marray1000
io "msmallArray10" sizeMut msmallArray10
io "msmallArray100" sizeMut msmallArray100
io "msmallArray1000" sizeMut msmallArray1000
io "mprimArray10" sizeMut mprimArray10
io "mprimArray100" sizeMut mprimArray100
io "mprimArray1000" sizeMut mprimArray1000
wgroup "null" $ do
func "array10" null array10
func "array100" null array100
func "array1000" null array1000
func "smallArray10" null smallArray10
func "smallArray100" null smallArray100
func "smallArray1000" null smallArray1000
func "primArray10" null primArray10
func "primArray100" null primArray100
func "primArray1000" null primArray1000
wgroup "index/read" $ do
func "array10: index#" (index## 5) array10
func "array100: index#" (index## 50) array100
func "array1000: index#" (index## 500) array1000
func "smallArray10: index#" (index## 5) smallArray10
func "smallArray100: index#" (index## 50) smallArray100
func "smallArray1000: index#" (index## 500) smallArray1000
func "primArray10: index#" (index## 5) primArray10
func "primArray100: index#" (index## 50) primArray100
func "primArray1000: index#" (index## 500) primArray1000
func "array10: index" (flip index 5) array10
func "array100: index" (flip index 50) array100
func "array1000: index" (flip index 500) array1000
func "smallArray10: index" (flip index 5) smallArray10
func "smallArray100: index" (flip index 50) smallArray100
func "smallArray1000: index" (flip index 500) smallArray1000
func "primArray10: index" (flip index 5) primArray10
func "primArray100: index" (flip index 50) primArray100
func "primArray1000: index" (flip index 500) primArray1000
io "marray10: read" (flip read 5) marray10
io "marray100: read" (flip read 50) marray100
io "marray1000: read" (flip read 500) marray1000
io "msmallArray10: read" (flip read 5) msmallArray10
io "msmallArray100: read" (flip read 50) msmallArray100
io "msmallArray1000: read" (flip read 500) msmallArray1000
io "mprimArray10: read" (flip read 5) mprimArray10
io "mprimArray100: read" (flip read 50) mprimArray100
io "mprimArray1000: read" (flip read 500) mprimArray1000
wgroup "folds" $ do
wgroup "foldMap" $ do
func "array10: foldMap computes sum" (foldMap sum1) array10
func "array100: foldMap computes sum" (foldMap sum1) array100
func "array1000: foldMap computes sum" (foldMap sum1) array1000
func "smallArray10: foldMap computes sum" (foldMap sum1) smallArray10
func "smallArray100: foldMap computes sum" (foldMap sum1) smallArray100
func "smallArray1000: foldMap computes sum" (foldMap sum1) smallArray1000
func "primArray10: foldMap computes sum" (foldMap sum1) primArray10
func "primArray100: foldMap computes sum" (foldMap sum1) primArray100
func "primArray1000: foldMap computes sum" (foldMap sum1) primArray1000
wgroup "foldMap'" $ do
func "array10: foldMap' computes sum" (foldMap' sum1) array10
func "array100: foldMap' computes sum" (foldMap' sum1) array100
func "array1000: foldMap' computes sum" (foldMap' sum1) array1000
func "smallArray10: foldMap' computes sum" (foldMap' sum1) smallArray10
func "smallArray100: foldMap' computes sum" (foldMap' sum1) smallArray100
func "smallArray1000: foldMap' computes sum" (foldMap' sum1) smallArray1000
func "primArray10: foldMap' computes sum" (foldMap' sum1) primArray10
func "primArray100: foldMap' computes sum" (foldMap' sum1) primArray100
func "primArray1000: foldMap' computes sum" (foldMap' sum1) primArray1000
wgroup "foldr" $ do
func "array10: foldr computes sum" (foldr (+) 0) array10
func "array100: foldr computes sum" (foldr (+) 0) array100
func "array1000: foldr computes sum" (foldr (+) 0) array1000
func "smallArray10: foldr computes sum" (foldr (+) 0) smallArray10
func "smallArray100: foldr computes sum" (foldr (+) 0) smallArray100
func "smallArray1000: foldr computes sum" (foldr (+) 0) smallArray1000
func "primArray10: foldr computes sum" (foldr (+) 0) primArray10
func "primArray100: foldr computes sum" (foldr (+) 0) primArray100
func "primArray1000: foldr computes sum" (foldr (+) 0) primArray1000
wgroup "foldr'" $ do
func "array10: foldr' computes sum" (foldr' (+) 0) array10
func "array100: foldr' computes sum" (foldr' (+) 0) array100
func "array1000: foldr' computes sum" (foldr' (+) 0) array1000
func "smallArray10: foldr' computes sum" (foldr' (+) 0) smallArray10
func "smallArray100: foldr' computes sum" (foldr' (+) 0) smallArray100
func "smallArray1000: foldr' computes sum" (foldr' (+) 0) smallArray1000
func "primArray10: foldr' computes sum" (foldr' (+) 0) primArray10
func "primArray100: foldr' computes sum" (foldr' (+) 0) primArray100
func "primArray1000: foldr' computes sum" (foldr' (+) 0) primArray1000
wgroup "foldl" $ do
func "array10: foldl computes sum" (foldl (+) 0) array10
func "array100: foldl computes sum" (foldl (+) 0) array100
func "array1000: foldl computes sum" (foldl (+) 0) array1000
func "smallArray10: foldl computes sum" (foldl (+) 0) smallArray10
func "smallArray100: foldl computes sum" (foldl (+) 0) smallArray100
func "smallArray1000: foldl computes sum" (foldl (+) 0) smallArray1000
func "primArray10: foldl computes sum" (foldl (+) 0) primArray10
func "primArray100: foldl computes sum" (foldl (+) 0) primArray100
func "primArray1000: foldl computes sum" (foldl (+) 0) primArray1000
wgroup "foldl'" $ do
func "array10: foldl' computes sum" (foldl' (+) 0) array10
func "array100: foldl' computes sum" (foldl' (+) 0) array100
func "array1000: foldl' computes sum" (foldl' (+) 0) array1000
func "smallArray10: foldl' computes sum" (foldl' (+) 0) smallArray10
func "smallArray100: foldl' computes sum" (foldl' (+) 0) smallArray100
func "smallArray1000: foldl' computes sum" (foldl' (+) 0) smallArray1000
func "primArray10: foldl' computes sum" (foldl' (+) 0) primArray10
func "primArray100: foldl' computes sum" (foldl' (+) 0) primArray100
func "primArray1000: foldl' computes sum" (foldl' (+) 0) primArray1000
wgroup "ifoldl'" $ do
func "array10: ifoldl' computes sum" (ifoldl' add3 0) array10
func "array100: ifoldl' computes sum" (ifoldl' add3 0) array100
func "array1000: ifoldl' computes sum" (ifoldl' add3 0) array1000
func "smallArray10: ifoldl' computes sum" (ifoldl' add3 0) smallArray10
func "smallArray100: ifoldl' computes sum" (ifoldl' add3 0) smallArray100
func "smallArray1000: ifoldl' computes sum" (ifoldl' add3 0) smallArray1000
func "primArray10: ifoldl' computes sum" (ifoldl' add3 0) primArray10
func "primArray100: ifoldl' computes sum" (ifoldl' add3 0) primArray100
func "primArray1000: ifoldl' computes sum" (ifoldl' add3 0) primArray1000
wgroup "ifoldr'" $ do
func "array10: ifoldr' computes sum" (ifoldr' add3 0) array10
func "array100: ifoldr' computes sum" (ifoldr' add3 0) array100
func "array1000: ifoldr' computes sum" (ifoldr' add3 0) array1000
func "smallArray10: ifoldr' computes sum" (ifoldr' add3 0) smallArray10
func "smallArray100: ifoldr' computes sum" (ifoldr' add3 0) smallArray100
func "smallArray1000: ifoldr' computes sum" (ifoldr' add3 0) smallArray1000
func "primArray10: ifoldr' computes sum" (ifoldr' add3 0) primArray10
func "primArray100: ifoldr' computes sum" (ifoldr' add3 0) primArray100
func "primArray1000: ifoldr' computes sum" (ifoldr' add3 0) primArray1000
wgroup "foldlMap'" $ do
func "array10: foldlMap' computes sum" (foldMap' sum1) array10
func "array100: foldlMap' computes sum" (foldMap' sum1) array100
func "array1000: foldlMap' computes sum" (foldMap' sum1) array1000
func "smallArray10: foldlMap' computes sum" (foldMap' sum1) smallArray10
func "smallArray100: foldlMap' computes sum" (foldMap' sum1) smallArray100
func "smallArray1000: foldlMap' computes sum" (foldMap' sum1) smallArray1000
func "primArray10: foldlMap' computes sum" (foldMap' sum1) primArray10
func "primArray100: foldlMap' computes sum" (foldMap' sum1) primArray100
func "primArray1000: foldlMap' computes sum" (foldMap' sum1) primArray1000
wgroup "ifoldlMap'" $ do
func "array10: ifoldlMap' computes sum" (ifoldlMap' isumN) array10
func "array100: ifoldlMap' computes sum" (ifoldlMap' isumN) array100
func "array1000: ifoldlMap' computes sum" (ifoldlMap' isumN) array1000
func "smallArray10: ifoldlMap' computes sum" (ifoldlMap' isumN) smallArray10
func "smallArray100: ifoldlMap' computes sum" (ifoldlMap' isumN) smallArray100
func "smallArray1000: ifoldlMap' computes sum" (ifoldlMap' isumN) smallArray1000
func "primArray10: ifoldlMap' computes sum" (ifoldlMap' isumN) primArray10
func "primArray100: ifoldlMap' computes sum" (ifoldlMap' isumN) primArray100
func "primArray1000: ifoldlMap' computes sum" (ifoldlMap' isumN) primArray1000
wgroup "ifoldlMap1'" $ do
func "array10: ifoldlMap1' computes sum" (ifoldlMap1' isumN) array10
func "array100: ifoldlMap1' computes sum" (ifoldlMap1' isumN) array100
func "array1000: ifoldlMap1' computes sum" (ifoldlMap1' isumN) array1000
func "smallArray10: ifoldlMap1' computes sum" (ifoldlMap1' isumN) smallArray10
func "smallArray100: ifoldlMap1' computes sum" (ifoldlMap1' isumN) smallArray100
func "smallArray1000: ifoldlMap1' computes sum" (ifoldlMap1' isumN) smallArray1000
func "primArray10: ifoldlMap1' computes sum" (ifoldlMap1' isumN) primArray10
func "primArray100: ifoldlMap1' computes sum" (ifoldlMap1' isumN) primArray100
func "primArray1000: ifoldlMap1' computes sum" (ifoldlMap1' isumN) primArray1000
wgroup "foldlM'" $ do
func "array10: foldlM' computes sum" (foldlM' idM 0) array10
func "array100: foldlM' computes sum" (foldlM' idM 0) array100
func "array1000: foldlM' computes sum" (foldlM' idM 0) array1000
func "smallArray10: foldlM' computes sum" (foldlM' idM 0) smallArray10
func "smallArray100: foldlM' computes sum" (foldlM' idM 0) smallArray100
func "smallArray1000: foldlM' computes sum" (foldlM' idM 0) smallArray1000
func "primArray10: foldlM' computes sum" (foldlM' idM 0) primArray10
func "primArray100: foldlM' computes sum" (foldlM' idM 0) primArray100
func "primArray1000: foldlM' computes sum" (foldlM' idM 0) primArray1000
wgroup "maps" $ do
wgroup "map" $ do
func "array10" mapPlus1 array10
func "array100" mapPlus1 array100
func "array1000" mapPlus1 array1000
func "smallArray10" mapPlus1 smallArray10
func "smallArray100" mapPlus1 smallArray100
func "smallArray1000" mapPlus1 smallArray1000
func "primArray10" mapPlus1 primArray10
func "primArray100" mapPlus1 primArray100
func "primArray1000" mapPlus1 primArray1000
wgroup "map'" $ do
func "array10" mapPlus1' array10
func "array100" mapPlus1' array100
func "array1000" mapPlus1' array1000
func "smallArray10" mapPlus1' smallArray10
func "smallArray100" mapPlus1' smallArray100
func "smallArray1000" mapPlus1' smallArray1000
func "primArray10" mapPlus1' primArray10
func "primArray100" mapPlus1' primArray100
func "primArray1000" mapPlus1' primArray1000
wgroup "mapMaybe" $ do
func "array10" mapMaybeJ array10
func "array100" mapMaybeJ array100
func "array1000" mapMaybeJ array1000
func "smallArray10" mapMaybeJ smallArray10
func "smallArray100" mapMaybeJ smallArray100
func "smallArray1000" mapMaybeJ smallArray1000
func "primArray10" mapMaybeJ primArray10
func "primArray100" mapMaybeJ primArray100
func "primArray1000" mapMaybeJ primArray1000
mapMaybeJ ::
forall arr.
(Contiguous arr, Element arr Int) =>
arr Int ->
()
mapMaybeJ arr =
let !(_arr' :: arr Int) = mapMaybe Just arr
in ()
mapPlus1 ::
forall arr.
(Contiguous arr, Element arr Int) =>
arr Int ->
()
mapPlus1 arr = let !(_arr' :: arr Int) = map (+ 1) arr in ()
mapPlus1' ::
forall arr.
(Contiguous arr, Element arr Int) =>
arr Int ->
()
mapPlus1' arr = let !(_arr' :: arr Int) = map' (+ 1) arr in ()
_plus1 :: Int -> Int
_plus1 = (+ 1)
sum1 :: a -> Sum Int
sum1 = const (Sum 1)
isumN :: Int -> a -> Sum Int
isumN x = const (Sum x)
idM :: Int -> Int -> Identity Int
idM x y = Identity (x + y)
add3 :: Int -> Int -> Int -> Int
add3 x y z = x + y + z
index## :: (Contiguous arr, Element arr a) => Int -> arr a -> ()
index## ix arr = case index# arr ix of !(# _x #) -> ()
randomList :: Int -> IO [Int]
randomList sz = replicateM sz (randomRIO (minBound, maxBound))
randomC ::
(Contiguous arr, Element arr Int) =>
Int ->
IO (arr Int)
randomC sz = do
rList <- randomList sz
rList' <- shuffleM rList
pure (fromListN sz rList')
randomCM ::
(Contiguous arr, Element arr Int) =>
Int ->
IO (Mutable arr RealWorld Int)
randomCM sz = do
rList <- randomList sz
rList' <- shuffleM rList
fromListMutableN sz rList'