Add wrapper function to interface with prelude folds and scans.

[rpglover64]

It's not hard to write, but it seems like it would be sufficiently common to merit inclusion; they don't meet the interface for purely.

[Gabriella439]

fold is already a wrapper over the Prelude's foldl', but I definitely would like to wrap scanl, too (and also provide a monadic scan). The non-trivial part is writing it in terms of foldr in order to get build/foldr fusion. Were you interested in contributing this?

[rpglover64]

I don't think I have the expertise to do so.

[tonyday567]

I'll give this a go.

[tonyday567]

So question 1 is how do you know if build/foldr fusion is happening? I assumed that I'd see a rewrite in compilation of the existing library but no such luck:

ghc src/Control/Foldl.hs -ddump-simpl-stats -isrc -O3

(from dumped output) 55 RuleFired 8 Class op $p1Applicative 8 Class op <*> 6 Class op fmap 6 Class op fromInteger 6 integerToInt 4 Class op + 4 Class op pure 2 Class op mappend 2 Class op mempty 2 SPEC Control.Foldl.genericIndex [GHC.Types.Int] 2 SPEC Control.Foldl.genericLength [GHC.Types.Int] 1 Class op $p1Integral 1 Class op $p1Ord 1 Class op $p1Real 1 Class op $p2Real 1 Class op ==

[Gabriella439]

The key rule to look for is fold/build or something like that. To get it to fire you need to do two things:

• Write scan in terms of foldr (tricky, but possible)
• Add an INLINE pragma

[tonyday567]

So, just warming up, something like this but for Foldables?

scan' :: Fold a b -> [a] -> [b]
scan' f as = loop f as []
  where
    loop _ [] bs = reverse bs
    loop (Fold step begin done) (a:as') bs =
      loop f' as' (b:bs)
      where
        begin' = foldr step' id [a] begin
        step' x k z = k $! step z x
        b = done begin'
        f' = Fold step begin' done
{-# INLINABLE scan' #-}

I get 2 foldr/nil and 2 fold/build rules firing (so it must be 4 times as fast!).

I assume using toList is cheating? And there seems to be two choices for what scan means:

• you return a list (ie the original structure isn't preserved), or
• you return the same structure (in which case I think you need a Traversable added to the type constraint).

[tonyday567]

I'm getting 2 foldr/nil rule firings for this:

scan :: (Foldable f) => Fold a b -> f a -> [b]
scan (Fold step begin done) as = F.foldr step' done' as begin'
  where
    step' x k z = k $! (step (head z) x:z)
    done' = map done . reverse
    begin' = [begin]
{-# INLINABLE scan #-}

But not sure how to really tell if the rules are firing.

https://gist.github.com/tonyday567/9518960

[Gabriella439]

I finally figured this out:

-- | Convert a strict left 'Fold' into a scan
scan :: Fold a b -> [a] -> [b]
scan (Fold step begin done) as = foldr cons nil as begin
  where
    nil      x = done x:[]
    cons a k x = done x:(k $! step x a)
{-# INLINE scan #-}

This preserves laziness, triggers fold/build fusion, and keeps the accumulator strict.

Here's an example program that I use to test for fusion:

import Control.Applicative
import qualified Control.Foldl as L

main = print $ L.scan (liftA2 (,) L.sum L.length) [0..]

... and fusion fires correctly:

$ ghc -O2 test.hs -ddump-rule-firings
[1 of 1] Compiling Main             ( test.hs, test.o )
...
Rule fired: fold/build
...
Linking test ...

... and here is the generated core, which is really really nice:

main_$sgo =
  \ (sc_s1Sl :: Int#)
    (sc1_s1Sm :: Int#)
    (sc2_s1Sn :: Int#) ->
    :
      @ (Int, Int)
      (I# sc1_s1Sm, I# sc2_s1Sn)
      (case sc_s1Sl of wild_Xi {
         __DEFAULT ->
           main_$sgo
             (+# wild_Xi 1)
             (+# sc1_s1Sm wild_Xi)
             (+# sc2_s1Sn 1);
         9223372036854775807 ->
           :
             @ (Int, Int)
             (I# (+# sc1_s1Sm 9223372036854775807),
              I# (+# sc2_s1Sn 1))
             ([] @ (Int, Int))
       })

[Gabriella439]

Fixed by c682f7fa5b5174614b639edd609dd4d5d24838c7

[tonyday567]

Nice! Now, for bonus points, how do you make it take a foldable ...