@@ -0,0 +1,134 @@
1+{-# LANGUAGE CPP #-}
2+
3+#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
4+
5+import Control.DeepSeq (deepseq)
6+
7+import qualified Streamly.Internal.Data.Array.Foreign as IA
8+import qualified GHC.Exts as GHC
9+
10+import qualified Streamly.Data.Array.Foreign as A
11+import qualified Streamly.Internal.Data.Array.Foreign as A
12+type Stream = A.Array
13+
14+#include "Streamly/Benchmark/Data/Array/Common.hs"
15+
16+-------------------------------------------------------------------------------
17+-- Benchmark helpers
18+-------------------------------------------------------------------------------
19+
20+-- Drain a source that generates a pure array
21+{-# INLINE benchPureSrc #-}
22+benchPureSrc :: String -> (Int -> Stream a) -> Benchmark
23+benchPureSrc name src = benchPure name src id
24+
25+-- Drain a source that generates an array in the IO monad
26+{-# INLINE benchIOSrc #-}
27+benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
28+benchIOSrc name src = benchIO name src id
29+
30+-------------------------------------------------------------------------------
31+-- Bench Ops
32+-------------------------------------------------------------------------------
33+
34+{-# INLINE sourceIntFromToFromList #-}
35+sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
36+sourceIntFromToFromList value n = P.return $ A.fromListN value $ [n..n + value]
37+
38+{-# INLINE readInstance #-}
39+readInstance :: P.String -> Stream Int
40+readInstance str =
41+ let r = P.reads str
42+ in case r of
43+ [(x,"")] -> x
44+ _ -> P.error "readInstance: no parse"
45+
46+#ifdef DEVBUILD
47+{-
48+{-# INLINE foldableFoldl' #-}
49+foldableFoldl' :: Stream Int -> Int
50+foldableFoldl' = F.foldl' (+) 0
51+
52+{-# INLINE foldableSum #-}
53+foldableSum :: Stream Int -> Int
54+foldableSum = P.sum
55+-}
56+#endif
57+
58+{-# INLINE sourceIsList #-}
59+sourceIsList :: Int -> Int -> Stream Int
60+sourceIsList value n = GHC.fromList [n..n+value]
61+
62+{-# INLINE sourceIsString #-}
63+sourceIsString :: Int -> Int -> Stream P.Char
64+sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
65+
66+{-# INLINE sourceIntFromToFromStream #-}
67+sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
68+sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
69+
70+-------------------------------------------------------------------------------
71+-- Bench groups
72+-------------------------------------------------------------------------------
73+
74+o_1_space_generation :: Int -> [Benchmark]
75+o_1_space_generation value =
76+ [ bgroup
77+ "generation"
78+ [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
79+ , let testStr = mkListString value
80+ in testStr `deepseq` (bench "read" $ nf readInstance testStr)
81+ , benchPureSrc "writeN . IsList.fromList" (sourceIsList value)
82+ , benchPureSrc
83+ "writeN . IsString.fromString"
84+ (sourceIsString value)
85+
86+ ]
87+ ]
88+
89+o_1_space_elimination :: Int -> [Benchmark]
90+o_1_space_elimination value =
91+ [ bgroup "elimination"
92+ [ benchPureSink value "length . IsList.toList" (length . GHC.toList)
93+ , benchFold "writeLastN.1"
94+ (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
95+ , benchFold "writeLastN.10"
96+ (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
97+#ifdef DEVBUILD
98+{-
99+ benchPureSink value "foldable/foldl'" foldableFoldl'
100+ , benchPureSink value "foldable/sum" foldableSum
101+-}
102+#endif
103+ ]
104+ ]
105+
106+o_n_heap_serial :: Int -> [Benchmark]
107+o_n_heap_serial value =
108+ [ bgroup "elimination"
109+ [
110+ -- Converting the stream to an array
111+ benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))
112+ (P.sourceUnfoldrM value)
113+ ]
114+ ]
115+
116+moduleName :: String
117+moduleName = "Data.Array.Foreign"
118+
119+defStreamSize :: Int
120+defStreamSize = defaultStreamSize
121+
122+main :: IO ()
123+main = runWithCLIOpts defStreamSize allBenchmarks
124+
125+ where
126+
127+ allBenchmarks size =
128+ [ bgroup (o_1_space_prefix moduleName) $ concat $
129+ [ o_1_space_generation size
130+ , o_1_space_elimination size
131+ ]
132+ , bgroup (o_n_space_prefix moduleName) $
133+ o_n_heap_serial size
134+ ] ++ commonBenchmarks size