Opened 5 years ago

Last modified 21 months ago

#6092 new bug

Liberate case not happening

Reported by: simonpj Owned by: simonpj
Priority: normal Milestone:
Component: Compiler Version: 7.4.1
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: Runtime performance bug Test Case:
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:

Description

Simon M writes: Johan Tibell and I were looking at the code GHC produces for isPrefixOf:

isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf [] _  =  True
isPrefixOf _  [] =  False
isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys

and noticed that it differs between 6.12 and 6.14 onwards incl 7.5, with the 6.12 code more heavily optimised. In particular, 6.12 applies liberate case so the unboxing of the Eq dictionary is pulled out of the loop, but 6.14 isn't doing this.

Here's the 6.12 core:

$ ghc -ddump-simpl -O2 isprefixof.hs -c -fliberate-case   

==================== Tidy Core ====================
Test.isPrefixOf :: forall a_ade.
                   (GHC.Classes.Eq a_ade) =>
                   [a_ade] -> [a_ade] -> GHC.Bool.Bool
GblId
[Arity 3
 NoCafRefs
 Str: DmdType LSL]
Test.isPrefixOf =
  \ (@ a_adE)
    ($dEq_adK :: GHC.Classes.Eq a_adE)
    (eta_B2 :: [a_adE])
    (eta1_B1 :: [a_adE]) ->
    case eta_B2 of _ {
      [] -> GHC.Bool.True;
      : ipv_se3 ipv1_se4 ->
        case eta1_B1 of _ {
          [] -> GHC.Bool.False;
          : ipv2_se7 ipv3_se8 ->
            case $dEq_adK of _ { GHC.Classes.D:Eq tpl1_Xk _ ->
            case tpl1_Xk ipv_se3 ipv2_se7 of _ {
              GHC.Bool.False -> GHC.Bool.False;
              GHC.Bool.True ->
                letrec {
                  isPrefixOf1_seA :: [a_adE] -> [a_adE] -> GHC.Bool.Bool
                  LclId
                  [Arity 2
                   Str: DmdType SL]
                  isPrefixOf1_seA =
                    \ (ds_ddM :: [a_adE]) (ds1_ddN :: [a_adE]) ->
                      case ds_ddM of _ {
                        [] -> GHC.Bool.True;
                        : ipv4_Xes ipv5_Xeu ->
                          case ds1_ddN of _ {
                            [] -> GHC.Bool.False;
                            : ipv6_XeA ipv7_XeC ->
                              case tpl1_Xk ipv4_Xes ipv6_XeA of _ {
                                GHC.Bool.False -> GHC.Bool.False;
                                GHC.Bool.True -> isPrefixOf1_seA ipv5_Xeu ipv7_XeC
                              }
                          }
                      }; } in
                isPrefixOf1_seA ipv1_se4 ipv3_se8
            }
            }
        }
    }

and the 6.14 code (also 7.5):

$ ghc-stage2 -ddump-simpl -O2 isprefixof.hs -c -fspec-constr

==================== Tidy Core ====================
Test.isPrefixOf
  :: forall a_aav.
     GHC.Classes.Eq a_aav =>
     [a_aav] -> [a_aav] -> GHC.Bool.Bool
[GblId,
 Arity=3,
 Caf=NoCafRefs,
 Str=DmdType LSL,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=3, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [1 0 0] 19 0}]
Test.isPrefixOf =
  \ (@ a_age)
    ($dEq_agk :: GHC.Classes.Eq a_age)
    (eta_B2 :: [a_age])
    (eta1_B1 :: [a_age]) ->
    letrec {
      isPrefixOf1_sha [Occ=LoopBreaker]
        :: [a_age] -> [a_age] -> GHC.Bool.Bool
      [LclId, Arity=2, Str=DmdType SL]
      isPrefixOf1_sha =
        \ (ds_dgm :: [a_age]) (ds1_dgn :: [a_age]) ->
          case ds_dgm of _ {
            [] -> GHC.Bool.True;
            : ipv_sgD ipv1_sgE ->
              case ds1_dgn of _ {
                [] -> GHC.Bool.False;
                : ipv2_sgH ipv3_sgI ->
                  case GHC.Classes.== @ a_age $dEq_agk ipv_sgD ipv2_sgH of _ {
                    GHC.Bool.False -> GHC.Bool.False;
                    GHC.Bool.True -> isPrefixOf1_sha ipv1_sgE ipv3_sgI
                  }
              }
          }; } in
    isPrefixOf1_sha eta_B2 eta1_B1

Change History (6)

comment:1 Changed 5 years ago by igloo

Milestone: 7.8.1
Owner: set to simonpj

comment:2 Changed 3 years ago by thoughtpolice

Milestone: 7.8.37.10.1

Moving to 7.10.1.

comment:3 Changed 3 years ago by thoughtpolice

Milestone: 7.10.17.12.1

Moving to 7.12.1 milestone; if you feel this is an error and should be addressed sooner, please move it back to the 7.10.1 milestone.

comment:4 Changed 2 years ago by thoughtpolice

Milestone: 7.12.18.0.1

Milestone renamed

comment:5 Changed 2 years ago by thomie

Type of failure: None/UnknownRuntime performance bug

comment:6 Changed 21 months ago by thomie

Milestone: 8.0.1
Note: See TracTickets for help on using tickets.