3947fee · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add Applicative instance for Unfold

3947feeHarendra Kumar6 years ago

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

compare with master

unifiedsplit

@@ -416,9 +416,12 @@ concatMapM size start =

416

417 unfoldOut = UF.enumerateFromToIntegral (start + sizeOuter)

418

419−{-# INLINE _ap #-}

419+{-# INLINE toNullAp #-}

420−_ap :: Int -> Int -> m ()

420+toNullAp :: Monad m => Int -> Int -> m ()

421−_ap = undefined

421+toNullAp linearCount start =

422+ let end = start + Nested.nestedCount2 linearCount

423+ s = Nested.source end

424+ in UF.fold ((+) <$> s <*> s) FL.drain start

422

425

423{-# INLINE _apDiscardFst #-}

426{-# INLINE _apDiscardFst #-}

424_apDiscardFst :: Int -> Int -> m ()

427_apDiscardFst :: Int -> Int -> m ()

@@ -527,7 +530,8 @@ o_1_space_nested :: Int -> [Benchmark]

527o_1_space_nested size =

530o_1_space_nested size =

528 [ bgroup

531 [ bgroup

529 "outer-product"

532 "outer-product"

533+ [ benchIO "toNullAp" $ toNullAp size

530− [ benchIO "toNull" $ Nested.toNull size

534+ , benchIO "toNull" $ Nested.toNull size

531 , benchIO "toNull3" $ Nested.toNull3 size

535 , benchIO "toNull3" $ Nested.toNull3 size

532 , benchIO "concat" $ Nested.concat size

536 , benchIO "concat" $ Nested.concat size

533 , benchIO "breakAfterSome" $ Nested.breakAfterSome size

537 , benchIO "breakAfterSome" $ Nested.breakAfterSome size

src/Streamly/Internal/Data/Unfold.hs+3−39

@@ -125,9 +125,6 @@ module Streamly.Internal.Data.Unfold

125 , concat

126 , concatMapM

127 , outerProduct

128− , ap

129− , apDiscardFst

130− , apDiscardSnd

131

128

132 -- * Exceptions

129 -- * Exceptions

133 , gbracket_

130 , gbracket_

@@ -159,7 +156,7 @@ import Streamly.Internal.Data.IOFinalizer

159 (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)

156 (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)

160import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..), Step(..))

157import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..), Step(..))

161import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)

158import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)

162−import Streamly.Internal.Data.Unfold.Types (Unfold(..), lmap, map)

159+import Streamly.Internal.Data.Unfold.Types (Unfold(..), lmap, map, const)

163import System.Mem (performMajorGC)

160import System.Mem (performMajorGC)

164

161

165import qualified Prelude

162import qualified Prelude

@@ -429,13 +426,6 @@ singleton f = singletonM $ return . f

429identity :: Monad m => Unfold m a a

426identity :: Monad m => Unfold m a a

430identity = singletonM return

427identity = singletonM return

431

428

432−const :: Monad m => m b -> Unfold m a b

433−const m = Unfold step inject

434− where

435− inject _ = return ()

436− step () = m >>= \r -> return $ Yield r ()

437−

438−

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

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

440{-# INLINE_LATE fromList #-}

430{-# INLINE_LATE fromList #-}

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

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

@@ -952,6 +942,8 @@ concat (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject

952data OuterProductState s1 s2 sy x y =

942data OuterProductState s1 s2 sy x y =

953 OuterProductOuter s1 y | OuterProductInner s1 sy s2 x

943 OuterProductOuter s1 y | OuterProductInner s1 sy s2 x

954

944

945+-- XXX this can be written in terms of "cross".

946+--

955-- | Create an outer product (vector product or cartesian product) of the

947-- | Create an outer product (vector product or cartesian product) of the

956-- output streams of two unfolds.

948-- output streams of two unfolds.

957--

949--

@@ -981,34 +973,6 @@ outerProduct (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject

981 Skip s -> Skip (OuterProductInner ost sy s x)

973 Skip s -> Skip (OuterProductInner ost sy s x)

982 Stop -> Skip (OuterProductOuter ost sy)

974 Stop -> Skip (OuterProductOuter ost sy)

983

975

984−-- Special cases of outer product

985−-- | Outer product with a function application.

986−--

987−-- /Unimplemented/

988−--

989−{-# INLINE_NORMAL ap #-}

990−ap :: -- Monad m =>

991− Unfold m a (b -> c) -> Unfold m d b -> Unfold m (a, d) c

992−ap (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined

993−

994−-- | Outer product discarding the first element.

995−--

996−-- /Unimplemented/

997−--

998−{-# INLINE_NORMAL apDiscardFst #-}

999−apDiscardFst :: -- Monad m =>

1000− Unfold m a b -> Unfold m c d -> Unfold m (a, c) d

1001−apDiscardFst (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined

1002−

1003−-- | Outer product discarding the second element.

1004−--

1005−-- /Unimplemented/

1006−--

1007−{-# INLINE_NORMAL apDiscardSnd #-}

1008−apDiscardSnd :: -- Monad m =>

1009− Unfold m a b -> Unfold m c d -> Unfold m (a, c) b

1010−apDiscardSnd (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined

1011−

1012-- XXX This can be used to implement a Monad instance for "Unfold m ()".

976-- XXX This can be used to implement a Monad instance for "Unfold m ()".

1013

977

1014data ConcatMapState s1 s2 = ConcatMapOuter s1 | ConcatMapInner s1 s2

978data ConcatMapState s1 s2 = ConcatMapOuter s1 | ConcatMapInner s1 s2

src/Streamly/Internal/Data/Unfold/Types.hs+88−1

@@ -10,6 +10,10 @@ module Streamly.Internal.Data.Unfold.Types

10 ( Unfold (..)

11 , lmap

12 , map

13+ , const

14+ , apSequence

15+ , apDiscardSnd

16+ , cross

13 )

17 )

14where

18where

@@ -17,7 +21,7 @@ where

18import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))

22import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))

20−import Prelude hiding (map)

24+import Prelude hiding (const, map)

22------------------------------------------------------------------------------

26------------------------------------------------------------------------------

23-- Monadic Unfolds

27-- Monadic Unfolds

@@ -63,3 +67,86 @@ map f (Unfold ustep uinject) = Unfold step uinject

63instance Functor m => Functor (Unfold m a) where

67instance Functor m => Functor (Unfold m a) where

64 {-# INLINE fmap #-}

68 {-# INLINE fmap #-}

65 fmap = map

69 fmap = map

70+

71+------------------------------------------------------------------------------

72+-- Applicative

73+------------------------------------------------------------------------------

74+

75+{-# INLINE const #-}

76+const :: Applicative m => m b -> Unfold m a b

77+const m = Unfold step inject

78+

79+ where

80+

81+ inject _ = pure False

82+

83+ step False = (`Yield` True) <$> m

84+ step True = pure Stop

85+

86+-- | Outer product discarding the first element.

87+--

88+-- /Unimplemented/

89+--

90+{-# INLINE_NORMAL apSequence #-}

91+apSequence :: -- Monad m =>

92+ Unfold m a b -> Unfold m a c -> Unfold m a c

93+apSequence (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined

94+

95+-- | Outer product discarding the second element.

96+--

97+-- /Unimplemented/

98+--

99+{-# INLINE_NORMAL apDiscardSnd #-}

100+apDiscardSnd :: -- Monad m =>

101+ Unfold m a b -> Unfold m a c -> Unfold m a b

102+apDiscardSnd (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined

103+

104+data Cross a s1 b s2 = CrossOuter a s1 | CrossInner a s1 b s2

105+

106+-- | Create a cross product (vector product or cartesian product) of the

107+-- output streams of two unfolds.

108+--

109+{-# INLINE_NORMAL cross #-}

110+cross :: Monad m => Unfold m a b -> Unfold m a c -> Unfold m a (b, c)

111+cross (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject

112+

113+ where

114+

115+ inject a = do

116+ s1 <- inject1 a

117+ return $ CrossOuter a s1

118+

119+ {-# INLINE_LATE step #-}

120+ step (CrossOuter a s1) = do

121+ r <- step1 s1

122+ case r of

123+ Yield b s -> do

124+ s2 <- inject2 a

125+ return $ Skip (CrossInner a s b s2)

126+ Skip s -> return $ Skip (CrossOuter a s)

127+ Stop -> return Stop

128+

129+ step (CrossInner a s1 b s2) = do

130+ r <- step2 s2

131+ return $ case r of

132+ Yield c s -> Yield (b, c) (CrossInner a s1 b s)

133+ Skip s -> Skip (CrossInner a s1 b s)

134+ Stop -> Skip (CrossOuter a s1)

135+

136+-- | Example:

137+--

138+-- >>> Stream.toList $ Stream.unfold ((,) <$> Unfold.lmap fst Unfold.fromList <*> Unfold.lmap snd Unfold.fromList) ([1,2],[3,4])

139+-- [(1,3),(1,4),(2,3),(2,4)]

140+--

141+instance Monad m => Applicative (Unfold m a) where

142+ {-# INLINE pure #-}

143+ pure = const . return

144+

145+ {-# INLINE (<*>) #-}

146+ u1 <*> u2 = fmap (\(a, b) -> a b) (cross u1 u2)

147+

148+ -- {-# INLINE (*>) #-}

149+ -- (*>) = apSequence

150+

151+ -- {-# INLINE (<*) #-}

152+ -- (<*) = apDiscardSnd

test/Streamly/Test/Data/Unfold.hs+2−2

@@ -146,8 +146,8 @@ singletonM =

146

147const :: Bool

148const =

149− let unf = UF.take 10 $ UF.const (modify (+ 1) >> get)

149+ let unf = UF.const (modify (+ 1) >> get)

150− in testUnfoldMD unf (0 :: Int) 0 10 [1 .. 10]

150+ in testUnfoldMD unf (0 :: Int) 0 1 [1]

151

152unfoldrM :: Property

153unfoldrM =