@@ -572,11 +572,16 @@ async = joinStreamVarAsync AsyncVar
572(<|) :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a
572(<|) :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a
573(<|) = async
573(<|) = async
575+-- IMPORTANT: using a monomorphically typed and SPECIALIZED consMAsync makes a
576+-- huge difference in the performance of consM in IsStream instance even we
577+-- have a SPECIALIZE in the instance.
575-- | XXX we can implement it more efficienty by directly implementing instead
579-- | XXX we can implement it more efficienty by directly implementing instead
576-- of combining streams using async.
580-- of combining streams using async.
577{-# INLINE consMAsync #-}
581{-# INLINE consMAsync #-}
582+{-# SPECIALIZE consMAsync :: IO a -> AsyncT IO a -> AsyncT IO a #-}
578−consMAsync :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a
583+consMAsync :: MonadAsync m => m a -> AsyncT m a -> AsyncT m a
579−consMAsync m r = K.yieldM m `async` r
584+consMAsync m r = fromStream $ K.yieldM m `async` (toStream r)
581------------------------------------------------------------------------------
586------------------------------------------------------------------------------
@@ -649,21 +654,22 @@ asyncly = adapt
649instance IsStream AsyncT where
654instance IsStream AsyncT where
650 toStream = getAsyncT
655 toStream = getAsyncT
651 fromStream = AsyncT
656 fromStream = AsyncT
653− {-# INLINE consM #-}
654− {-# SPECIALIZE consM :: IO a -> AsyncT IO a -> AsyncT IO a #-}
655 consM = consMAsync
657 consM = consMAsync
656−
658+ (|:) = consMAsync
658− {-# SPECIALIZE (|:) :: IO a -> AsyncT IO a -> AsyncT IO a #-}
661------------------------------------------------------------------------------
660------------------------------------------------------------------------------
662-- Semigroup
661-- Semigroup
663------------------------------------------------------------------------------
662------------------------------------------------------------------------------
664+-- Monomorphically typed version of "async" for better performance of Semigroup
666+{-# INLINE mappendAsync #-}
667+{-# SPECIALIZE mappendAsync :: AsyncT IO a -> AsyncT IO a -> AsyncT IO a #-}
668+mappendAsync :: MonadAsync m => AsyncT m a -> AsyncT m a -> AsyncT m a
669+mappendAsync m1 m2 = fromStream $ async (toStream m1) (toStream m2)
665instance MonadAsync m => Semigroup (AsyncT m a) where
671instance MonadAsync m => Semigroup (AsyncT m a) where
666− (<>) = async
672+ (<>) = mappendAsync
668------------------------------------------------------------------------------
674------------------------------------------------------------------------------
@@ -677,14 +683,21 @@ instance MonadAsync m => Monoid (AsyncT m a) where
678------------------------------------------------------------------------------
684------------------------------------------------------------------------------
686+{-# INLINE bindAsync #-}
687+{-# SPECIALIZE bindAsync :: AsyncT IO a -> (a -> AsyncT IO b) -> AsyncT IO b #-}
688+bindAsync :: MonadAsync m => AsyncT m a -> (a -> AsyncT m b) -> AsyncT m b
689+bindAsync m f = fromStream $ K.bindWith async (adapt m) (\a -> adapt $ f a)
680instance MonadAsync m => Monad (AsyncT m) where
691instance MonadAsync m => Monad (AsyncT m) where
681 return = pure
692 return = pure
682− (>>=) = K.bindWith async
693+ (>>=) = bindAsync
684------------------------------------------------------------------------------
695------------------------------------------------------------------------------
685-- Other instances
696-- Other instances
686------------------------------------------------------------------------------
697------------------------------------------------------------------------------
699+-- XXX SPECIALIZE the applicative as well?
688MONAD_APPLICATIVE_INSTANCE(AsyncT,MONADPARALLEL)
701MONAD_APPLICATIVE_INSTANCE(AsyncT,MONADPARALLEL)
689MONAD_COMMON_INSTANCES(AsyncT, MONADPARALLEL)
702MONAD_COMMON_INSTANCES(AsyncT, MONADPARALLEL)
@@ -695,8 +708,9 @@ MONAD_COMMON_INSTANCES(AsyncT, MONADPARALLEL)
695-- | XXX we can implement it more efficienty by directly implementing instead
708-- | XXX we can implement it more efficienty by directly implementing instead
696-- of combining streams using wAsync.
709-- of combining streams using wAsync.
697{-# INLINE consMWAsync #-}
710{-# INLINE consMWAsync #-}
711+{-# SPECIALIZE consMWAsync :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}
698−consMWAsync :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a
712+consMWAsync :: MonadAsync m => m a -> WAsyncT m a -> WAsyncT m a
699−consMWAsync m r = K.yieldM m `wAsync` r
713+consMWAsync m r = fromStream $ K.yieldM m `wAsync` (toStream r)
701-- | Polymorphic version of the 'Semigroup' operation '<>' of 'WAsyncT'.
715-- | Polymorphic version of the 'Semigroup' operation '<>' of 'WAsyncT'.
702-- Merges two streams concurrently choosing elements from both fairly.
716-- Merges two streams concurrently choosing elements from both fairly.
@@ -771,21 +785,20 @@ wAsyncly = adapt
771instance IsStream WAsyncT where
785instance IsStream WAsyncT where
772 toStream = getWAsyncT
786 toStream = getWAsyncT
773 fromStream = WAsyncT
787 fromStream = WAsyncT
775− {-# INLINE consM #-}
776− {-# SPECIALIZE consM :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}
777 consM = consMWAsync
788 consM = consMWAsync
778−
789+ (|:) = consMWAsync
780− {-# SPECIALIZE (|:) :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}
783------------------------------------------------------------------------------
791------------------------------------------------------------------------------
784-- Semigroup
792-- Semigroup
785------------------------------------------------------------------------------
793------------------------------------------------------------------------------
795+{-# INLINE mappendWAsync #-}
796+{-# SPECIALIZE mappendWAsync :: WAsyncT IO a -> WAsyncT IO a -> WAsyncT IO a #-}
797+mappendWAsync :: MonadAsync m => WAsyncT m a -> WAsyncT m a -> WAsyncT m a
798+mappendWAsync m1 m2 = fromStream $ wAsync (toStream m1) (toStream m2)
787instance MonadAsync m => Semigroup (WAsyncT m a) where
800instance MonadAsync m => Semigroup (WAsyncT m a) where
788− (<>) = wAsync
801+ (<>) = mappendWAsync
790------------------------------------------------------------------------------
803------------------------------------------------------------------------------
@@ -799,9 +812,16 @@ instance MonadAsync m => Monoid (WAsyncT m a) where
800------------------------------------------------------------------------------
813------------------------------------------------------------------------------
815+{-# INLINE bindWAsync #-}
816+{-# SPECIALIZE bindWAsync :: WAsyncT IO a -> (a -> WAsyncT IO b) -> WAsyncT IO b #-}
817+bindWAsync :: MonadAsync m => WAsyncT m a -> (a -> WAsyncT m b) -> WAsyncT m b
818+bindWAsync m f = fromStream $ K.bindWith wAsync (adapt m) (\a -> adapt $ f a)
802instance MonadAsync m => Monad (WAsyncT m) where
820instance MonadAsync m => Monad (WAsyncT m) where
803 return = pure
821 return = pure
804− (>>=) = K.bindWith wAsync
822+ (>>=) = bindWAsync
824+-- XXX SPECIALIZE the applicative as well?
806------------------------------------------------------------------------------
826------------------------------------------------------------------------------
807-- Other instances
827-- Other instances