Add benchmarks for PrimArray

benchmark/Streamly/Benchmark/Data/PrimArray.hs

@@ -0,0 +1,97 @@
+-- |
+-- Module      : Main
+-- Copyright   : (c) 2019 Composewell Technologies
+--
+-- License     : BSD-3-Clause
+-- Maintainer  : streamly@composewell.com
+-- Stability   : experimental
+-- Portability : GHC
+
+{-# LANGUAGE CPP #-}
+
+module Main (main) where
+
+import Control.DeepSeq (NFData(..))
+import System.Random (randomRIO)
+
+import qualified Streamly.Benchmark.Data.PrimArrayOps as Ops
+import qualified Streamly.Data.PrimArray as A
+import qualified Streamly.Prelude as S
+
+import Gauge
+
+-------------------------------------------------------------------------------
+--
+-------------------------------------------------------------------------------
+
+{-# INLINE benchIO #-}
+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
+benchIO name src f = bench name $ nfIO $
+    randomRIO (1,1) >>= src >>= return . f
+
+-- Drain a source that generates an array in the IO monad
+{-# INLINE benchIOSrc #-}
+benchIOSrc :: A.Prim a => String -> (Int -> IO (Ops.Stream a)) -> Benchmark
+benchIOSrc name src = benchIO name src id
+
+{-# INLINE benchPureSink #-}
+benchPureSink :: NFData b => String -> (Ops.Stream Int -> b) -> Benchmark
+benchPureSink name f = benchIO name Ops.sourceIntFromTo f
+
+{-# INLINE benchIO' #-}
+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
+benchIO' name src f = bench name $ nfIO $
+    randomRIO (1,1) >>= src >>= f
+
+{-# INLINE benchIOSink #-}
+benchIOSink :: NFData b => String -> (Ops.Stream Int -> IO b) -> Benchmark
+benchIOSink name f = benchIO' name Ops.sourceIntFromTo f
+
+{-
+mkString :: String
+mkString = "[1" ++ concat (replicate Ops.value ",1") ++ "]"
+-}
+
+main :: IO ()
+main =
+  defaultMain
+    [ bgroup "Data.PrimArray"
+     [  bgroup "generation"
+        [ benchIOSrc "writeN . intFromTo" Ops.sourceIntFromTo
+        , benchIOSrc "write . intFromTo" Ops.sourceIntFromToFromStream
+        , benchIOSrc "fromList . intFromTo" Ops.sourceIntFromToFromList
+        , benchIOSrc "writeN . unfoldr" Ops.sourceUnfoldr
+        , benchIOSrc "writeN . fromList" Ops.sourceFromList
+        -- , benchPureSrc "writeN . IsList.fromList" Ops.sourceIsList
+        -- , benchPureSrc "writeN . IsString.fromString" Ops.sourceIsString
+        -- , mkString `deepseq` (bench "read" $ nf Ops.readInstance mkString)
+        , benchPureSink "show" Ops.showInstance
+        ]
+      , bgroup "elimination"
+        [ benchPureSink "id" id
+        , benchPureSink "==" Ops.eqInstance
+        , benchPureSink "/=" Ops.eqInstanceNotEq
+        , benchPureSink "<" Ops.ordInstance
+        , benchPureSink "min" Ops.ordInstanceMin
+        -- length is used to check for foldr/build fusion
+        -- , benchPureSink "length . IsList.toList" (length . GHC.toList)
+        , benchIOSink "foldl'" Ops.pureFoldl'
+        , benchIOSink "read" (S.drain . S.unfold A.read)
+        , benchIOSink "toStreamRev" (S.drain . A.toStreamRev)
+#ifdef DEVBUILD
+        , benchPureSink "foldable/foldl'" Ops.foldableFoldl'
+        , benchPureSink "foldable/sum" Ops.foldableSum
+#endif
+        ]
+      , bgroup "transformation"
+        [ benchIOSink "scanl'" (Ops.scanl' 1)
+        , benchIOSink "scanl1'" (Ops.scanl1' 1)
+        , benchIOSink "map" (Ops.map 1)
+        ]
+      , bgroup "transformationX4"
+        [ benchIOSink "scanl'" (Ops.scanl' 4)
+        , benchIOSink "scanl1'" (Ops.scanl1' 4)
+        , benchIOSink "map" (Ops.map 4)
+        ]
+    ]
+    ]

benchmark/Streamly/Benchmark/Data/PrimArrayOps.hs

@@ -0,0 +1,150 @@
+-- |
+-- Module      : Streamly.Benchmark.Data.PrimArrayOps
+-- Copyright   : (c) 2019 Composewell Technologies
+--
+-- License     : BSD-3-Clause
+-- Maintainer  : streamly@composewell.com
+-- Stability   : experimental
+-- Portability : GHC
+
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE DeriveAnyClass      #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Streamly.Benchmark.Data.PrimArrayOps where
+
+import Control.Monad.IO.Class (MonadIO)
+import Prelude (Int, Bool, (+), ($), (==), (>), (.), Maybe(..), undefined)
+import qualified Prelude as P
+#ifdef DEVBUILD
+import qualified Data.Foldable as F
+#endif
+
+import qualified Streamly           as S hiding (foldMapWith, runStream)
+import qualified Streamly.Data.PrimArray as A
+import qualified Streamly.Prelude   as S
+
+value :: Int
+value = 100000
+
+-------------------------------------------------------------------------------
+-- Benchmark ops
+-------------------------------------------------------------------------------
+
+-------------------------------------------------------------------------------
+-- Stream generation and elimination
+-------------------------------------------------------------------------------
+
+type Stream = A.PrimArray
+
+{-# INLINE sourceUnfoldr #-}
+sourceUnfoldr :: MonadIO m => Int -> m (Stream Int)
+sourceUnfoldr n = S.fold (A.writeN value) $ S.unfoldr step n
+    where
+    step cnt =
+        if cnt > n + value
+        then Nothing
+        else (Just (cnt, cnt + 1))
+
+{-# INLINE sourceIntFromTo #-}
+sourceIntFromTo :: MonadIO m => Int -> m (Stream Int)
+sourceIntFromTo n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
+
+{-# INLINE sourceIntFromToFromStream #-}
+sourceIntFromToFromStream :: MonadIO m => Int -> m (Stream Int)
+sourceIntFromToFromStream n = S.fold A.write $ S.enumerateFromTo n (n + value)
+
+{-# INLINE sourceIntFromToFromList #-}
+sourceIntFromToFromList :: MonadIO m => Int -> m (Stream Int)
+sourceIntFromToFromList n = P.return $ A.fromList $ [n..n + value]
+
+{-# INLINE sourceFromList #-}
+sourceFromList :: MonadIO m => Int -> m (Stream Int)
+sourceFromList n = S.fold (A.writeN value) $ S.fromList [n..n+value]
+{-
+{-# INLINE sourceIsList #-}
+sourceIsList :: Int -> Stream Int
+sourceIsList n = GHC.fromList [n..n+value]
+
+{-# INLINE sourceIsString #-}
+sourceIsString :: Int -> Stream P.Char
+sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
+-}
+-------------------------------------------------------------------------------
+-- Transformation
+-------------------------------------------------------------------------------
+
+{-# INLINE composeN #-}
+composeN :: P.Monad m
+    => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
+composeN n f x =
+    case n of
+        1 -> f x
+        2 -> f x P.>>= f
+        3 -> f x P.>>= f P.>>= f
+        4 -> f x P.>>= f P.>>= f P.>>= f
+        _ -> undefined
+
+{-# INLINE scanl' #-}
+{-# INLINE scanl1' #-}
+{-# INLINE map #-}
+
+scanl', scanl1', map
+    :: MonadIO m => Int -> Stream Int -> m (Stream Int)
+
+{-# INLINE onArray #-}
+onArray
+    :: MonadIO m => (S.SerialT m Int -> S.SerialT m Int)
+    -> Stream Int
+    -> m (Stream Int)
+onArray f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
+
+scanl'        n = composeN n $ onArray $ S.scanl' (+) 0
+scanl1'       n = composeN n $ onArray $ S.scanl1' (+)
+map           n = composeN n $ onArray $ S.map (+1)
+
+{-# INLINE eqInstance #-}
+eqInstance :: Stream Int -> Bool
+eqInstance src = src == src
+
+{-# INLINE eqInstanceNotEq #-}
+eqInstanceNotEq :: Stream Int -> Bool
+eqInstanceNotEq src = src P./= src
+
+{-# INLINE ordInstance #-}
+ordInstance :: Stream Int -> Bool
+ordInstance src = src P.< src
+
+{-# INLINE ordInstanceMin #-}
+ordInstanceMin :: Stream Int -> Stream Int
+ordInstanceMin src = P.min src src
+
+{-# INLINE showInstance #-}
+showInstance :: Stream Int -> P.String
+showInstance src = P.show src
+
+{-
+{-# INLINE readInstance #-}
+readInstance :: P.String -> Stream Int
+readInstance str =
+    let r = P.reads str
+    in case r of
+        [(x,"")] -> x
+        _ -> P.error "readInstance: no parse"
+-}
+
+{-# INLINE pureFoldl' #-}
+pureFoldl' :: MonadIO m => Stream Int -> m Int
+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
+
+#ifdef DEVBUILD
+{-# INLINE foldableFoldl' #-}
+foldableFoldl' :: Stream Int -> Int
+foldableFoldl' = F.foldl' (+) 0
+
+{-# INLINE foldableSum #-}
+foldableSum :: Stream Int -> Int
+foldableSum = P.sum
+#endif

streamly.cabal

@@ -691,6 +691,22 @@ benchmark unpinned-array
     build-depends:
         transformers  >= 0.4 && < 0.6
 
+benchmark prim-array
+  import: bench-options
+  type: exitcode-stdio-1.0
+  hs-source-dirs: benchmark
+  main-is: Streamly/Benchmark/Data/PrimArray.hs
+  other-modules: Streamly.Benchmark.Data.PrimArrayOps
+  build-depends:
+      streamly
+    , base                >= 4.8   && < 5
+    , deepseq             >= 1.4.1 && < 1.5
+    , random              >= 1.0   && < 2.0
+    , gauge               >= 0.2.4 && < 0.3
+  if impl(ghc < 8.0)
+    build-depends:
+        transformers  >= 0.4 && < 0.6
+        
 benchmark small-array
   import: bench-options
   type: exitcode-stdio-1.0