c93bad0 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Simplify the type of resumable Unfold

c93bad0Harendra Kumar6 years ago

benchmark/Streamly/Benchmark/Data/Parser.hs+13−11

compare with master

unifiedsplit

@@ -245,7 +245,7 @@ parseManyChunksOfSum n inh =

245{-# INLINE parseManyUnfoldArrays #-}

246parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()

247parseManyUnfoldArrays count arrays = do

248− let src = Source.source (arrays, Nothing)

248+ let src = Source.source (Just (arrays, Nothing))

249 let parser = PR.fromFold (FL.takeLE count FL.drain)

250 let readSrc =

251 Source.read

@@ -300,19 +300,19 @@ choice value =

300-------------------------------------------------------------------------------

301

302{-# INLINE parseMany #-}

303−parseMany :: MonadCatch m => SerialT m Int -> m ()

303+parseMany :: MonadCatch m => Int -> SerialT m Int -> m ()

304−parseMany =

304+parseMany n =

305 S.drain

306 . S.map getSum

307− . IP.parseMany (PR.fromFold $ FL.takeLE 2 FL.mconcat)

307+ . IP.parseMany (PR.fromFold $ FL.takeLE n FL.mconcat)

308 . S.map Sum

309

310{-# INLINE parseIterate #-}

311−parseIterate :: MonadCatch m => SerialT m Int -> m ()

311+parseIterate :: MonadCatch m => Int -> SerialT m Int -> m ()

312−parseIterate =

312+parseIterate n =

313 S.drain

314 . S.map getSum

315− . IP.parseIterate (PR.fromFold . FL.takeLE 2 . FL.sconcat) (Sum 0)

315+ . IP.parseIterate (PR.fromFold . FL.takeLE n . FL.sconcat) (Sum 0)

316 . S.map Sum

317

318-------------------------------------------------------------------------------

@@ -345,8 +345,10 @@ o_1_space_serial value =

345 , benchIOSink value "teeFst" $ teeFstAllAny value

346 , benchIOSink value "shortest" $ shortestAllAny value

347 , benchIOSink value "longest" $ longestAllAny value

348− , benchIOSink value "parseMany" parseMany

348+ , benchIOSink value "parseMany (take 1)" (parseMany 1)

349+ , benchIOSink value "parseMany (take all)" (parseMany value)

349− , benchIOSink value "parseIterate" parseIterate

350+ , benchIOSink value "parseIterate (take 1)" (parseIterate 1)

351+ , benchIOSink value "parseIterate (take all)" (parseIterate value)

350 ]

352 ]

351

353

352o_1_space_filesystem :: BenchEnv -> [Benchmark]

354o_1_space_filesystem :: BenchEnv -> [Benchmark]

@@ -359,9 +361,9 @@ o_1_space_filesystem env =

359

361

360o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]

362o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]

361o_1_space_serial_unfold bound arrays =

363o_1_space_serial_unfold bound arrays =

362− [ bench "parseMany/Unfold/1000 arrays/1 parse"

364+ [ bench "parseMany/Unfold/1000 arrays/take all"

363 $ nfIO $ parseManyUnfoldArrays bound arrays

365 $ nfIO $ parseManyUnfoldArrays bound arrays

364− , bench "parseMany/Unfold/1000 arrays/100000 parses"

366+ , bench "parseMany/Unfold/1000 arrays/take 1"

365 $ nfIO $ parseManyUnfoldArrays 1 arrays

367 $ nfIO $ parseManyUnfoldArrays 1 arrays

366 ]

368 ]

367

369

benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+1−1

@@ -219,7 +219,7 @@ parseManyGroupsRolling b =

219{-# INLINE parseManyUnfoldArrays #-}

220parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()

221parseManyUnfoldArrays count arrays = do

222− let src = Source.source (arrays, Nothing)

222+ let src = Source.source (Just (arrays, Nothing))

223 let parser = PR.fromFold (FL.takeLE count FL.drain)

224 let readSrc =

225 Source.read

src/Streamly/Internal/Data/Array/Foreign/Mut/Types.hs+1−1

@@ -527,7 +527,7 @@ readResumable = UnfoldR.Unfold step inject extract

527 (ReadUState fp (p `plusPtr` sizeOf (undefined :: a)))

528

529 extract (ReadUState (ForeignPtr end contents) (Ptr p)) =

530− return $ Just $ Array (ForeignPtr p contents) (Ptr end) (Ptr end)

530+ return $ Array (ForeignPtr p contents) (Ptr end) (Ptr end)

531

532-- | Unfold an array into a stream.

533--

src/Streamly/Internal/Data/Unfold/Resume.hs+14−13

@@ -89,7 +89,8 @@ simplify (Unfold step inject _) = Unfold.Unfold step inject

89-- /Internal/

90{-# INLINE_NORMAL fromStreamD #-}

91fromStreamD :: Monad m => Unfold m (Stream m a) a

92−fromStreamD = Unfold step return (return . Just)

92+fromStreamD = Unfold step return return

93+

93 where

94 where

95 {-# INLINE_LATE step #-}

96 {-# INLINE_LATE step #-}

@@ -115,7 +116,7 @@ parseD

115 => ParserD.Parser m a b

116 => ParserD.Parser m a b

116 -> Unfold m (Source s a) a

117 -> Unfold m (Source s a) a

117 -> Source s a

118 -> Source s a

118− -> m (b, Maybe (Source s a))

119+ -> m (b, Source s a)

119parseD

120parseD

120 (ParserD.Parser pstep initial extract)

121 (ParserD.Parser pstep initial extract)

121 (Unfold ustep uinject uextract)

122 (Unfold ustep uinject uextract)

@@ -153,13 +154,13 @@ parseD

153 let src0 = Prelude.take n (x:getList buf)

154 let src0 = Prelude.take n (x:getList buf)

154 src = Prelude.reverse src0

155 src = Prelude.reverse src0

155 s1 <- uextract s

156 s1 <- uextract s

156− return (b, fmap (Source.unread src) s1)

157+ return (b, Source.unread src s1)

157 Error err -> throwM $ ParseError err

158 Error err -> throwM $ ParseError err

158 Skip s -> go SPEC s buf pst

159 Skip s -> go SPEC s buf pst

159 Stop -> do

160 Stop -> do

160 b <- extract pst

161 b <- extract pst

161 -- XXX we should return the remaining buffer

162 -- XXX we should return the remaining buffer

162− return (b, Nothing)

163+ return (b, Source.source Nothing)

163

164

164 gobuf !_ s buf (List []) !pst = go SPEC s buf pst

165 gobuf !_ s buf (List []) !pst = go SPEC s buf pst

165 gobuf !_ s buf (List (x:xs)) !pst = do

166 gobuf !_ s buf (List (x:xs)) !pst = do

@@ -184,7 +185,7 @@ parseD

184 let src0 = Prelude.take n (x:getList buf)

185 let src0 = Prelude.take n (x:getList buf)

185 src = Prelude.reverse src0

186 src = Prelude.reverse src0

186 s1 <- uextract s

187 s1 <- uextract s

187− return (b, fmap (Source.unread src) s1)

188+ return (b, Source.unread src s1)

188 Error err -> throwM $ ParseError err

189 Error err -> throwM $ ParseError err

189

190

190-- | Parse a resumable unfold returning the parsed value and the state of the

191-- | Parse a resumable unfold returning the parsed value and the state of the

@@ -197,7 +198,7 @@ parse

197 => ParserK.Parser m a b

198 => ParserK.Parser m a b

198 -> Unfold m (Source s a) a

199 -> Unfold m (Source s a) a

199 -> Source s a

200 -> Source s a

200− -> m (b, Maybe (Source s a))

201+ -> m (b, Source s a)

201parse = parseD . ParserK.fromParserK

202parse = parseD . ParserK.fromParserK

202

203

203-------------------------------------------------------------------------------

204-------------------------------------------------------------------------------

@@ -207,17 +208,17 @@ parse = parseD . ParserK.fromParserK

207{-# INLINE parseManyD #-}

208{-# INLINE parseManyD #-}

208parseManyD :: MonadThrow m =>

209parseManyD :: MonadThrow m =>

209 ParserD.Parser m a b -> Unfold m (Source x a) a -> Unfold m (Source x a) b

210 ParserD.Parser m a b -> Unfold m (Source x a) a -> Unfold m (Source x a) b

210−parseManyD parser reader = Unfold step inject return

211+parseManyD parser reader = Unfold step return return

211

212

212 where

213 where

213

214

214− inject = return . Just

215−

216 {-# INLINE_LATE step #-}

215 {-# INLINE_LATE step #-}

217− step (Just src) = do

216+ step src = do

217+ if Source.isEmpty src

218+ then return Stop

219+ else do

218− (b, s1) <- parseD parser reader src

220+ (b, s1) <- parseD parser reader src

219− return $ Yield b s1

221+ return $ Yield b s1

220− step Nothing = return Stop

221

222

222-- | Apply a parser repeatedly on an unfold to generate an unfold of parsed

223-- | Apply a parser repeatedly on an unfold to generate an unfold of parsed

223-- values.

224-- values.

src/Streamly/Internal/Data/Unfold/Resume/Type.hs+12−26

@@ -46,22 +46,15 @@ import Prelude hiding (concat)

47data Unfold m a b =

48 -- | @Unfold step inject extract@

49− forall s. Unfold (s -> m (Step s b)) (a -> m s) (s -> m (Maybe a))

49+ forall s. Unfold (s -> m (Step s b)) (a -> m s) (s -> m a)

51------------------------------------------------------------------------------

52-- Unfolds

53------------------------------------------------------------------------------

55−-- XXX we do not need a Maybe, we can just use undefined or error. There is no

56−-- state to extract in this case, and it should not be used.

57−--

58−-- However, in certain cases we may not be able to extract, e.g. if we are

59−-- unfolding a Map, we may not be able to resume reading a Map. In such cases

60−-- it may be useful to return a Nothing. Or maybe we do not allow unfolding

61−-- such structures?

62{-# INLINE nilM #-}

55{-# INLINE nilM #-}

63nilM :: Monad m => (a -> m c) -> Unfold m a b

56nilM :: Monad m => (a -> m c) -> Unfold m a b

64−nilM f = Unfold step return (\_ -> return Nothing)

57+nilM f = Unfold step return return

66 where

59 where

@@ -74,26 +67,26 @@ nil = nilM (\_ -> return ())

75{-# INLINE unfoldrM #-}

68{-# INLINE unfoldrM #-}

76unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> Unfold m a b

69unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> Unfold m a b

77−unfoldrM next = Unfold step return (return . Just)

70+unfoldrM next = Unfold step return return

78 where

71 where

79 {-# INLINE_LATE step #-}

72 {-# INLINE_LATE step #-}

80 step st = do

73 step st = do

81 r <- next st

74 r <- next st

82 return $ case r of

75 return $ case r of

83 Just (x, s) -> Yield x s

76 Just (x, s) -> Yield x s

84− Nothing -> Stop

77+ Nothing -> Stop

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

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

87--

80--

88-- /Internal/

81-- /Internal/

89{-# INLINE_LATE fromList #-}

82{-# INLINE_LATE fromList #-}

90fromList :: Monad m => Unfold m [a] a

83fromList :: Monad m => Unfold m [a] a

91−fromList = Unfold step inject (return . Just)

84+fromList = Unfold step inject return

92 where

85 where

93 inject = return

86 inject = return

94 {-# INLINE_LATE step #-}

87 {-# INLINE_LATE step #-}

95 step (x:xs) = return $ Yield x xs

88 step (x:xs) = return $ Yield x xs

96− step [] = return Stop

89+ step [] = return Stop

98------------------------------------------------------------------------------

91------------------------------------------------------------------------------

99-- Mapping

92-- Mapping

@@ -106,7 +99,7 @@ fromList = Unfold step inject (return . Just)

106{-# INLINE_NORMAL lmap #-}

99{-# INLINE_NORMAL lmap #-}

107lmap :: Functor m => (a -> c) -> (c -> a) -> Unfold m c b -> Unfold m a b

100lmap :: Functor m => (a -> c) -> (c -> a) -> Unfold m c b -> Unfold m a b

108lmap f g (Unfold ustep uinject uextract) =

101lmap f g (Unfold ustep uinject uextract) =

109− Unfold ustep (uinject . f) (fmap (fmap g) . uextract)

102+ Unfold ustep (uinject . f) (fmap g . uextract)

110

103

111------------------------------------------------------------------------------

104------------------------------------------------------------------------------

112-- Nesting

105-- Nesting

@@ -115,6 +108,8 @@ lmap f g (Unfold ustep uinject uextract) =

115{-# ANN type ConcatState Fuse #-}

108{-# ANN type ConcatState Fuse #-}

116data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2

109data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2

117

110

111+-- XXX Use Either a (a,b) for extracted state.

112+--

118-- | Apply the second unfold to each output element of the first unfold and

113-- | Apply the second unfold to each output element of the first unfold and

119-- flatten the output in a single stream.

114-- flatten the output in a single stream.

120--

115--

@@ -152,17 +147,8 @@ concat (Unfold step1 inject1 extract1) (Unfold step2 inject2 extract2) =

152 Skip s -> Skip (ConcatInner ost s)

147 Skip s -> Skip (ConcatInner ost s)

153 Stop -> Skip (ConcatOuter ost)

148 Stop -> Skip (ConcatOuter ost)

154

149

155− extract (ConcatOuter s1) = do

150+ extract (ConcatOuter s1) = (,Nothing) <$> extract1 s1

156− r <- extract1 s1

157− return $ case r of

158− Nothing -> Nothing

159− Just a -> Just (a, Nothing)

160 extract (ConcatInner s1 s2) = do

151 extract (ConcatInner s1 s2) = do

161 r1 <- extract1 s1

152 r1 <- extract1 s1

162− case r1 of

163− Nothing -> return Nothing

164− Just a -> do

165− r2 <- extract2 s2

153+ r2 <- extract2 s2

166− return $ case r2 of

154+ return (r1, Just r2)

167− Nothing -> Just (a, Nothing)

168− Just b -> Just (a, Just b)

src/Streamly/Internal/Data/Unfold/Source.hs+25−21

@@ -17,9 +17,12 @@ module Streamly.Internal.Data.Unfold.Source

17 -- * Creation

18 , source

20− -- * Reading

20+ -- * Transformation

21− , read

22 , unread

21 , unread

22+

23+ -- * Consumption

24+ , isEmpty

25+ , read

23 )

26 )

24where

27where

@@ -32,17 +35,28 @@ import Prelude hiding (read)

32-- | An unfold seed with some buffered data. It allows us to 'unread' or return

35-- | An unfold seed with some buffered data. It allows us to 'unread' or return

33-- some data after reading it. Useful in backtracked parsing.

36-- some data after reading it. Useful in backtracked parsing.

34--

37--

35−data Source a b = Source [b] a

38+data Source a b = Source [b] (Maybe a)

37-- | Make a source from a seed value. The buffer would start as empty. You can

40-- | Make a source from a seed value. The buffer would start as empty. You can

38-- use 'unread' to add to the buffer.

41-- use 'unread' to add to the buffer.

39--

42--

40-- /Internal/

43-- /Internal/

41−source :: a -> Source a b

44+source :: Maybe a -> Source a b

42source = Source []

45source = Source []

47+

48+-- | Return some unused data back to the source. The data is prepended (or

49+-- consed) to the source.

50+--

51+-- /Internal/

52+unread :: [b] -> Source a b -> Source a b

53+unread xs (Source ys seed) = Source (xs ++ ys) seed

54+isEmpty :: Source a b -> Bool

55+isEmpty (Source [] Nothing) = True

56+isEmpty _ = False

57+

44-- | An unfold to read from a 'Source'. If the buffer has data then it is read

58-- | An unfold to read from a 'Source'. If the buffer has data then it is read

45−-- first otherwise the seed is unfolded using the supplied unfold.

59+-- first and then the seed is unfolded using the supplied unfold.

46--

60--

47-- /Internal/

61-- /Internal/

48{-# INLINE_NORMAL read #-}

62{-# INLINE_NORMAL read #-}

@@ -51,7 +65,7 @@ read (Unfold step1 inject1 extract1) = Unfold step inject extract

52 where

66 where

54− inject (Source [] a) = do

68+ inject (Source [] (Just a)) = do

55 s <- inject1 a

69 s <- inject1 a

56 return $ Left s

70 return $ Left s

57 inject (Source xs a) = return $ Right (xs, a)

71 inject (Source xs a) = return $ Right (xs, a)

@@ -63,22 +77,12 @@ read (Unfold step1 inject1 extract1) = Unfold step inject extract

63 Yield x s1 -> Yield x (Left s1)

77 Yield x s1 -> Yield x (Left s1)

64 Skip s1 -> Skip (Left s1)

78 Skip s1 -> Skip (Left s1)

65 Stop -> Stop

79 Stop -> Stop

80+ step (Right ([], Nothing)) = return Stop

66− step (Right ([], _)) = error "Bug: unreachable"

81+ step (Right ([], Just _)) = error "Bug: unreachable"

67− step (Right (x:[], a)) = do

82+ step (Right (x:[], Just a)) = do

68 s <- inject1 a

83 s <- inject1 a

69 return $ Yield x (Left s)

84 return $ Yield x (Left s)

70 step (Right (x:xs, a)) = return $ Yield x (Right (xs, a))

85 step (Right (x:xs, a)) = return $ Yield x (Right (xs, a))

72− extract (Left s) = do

87+ extract (Left s) = Source [] . Just <$> extract1 s

73− r <- extract1 s

74− return $ case r of

75− Nothing -> Nothing

76− Just x -> Just $ Source [] x

77− extract (Right (xs, a)) = return $ Just $ Source xs a

88+ extract (Right (xs, a)) = return $ Source xs a

78−

79−-- | Return some unused data back to the source. The data is prepended (or

80−-- consed) to the source.

81−--

82−-- /Internal/

83−unread :: [b] -> Source a b -> Source a b

84−unread xs (Source ys seed) = Source (xs ++ ys) seed

test/Streamly/Test/Data/Parser/ParserD.hs+1−1

@@ -621,7 +621,7 @@ parseUnfold = do

621 <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->

622 monadicIO $ do

623 arrays <- S.toList $ S.arraysOf clen (S.fromList ls)

624− let src = Source.source (arrays, Nothing)

624+ let src = Source.source (Just (arrays, Nothing))

625 let parser = P.fromFold (FL.takeLE tlen FL.toList)

626 let readSrc =

627 Source.read