202f674 · streamly · git.iko.soy

git.iko.soy/streamly

Change the signature of foldlM' to use a monadic seed.

- Also change usages of foldlM' in tests and benchmarks.

commit202f674462c76811940201c838ba0078db4cacbe authorpranaysashank <pranaysashank@composewell.com> dateMon 29 Jun 2020, 07:56 (6 years ago) parenta18f1b5

17 files changed+29−23

compare with master

unifiedsplit

.hlint.ignore−1

@@ -15,7 +15,6 @@ src/Streamly/Internal/Data/Stream/StreamDK/Type.hs

1515src/Streamly/Internal/Data/Stream/StreamD.hs

1616src/Streamly/Internal/Data/Pipe/Types.hs

1717src/Streamly/Internal/Data/Sink.hs

18−src/Streamly/Internal/Data/Zipper/Array.hs

1918src/Streamly/Internal/Data/Parser/ParserD/Types.hs

2019src/Streamly/Internal/Data/Parser/ParserD.hs

2120src/Streamly/Internal/Data/Prim/Array/Types.hs

Changelog.md+5

@@ -1,5 +1,10 @@

11## Unreleased

3+### Breaking changes

5+* Change the signature of `foldlM'` to ensure that the accumulator is

6+ monadic.

38### Bug Fixes

510* `accept*` and `connect` APIs in `Streamly.Network.Inet.TCP` and the `accept`

benchmark/Streamly/Benchmark/FileIO/Stream.hs+1−1

@@ -433,7 +433,7 @@ inspect $ 'chunksOf `hasNoType` ''GroupState

433433{-# INLINE chunksOfD #-}

434434chunksOfD :: Int -> Handle -> IO Int

435435chunksOfD n inh =

436− D.foldlM' (\i _ -> return $ i + 1) 0

436+ D.foldlM' (\i _ -> return $ i + 1) (return 0)

437437 $ D.groupsOf n (AT.writeNUnsafe n)

438438 $ D.fromStreamK (S.unfold FH.read inh)

439439

benchmark/Streamly/Benchmark/Memory/ArrayOps.hs+2−2

@@ -173,13 +173,13 @@ toRevList = S.toRevList

173173

174174foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])

175175foldl'Build = S.foldl' (flip (:)) []

176−foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []

176+foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])

177177

178178foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)

179179foldl'Reduce = S.foldl' (+) 0

180180foldl'ReduceMap = P.fmap (+1) . S.foldl' (+) 0

181181foldl1'Reduce = S.foldl1' (+)

182−foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0

182+foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)

183183

184184last = S.last

185185null = S.null

benchmark/Streamly/Benchmark/Prelude/Serial.hs+2−2

@@ -383,7 +383,7 @@ foldl1'Reduce = S.foldl1' (+)

383383

384384{-# INLINE foldlM'Reduce #-}

385385foldlM'Reduce :: Monad m => SerialT m Int -> m Int

386−foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0

386+foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)

387387

388388{-# INLINE last #-}

389389last :: Monad m => SerialT m Int -> m (Maybe Int)

@@ -539,7 +539,7 @@ foldl'Build = S.foldl' (flip (:)) []

539539

540540{-# INLINE foldlM'Build #-}

541541foldlM'Build :: Monad m => SerialT m Int -> m [Int]

542−foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []

542+foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])

543543

544544o_n_heap_elimination_foldl :: Int -> [Benchmark]

545545o_n_heap_elimination_foldl value =

examples/WordClassifier.hs+1−1

@@ -61,7 +61,7 @@ main = do

6161 & S.map toLower -- SerialT IO Char

6262 & S.words FL.toList -- SerialT IO String

6363 & S.filter (all isAlpha) -- SerialT IO String

64− & S.foldlM' (flip (Map.alterF alter)) Map.empty -- IO (Map String (IORef Int))

64+ & S.foldlM' (flip (Map.alterF alter)) (return Map.empty) -- IO (Map String (IORef Int))

6565

6666 -- Print the top hashmap entries

6767 counts <-

examples/WordCount.hs+1−1

@@ -603,7 +603,7 @@ countArray src = do

603603{-# INLINE wc_mwl_parallel #-}

604604wc_mwl_parallel :: Handle -> Int -> IO (V.IOVector Int)

605605wc_mwl_parallel src n = do

606− counts <- newCounts

606+ let counts = newCounts

607607 S.foldlM' addCounts counts

608608 $ S.aheadly

609609 $ S.maxThreads numCapabilities

src/Streamly/Internal/Data/Array.hs+1−1

@@ -143,7 +143,7 @@ fromStreamDN limit str = do

143143 i <-

144144 D.foldlM'

145145 (\i x -> i `seq` liftIO $ writeArray marr i x >> return (i + 1))

146− 0 $

146+ (return 0) $

147147 D.take limit str

148148 liftIO $ freezeArray marr 0 i

149149

src/Streamly/Internal/Data/Prim/Array.hs+1−1

@@ -136,7 +136,7 @@ fromStreamDN limit str = do

136136 _ <-

137137 D.foldlM'

138138 (\i x -> i `seq` liftIO (writePrimArray marr i x) >> return (i + 1))

139− 0 $

139+ (return 0) $

140140 D.take limit str

141141 liftIO $ unsafeFreezePrimArray marr

142142

src/Streamly/Internal/Data/SmallArray.hs+1−1

@@ -122,7 +122,7 @@ fromStreamDN limit str = do

122122 i <-

123123 D.foldlM'

124124 (\i x -> i `seq` liftIO (writeSmallArray marr i x) >> return (i + 1))

125− 0 $

125+ (return 0) $

126126 D.take limit str

127127 liftIO $ freezeSmallArray marr 0 i

128128

src/Streamly/Internal/Data/Stream/StreamD/Type.hs+5−3

@@ -480,8 +480,10 @@ foldlx' fstep begin done m =

480480

481481-- XXX implement in terms of foldlMx'?

482482{-# INLINE_NORMAL foldlM' #-}

483−foldlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b

484−foldlM' fstep begin (Stream step state) = go SPEC begin state

483+foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b

484+foldlM' fstep mbegin (Stream step state) = do

485+ begin <- mbegin

486+ go SPEC begin state

485487 where

486488 {-# INLINE_LATE go #-}

487489 go !_ acc st = acc `seq` do

@@ -495,7 +497,7 @@ foldlM' fstep begin (Stream step state) = go SPEC begin state

495497

496498{-# INLINE foldl' #-}

497499foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b

498−foldl' fstep = foldlM' (\b a -> return (fstep b a))

500+foldl' fstep begin = foldlM' (\b a -> return (fstep b a)) (return begin)

499501

500502-- | Convert a list of pure values to a 'Stream'

501503{-# INLINE_LATE fromList #-}

src/Streamly/Internal/Data/Stream/StreamK.hs+2−2

@@ -433,8 +433,8 @@ foldlMx' step begin done m = go begin m

433433

434434-- | Like 'foldl'' but with a monadic step function.

435435{-# INLINE foldlM' #-}

436−foldlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> m b

437−foldlM' step begin = foldlMx' step (return begin) return

436+foldlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> m b

437+foldlM' step begin = foldlMx' step begin return

438438

439439-- | Lazy left fold to a stream.

440440{-# INLINE foldlS #-}

src/Streamly/Internal/Memory/Array/Types.hs+1−1

@@ -706,7 +706,7 @@ fromStreamDN :: forall m a. (MonadIO m, Storable a)

706706 => Int -> D.Stream m a -> m (Array a)

707707fromStreamDN limit str = do

708708 arr <- liftIO $ newArray limit

709− end <- D.foldlM' fwrite (aEnd arr) $ D.take limit str

709+ end <- D.foldlM' fwrite (return $ aEnd arr) $ D.take limit str

710710 return $ arr {aEnd = end}

711711

712712 where

src/Streamly/Internal/Memory/ArrayStream.hs+3−3

@@ -158,12 +158,12 @@ spliceArraysLenUnsafe :: (MonadIO m, Storable a)

158158 => Int -> SerialT m (Array a) -> m (Array a)

159159spliceArraysLenUnsafe len buffered = do

160160 arr <- liftIO $ A.newArray len

161− end <- S.foldlM' writeArr (aEnd arr) buffered

161+ end <- S.foldlM' writeArr (return $ aEnd arr) buffered

162162 return $ arr {aEnd = end}

163163

164164 where

165165

166− writeArr dst Array{..} =

166+ writeArr dst Array{..} = do

167167 liftIO $ withForeignPtr aStart $ \src -> do

168168 let count = aEnd `minusPtr` src

169169 A.memcpy (castPtr dst) (castPtr src) count

@@ -181,7 +181,7 @@ _spliceArraysBuffered s = do

181181spliceArraysRealloced :: forall m a. (MonadIO m, Storable a)

182182 => SerialT m (Array a) -> m (Array a)

183183spliceArraysRealloced s = do

184− idst <- liftIO $ A.newArray (A.bytesToElemCount (undefined :: a)

184+ let idst = liftIO $ A.newArray (A.bytesToElemCount (undefined :: a)

185185 (A.mkChunkSizeKB 4))

186186

187187 arr <- S.foldlM' A.spliceWithDoubling idst s

src/Streamly/Internal/Prelude.hs+1−1

@@ -1325,7 +1325,7 @@ foldxM = P.foldlMx'

13251325--

13261326-- @since 0.2.0

13271327{-# INLINE foldlM' #-}

1328−foldlM' :: Monad m => (b -> a -> m b) -> b -> SerialT m a -> m b

1328+foldlM' :: Monad m => (b -> a -> m b) -> m b -> SerialT m a -> m b

13291329foldlM' step begin m = S.foldlM' step begin $ toStreamS m

13301330

13311331------------------------------------------------------------------------------

test/Main.hs+1−1

@@ -706,7 +706,7 @@ checkScanl'Strictness = do

706706 `shouldReturn` "success"

707707

708708foldlM'StrictCheck :: IORef Int -> SerialT IO Int -> IO ()

709−foldlM'StrictCheck ref = S.foldlM' (\_ _ -> writeIORef ref 1) ()

709+foldlM'StrictCheck ref = S.foldlM' (\_ _ -> writeIORef ref 1) (return ())

710710

711711#ifdef DEVBUILD

712712foldxMStrictCheck :: IORef Int -> SerialT IO Int -> IO ()

test/Prop.hs+1−1

@@ -374,7 +374,7 @@ concurrentFoldlApplication n =

374374 -- XXX we should test empty list case as well

375375 let list = [0..n]

376376 stream <- run $

377− sourceUnfoldrM1 n |&. S.foldlM' (\xs x -> return (x : xs)) []

377+ sourceUnfoldrM1 n |&. S.foldlM' (\xs x -> return (x : xs)) (return [])

378378 listEquals (==) (reverse stream) list

379379

380380concurrentFoldrApplication :: Word8 -> Property