RE: Unexpected lack of optimisation

29 Apr 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@haskell.org [mailto:glasgow-haskell-users-bounces@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@haskell.org
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

RE: Unexpected lack of optimisation

Simon Peyton-Jones