[GHC] #13966: Skip-less stream fusion

[GHC]

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

Comment (by jmspiewak):

 A typeclass-based Skip-less stream (also from the blog post) does fuse.
 {{{#!hs
 data Step3 s = Done3 | Yield3 s (Item3 s)

 class Stream3 s where
   type Item3 s
   next3 :: s -> Step3 s


 data EnumFromTo3 a = EnumFromTo3 a a

 instance (Ord a, Num a) => Stream3 (EnumFromTo3 a) where
   type Item3 (EnumFromTo3 a) = a
   next3 (EnumFromTo3 i high)
     | i > high  = Done3
     | otherwise = Yield3 (EnumFromTo3 (i + 1) high) i


 data Filter3 a s = Filter3 (a -> Bool) s

 instance (Stream3 s, Item3 s ~ a) => Stream3 (Filter3 a s) where
   type Item3 (Filter3 a s) = a
   next3 (Filter3 predicate s0) = loop s0 where
     loop s1 = case next3 s1 of
       Done3 -> Done3
       Yield3 s2 x
         | predicate x -> Yield3 (Filter3 predicate s2) x
         | otherwise   -> loop s2


 sum3 :: (Num (Item3 s), Stream3 s) => s -> Item3 s
 sum3 = loop 0 where
   loop total s1 = case next3 s1 of
     Done3 -> total
     Yield3 s2 x -> loop (total + x) s2


 {-# NOINLINE chain3 #-}
 chain3 :: Int -> Int
 chain3 = sum3 . Filter3 even . EnumFromTo3 1
 }}}


 Adding an existential wrapper doesn't break the fusion.
 {{{#!hs
 data Stream4 a = forall s. (Stream3 s, Item3 s ~ a) => Stream4 s

 enumFromTo4 :: (Ord a, Num a) => a -> a -> Stream4 a
 enumFromTo4 start high = Stream4 (EnumFromTo3 start high)

 filter4 :: (a -> Bool) -> Stream4 a -> Stream4 a
 filter4 p (Stream4 s) = Stream4 (Filter3 p s)

 sum4 :: Num a => Stream4 a -> a
 sum4 (Stream4 s) = sum3 s

 {-# NOINLINE chain4 #-}
 chain4 :: Int -> Int
 chain4 = sum4 . filter4 even . enumFromTo4 1
 }}}


 {{{
 benchmarking typeclass Skip-less
 time                 73.11 ms   (72.50 ms .. 73.94 ms)
                      0.999 R²   (0.998 R² .. 1.000 R²)
 mean                 69.80 ms   (68.86 ms .. 70.72 ms)
 std dev              2.916 ms   (2.483 ms .. 3.577 ms)
 variance introduced by outliers: 20% (moderately inflated)

 benchmarking typeclass existential Skip-less
 time                 75.44 ms   (74.91 ms .. 76.13 ms)
                      1.000 R²   (0.999 R² .. 1.000 R²)
 mean                 75.44 ms   (75.06 ms .. 75.80 ms)
 std dev              1.118 ms   (904.6 μs .. 1.479 ms)
 }}}


 Both result in:
 {{{
 Rec {
 -- RHS size: {terms: 36, types: 11, coercions: 0, joins: 1/1}
 Main.main_$s$wloop1 [Occ=LoopBreaker]
   :: Int# -> Int# -> Int# -> Int#
 [GblId, Arity=3, Caf=NoCafRefs, Str=<S,U><S,U><S,U>]
 Main.main_$s$wloop1
   = \ (sc_s9HL :: Int#) (sc1_s9HK :: Int#) (sc2_s9HJ :: Int#) ->
       joinrec {
         $wloop2_s9y9 [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# ->
 Int#
         [LclId[JoinId(2)], Arity=2, Str=<S,U><S,U>, Unf=OtherCon []]
         $wloop2_s9y9 (ww_s9y1 :: Int#) (ww1_s9y6 :: Int#)
           = case tagToEnum# @ Bool (># ww_s9y1 ww1_s9y6) of {
               False ->
                 case remInt# ww_s9y1 2# of {
                   __DEFAULT -> jump $wloop2_s9y9 (+# ww_s9y1 1#) ww1_s9y6;
                   0# ->
                     Main.main_$s$wloop1 ww1_s9y6 (+# ww_s9y1 1#) (+#
 sc2_s9HJ ww_s9y1)
                 };
               True -> sc2_s9HJ
             }; } in
       jump $wloop2_s9y9 sc1_s9HK sc_s9HL
 end Rec }
 }}}

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