GHC.List.reverse does not fuse
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
.
{-# INLINE reverse #-}
reverse :: [a] -> [a]
reverse xs = build $ \c n -> foldl (\a x -> x `c` a) n xs
This simplifies to
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
):
testReverseUnfoldr f q0 = reverse (unfoldr f q0)
simplifies to
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
!
Trac metadata
Trac field | Value |
---|---|
Version | 7.9 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | libraries/base |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | ekmett, hvr |
Operating system | |
Architecture |