#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