5004f12 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add docs & change the signature of replicateM and repeatM

5004f12adithyaov6 years ago

benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs+4−1

compare with master

unifiedsplit

@@ -407,7 +407,10 @@ inspect $ 'concatMapRepl `hasNoType` ''SPEC

407{-# INLINE concatUnfoldRepl #-}

408concatUnfoldRepl :: Int -> Int -> Int -> IO ()

409concatUnfoldRepl outer inner n =

410+ S.drain

411+ $ S.concatMapU

412+ (UF.lmap return (UF.replicateM inner))

410− S.drain $ S.concatMapU (UF.replicateM inner) (sourceUnfoldrMN outer n)

413+ (sourceUnfoldrMN outer n)

411

414

412#ifdef INSPECTION

415#ifdef INSPECTION

413inspect $ hasNoTypeClasses 'concatUnfoldRepl

416inspect $ hasNoTypeClasses 'concatUnfoldRepl

benchmark/Streamly/Benchmark/Data/Unfold.hs+8−9

@@ -36,11 +36,11 @@ fromListM value n =

37{-# INLINE replicateM #-}

38replicateM :: Monad m => Int -> Int -> m ()

39−replicateM value n = S.drain $ S.unfold (UF.replicateM value) n

39+replicateM value n = S.drain $ S.unfold (UF.replicateM value) (return n)

41{-# INLINE repeatM #-}

42repeatM :: Monad m => Int -> Int -> m ()

43−repeatM value n = S.drain $ S.take value $ S.unfold UF.repeatM n

43+repeatM value n = S.drain $ S.take value $ S.unfold UF.repeatM (return n)

45{-# INLINE enumerateFromStepIntegral #-}

46enumerateFromStepIntegral :: Monad m => Int -> Int -> m ()

@@ -56,7 +56,6 @@ enumerateFromToIntegral value n =

56-- Stream transformation

57-------------------------------------------------------------------------------

59−-- XXX Investigate

60{-# INLINE take #-}

59{-# INLINE take #-}

61take :: Monad m => Int -> Int -> m ()

60take :: Monad m => Int -> Int -> m ()

62take value n =

61take value n =

@@ -73,9 +72,9 @@ takeWhileM value n =

73 (UF.enumerateFromToIntegral (value + n)))

72 (UF.enumerateFromToIntegral (value + n)))

74 n

73 n

76−{-# INLINE dropOne #-}

75+{-# INLINE _dropOne #-}

77−dropOne :: Monad m => Int -> Int -> m ()

76+_dropOne :: Monad m => Int -> Int -> m ()

78−dropOne value n =

77+_dropOne value n =

79 S.drain $ S.unfold (UF.drop 1 (UF.enumerateFromToIntegral (value + n))) n

78 S.drain $ S.unfold (UF.drop 1 (UF.enumerateFromToIntegral (value + n))) n

81{-# INLINE dropAll #-}

80{-# INLINE dropAll #-}

@@ -147,14 +146,15 @@ o_1_space_serial_transformation value =

147 , benchIO "filterAllOut" $ filterAllOut value

146 , benchIO "filterAllOut" $ filterAllOut value

148 , benchIO "filterAllIn" $ filterAllIn value

147 , benchIO "filterAllIn" $ filterAllIn value

149 , benchIO "filterSome" $ filterSome value

148 , benchIO "filterSome" $ filterSome value

149+ -- This will take nanoseconds, We need to fix the benchmark reporting to

150+ -- have microseconds as the minimum unit before uncommenting this.

150− , benchIO "dropOne" $ dropOne value

151+ -- , benchIO "dropOne" $ dropOne value

151 , benchIO "dropAll" $ dropAll value

152 , benchIO "dropAll" $ dropAll value

152 , benchIO "dropWhileMTrue" $ dropWhileMTrue value

153 , benchIO "dropWhileMTrue" $ dropWhileMTrue value

153 , benchIO "dropWhileMFalse" $ dropWhileMFalse value

154 , benchIO "dropWhileMFalse" $ dropWhileMFalse value

154 ]

155 ]

156 ]

156

157

157−

158o_1_space_serial_combination :: Int -> [Benchmark]

159o_1_space_serial_combination value =

160 [ bgroup "combination"

@@ -162,7 +162,6 @@ o_1_space_serial_combination value =

162 ]

163 ]

164

165−

166o_1_space_serial_outerProduct :: Int -> [Benchmark]

165o_1_space_serial_outerProduct :: Int -> [Benchmark]

167o_1_space_serial_outerProduct value =

166o_1_space_serial_outerProduct value =

168 [ bgroup "outer-product"

167 [ bgroup "outer-product"

benchmark/Streamly/Benchmark/Prelude/Serial.hs+4−1

@@ -1570,7 +1570,10 @@ inspect $ 'concatMapWithAppend `hasNoType` ''SPEC

1570{-# INLINE concatUnfoldRepl #-}

1571concatUnfoldRepl :: Int -> Int -> Int -> IO ()

1572concatUnfoldRepl outer inner n =

1573+ S.drain

1574+ $ S.concatUnfold

1575+ (UF.lmap return (UF.replicateM inner))

1573− S.drain $ S.concatUnfold (UF.replicateM inner) (sourceUnfoldrM outer n)

1576+ (sourceUnfoldrM outer n)

1574

1577

1575#ifdef INSPECTION

1578#ifdef INSPECTION

1576inspect $ hasNoTypeClasses 'concatUnfoldRepl

1579inspect $ hasNoTypeClasses 'concatUnfoldRepl

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

@@ -126,7 +126,7 @@ o_1_space_concat value =

126concatUnfoldInterleaveRepl4xN :: Int -> Int -> IO ()

127concatUnfoldInterleaveRepl4xN value n =

128 S.drain $ Internal.concatUnfoldInterleave

129− (UF.replicateM 4)

129+ (UF.lmap return (UF.replicateM 4))

130 (sourceUnfoldrM (value `div` 4) n)

131

132#ifdef INSPECTION

@@ -140,7 +140,7 @@ inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN

140concatUnfoldRoundrobinRepl4xN :: Int -> Int -> IO ()

141concatUnfoldRoundrobinRepl4xN value n =

142 S.drain $ Internal.concatUnfoldRoundrobin

143− (UF.replicateM 4)

143+ (UF.lmap return (UF.replicateM 4))

144 (sourceUnfoldrM (value `div` 4) n)

145

146#ifdef INSPECTION

src/Streamly/Internal/Data/Unfold.hs+45−29

@@ -484,30 +484,36 @@ unfoldrM next = Unfold step return

484-- Specialized Generation

485------------------------------------------------------------------------------

486

487−-- XXX replicateM? Maybe just replicate?

488-- | Generates a stream replicating the seed @n@ times.

487-- | Generates a stream replicating the seed @n@ times.

489--

488--

490{-# INLINE replicateM #-}

489{-# INLINE replicateM #-}

491−replicateM :: Monad m => Int -> Unfold m a a

490+replicateM :: Monad m => Int -> Unfold m (m a) a

492replicateM n = Unfold step inject

491replicateM n = Unfold step inject

492+

493 where

494+

494 inject x = return (x, n)

495 inject x = return (x, n)

496+

495 {-# INLINE_LATE step #-}

497 {-# INLINE_LATE step #-}

498+ step (x, i) = do

499+ x1 <- x

496− step (x, i) = return $

500+ return

497− if i <= 0

501+ $ if i <= 0

498− then Stop

502+ then Stop

499− else Yield x (x, i - 1)

503+ else Yield x1 (x, i - 1)

500

504

501−-- XXX repeatM? Maybe just repeat?

502-- | Generates an infinite stream repeating the seed.

505-- | Generates an infinite stream repeating the seed.

503--

506--

504{-# INLINE repeatM #-}

507{-# INLINE repeatM #-}

505−repeatM :: Monad m => Unfold m a a

508+repeatM :: Monad m => Unfold m (m a) a

506repeatM = Unfold step return

509repeatM = Unfold step return

507 where

510 where

508 {-# INLINE_LATE step #-}

511 {-# INLINE_LATE step #-}

509− step x = return $ Yield x x

512+ step x = x >>= \x1 -> return $ Yield x1 x

510

513

514+-- | Generates an infinite stream starting with the given seed and applying the

515+-- given function repeteadly.

516+--

511{-# INLINE iterateM #-}

517{-# INLINE iterateM #-}

512iterateM :: Monad m => (a -> m a) -> Unfold m a a

518iterateM :: Monad m => (a -> m a) -> Unfold m a a

513iterateM f = Unfold step f

519iterateM f = Unfold step f

@@ -517,6 +523,9 @@ iterateM f = Unfold step f

517 fx <- f x

523 fx <- f x

518 return $ Yield fx fx

524 return $ Yield fx fx

519

525

526+-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@

527+-- starting from the seed.

528+--

520{-# INLINE_NORMAL fromIndicesM #-}

529{-# INLINE_NORMAL fromIndicesM #-}

521fromIndicesM :: Monad m => (Int -> m a) -> Unfold m Int a

530fromIndicesM :: Monad m => (Int -> m a) -> Unfold m Int a

522fromIndicesM gen = Unfold step return

531fromIndicesM gen = Unfold step return

@@ -585,52 +594,59 @@ filter f = filterM (return . f)

585{-# INLINE_NORMAL drop #-}

594{-# INLINE_NORMAL drop #-}

586drop :: Monad m => Int -> Unfold m a b -> Unfold m a b

595drop :: Monad m => Int -> Unfold m a b -> Unfold m a b

587drop n (Unfold step inject) = Unfold step' inject'

596drop n (Unfold step inject) = Unfold step' inject'

597+

588− where

598+ where

599+

589 inject' a = do

600 inject' a = do

590 b <- inject a

601 b <- inject a

591 return (b, n)

602 return (b, n)

603+

592 {-# INLINE_LATE step' #-}

604 {-# INLINE_LATE step' #-}

593 step' (st, i)

605 step' (st, i)

594 | i > 0 = do

606 | i > 0 = do

595 r <- step st

607 r <- step st

596− return $

608+ return

597− case r of

609+ $ case r of

598− Yield _ s -> Skip (s, i - 1)

610+ Yield _ s -> Skip (s, i - 1)

599− Skip s -> Skip (s, i)

611+ Skip s -> Skip (s, i)

600− Stop -> Stop

612+ Stop -> Stop

601 | otherwise = do

613 | otherwise = do

602 r <- step st

614 r <- step st

603− return $

615+ return

604− case r of

616+ $ case r of

605− Yield x s -> Yield x (s, 0)

617+ Yield x s -> Yield x (s, 0)

606− Skip s -> Skip (s, 0)

618+ Skip s -> Skip (s, 0)

607− Stop -> Stop

619+ Stop -> Stop

608

620

609{-# INLINE_NORMAL dropWhileM #-}

621{-# INLINE_NORMAL dropWhileM #-}

610dropWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b

622dropWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b

611dropWhileM f (Unfold step inject) = Unfold step' inject'

623dropWhileM f (Unfold step inject) = Unfold step' inject'

624+

612− where

625+ where

626+

613 inject' a = do

627 inject' a = do

614 b <- inject a

628 b <- inject a

615 return $ Left b

629 return $ Left b

630+

616 {-# INLINE_LATE step' #-}

631 {-# INLINE_LATE step' #-}

617 step' (Left st) = do

632 step' (Left st) = do

618 r <- step st

633 r <- step st

619 case r of

634 case r of

620 Yield x s -> do

635 Yield x s -> do

621 b <- f x

636 b <- f x

637+ return

622− if b

638+ $ if b

623− then return $ Skip (Left s)

639+ then Skip (Left s)

624− else return $ Yield x (Right s)

640+ else Yield x (Right s)

625 Skip s -> return $ Skip (Left s)

641 Skip s -> return $ Skip (Left s)

626 Stop -> return Stop

642 Stop -> return Stop

627−

628 step' (Right st) = do

643 step' (Right st) = do

629 r <- step st

644 r <- step st

645+ return

630− case r of

646+ $ case r of

631− Yield x s -> return $ Yield x (Right s)

647+ Yield x s -> Yield x (Right s)

632− Skip s -> return $ Skip (Right s)

648+ Skip s -> Skip (Right s)

633− Stop -> return Stop

649+ Stop -> Stop

634

650

635{-# INLINE dropWhile #-}

651{-# INLINE dropWhile #-}

636dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b

652dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b

test/Streamly/Test/Internal/Data/Unfold.hs+6−4

@@ -90,7 +90,7 @@ replicateM :: Property

90replicateM =

91 property $ \x ->

92 runIdentity $ do

93− x1 <- S.toList $ S.unfold (UF.replicateM x) ()

93+ x1 <- S.toList $ S.unfold (UF.replicateM x) (return ())

94 let x2 = P.replicate x ()

95 return $ x1 == x2

@@ -98,7 +98,7 @@ repeatM :: Property

98repeatM =

99 property $ \x ->

100 runIdentity $ do

101− x1 <- S.toList $ S.take x $ S.unfold UF.repeatM ()

101+ x1 <- S.toList $ S.take x $ S.unfold UF.repeatM (return ())

102 let x2 = P.take x $ P.repeat ()

103 return $ x1 == x2

104

@@ -142,8 +142,10 @@ drop :: Property

142drop =

143 property $ \x y ->

144 runIdentity $ do

145+ x1 <- S.toList

145− x1 <- S.toList $ S.unfold (UF.drop x (UF.replicateM (x + y))) ()

146+ $ S.unfold (UF.drop x (UF.replicateM (x + y))) (return ())

147+ x2 <- S.toList

146− x2 <- S.toList $ S.drop x $ S.unfold (UF.replicateM (x + y)) ()

148+ $ S.drop x $ S.unfold (UF.replicateM (x + y)) (return ())

147 return $ x1 == x2

149 return $ x1 == x2

148

150

149dropWhileM :: Property

151dropWhileM :: Property