improve performance of foldable instance

* use foldl' based implementations of type class methods instead of
  using default implementations
* reimplement some type class methods to use INLINE pragmas
This commit is contained in:
Harendra Kumar 2020-02-17 21:02:07 +05:30
parent b50e1a5285
commit 007df998b9
3 changed files with 66 additions and 8 deletions

View File

@ -109,13 +109,53 @@ instance NFData a => NFData (STREAM Identity a) where { \
-- Foldable
-------------------------------------------------------------------------------
-- XXX the foldable instance seems to be quit slow. We can try writing
-- custom implementations of foldr and foldl'. If nothing works we can also try
-- writing a Foldable for Identity monad rather than for "Foldable m".
-- The default Foldable instance has several issues:
-- 1) several definitions do not have INLINE on them, so we provide
-- re-implementations with INLINE pragmas.
-- 2) the definitions of sum/product/maximum/minimum are inefficient as they
-- use right folds, they cannot run in constant memory. We provide
-- implementations using strict left folds here.
#define FOLDABLE_INSTANCE(STREAM) \
instance (Foldable m, Monad m) => Foldable (STREAM m) where { \
{-# INLINE foldMap #-}; \
foldMap f = fold . P.foldr mappend mempty . fmap f }
\
{-# INLINE foldMap #-}; \
foldMap f = fold . P.foldr (mappend . f) mempty; \
\
{-# INLINE foldr #-}; \
foldr f z t = appEndo (foldMap (Endo #. f) t) z; \
\
{-# INLINE foldl' #-}; \
foldl' f z0 xs = foldr f' id xs z0 \
where { f' x k z = k $! f z x}; \
\
{-# INLINE length #-}; \
length = foldl' (\n _ -> n + 1) 0; \
\
{-# INLINE elem #-}; \
elem = any . (==); \
\
{-# INLINE maximum #-}; \
maximum = \
fromMaybe (errorWithoutStackTrace $ "maximum: empty stream") \
. toMaybe \
. foldl' getMax Nothing' where { \
getMax Nothing' x = Just' x; \
getMax (Just' mx) x = Just' $! max mx x }; \
\
{-# INLINE minimum #-}; \
minimum = \
fromMaybe (errorWithoutStackTrace $ "minimum: empty stream") \
. toMaybe \
. foldl' getMin Nothing' where { \
getMin Nothing' x = Just' x; \
getMin (Just' mn) x = Just' $! min mn x }; \
\
{-# INLINE sum #-}; \
sum = foldl' (+) 0; \
\
{-# INLINE product #-}; \
product = foldl' (*) 1 }
-------------------------------------------------------------------------------
-- Traversable

View File

@ -61,8 +61,11 @@ import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Data.Coerce (Coercible, coerce)
import Data.Foldable (Foldable(foldl'), fold)
import Data.Functor.Identity (Identity(..), runIdentity)
import Data.Foldable (fold)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Endo(..))
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup (Semigroup(..))
#endif
@ -73,6 +76,7 @@ import Prelude hiding (map, mapM)
import Streamly.Internal.Data.Stream.StreamK (IsStream(..), adapt, Stream, mkStream,
foldStream)
import Streamly.Internal.Data.Strict (Maybe'(..), toMaybe)
import qualified Streamly.Internal.Data.Stream.Prelude as P
import qualified Streamly.Internal.Data.Stream.StreamK as K
import qualified Streamly.Internal.Data.Stream.StreamD as D
@ -80,6 +84,11 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D
#include "Instances.hs"
#include "inline.hs"
-- XXX move this to Streamly.Internal.Data.Coerce?
{-# INLINE (#.) #-}
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
(#.) _f = coerce
------------------------------------------------------------------------------
-- SerialT
------------------------------------------------------------------------------

View File

@ -45,8 +45,11 @@ import Control.DeepSeq (NFData(..))
#if MIN_VERSION_deepseq(1,4,3)
import Control.DeepSeq (NFData1(..))
#endif
import Data.Functor.Identity (Identity, runIdentity)
import Data.Foldable (fold)
import Data.Coerce (Coercible, coerce)
import Data.Foldable (Foldable(foldl'), fold)
import Data.Functor.Identity (Identity(..), runIdentity)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Endo(..))
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup (Semigroup(..))
#endif
@ -56,6 +59,7 @@ import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec,
import Prelude hiding (map, repeat, zipWith)
import Streamly.Internal.Data.Stream.StreamK (IsStream(..), Stream)
import Streamly.Internal.Data.Strict (Maybe'(..), toMaybe)
import Streamly.Internal.Data.SVar (MonadAsync)
import qualified Streamly.Internal.Data.Stream.Prelude as P
@ -70,6 +74,11 @@ import qualified Streamly.Internal.Data.Stream.StreamD as S
#include "Instances.hs"
-- XXX move this to Streamly.Internal.Data.Coerce?
{-# INLINE (#.) #-}
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
(#.) _f = coerce
-- | Like 'zipWith' but using a monadic zipping function.
--
-- @since 0.4.0