@@ -154,8 +154,12 @@ foldrM step acc m = go (toStream m)
154154 yield a (Just x) = step a (go x)
155155 in (runStream m1) Nothing stop yield
156156
157−-- | Strict left fold. This is typed to work with the foldl package. To use
158−-- directly pass 'id' as the third argument.
157+-- XXX This more straightforward implementation of fold is almost twice as
158+-- costly as the implementation we are using! Need to figure out what's wrong
159+-- with it. Is it GHC that is not able to optimize this somehow? Or is it
160+-- something else? In fact scan is more optimal than this. The fold we are
161+-- using is actually a @scan@ where we discard the intermediate values!
162+{-
159163foldl :: (Streaming t, Monad m)
160164 => (x -> a -> x) -> x -> (x -> b) -> t m a -> m b
161165foldl step begin done m = go begin (toStream m)
@@ -165,7 +169,38 @@ foldl step begin done m = go begin (toStream m)
165169 yield a Nothing = return (done (step acc a))
166170 yield a (Just x) = go (step acc a) x
167171 in (runStream m1) Nothing stop yield
172+-}
173+
174+-- XXX We implement fold like a scan but just drop the intermediate steps and
175+-- extract the last step as the only element from the stream. We also use a
176+-- NOINLINE on the extraction function but INLINE the fold function. This seems
177+-- to work well with the GHC simplifier and we get almost 50% reduction in
178+-- cost! Need to figure what's going on with GHC simplifier, why is the simpler
179+-- code above is not optimal.
180+
181+-- | Strict left fold. This is typed to work with the foldl package. To use
182+-- it normally just pass 'id' as the third argument.
183+{-# INLINE foldl #-}
184+foldl :: (Streaming t, Monad m)
185+ => (x -> a -> x) -> x -> (x -> b) -> t m a -> m b
186+foldl step begin done m = get $ go (toStream m) begin
187+ where
188+ {-# NOINLINE get #-}
189+ get m1 =
190+ let yield a Nothing = return $ done a
191+ yield _ _ = undefined
192+ in (runStream m1) Nothing undefined yield
193+
194+ go m1 !acc = Stream $ \_ stp yld ->
195+ let
196+ stop = yld acc Nothing
197+ yield a Nothing = yld (step acc a) Nothing
198+ yield a (Just x) =
199+ let s = step acc a
200+ in (runStream (go x s)) Nothing stp yld
201+ in (runStream m1) Nothing stop yield
168202
203+-- XXX Need to measure perf and optimize like foldl if needed.
169204-- | Strict left fold, with monadic step function. This is typed to work
170205-- with the foldl package. To use directly pass 'id' as the third argument.
171206foldlM :: (Streaming t, Monad m)