git.iko.soy/streamly
on master help sign in
Remove Instances.hs from streamly-core
21b6ed5Harendra Kumar
core/src/Streamly/Internal/Data/Stream/Instances.hsdeleted−171
compare with master
unifiedsplit
@@ -1,171 +0,0 @@
1−------------------------------------------------------------------------------
2−-- CPP macros for common instances
3−------------------------------------------------------------------------------
4−
5−-- XXX use template haskell instead and include Monoid and IsStream instances
6−-- as well.
7−
8−#define MONADPARALLEL , MonadAsync m
9−
10−#define MONAD_COMMON_INSTANCES(STREAM,CONSTRAINT) \
11−instance Monad m => Functor (STREAM m) where { \
12− {-# INLINE fmap #-}; \
13− fmap f (STREAM m) = \
14− STREAM $ D.toStreamK $ D.mapM (return . f) $ D.fromStreamK m; \
15− {-# INLINE (<$) #-}; \
16− (<$) = fmap . const }; \
17− \
18−instance (MonadBase b m, Monad m CONSTRAINT) => MonadBase b (STREAM m) where {\
19− liftBase = liftBaseDefault }; \
20− \
21−instance (MonadIO m CONSTRAINT) => MonadIO (STREAM m) where { \
22− liftIO = lift . liftIO }; \
23− \
24−instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where { \
25− throwM = lift . throwM }; \
26− \
27−{- \
28−instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where { \
29− throwError = lift . throwError; \
30− catchError m h = \
31− fromStream $ withCatchError (toStream m) (\e -> toStream $ h e) }; \
32−-} \
33− \
34−instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where { \
35− ask = lift ask; \
36− local f (STREAM m) = STREAM $ K.withLocal f m }; \
37− \
38−instance (MonadState s m CONSTRAINT) => MonadState s (STREAM m) where { \
39− {-# INLINE get #-}; \
40− get = lift get; \
41− {-# INLINE put #-}; \
42− put x = lift (put x); \
43− {-# INLINE state #-}; \
44− state k = lift (state k) }
45−
46−------------------------------------------------------------------------------
47−-- Lists
48−------------------------------------------------------------------------------
49−
50−-- Serial streams can act like regular lists using the Identity monad
51−
52−-- XXX Show instance is 10x slower compared to read, we can do much better.
53−-- The list show instance itself is really slow.
54−
55−-- XXX The default definitions of "<" in the Ord instance etc. do not perform
56−-- well, because they do not get inlined. Need to add INLINE in Ord class in
57−-- base?
58−
59−#define NFDATA1_INSTANCE(STREAM) \
60−instance NFData1 (STREAM Identity) where { \
61− {-# INLINE liftRnf #-}; \
62− liftRnf f (STREAM xs) = runIdentity $ P.foldl' (\_ x -> f x) () xs}
63−
64−#define LIST_INSTANCES(STREAM) \
65−instance IsList (STREAM Identity a) where { \
66− type (Item (STREAM Identity a)) = a; \
67− {-# INLINE fromList #-}; \
68− fromList xs = STREAM $ P.fromList xs; \
69− {-# INLINE toList #-}; \
70− toList (STREAM xs) = runIdentity $ P.toList xs }; \
71− \
72−instance Eq a => Eq (STREAM Identity a) where { \
73− {-# INLINE (==) #-}; \
74− (==) (STREAM xs) (STREAM ys) = runIdentity $ P.eqBy (==) xs ys }; \
75− \
76−instance Ord a => Ord (STREAM Identity a) where { \
77− {-# INLINE compare #-}; \
78− compare (STREAM xs) (STREAM ys) = runIdentity $ P.cmpBy compare xs ys; \
79− {-# INLINE (<) #-}; \
80− x < y = case compare x y of { LT -> True; _ -> False }; \
81− {-# INLINE (<=) #-}; \
82− x <= y = case compare x y of { GT -> False; _ -> True }; \
83− {-# INLINE (>) #-}; \
84− x > y = case compare x y of { GT -> True; _ -> False }; \
85− {-# INLINE (>=) #-}; \
86− x >= y = case compare x y of { LT -> False; _ -> True }; \
87− {-# INLINE max #-}; \
88− max x y = if x <= y then y else x; \
89− {-# INLINE min #-}; \
90− min x y = if x <= y then x else y; }; \
91− \
92−instance Show a => Show (STREAM Identity a) where { \
93− showsPrec p dl = showParen (p > 10) $ \
94− showString "fromList " . shows (toList dl) }; \
95− \
96−instance Read a => Read (STREAM Identity a) where { \
97− readPrec = parens $ prec 10 $ do { \
98− Ident "fromList" <- lexP; \
99− fromList <$> readPrec }; \
100− readListPrec = readListPrecDefault }; \
101− \
102−instance (a ~ Char) => IsString (STREAM Identity a) where { \
103− {-# INLINE fromString #-}; \
104− fromString xs = STREAM $ P.fromList xs }; \
105− \
106−instance NFData a => NFData (STREAM Identity a) where { \
107− {-# INLINE rnf #-}; \
108− rnf (STREAM xs) = runIdentity $ P.foldl' (\_ x -> rnf x) () xs}; \
109−
110−-------------------------------------------------------------------------------
111−-- Foldable
112−-------------------------------------------------------------------------------
113−
114−-- The default Foldable instance has several issues:
115−-- 1) several definitions do not have INLINE on them, so we provide
116−-- re-implementations with INLINE pragmas.
117−-- 2) the definitions of sum/product/maximum/minimum are inefficient as they
118−-- use right folds, they cannot run in constant memory. We provide
119−-- implementations using strict left folds here.
120−
121−#define FOLDABLE_INSTANCE(STREAM) \
122−instance (Foldable m, Monad m) => Foldable (STREAM m) where { \
123− \
124− {-# INLINE foldMap #-}; \
125− foldMap f (STREAM xs) = fold $ P.foldr (mappend . f) mempty xs; \
126− \
127− {-# INLINE foldr #-}; \
128− foldr f z t = appEndo (foldMap (Endo #. f) t) z; \
129− \
130− {-# INLINE foldl' #-}; \
131− foldl' f z0 xs = foldr f' id xs z0 \
132− where {f' x k = oneShot $ \z -> k $! f z x}; \
133− \
134− {-# INLINE length #-}; \
135− length = foldl' (\n _ -> n + 1) 0; \
136− \
137− {-# INLINE elem #-}; \
138− elem = any . (==); \
139− \
140− {-# INLINE maximum #-}; \
141− maximum = \
142− fromMaybe (errorWithoutStackTrace "maximum: empty stream") \
143− . toMaybe \
144− . foldl' getMax Nothing' where { \
145− getMax Nothing' x = Just' x; \
146− getMax (Just' mx) x = Just' $! max mx x }; \
147− \
148− {-# INLINE minimum #-}; \
149− minimum = \
150− fromMaybe (errorWithoutStackTrace "minimum: empty stream") \
151− . toMaybe \
152− . foldl' getMin Nothing' where { \
153− getMin Nothing' x = Just' x; \
154− getMin (Just' mn) x = Just' $! min mn x }; \
155− \
156− {-# INLINE sum #-}; \
157− sum = foldl' (+) 0; \
158− \
159− {-# INLINE product #-}; \
160− product = foldl' (*) 1 }
161−
162−-------------------------------------------------------------------------------
163−-- Traversable
164−-------------------------------------------------------------------------------
165−
166−#define TRAVERSABLE_INSTANCE(STREAM) \
167−instance Traversable (STREAM Identity) where { \
168− {-# INLINE traverse #-}; \
169− traverse f (STREAM xs) = \
170− fmap STREAM $ runIdentity $ P.foldr consA (pure mempty) xs \
171− where { consA x ys = liftA2 K.cons (f x) ys }}
core/src/Streamly/Internal/Data/Stream/Type.hs+221−31
@@ -37,6 +37,8 @@ module Streamly.Internal.Data.Stream.Type
37 )
37 )
38where
38where
39
39
40+#include "inline.hs"
41+
40import Control.Applicative (liftA2)
42import Control.Applicative (liftA2)
41import Control.DeepSeq (NFData(..), NFData1(..))
43import Control.DeepSeq (NFData(..), NFData1(..))
42import Control.Monad.Base (MonadBase(..), liftBaseDefault)
44import Control.Monad.Base (MonadBase(..), liftBaseDefault)
@@ -63,9 +65,6 @@ import qualified Streamly.Internal.Data.Stream.Common as P
63import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
65import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
64import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
66import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
65
67
66−#include "Instances.hs"
67−#include "inline.hs"
68−
69-- $setup
68-- $setup
70-- >>> import qualified Streamly.Data.Fold as Fold
69-- >>> import qualified Streamly.Data.Fold as Fold
71-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold
70-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold
@@ -112,19 +111,19 @@ newtype Stream m a = Stream (K.Stream m a)
112-- Conversions
111-- Conversions
113------------------------------------------------------------------------------
112------------------------------------------------------------------------------
114
113
115−{-# INLINE fromStreamK #-}
114+{-# INLINE_EARLY fromStreamK #-}
116fromStreamK :: K.Stream m a -> Stream m a
115fromStreamK :: K.Stream m a -> Stream m a
117fromStreamK = Stream
116fromStreamK = Stream
118
117
119−{-# INLINE toStreamK #-}
118+{-# INLINE_EARLY toStreamK #-}
120toStreamK :: Stream m a -> K.Stream m a
119toStreamK :: Stream m a -> K.Stream m a
121toStreamK (Stream k) = k
120toStreamK (Stream k) = k
122
121
123−{-# INLINE fromStreamD #-}
122+{-# INLINE_EARLY fromStreamD #-}
124fromStreamD :: Monad m => D.Stream m a -> Stream m a
123fromStreamD :: Monad m => D.Stream m a -> Stream m a
125fromStreamD = fromStreamK . D.toStreamK
124fromStreamD = fromStreamK . D.toStreamK
126
125
127−{-# INLINE toStreamD #-}
126+{-# INLINE_EARLY toStreamD #-}
128toStreamD :: Applicative m => Stream m a -> D.Stream m a
127toStreamD :: Applicative m => Stream m a -> D.Stream m a
129toStreamD = D.fromStreamK . toStreamK
128toStreamD = D.fromStreamK . toStreamK
130
129
@@ -150,30 +149,19 @@ cmpBy
150cmpBy f m1 m2 = D.cmpBy f (toStreamD m1) (toStreamD m2)
149cmpBy f m1 m2 = D.cmpBy f (toStreamD m1) (toStreamD m2)
151
150
152------------------------------------------------------------------------------
151------------------------------------------------------------------------------
153−-- Monad
152+-- Functor
154------------------------------------------------------------------------------
153------------------------------------------------------------------------------
155
154
156−instance Monad m => Monad (Stream m) where
155+instance Monad m => Functor (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 (>>=) #-}
156+ {-# INLINE fmap #-}
170− (>>=) m f = fromStreamK $ K.bindWith K.serial (toStreamK m) (toStreamK . f)
157+ -- IMPORTANT: do not use eta reduction.
158+ fmap f m = fromStreamD $ D.mapM (return . f) $ toStreamD m
171
159
172− {-# INLINE (>>) #-}
160+ {-# INLINE (<$) #-}
173− (>>) = (*>)
161+ (<$) = fmap . const
174
162
175------------------------------------------------------------------------------
163------------------------------------------------------------------------------
176−-- Other instances
164+-- Applicative
177------------------------------------------------------------------------------
165------------------------------------------------------------------------------
178
166
179{-# INLINE apSerial #-}
167{-# INLINE apSerial #-}
@@ -212,12 +200,214 @@ instance Monad m => Applicative (Stream m) where
212 (<*) = apDiscardSnd
200 (<*) = apDiscardSnd
213 -- (<*) = K.apSerialDiscardSnd
201 -- (<*) = K.apSerialDiscardSnd
214
202
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+
215-- XXX Need to remove the MonadBase instance
230-- XXX Need to remove the MonadBase instance
216−MONAD_COMMON_INSTANCES(Stream,)
231+instance (MonadBase b m, Monad m ) => MonadBase b (Stream m) where
217−LIST_INSTANCES(Stream)
232+ liftBase = liftBaseDefault
218−NFDATA1_INSTANCE(Stream)
233+
219−FOLDABLE_INSTANCE(Stream)
234+instance (MonadIO m) => MonadIO (Stream m) where
220−TRAVERSABLE_INSTANCE(Stream)
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
221
411
222-------------------------------------------------------------------------------
412-------------------------------------------------------------------------------
223-- Construction
413-- Construction
core/streamly-core.cabal−1
@@ -20,7 +20,6 @@ extra-source-files:
20 configure.ac
20 configure.ac
21
21
22 -- This is duplicated
22 -- This is duplicated
23− src/Streamly/Internal/Data/Stream/Instances.hs
24 src/Streamly/Internal/Data/Array/ArrayMacros.h
23 src/Streamly/Internal/Data/Array/ArrayMacros.h
25 src/assert.hs
24 src/assert.hs
26 src/inline.hs
25 src/inline.hs
streamly.cabal−1
@@ -129,7 +129,6 @@ extra-source-files:
129 core/src/assert.hs
129 core/src/assert.hs
130 core/src/config.h.in
130 core/src/config.h.in
131 core/src/inline.hs
131 core/src/inline.hs
132− core/src/Streamly/Internal/Data/Stream/Instances.hs
133 core/src/Streamly/Internal/Data/Array/ArrayMacros.h
132 core/src/Streamly/Internal/Data/Array/ArrayMacros.h
134 core/src/Streamly/Internal/Data/Time/Clock/config-clock.h
133 core/src/Streamly/Internal/Data/Time/Clock/config-clock.h
135 core/src/Streamly/Internal/BaseCompat.hs
134 core/src/Streamly/Internal/BaseCompat.hs