Unexpected lack of optimisation

28 Apr 2008

      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"
                }
                }
            }
        }
        }
    }

Unexpected lack of optimisation

Neil Mitchell