on master help sign in
Use foldr/build fusion for toList
commitfbec11f24deda94a4e55dc4bec5d4c16d3db3d0c authorHarendra Kumar <harendra.kumar@gmail.com> dateThu 17 Oct 2019, 00:09 (7 years ago) parent54acd41
4 files changed+47−6
benchmark/Array.hs+2−1 benchmark/Linear.hs+2−1 src/Streamly/Internal/Memory/Array/Types.hs+24−3 src/Streamly/Streams/StreamD/Type.hs+19−1
benchmark/Array.hs+2−1
@@ -86,7 +86,8 @@ main =
8686 -}
8787 , benchPureSink "<" Ops.ordInstance
8888 , benchPureSink "min" Ops.ordInstanceMin
89− , benchPureSink "IsList.toList" GHC.toList
89+ -- length is used to check for foldr/build fusion
90+ , benchPureSink "length . IsList.toList" (length . GHC.toList)
9091 , benchIOSink "foldl'" Ops.pureFoldl'
9192 , benchIOSink "read" (S.drain . S.unfold A.read)
9293 , benchIOSink "toStreamRev" (S.drain . IA.toStreamRev)
benchmark/Linear.hs+2−1
@@ -124,7 +124,8 @@ main =
124124 , benchPureSink "<" Ops.ordInstance
125125 , benchPureSink "min" Ops.ordInstanceMin
126126 , benchPureSrc "IsList.fromList" Ops.sourceIsList
127− , benchPureSink "IsList.toList" GHC.toList
127+ -- length is used to check for foldr/build fusion
128+ , benchPureSink "length . IsList.toList" (length . GHC.toList)
128129 , benchPureSrc "IsString.fromString" Ops.sourceIsString
129130 , mkString `deepseq` (bench "readsPrec pure streams" $
130131 nf Ops.readInstance mkString)
src/Streamly/Internal/Memory/Array/Types.hs+24−3
@@ -102,7 +102,7 @@ import Foreign.Storable (Storable(..))
102102import Prelude hiding (length, foldr, read, unlines, splitAt)
103103import Text.Read (readPrec, readListPrec, readListPrecDefault)
104104
105−import GHC.Base (Addr#, nullAddr#, realWorld#)
105+import GHC.Base (Addr#, nullAddr#, realWorld#, build)
106106import GHC.Exts (IsList, IsString(..))
107107import GHC.ForeignPtr (ForeignPtr(..), newForeignPtr_)
108108import GHC.IO (IO(IO), unsafePerformIO)
@@ -738,12 +738,33 @@ fromStreamD m = runFold write m
738738 runFold (Fold step begin done) = D.foldlMx' step begin done
739739-}
740740
741+-- Use foldr/build fusion to fuse with list consumers
742+-- This can be useful when using the IsList instance
743+{-# INLINE_LATE toListFB #-}
744+toListFB :: forall a b. Storable a => (a -> b -> b) -> b -> Array a -> b
745+toListFB c n Array{..} = go (unsafeForeignPtrToPtr aStart)
746+ where
747+
748+ go p | p == aEnd = n
749+ go p =
750+ -- unsafeInlineIO allows us to run this in Identity monad for pure
751+ -- toList/foldr case which makes them much faster due to not
752+ -- accumulating the list and fusing better with the pure consumers.
753+ --
754+ -- This should be safe as the array contents are guaranteed to be
755+ -- evaluated/written to before we peek at them.
756+ let !x = unsafeInlineIO $ do
757+ r <- peek p
758+ touchForeignPtr aStart
759+ return r
760+ in c x (go (p `plusPtr` (sizeOf (undefined :: a))))
761+
741762-- | Convert an 'Array' into a list.
742763--
743764-- @since 0.7.0
744−{-# INLINABLE toList #-}
765+{-# INLINE toList #-}
745766toList :: Storable a => Array a -> [a]
746−toList = foldr (:) []
767+toList s = build (\c n -> toListFB c n s)
747768
748769instance (Show a, Storable a) => Show (Array a) where
749770 {-# INLINE showsPrec #-}
src/Streamly/Streams/StreamD/Type.hs+19−1
@@ -68,6 +68,8 @@ where
6868import Control.Applicative (liftA2)
6969import Control.Monad (ap, when)
7070import Control.Monad.Trans (lift, MonadTrans)
71+import Data.Functor.Identity (Identity(..))
72+import GHC.Base (build)
7173import GHC.Types (SPEC(..))
7274import Prelude hiding (map, mapM, foldr, take, concatMap)
7375
@@ -344,10 +346,26 @@ foldrT f final (Stream step state) = go SPEC state
344346 Skip s -> go SPEC s
345347 Stop -> final
346348
347−{-# INLINE toList #-}
349+{-# INLINE_NORMAL toList #-}
348350toList :: Monad m => Stream m a -> m [a]
349351toList = foldr (:) []
350352
353+-- Use foldr/build fusion to fuse with list consumers
354+-- This can be useful when using the IsList instance
355+{-# INLINE_LATE toListFB #-}
356+toListFB :: (a -> b -> b) -> b -> Stream Identity a -> b
357+toListFB c n (Stream step state) = go state
358+ where
359+ go st = case runIdentity (step defState st) of
360+ Yield x s -> x `c` go s
361+ Skip s -> go s
362+ Stop -> n
363+
364+{-# RULES "toList Identity" toList = toListId #-}
365+{-# INLINE_EARLY toListId #-}
366+toListId :: Stream Identity a -> Identity [a]
367+toListId s = Identity $ build (\c n -> toListFB c n s)
368+
351369-- XXX run begin action only if the stream is not empty.
352370{-# INLINE_NORMAL foldlMx' #-}
353371foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> m b