[GHC] #9434: GHC.List.reverse does not fuse
GHC
ghc-devs at haskell.org
Tue Aug 12 08:19:19 UTC 2014
#9434: GHC.List.reverse does not fuse
-------------------------------------+-------------------------------------
Reporter: dfeuer | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: libraries/base | Version: 7.9
Keywords: | Operating System:
Architecture: Unknown/Multiple | Unknown/Multiple
Difficulty: Easy (less than 1 | Type of failure: Runtime
hour) | performance bug
Blocked By: | Test Case:
Related Tickets: | Blocking:
| Differential Revisions:
-------------------------------------+-------------------------------------
As Edward Kmett speculated could be the case a couple months ago, Joachim
Breitner's call arity analysis makes the Prelude version of `reverse`
better than GHC's version. It's less clear to me whether it's beneficial
to wrap it in `build`, but I think the answer is ''probably'' yes, based
on the fact that doing so turns `foldr c n $ reverse xs` into `foldl (flip
c) n xs`.
{{{#!hs
{-# INLINE reverse #-}
reverse :: [a] -> [a]
reverse xs = build $ \c n -> foldl (\a x -> x `c` a) n xs
}}}
This simplifies to
{{{#!hs
Rec {
poly_go_r2uL
poly_go_r2uL =
\ @ a_a2nn ds_a2xO eta_Xh ->
case ds_a2xO of _ {
[] -> eta_Xh;
: y_a2xT ys_a2xU -> poly_go_r2uL ys_a2xU (: y_a2xT eta_Xh)
}
end Rec }
reverse
reverse = \ @ a_a2nn eta_B1 -> poly_go_r2uL eta_B1 ([])
}}}
which looks about the same as the current version in GHC.List.
Behold the beauty when it is applied to an unfold (with a fusion-friendly
version of `unfoldr`):
{{{#!hs
testReverseUnfoldr f q0 = reverse (unfoldr f q0)
}}}
simplifies to
{{{#!hs
testReverseUnfoldr
testReverseUnfoldr =
\ @ a_a2w3 @ b_a2w4 f_a2mn q0_a2mo ->
letrec {
go_a1QX
go_a1QX =
\ b1_a1Hy eta_B1 ->
case f_a2mn b1_a1Hy of _ {
Nothing -> eta_B1;
Just ds_d2d8 ->
case ds_d2d8 of _ { (a1_a1Hz, new_b_a1HA) ->
go_a1QX new_b_a1HA (: a1_a1Hz eta_B1)
}
}; } in
go_a1QX q0_a2mo ([])
}}}
This looks exactly like a hand-written `unfoldl`!
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9434>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list