@@ -109,13 +109,53 @@ instance NFData a => NFData (STREAM Identity a) where { \
109109-- Foldable
110110-------------------------------------------------------------------------------
111111
112−-- XXX the foldable instance seems to be quit slow. We can try writing
113−-- custom implementations of foldr and foldl'. If nothing works we can also try
114−-- writing a Foldable for Identity monad rather than for "Foldable m".
112+-- The default Foldable instance has several issues:
113+-- 1) several definitions do not have INLINE on them, so we provide
114+-- re-implementations with INLINE pragmas.
115+-- 2) the definitions of sum/product/maximum/minimum are inefficient as they
116+-- use right folds, they cannot run in constant memory. We provide
117+-- implementations using strict left folds here.
118+
115119#define FOLDABLE_INSTANCE(STREAM) \
116120instance (Foldable m, Monad m) => Foldable (STREAM m) where { \
117− {-# INLINE foldMap #-}; \
118− foldMap f = fold . P.foldr mappend mempty . fmap f }
121+ \
122+ {-# INLINE foldMap #-}; \
123+ foldMap f = fold . P.foldr (mappend . f) mempty; \
124+ \
125+ {-# INLINE foldr #-}; \
126+ foldr f z t = appEndo (foldMap (Endo #. f) t) z; \
127+ \
128+ {-# INLINE foldl' #-}; \
129+ foldl' f z0 xs = foldr f' id xs z0 \
130+ where { f' x k z = k $! f z x}; \
131+ \
132+ {-# INLINE length #-}; \
133+ length = foldl' (\n _ -> n + 1) 0; \
134+ \
135+ {-# INLINE elem #-}; \
136+ elem = any . (==); \
137+ \
138+ {-# INLINE maximum #-}; \
139+ maximum = \
140+ fromMaybe (errorWithoutStackTrace $ "maximum: empty stream") \
141+ . toMaybe \
142+ . foldl' getMax Nothing' where { \
143+ getMax Nothing' x = Just' x; \
144+ getMax (Just' mx) x = Just' $! max mx x }; \
145+ \
146+ {-# INLINE minimum #-}; \
147+ minimum = \
148+ fromMaybe (errorWithoutStackTrace $ "minimum: empty stream") \
149+ . toMaybe \
150+ . foldl' getMin Nothing' where { \
151+ getMin Nothing' x = Just' x; \
152+ getMin (Just' mn) x = Just' $! min mn x }; \
153+ \
154+ {-# INLINE sum #-}; \
155+ sum = foldl' (+) 0; \
156+ \
157+ {-# INLINE product #-}; \
158+ product = foldl' (*) 1 }
119159
120160-------------------------------------------------------------------------------
121161-- Traversable