Unexpected lack of optimisation
Simon Peyton-Jones
simonpj at microsoft.com
Tue Apr 29 06:21:54 EDT 2008
Neil
A nice example, but I think it's difficult to give systematic solution.
* The 'retry' function is a "join point", where two different conditional branches join up.
* As you say, if 'retry' was inlined, all would be fine. But what if 'retry' was big? Then we'd get lots of code duplication, in exchange for fewer tests.
* Presumably it's not inlined because it's over the inline size threshold. (You did use -O?)
* The 'state' argument is just there to make sure that 'retry' is a *function* not a *thunk*, to avoid the overheads of unnecessary thunk update.
So it's not obvious to me how to improve this example, at least in general. But I could easily be missing something.
Simon
| -----Original Message-----
| From: glasgow-haskell-users-bounces at haskell.org [mailto:glasgow-haskell-users-bounces at haskell.org] On
| Behalf Of Neil Mitchell
| Sent: 28 April 2008 22:13
| To: GHC Users Mailing List
| Subject: Unexpected lack of optimisation
|
| Hi
|
| Using GHC 6.9.20071226:
|
| The following code:
|
| -------------------------------------------------------
|
| test s | begin2 'n' 'a' s = "test"
| | begin2 'n' 'b' s = "test2"
|
|
| begin2 :: Char -> Char -> String -> Bool
| begin2 x1 x2 (y:ys) | x1 == y = begin1 x2 ys
| begin2 _ _ _ = False
|
| begin1 :: Char -> String -> Bool
| begin1 x1 (y:ys) | x1 == y = True
|
| -------------------------------------------------------
|
| You might expect the head of the list s to be tested for equality with
| 'n' only once. Something like:
|
| test s = case s of
| s1:ss -> case s1 of
| 'n' -> .... choose 'a' or 'b' ....
| _ -> fail
|
| Unfortunately, GHC can't common up these two tests. It inserts a
| State# RealWorld in the middle, giving a result of:
|
| test s = case s of
| s1:ss -> case s1 of
| 'n' -> case ss of
| s2:ss -> case s2 of
| 'a' -> ....
| _ ->
| retry state
| _ -> retry state
|
| retry dummy = case s of
| s1:ss -> case s1 of
| 'n' -> ....
|
| If GHC was to inline the "retry" (which is a local let-bound lambda)
| it should have no problem merging these two cases. I'm not entirely
| sure why the State# gets inserted, but was wondering if it is
| necessary?
|
| The complete -ddump-simpl is at the end of this message.
|
| Thanks
|
| Neil
|
| --------------------------------------------------------------
|
| Text.HTML.TagSoup.Development.Sample.test :: GHC.Base.String -> [GHC.Base.Char]
| [GlobalId]
| [Arity 1]
| Text.HTML.TagSoup.Development.Sample.test =
| \ (s_a6g :: GHC.Base.String) ->
| let {
| $j_s7l :: GHC.Prim.State# GHC.Prim.RealWorld -> [GHC.Base.Char]
| [Arity 1]
| $j_s7l =
| \ (w_s7m :: GHC.Prim.State# GHC.Prim.RealWorld) ->
| let {
| $j1_s7d :: GHC.Prim.State# GHC.Prim.RealWorld -> [GHC.Base.Char]
| [Arity 1]
| $j1_s7d =
| \ (w1_s7e :: GHC.Prim.State# GHC.Prim.RealWorld) ->
| GHC.Err.patError
| @ [GHC.Base.Char]
|
| "Text/HTML/TagSoup/Development/Sample.hs:(48,0)-(49,34)|function test"
| } in
| case s_a6g of wild_Xl {
| [] -> $j1_s7d GHC.Prim.realWorld#;
| : y_a6o ys_a6q ->
| case GHC.Base.$f4 of tpl_Xr { GHC.Base.:DEq tpl1_B2 tpl2_B3 ->
| case tpl1_B2 (GHC.Base.C# 'n') y_a6o of wild1_Xp {
| GHC.Base.False -> $j1_s7d GHC.Prim.realWorld#;
| GHC.Base.True ->
| let {
| fail_d6S :: GHC.Base.Bool
| []
| fail_d6S =
| GHC.Err.patError
| @ GHC.Base.Bool
|
| "Text/HTML/TagSoup/Development/Sample.hs:57:0-32|function begin1" } in
| case ys_a6q of wild2_XB {
| [] ->
| case fail_d6S of wild3_Xj {
| GHC.Base.False -> $j1_s7d GHC.Prim.realWorld#;
| GHC.Base.True -> GHC.Base.unpackCString# "test2"
| };
| : y1_a6y ys1_a6A ->
| case GHC.Base.$f4 of tpl3_XH { GHC.Base.:DEq
| tpl4_XL tpl5_XN ->
| case tpl4_XL (GHC.Base.C# 'b') y1_a6y of wild3_Xo {
| GHC.Base.False ->
| case fail_d6S of wild4_Xj {
| GHC.Base.False -> $j1_s7d GHC.Prim.realWorld#;
| GHC.Base.True -> GHC.Base.unpackCString# "test2"
| };
| GHC.Base.True -> GHC.Base.unpackCString# "test2"
| }
| }
| }
| }
| }
| } } in
| case s_a6g of wild_B1 {
| [] -> $j_s7l GHC.Prim.realWorld#;
| : y_a6o ys_a6q ->
| case GHC.Base.$f4 of tpl_Xp { GHC.Base.:DEq tpl1_B2 tpl2_B3 ->
| case tpl1_B2 (GHC.Base.C# 'n') y_a6o of wild1_XT {
| GHC.Base.False -> $j_s7l GHC.Prim.realWorld#;
| GHC.Base.True ->
| let {
| fail_d6S :: GHC.Base.Bool
| []
| fail_d6S =
| GHC.Err.patError
| @ GHC.Base.Bool
|
| "Text/HTML/TagSoup/Development/Sample.hs:57:0-32|function begin1" } in
| case ys_a6q of wild2_Xz {
| [] ->
| case fail_d6S of wild3_XD {
| GHC.Base.False -> $j_s7l GHC.Prim.realWorld#;
| GHC.Base.True -> GHC.Base.unpackCString# "test"
| };
| : y1_a6y ys1_a6A ->
| case GHC.Base.$f4 of tpl3_XF { GHC.Base.:DEq tpl4_XJ tpl5_XL ->
| case tpl4_XJ (GHC.Base.C# 'a') y1_a6y of wild3_Xo {
| GHC.Base.False ->
| case fail_d6S of wild4_XN {
| GHC.Base.False -> $j_s7l GHC.Prim.realWorld#;
| GHC.Base.True -> GHC.Base.unpackCString# "test"
| };
| GHC.Base.True -> GHC.Base.unpackCString# "test"
| }
| }
| }
| }
| }
| }
| _______________________________________________
| Glasgow-haskell-users mailing list
| Glasgow-haskell-users at haskell.org
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
More information about the Glasgow-haskell-users
mailing list