[GHC] #9398: Data.List.cycle is not a good producer

[GHC]

#9398: Data.List.cycle is not a good producer
-------------------------------------+-------------------------------------
              Reporter:  dfeuer      |            Owner:
                  Type:  bug         |           Status:  new
              Priority:  normal      |        Milestone:  7.8.4
             Component:              |          Version:  7.8.3
  libraries/base                     |         Keywords:
            Resolution:              |     Architecture:  Unknown/Multiple
      Operating System:              |       Difficulty:  Easy (less than 1
  Unknown/Multiple                   |  hour)
       Type of failure:  Runtime     |       Blocked By:
  performance bug                    |  Related Tickets:
             Test Case:              |
              Blocking:              |
Differential Revisions:              |
-------------------------------------+-------------------------------------

Comment (by dfeuer):

 Replying to [comment:12 nomeata]:
 I wrote some test functions, using the type

 {{{#!hs
 type BuildArg a = forall b . (a -> b -> b) -> b -> b
 }}}

 Generally things look pretty good (lots of Core to look at below, along
 with comments you should take with a grain of salt since I'm just a
 newbie). I found one case where your definition works significantly worse
 than the Prelude's. The bad case I've found:

 {{{#!hs
 main = print $ foldr (+) 0 $ take 30000000 $ map (* 13) $ cycle
 [1,8,4,0,(5::Int)]
 }}}

 For some reason, your `cycle` implementation allocates a lot, but the
 Prelude one runs in constant space.

 The basic test translations:

 {{{#!hs
 cycleBuild :: BuildArg a -> [a]
 cycleBuild g = cycle (build g)
 }}}

 produces

 {{{#!hs
 cycleBuild
 cycleBuild =
   \ @ a_a3jG g_a3hO ->
     letrec {
       cyc_a2iD
       cyc_a2iD = g_a3hO (:) cyc_a2iD; } in
     cyc_a2iD
 }}}

 which is obviously good, and obviously better than the result with
 `Prelude.cycle`, which is

 {{{#!hs
 cycleBuild
 cycleBuild =
   \ @ a_a1Xy g_a1zF ->
     case g_a1zF (:) ([]) of wild_a2aX {
       [] -> cycle1;
       : ipv_a2b3 ipv1_a2b4 ->
         letrec {
           xs'_a2b1
           xs'_a2b1 = ++ wild_a2aX xs'_a2b1; } in
         xs'_a2b1
     }
 }}}

 {{{#!hs
 cycleAugment :: BuildArg a -> [a] -> [a]
 cycleAugment g xs = cycle (augment g xs)
 }}}

 produces

 {{{#!hs
 cycleAugment
 cycleAugment =
   \ @ a_a3j1 g_a3hS xs_a3hT ->
     letrec {
       cyc_a2iD
       cyc_a2iD = g_a3hS (:) (++ xs_a3hT cyc_a2iD); } in
     cyc_a2iD
 }}}

 which I think is likely the best we can do, and clearly better than what
 the Prelude gives:

 {{{#!hs
 cycleAugment
 cycleAugment =
   \ @ a_a1WT g_a1zJ xs_a1zK ->
     case g_a1zJ (:) xs_a1zK of wild_a2aX {
       [] -> cycle1;
       : ipv_a2b3 ipv1_a2b4 ->
         letrec {
           xs'_a2b1
           xs'_a2b1 = ++ wild_a2aX xs'_a2b1; } in
         xs'_a2b1
     }
 }}}

 {{{#!hs
 foldCycleBuild :: (a -> b -> b) -> b -> BuildArg a -> b
 foldCycleBuild c n g = foldr c n (cycle (build g))
 }}}

 produces

 {{{#!hs
 foldCycleBuild
 foldCycleBuild =
   \ @ a_a3jl @ b_a3jm c_a3hP _ g_a3hR ->
     letrec {
       cyc_a2iD
       cyc_a2iD = g_a3hR c_a3hP cyc_a2iD; } in
     cyc_a2iD
 }}}

 which is obviously good, and ''incomparably'' better than what the Prelude
 gives, which I will not paste here because it is very obviously very much
 inferior.

 The rest of the tests are a little harder for me to interpret, because the
 nested letrecs confuse me, but I think they're probably good too.

 {{{#!hs
 foldCycle c n xs = foldr c n (cycle xs)
 }}}

 produces

 {{{#!hs
 $wfoldCycle
 $wfoldCycle =
   \ @ a_a3lf @ b_a3lg w_s3mE w1_s3mG ->
     letrec {
       cyc_a2iD
       cyc_a2iD =
         letrec {
           go_a2GG
           go_a2GG =
             \ ds_a2GH ->
               case ds_a2GH of _ {
                 [] -> cyc_a2iD;
                 : y_a2GM ys_a2GN -> w_s3mE y_a2GM (go_a2GG ys_a2GN)
               }; } in
         go_a2GG w1_s3mG; } in
     cyc_a2iD

 foldCycle
 foldCycle =
   \ @ a_a3lf @ b_a3lg w_s3mE _ w2_s3mG -> $wfoldCycle w_s3mE w2_s3mG
 }}}

 {{{#!hs
 foldCycleAugment :: (a -> b -> b) -> b -> BuildArg a -> [a] -> b
 foldCycleAugment c n g xs = foldr c n (cycle (augment g xs))
 }}}

 produces

 {{{#!hs
 $wfoldCycleAugment
 $wfoldCycleAugment =
   \ @ a_a3hx @ b_a3hy w_s3mD w1_s3mF w2_s3mG ->
     letrec {
       cyc_a2iD
       cyc_a2iD =
         w1_s3mF
           w_s3mD
           (letrec {
              go_a2GG
              go_a2GG =
                \ ds_a2GH ->
                  case ds_a2GH of _ {
                    [] -> cyc_a2iD;
                    : y_a2GM ys_a2GN -> w_s3mD y_a2GM (go_a2GG ys_a2GN)
                  }; } in
            go_a2GG w2_s3mG); } in
     cyc_a2iD

 foldCycleAugment
 foldCycleAugment =
   \ @ a_a3hx @ b_a3hy w_s3mD _ w2_s3mF w3_s3mG ->
     $wfoldCycleAugment w_s3mD w2_s3mF w3_s3mG
 }}}

 which I have no idea what to think of, honestly.

 {{{#!hs
 mapCycle f xs = map f (cycle xs)
 }}}

 produces

 {{{#!hs
 mapCycle
 mapCycle =
   \ @ a_a3lA @ b_a3lB f_a3hJ xs_a3hK ->
     letrec {
       cyc_a2iD
       cyc_a2iD =
         letrec {
           go_a2GG
           go_a2GG =
             \ ds_a2GH ->
               case ds_a2GH of _ {
                 [] -> cyc_a2iD;
                 : y_a2GM ys_a2GN -> : (f_a3hJ y_a2GM) (go_a2GG ys_a2GN)
               }; } in
         go_a2GG xs_a3hK; } in
     cyc_a2iD
 }}}

 which looks sane enough—it just maps over `xs` and then cycles the result.
 I also took a look at

 {{{#!hs
 cycleMap f xs = cycle (map f xs)
 }}}

 This produced exactly the same Core, which I think is a positive sign.

 The Prelude implementation, on the other hand, gives a rather terrible
 result:

 {{{#!hs
 mapCycle
 mapCycle =
   \ @ a_a2aw @ b_a2ax f_a1x7 xs_a1x8 ->
     case xs_a1x8 of wild_a2aV {
       [] -> case cycle1 of wild1_00 { };
       : ipv_a2b1 ipv1_a2b2 ->
         letrec {
           xs'_a2aZ
           xs'_a2aZ = ++ wild_a2aV xs'_a2aZ; } in
         map f_a1x7 xs'_a2aZ
     }
 }}}

 Yes, it actually cycles the argument and then maps over the
 result—horrible in every way.

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