b8b410d · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Simplify array strip, improve perf

b8b410dHarendra Kumar5 years ago

benchmark/Streamly/Benchmark/Data/Array/Foreign/Mut.hs+4−18

compare with master

unifiedsplit

@@ -49,8 +49,8 @@ benchIO

49benchIO name src sink =

50 bench name $ nfIO $ randomRIO (1,1) >>= sink . src

52−o_n_space_serial_marray :: Int -> MArray.Array Int -> [Benchmark]

52+o_1_space_serial_marray :: Int -> MArray.Array Int -> [Benchmark]

53−o_n_space_serial_marray value array =

53+o_1_space_serial_marray value array =

54 [ benchIO "partitionBy (< 0)" (const array)

55 $ MArray.partitionBy (< 0)

56 , benchIO "partitionBy (> 0)" (const array)

@@ -59,22 +59,10 @@ o_n_space_serial_marray value array =

59 $ MArray.partitionBy (< (value `div` 2))

60 , benchIO "partitionBy (> value/2)" (const array)

61 $ MArray.partitionBy (> (value `div` 2))

62− ]

63−

64−o_1_space_serial_marray :: Int -> MArray.Array Int -> [Benchmark]

65−o_1_space_serial_marray value array =

66− [ benchIO "strip (< 0)" (const array)

62+ , benchIO "strip (< value/2 || > value/2)" (const array)

67− $ MArray.strip (< 0)

63+ $ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)

68 , benchIO "strip (> 0)" (const array)

64 , benchIO "strip (> 0)" (const array)

69 $ MArray.strip (> 0)

65 $ MArray.strip (> 0)

70− , benchIO "strip (< value/2)" (const array)

71− $ MArray.strip (< (value `div` 2))

72− , benchIO "strip (> value/2)" (const array)

73− $ MArray.strip (> (value `div` 2))

74− , benchIO "strip (odd)" (const array)

75− $ MArray.strip odd

76− , benchIO "strip (even)" (const array)

77− $ MArray.strip even

78 ]

66 ]

80-------------------------------------------------------------------------------

68-------------------------------------------------------------------------------

@@ -94,7 +82,5 @@ main = do

95 allBenchmarks array value =

83 allBenchmarks array value =

96 [ bgroup (o_1_space_prefix moduleName) $

84 [ bgroup (o_1_space_prefix moduleName) $

97− o_n_space_serial_marray value array

98− , bgroup (o_1_space_prefix moduleName) $

99 o_1_space_serial_marray value array

85 o_1_space_serial_marray value array

100 ]

86 ]

core/src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+34−28

@@ -135,6 +135,7 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type

135 , bytesFree

136

137 -- * In-place Mutation Algorithms

138+ , strip

138 , reverse

139 , reverse

139 , permute

140 , permute

140 , partitionBy

141 , partitionBy

@@ -193,7 +194,6 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type

193 , memcpy

194 , memcpy

194 , memcmp

195 , memcmp

195 , c_memchr

196 , c_memchr

196− , strip

197 )

198where

199

@@ -2300,37 +2300,43 @@ instance NFData1 Array where

2300-- | Strip elements which match with predicate from both ends.

2301--

2302-- /Pre-release/

2303+{-# INLINE strip #-}

2303strip :: forall a m. (Storable a, MonadIO m) =>

2304strip :: forall a m. (Storable a, MonadIO m) =>

2304 (a -> Bool) -> Array a -> m (Array a)

2305 (a -> Bool) -> Array a -> m (Array a)

2305strip eq arr@Array{..} = do

2306strip eq arr@Array{..} = do

2306− let p = arrStart

2307+ st <- liftIO $ getStart arrStart

2307− q = aEnd

2308+ end <- liftIO $ getLast aEnd st

2308− len = length arr

2309− st <- liftIO $ getStart p len

2310− end <- liftIO $ do

2309+ liftIO $ do

2311 touch arrContents

2310 touch arrContents

2312− if st == q

2311+ return arr {arrStart = st, aEnd = end, aBound = end}

2313− then return q

2314− else getLast $ PTR_PREV(q, a)

2315− go st end

2316

2312

2317 where

2313 where

2318

2314

2319− getStart p i = do

2315+ {-

2320− touch arrContents

2316+ -- XXX This should have the same perf but it does not, investigate.

2321− r <- peek p

2317+ getStart = do

2322− if eq r && i > 0

2318+ r <- liftIO $ D.head $ D.findIndices (not . eq) $ toStreamD arr

2323− then getStart (PTR_NEXT(p, a)) (i - 1)

2319+ pure $

2324− else return p

2320+ case r of

2325−

2321+ Nothing -> aEnd

2326− getLast p = do

2322+ Just i -> PTR_INDEX(arrStart,i,a)

2327− touch arrContents

2323+ -}

2328− r <- peek p

2324+

2329− if eq r

2325+ getStart cur = do

2330− then getLast $ PTR_PREV(p, a)

2326+ if cur < aEnd

2331− else return $ PTR_NEXT(p, a)

2327+ then do

2332−

2328+ r <- peek cur

2333− {-# INLINE go #-}

2329+ if eq r

2334− go p q = liftIO $ do

2330+ then getStart (PTR_NEXT(cur, a))

2335− touch arrContents

2331+ else return cur

2336− return arr {arrStart = p, aEnd = q, aBound = q}

2332+ else return cur

2333+

2334+ getLast cur low = do

2335+ if cur > low

2336+ then do

2337+ let prev = PTR_PREV(cur,a)

2338+ r <- peek prev

2339+ if eq r

2340+ then getLast prev low

2341+ else return cur

2342+ else return cur