Re: [GHC] #13966: Skip-less stream fusion (was: Missed optimization - loop fusion)

14 Jul 2017

      #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:                    |
-------------------------------------+-------------------------------------
Changes (by jmspiewak):

 * priority:  low => normal
 * keywords:   => JoinPoints

Old description:
...
I think GHC should be able to optimize func1 into func2, but currently it
doesn't.
{{{#!hs
data Step s a = Done | Yield s a
func1 high = loop1 0# 1# where
  loop1 acc i = case loop2 i of
    Done -> acc
    Yield (I# i') (I# x) -> loop1 (acc +# x) i'
loop2 i = case tagToEnum# (i ># high) :: Bool of
    False -> case remInt# i 2# of
      0# -> Yield (I# (i +# 1#)) (I# i)
      _ -> loop2 (i +# 1#)
    True -> Done
func2 high = loop1 0# 1# where
  loop1 acc i = case tagToEnum# (i ># high) :: Bool of
    False -> case remInt# i 2# of
      0# -> loop1 (acc +# i) (i +# 1#)
      _ -> loop1 acc (i +# 1#)
    True -> acc
}}}
When using the LLVM backend func2 is almost 4x faster than func1.
New description:

 A simple stream chain
 {{{#!hs
 chain :: Int -> Int
 chain = sum . filter even . enumFromTo 1
 }}}
 doesn't fuse under a Skip-less stream on GHC 8.2-rc3 -O2.

 Benchmarked against a Skip stream (LLVM backend):
 {{{
 benchmarking Skip-less
 time                 248.9 ms   (243.3 ms .. 257.3 ms)
                      0.998 R²   (0.995 R² .. 0.999 R²)
 mean                 250.9 ms   (248.1 ms .. 254.7 ms)
 std dev              5.985 ms   (4.831 ms .. 7.311 ms)

 benchmarking Skip
 time                 61.26 ms   (60.39 ms .. 62.44 ms)
                      0.998 R²   (0.997 R² .. 0.999 R²)
 mean                 62.45 ms   (61.96 ms .. 62.91 ms)
 std dev              1.387 ms   (1.190 ms .. 1.669 ms)
 }}}

 Relevant core (chain1 is Skip-less, chain2 has Skip):
 {{{
 -- RHS size: {terms: 51, types: 27, coercions: 0, joins: 1/2}
 Main.$wchain1 [InlPrag=NOINLINE] :: Int# -> Int#
 [GblId, Arity=1, Caf=NoCafRefs, Str=]
 Main.$wchain1
   = \ (ww_s9ep :: Int#) ->
       letrec {
         $wloop_s9ea [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Step1 Int
 Int
         [LclId, Arity=1, Str=, Unf=OtherCon []]
         $wloop_s9ea
           = \ (ww1_s9e8 :: Int#) ->
               case tagToEnum# @ Bool (># ww1_s9e8 ww_s9ep) of {
                 False ->
                   case remInt# ww1_s9e8 2# of {
                     __DEFAULT -> $wloop_s9ea (+# ww1_s9e8 1#);
                     0# ->
                       Main.Yield1
                         @ Int @ Int (GHC.Types.I# (+# ww1_s9e8 1#))
 (GHC.Types.I# ww1_s9e8)
                   };
                 True -> Main.Done1 @ Int @ Int
               }; } in
       joinrec {
         $wloop1_s9el [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# ->
 Int#
         [LclId[JoinId(2)], Arity=2, Str=, Unf=OtherCon []]
         $wloop1_s9el (ww1_s9ef :: Int#) (ww2_s9ej :: Int#)
           = case $wloop_s9ea ww2_s9ej of {
               Done1 -> ww1_s9ef;
               Yield1 s'_a497 x_a498 ->
                 case x_a498 of { GHC.Types.I# y_a66i ->
                 case s'_a497 of { GHC.Types.I# ww4_X9hA ->
                 jump $wloop1_s9el (+# ww1_s9ef y_a66i) ww4_X9hA
                 }
                 }
             }; } in
       jump $wloop1_s9el 0# 1#

 -- RHS size: {terms: 33, types: 9, coercions: 0, joins: 1/1}
 Main.$wchain2 [InlPrag=NOINLINE] :: Int# -> Int#
 [GblId, Arity=1, Caf=NoCafRefs, Str=]
 Main.$wchain2
   = \ (ww_s9dZ :: Int#) ->
       joinrec {
         $wloop_s9dV [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# -> Int#
         [LclId[JoinId(2)], Arity=2, Str=, Unf=OtherCon []]
         $wloop_s9dV (ww1_s9dP :: Int#) (ww2_s9dT :: Int#)
           = case tagToEnum# @ Bool (># ww2_s9dT ww_s9dZ) of {
               False ->
                 case remInt# ww2_s9dT 2# of {
                   __DEFAULT -> jump $wloop_s9dV ww1_s9dP (+# ww2_s9dT 1#);
                   0# -> jump $wloop_s9dV (+# ww1_s9dP ww2_s9dT) (+#
 ww2_s9dT 1#)
                 };
               True -> ww1_s9dP
             }; } in
       jump $wloop_s9dV 0# 1#
 }}}

 The code was adapted from M. Snoyman's blog post "Iterators and Streams in
 Rust and Haskell".

--

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