Add a Builder data type for incremental appends

benchmark/Streamly/Benchmark/Data/Builder.hs

@@ -0,0 +1,201 @@
+-- |
+-- Module      : Streamly.Benchmark.Prelude
+-- Copyright   : (c) 2020 Composewell Technologies
+--
+-- License     : BSD-3-Clause
+-- Maintainer  : [email protected]
+
+module Main where
+
+import Streamly.Prelude (SerialT, serially)
+
+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
+import qualified Streamly.Internal.Data.Builder as Builder
+import qualified Streamly.Internal.Data.Monoid.Builder as MBuilder
+
+import Gauge
+import Streamly.Benchmark.Common
+import Streamly.Benchmark.Prelude
+
+moduleName :: String
+moduleName = "Data.Builder"
+
+-------------------------------------------------------------------------------
+-- Right Associated Appends
+-------------------------------------------------------------------------------
+
+{-# INLINE appendListSourceR #-}
+appendListSourceR :: Int -> Int -> [Int]
+appendListSourceR value n =
+    Prelude.foldr (Prelude.++) [] (Prelude.fmap (: []) [n..n+value])
+
+{-# INLINE appendListBuilderSourceR #-}
+appendListBuilderSourceR :: Int -> Int -> [Int]
+appendListBuilderSourceR value n =
+    Builder.use $ foldMap (Builder.add . (: [])) [n..n+value]
+
+{-# INLINE consListBuilderSourceR #-}
+consListBuilderSourceR :: Int -> Int -> [Int]
+consListBuilderSourceR value n =
+    Builder.use $ foldMap Builder.mk [n..n+value]
+
+{-# INLINE appendSourceR #-}
+appendSourceR :: Int -> Int -> SerialT m Int
+appendSourceR value n = foldMap Stream.yield [n..n+value]
+
+{-# INLINE consStreamBuilderSourceR #-}
+consStreamBuilderSourceR :: Int -> Int -> SerialT m Int
+consStreamBuilderSourceR value n =
+    Builder.use $ foldMap Builder.mk [n..n+value]
+
+{-# INLINE appendStreamBuilderSourceR #-}
+appendStreamBuilderSourceR :: Int -> Int -> SerialT m Int
+appendStreamBuilderSourceR value n =
+    Builder.use $ foldMap (Builder.add . Stream.yield) [n..n+value]
+
+o_1_space_appendR :: Int -> [Benchmark]
+o_1_space_appendR value =
+    [ bgroup "appendR"
+        [ benchPure "singleton lists" (appendListSourceR value) id
+        , benchIOSrc serially "singleton streams" (appendSourceR value)
+        , benchPure "consed list builders" (consListBuilderSourceR value) id
+        , benchPure
+            "singleton list builders" (appendListBuilderSourceR value) id
+        , benchIOSrc
+            serially
+            "singleton stream builders"
+            (appendStreamBuilderSourceR value)
+        , benchIOSrc
+            serially
+            "consed stream builders"
+            (consStreamBuilderSourceR value)
+        ]
+    ]
+
+-------------------------------------------------------------------------------
+-- Left Associated Appends
+-------------------------------------------------------------------------------
+
+{-# INLINE appendListSourceL #-}
+appendListSourceL :: Int -> Int -> [Int]
+appendListSourceL value n =
+    Prelude.foldl (Prelude.++) [] (map (: []) [n..n+value])
+
+{-# INLINE appendListBuilderSourceL #-}
+appendListBuilderSourceL :: Int -> Int -> [Int]
+appendListBuilderSourceL value n =
+    Builder.use
+        $ Prelude.foldl
+            (<>) mempty (map (Builder.add . (: [])) [n..n+value])
+
+{-# INLINE appendListMonoidBuilderSourceL #-}
+appendListMonoidBuilderSourceL :: Int -> Int -> [Int]
+appendListMonoidBuilderSourceL value n =
+    MBuilder.use
+        $ Prelude.foldl (<>) mempty (map (MBuilder.mk . (: [])) [n..n+value])
+
+{-# INLINE consListBuilderSourceL #-}
+consListBuilderSourceL :: Int -> Int -> [Int]
+consListBuilderSourceL value n =
+    Builder.use
+        $ Prelude.foldl (<>) mempty (map  Builder.mk [n..n+value])
+
+{-# INLINE appendSourceL #-}
+appendSourceL :: Int -> Int -> SerialT m Int
+appendSourceL value n =
+    Prelude.foldl
+        (Prelude.<>) Stream.nil (Prelude.fmap Stream.yield [n..n+value])
+
+{-# INLINE appendStreamBuilderSourceL #-}
+appendStreamBuilderSourceL :: Int -> Int -> SerialT m Int
+appendStreamBuilderSourceL value n =
+    Builder.use
+        $ Prelude.foldl
+            (<>)
+            mempty
+            (map (Builder.add . Stream.yield) [n..n+value])
+
+{-# INLINE consStreamBuilderSourceL #-}
+consStreamBuilderSourceL :: Int -> Int -> SerialT m Int
+consStreamBuilderSourceL value n =
+    Builder.use
+        $ Prelude.foldl (<>) mempty (map Builder.mk [n..n+value])
+
+{-# INLINE appendStreamMonoidBuilderSourceL #-}
+appendStreamMonoidBuilderSourceL :: Int -> Int -> SerialT m Int
+appendStreamMonoidBuilderSourceL value n =
+    MBuilder.use
+        $ Prelude.foldl
+            (<>) mempty (map (MBuilder.mk . Stream.yield) [n..n+value])
+
+-- Use builder of streams and concat
+{-# INLINE streamConcatStreamBuilderSourceL #-}
+streamConcatStreamBuilderSourceL :: Monad m => Int -> Int -> SerialT m Int
+streamConcatStreamBuilderSourceL value n =
+    Stream.concat
+        $ Builder.use
+        $ Prelude.foldl
+            (<>)
+            mempty
+            (map (Builder.mk . Stream.yield) [n..n+value])
+
+o_1_space_appendL :: Int -> [Benchmark]
+o_1_space_appendL value =
+    [ bgroup "appendL"
+        [ benchPure
+            "singleton lists (n/100)" (appendListSourceL (value `div` 100)) id
+        , benchPure
+            "singleton list builders"
+            (appendListBuilderSourceL value)
+            id
+        , benchPure
+            "singleton list monoid builders"
+            (appendListMonoidBuilderSourceL value)
+            id
+        , benchPure
+            "consed list builders"
+            (consListBuilderSourceL value)
+            id
+        , benchIOSrc
+            serially
+            "singleton streams (n/100)"
+            (appendSourceL (value `div` 100))
+        , benchIOSrc
+            serially
+            "singleton stream builders"
+            (appendStreamBuilderSourceL value)
+        , benchIOSrc
+            serially
+            "consed stream builders"
+            (consStreamBuilderSourceL value)
+        , benchIOSrc
+            serially
+            "singleton stream monoid builders"
+            (appendStreamMonoidBuilderSourceL value)
+        , benchIOSrc
+            serially
+            "Stream.concat stream builders"
+            (streamConcatStreamBuilderSourceL value)
+        ]
+    ]
+
+-------------------------------------------------------------------------------
+-- Main
+-------------------------------------------------------------------------------
+
+-- In addition to gauge options, the number of elements in the stream can be
+-- passed using the --stream-size option.
+--
+main :: IO ()
+main = do
+    (value, cfg, benches) <- parseCLIOpts defaultStreamSize
+    value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
+
+    where
+
+    allBenchmarks size =
+        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
+            [ o_1_space_appendR size
+            , o_1_space_appendL size
+            ]
+        ]

benchmark/Streamly/Benchmark/Prelude/Serial.hs

@@ -1470,13 +1470,13 @@ o_1_space_joining value =
 o_1_space_concatFoldable :: Int -> [Benchmark]
 o_1_space_concatFoldable value =
     [ bgroup "concat-foldable"
-        [ benchIOSrc serially "foldMapWith (<>) (List)"
+        [ benchIOSrc serially "concatMapFoldableWith (<>) yield (List)"
             (sourceFoldMapWith value)
-        , benchIOSrc serially "foldMapWith (<>) (Stream)"
+        , benchIOSrc serially "concatMapFoldableWith (<>) yield (Stream)"
             (sourceFoldMapWithStream value)
-        , benchIOSrc serially "foldMapWithM (<>) (List)"
+        , benchIOSrc serially "concatMapFoldableWith (<>) yieldM (List)"
             (sourceFoldMapWithM value)
-        , benchIOSrc serially "foldMapM (List)" (sourceFoldMapM value)
+        , benchIOSrc serially "foldMap yieldM (List)" (sourceFoldMapM value)
         ]
     ]
 

benchmark/streamly-benchmarks.cabal

@@ -300,6 +300,16 @@ benchmark Data.Parser
     buildable: True
     build-depends: exceptions >= 0.8   && < 0.11
 
+benchmark Data.Builder
+  import: bench-options
+  type: exitcode-stdio-1.0
+  hs-source-dirs: Streamly/Benchmark/Data
+  main-is: Builder.hs
+  if impl(ghcjs)
+    buildable: False
+  else
+    buildable: True
+
 -------------------------------------------------------------------------------
 -- Raw Streams
 -------------------------------------------------------------------------------