[GHC] #6092: Liberate case not happening

[GHC]

#6092: Liberate case not happening
---------------------------------+------------------------------------------
    Reporter:  simonpj           |       Owner:                  
        Type:  bug               |      Status:  new             
    Priority:  normal            |   Milestone:                  
   Component:  Compiler          |     Version:  7.4.1           
    Keywords:                    |          Os:  Unknown/Multiple
Architecture:  Unknown/Multiple  |     Failure:  None/Unknown    
  Difficulty:  Unknown           |    Testcase:                  
   Blockedby:                    |    Blocking:                  
     Related:                    |  
---------------------------------+------------------------------------------
 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
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/6092>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler