@@ -37,6 +37,8 @@ module Streamly.Internal.Data.Stream.Type
3737 )
3838where
3939
40+#include "inline.hs"
41+
4042import Control.Applicative (liftA2)
4143import Control.DeepSeq (NFData(..), NFData1(..))
4244import Control.Monad.Base (MonadBase(..), liftBaseDefault)
@@ -63,9 +65,6 @@ import qualified Streamly.Internal.Data.Stream.Common as P
6365import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
6466import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
6567
66−#include "Instances.hs"
67−#include "inline.hs"
68−
6968-- $setup
7069-- >>> import qualified Streamly.Data.Fold as Fold
7170-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold
@@ -112,19 +111,19 @@ newtype Stream m a = Stream (K.Stream m a)
112111-- Conversions
113112------------------------------------------------------------------------------
114113
115−{-# INLINE fromStreamK #-}
114+{-# INLINE_EARLY fromStreamK #-}
116115fromStreamK :: K.Stream m a -> Stream m a
117116fromStreamK = Stream
118117
119−{-# INLINE toStreamK #-}
118+{-# INLINE_EARLY toStreamK #-}
120119toStreamK :: Stream m a -> K.Stream m a
121120toStreamK (Stream k) = k
122121
123−{-# INLINE fromStreamD #-}
122+{-# INLINE_EARLY fromStreamD #-}
124123fromStreamD :: Monad m => D.Stream m a -> Stream m a
125124fromStreamD = fromStreamK . D.toStreamK
126125
127−{-# INLINE toStreamD #-}
126+{-# INLINE_EARLY toStreamD #-}
128127toStreamD :: Applicative m => Stream m a -> D.Stream m a
129128toStreamD = D.fromStreamK . toStreamK
130129
@@ -150,30 +149,19 @@ cmpBy
150149cmpBy f m1 m2 = D.cmpBy f (toStreamD m1) (toStreamD m2)
151150
152151------------------------------------------------------------------------------
153−-- Monad
152+-- Functor
154153------------------------------------------------------------------------------
155154
156−instance Monad m => Monad (Stream m) where
157− return = pure
158−
159− -- Benchmarks better with StreamD bind and pure:
160− -- toList, filterAllout, *>, *<, >> (~2x)
161− --
162− -- pure = Stream . D.fromStreamD . D.fromPure
163− -- m >>= f = D.fromStreamD $ D.concatMap (D.toStreamD . f) (D.toStreamD m)
164−
165− -- Benchmarks better with CPS bind and pure:
166− -- Prime sieve (25x)
167− -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)
168− --
169− {-# INLINE (>>=) #-}
170− (>>=) m f = fromStreamK $ K.bindWith K.serial (toStreamK m) (toStreamK . f)
155+instance Monad m => Functor (Stream m) where
156+ {-# INLINE fmap #-}
157+ -- IMPORTANT: do not use eta reduction.
158+ fmap f m = fromStreamD $ D.mapM (return . f) $ toStreamD m
171159
172− {-# INLINE (>>) #-}
173− (>>) = (*>)
160+ {-# INLINE (<$) #-}
161+ (<$) = fmap . const
174162
175163------------------------------------------------------------------------------
176−-- Other instances
164+-- Applicative
177165------------------------------------------------------------------------------
178166
179167{-# INLINE apSerial #-}
@@ -212,12 +200,214 @@ instance Monad m => Applicative (Stream m) where
212200 (<*) = apDiscardSnd
213201 -- (<*) = K.apSerialDiscardSnd
214202
203+------------------------------------------------------------------------------
204+-- Monad
205+------------------------------------------------------------------------------
206+
207+instance Monad m => Monad (Stream m) where
208+ return = pure
209+
210+ -- Benchmarks better with StreamD bind and pure:
211+ -- toList, filterAllout, *>, *<, >> (~2x)
212+ --
213+ -- pure = Stream . D.fromStreamD . D.fromPure
214+ -- m >>= f = D.fromStreamD $ D.concatMap (D.toStreamD . f) (D.toStreamD m)
215+
216+ -- Benchmarks better with CPS bind and pure:
217+ -- Prime sieve (25x)
218+ -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)
219+ --
220+ {-# INLINE (>>=) #-}
221+ (>>=) m f = fromStreamK $ K.bindWith K.serial (toStreamK m) (toStreamK . f)
222+
223+ {-# INLINE (>>) #-}
224+ (>>) = (*>)
225+
226+------------------------------------------------------------------------------
227+-- Transformers
228+------------------------------------------------------------------------------
229+
215230-- XXX Need to remove the MonadBase instance
216−MONAD_COMMON_INSTANCES(Stream,)
217−LIST_INSTANCES(Stream)
218−NFDATA1_INSTANCE(Stream)
219−FOLDABLE_INSTANCE(Stream)
220−TRAVERSABLE_INSTANCE(Stream)
231+instance (MonadBase b m, Monad m ) => MonadBase b (Stream m) where
232+ liftBase = liftBaseDefault
233+
234+instance (MonadIO m) => MonadIO (Stream m) where
235+ liftIO = lift . liftIO
236+
237+instance (MonadThrow m) => MonadThrow (Stream m) where
238+ throwM = lift . throwM
239+
240+instance (MonadReader r m) => MonadReader r (Stream m) where
241+ ask = lift ask
242+
243+ local f (Stream m) = Stream $ K.withLocal f m
244+
245+instance (MonadState s m) => MonadState s (Stream m) where
246+ {-# INLINE get #-}
247+ get = lift get
248+
249+ {-# INLINE put #-}
250+ put x = lift (put x)
251+
252+ {-# INLINE state #-}
253+ state k = lift (state k)
254+
255+------------------------------------------------------------------------------
256+-- NFData
257+------------------------------------------------------------------------------
258+
259+instance NFData a => NFData (Stream Identity a) where
260+ {-# INLINE rnf #-}
261+ rnf (Stream xs) = runIdentity $ P.foldl' (\_ x -> rnf x) () xs
262+
263+instance NFData1 (Stream Identity) where
264+ {-# INLINE liftRnf #-}
265+ liftRnf f (Stream xs) = runIdentity $ P.foldl' (\_ x -> f x) () xs
266+
267+------------------------------------------------------------------------------
268+-- Lists
269+------------------------------------------------------------------------------
270+
271+-- Serial streams can act like regular lists using the Identity monad
272+
273+-- XXX Show instance is 10x slower compared to read, we can do much better.
274+-- The list show instance itself is really slow.
275+
276+-- XXX The default definitions of "<" in the Ord instance etc. do not perform
277+-- well, because they do not get inlined. Need to add INLINE in Ord class in
278+-- base?
279+
280+instance IsList (Stream Identity a) where
281+ type (Item (Stream Identity a)) = a
282+
283+ {-# INLINE fromList #-}
284+ fromList xs = Stream $ P.fromList xs
285+
286+ {-# INLINE toList #-}
287+ toList (Stream xs) = runIdentity $ P.toList xs
288+
289+instance Eq a => Eq (Stream Identity a) where
290+ {-# INLINE (==) #-}
291+ (==) (Stream xs) (Stream ys) = runIdentity $ P.eqBy (==) xs ys
292+
293+instance Ord a => Ord (Stream Identity a) where
294+ {-# INLINE compare #-}
295+ compare (Stream xs) (Stream ys) = runIdentity $ P.cmpBy compare xs ys
296+
297+ {-# INLINE (<) #-}
298+ x < y =
299+ case compare x y of
300+ LT -> True
301+ _ -> False
302+
303+ {-# INLINE (<=) #-}
304+ x <= y =
305+ case compare x y of
306+ GT -> False
307+ _ -> True
308+
309+ {-# INLINE (>) #-}
310+ x > y =
311+ case compare x y of
312+ GT -> True
313+ _ -> False
314+
315+ {-# INLINE (>=) #-}
316+ x >= y =
317+ case compare x y of
318+ LT -> False
319+ _ -> True
320+
321+ {-# INLINE max #-}
322+ max x y = if x <= y then y else x
323+
324+ {-# INLINE min #-}
325+ min x y = if x <= y then x else y
326+
327+instance Show a => Show (Stream Identity a) where
328+ showsPrec p dl = showParen (p > 10) $
329+ showString "fromList " . shows (toList dl)
330+
331+instance Read a => Read (Stream Identity a) where
332+ readPrec = parens $ prec 10 $ do
333+ Ident "fromList" <- lexP
334+ fromList <$> readPrec
335+
336+ readListPrec = readListPrecDefault
337+
338+instance (a ~ Char) => IsString (Stream Identity a) where
339+ {-# INLINE fromString #-}
340+ fromString xs = Stream $ P.fromList xs
341+
342+-------------------------------------------------------------------------------
343+-- Foldable
344+-------------------------------------------------------------------------------
345+
346+-- The default Foldable instance has several issues:
347+-- 1) several definitions do not have INLINE on them, so we provide
348+-- re-implementations with INLINE pragmas.
349+-- 2) the definitions of sum/product/maximum/minimum are inefficient as they
350+-- use right folds, they cannot run in constant memory. We provide
351+-- implementations using strict left folds here.
352+
353+instance (Foldable m, Monad m) => Foldable (Stream m) where
354+
355+ {-# INLINE foldMap #-}
356+ foldMap f (Stream xs) = fold $ P.foldr (mappend . f) mempty xs
357+
358+ {-# INLINE foldr #-}
359+ foldr f z t = appEndo (foldMap (Endo #. f) t) z
360+
361+ {-# INLINE foldl' #-}
362+ foldl' f z0 xs = foldr f' id xs z0
363+ where f' x k = oneShot $ \z -> k $! f z x
364+
365+ {-# INLINE length #-}
366+ length = foldl' (\n _ -> n + 1) 0
367+
368+ {-# INLINE elem #-}
369+ elem = any . (==)
370+
371+ {-# INLINE maximum #-}
372+ maximum =
373+ fromMaybe (errorWithoutStackTrace "maximum: empty stream")
374+ . toMaybe
375+ . foldl' getMax Nothing'
376+
377+ where
378+
379+ getMax Nothing' x = Just' x
380+ getMax (Just' mx) x = Just' $! max mx x
381+
382+ {-# INLINE minimum #-}
383+ minimum =
384+ fromMaybe (errorWithoutStackTrace "minimum: empty stream")
385+ . toMaybe
386+ . foldl' getMin Nothing'
387+
388+ where
389+
390+ getMin Nothing' x = Just' x
391+ getMin (Just' mn) x = Just' $! min mn x
392+
393+ {-# INLINE sum #-}
394+ sum = foldl' (+) 0
395+
396+ {-# INLINE product #-}
397+ product = foldl' (*) 1
398+
399+-------------------------------------------------------------------------------
400+-- Traversable
401+-------------------------------------------------------------------------------
402+
403+instance Traversable (Stream Identity) where
404+ {-# INLINE traverse #-}
405+ traverse f (Stream xs) =
406+ fmap Stream $ runIdentity $ P.foldr consA (pure mempty) xs
407+
408+ where
409+
410+ consA x ys = liftA2 K.cons (f x) ys
221411
222412-------------------------------------------------------------------------------
223413-- Construction