[GHC] #13966: Skip-less stream fusion: a missed opportunity

[GHC]

#13966: Skip-less stream fusion: a missed opportunity
-------------------------------------+-------------------------------------
        Reporter:  jmspiewak         |                Owner:  mpickering
            Type:  feature request   |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.2.1-rc3
      Resolution:                    |             Keywords:  JoinPoints,
                                     |  StaticArgumentTransformation
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  #14067 #14068     |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by mpickering):

 Here is the exact file I am using.

 {{{
 {-# LANGUAGE ExistentialQuantification #-}
 module Main where

 import GHC.Prim

 import Criterion.Main
 import GHC.Prim

 main :: IO ()
 main = defaultMain [b1, b2] where
   b1 = bench "Skip-less" $ whnf chain1 x
   b2 = bench "Skip" $ whnf chain2 x
   x = 100000000


 --------------------------------------------------------------------------------

 data Step1 s a = Done1 | Yield1 s a
 data Stream1 a = forall s. Stream1 s (s -> Step1 s a)

 enumFromTo1 :: (Ord a, Num a) => a -> a -> Stream1 a
 enumFromTo1 start high = Stream1 start f where
   f i | i > high  = Done1
       | otherwise = Yield1 (i + 1) i

 filter1 :: (a -> Bool) -> Stream1 a -> Stream1 a
 filter1 predicate (Stream1 s0 next) = Stream1 s0 loop where
   loop s = case next s of
     Done1 -> Done1
     Yield1 s' x
       | predicate x -> Yield1 s' x
       | otherwise   -> loop s'

 sum1 :: Num a => Stream1 a -> a
 sum1 (Stream1 s0 next) = loop 0 s0 where
   loop total s = case next s of
     Done1 -> total
     Yield1 s' x -> loop (total + x) s'

 chain1 :: Int -> Int
 chain1 = sum1 . filter1 even . enumFromTo1 1

 --------------------------------------------------------------------------------

 data Step2 s a = Done2 | Skip2 s | Yield2 s a
 data Stream2 a = forall s. Stream2 s (s -> Step2 s a)

 enumFromTo2 :: (Ord a, Num a) => a -> a -> Stream2 a
 enumFromTo2 start high = Stream2 start f where
   f i | i > high  = Done2
       | otherwise = Yield2 (i + 1) i

 filter2 :: (a -> Bool) -> Stream2 a -> Stream2 a
 filter2 predicate (Stream2 s0 next) = Stream2 s0 loop where
   loop s = case next s of
     Done2 -> Done2
     Skip2 s' -> Skip2 s'
     Yield2 s' x
       | predicate x -> Yield2 s' x
       | otherwise   -> Skip2 s'

 sum2 :: Num a => Stream2 a -> a
 sum2 (Stream2 s0 next) = loop 0 s0 where
   loop total s = case next s of
     Done2 -> total
     Skip2 s' -> loop total s'
     Yield2 s' x -> loop (total + x) s'

 chain2 :: Int -> Int
 chain2 = sum2 . filter2 even . enumFromTo2 1
 }}}

 I modified the SAT pass to ignore information about static arguments,
 perform the SAT transformation and then check whether we created a join
 point. If we create a join point then we keep the transformed version,
 otherwise we leave the code as it was. (This is what you suggested in
 comment:8)

 I then compiled the above program with this transformation turned on.
 `chain2` was unaffected, the core is as before but the core for `chain1`
 changed quite a bit.

 It seems from running the benchmarks that `chain1` is better but I didn't
 look yet why this might be the case.

 I am building from a recent HEAD
 (11d9615e9f751d6ed084f1cb20c24ad6b408230e) so whether loopification is in
 there or not I don't know.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13966#comment:17>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler