[GHC] #5949: Demand analysis attributes manifestly wrong demand type

[GHC]

#5949: Demand analysis attributes manifestly wrong demand type
-------------------------------------+--------------------------------------
 Reporter:  batterseapower           |          Owner:                  
     Type:  bug                      |         Status:  new             
 Priority:  normal                   |      Component:  Compiler        
  Version:  7.4.1                    |       Keywords:                  
       Os:  Unknown/Multiple         |   Architecture:  Unknown/Multiple
  Failure:  Runtime performance bug  |       Testcase:                  
Blockedby:                           |       Blocking:                  
  Related:                           |  
-------------------------------------+--------------------------------------
 (Further to my email to Simon, adding to bug tracker so it doesn't get
 lost)

 Consider:

 {{{
 e :: (Int, Int) -> Int -> (Int, Int)
 e x y = x `seq` if y > 10
         then x
         else e x (y + 1)
 }}}

 After worker/wrapper we get:

 {{{
 Rec {
 CPR2.$we [Occ=LoopBreaker]
  :: (GHC.Types.Int, GHC.Types.Int)
     -> GHC.Prim.Int# -> (# GHC.Types.Int, GHC.Types.Int #)
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
  Str=DmdType S(AA)L,
  Unf=OtherCon []]
 CPR2.$we =
  \ (w_srv :: (GHC.Types.Int, GHC.Types.Int))
    (ww_srt :: GHC.Prim.Int#) ->
    case GHC.Prim.># ww_srt 10 of _ {
      GHC.Types.False ->
        case GHC.Prim.+# ww_srt 1 of sat_ssS { __DEFAULT ->
        CPR2.$we w_srv sat_ssS
        };
      GHC.Types.True ->
        case w_srv of _ { (ww2_srA, ww3_srB) -> (# ww2_srA, ww3_srB #) }
    }
 end Rec }
 }}}

 The demand type S(AA) is entirely wrong because the box is unused (so it
 should be U(AA)) and because the two components are not absent -- they are
 used.

 This leads to the worker/wrapper transformation being insufficiently
 agressive. This bites in practice with examples like:

 {{{
 d :: M.Map Int Int -> (Int, Int)
 d m = M.foldrWithKey' (\k v (a, b) -> if k + v > 2 then (a, b) else
 (b, a)) (0, 1) m
 }}}

 Which generates this inner loop:

 {{{
 Rec {
 CPR2.$wgo2 [Occ=LoopBreaker]
  :: (GHC.Types.Int, GHC.Types.Int)
     -> Data.Map.Base.Map GHC.Types.Int GHC.Types.Int
     -> (# GHC.Types.Int, GHC.Types.Int #)
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
  Str=DmdType S(AA)S,
  Unf=OtherCon []]
 CPR2.$wgo2 =
  \ (w_srS :: (GHC.Types.Int, GHC.Types.Int))
    (w1_srQ :: Data.Map.Base.Map GHC.Types.Int GHC.Types.Int) ->
    case w1_srQ of _ {
      Data.Map.Base.Tip ->
        case w_srS of _ { (ww1_srW, ww2_srX) -> (# ww1_srW, ww2_srX #) };
      Data.Map.Base.Bin rb_st1 kx_ss3 x_ssa l_ssk r_ss6 ->
        case kx_ss3 of _ { GHC.Types.I# x1_ssd ->
        case CPR2.$wgo2 w_srS r_ss6 of _ { (# ww1_ssi, ww2_ssh #) ->
        case x_ssa of _ { GHC.Types.I# y_sse ->
        case GHC.Prim.+# x1_ssd y_sse of sat_st0 { __DEFAULT ->
        case GHC.Prim.># sat_st0 2 of _ {
          GHC.Types.False ->
            let {
              sat_ssZ :: (GHC.Types.Int, GHC.Types.Int)
              [LclId]
              sat_ssZ = (ww2_ssh, ww1_ssi) } in
            CPR2.$wgo2 sat_ssZ l_ssk;
          GHC.Types.True ->
            let {
              sat_st6 :: (GHC.Types.Int, GHC.Types.Int)
              [LclId]
              sat_st6 = (ww1_ssi, ww2_ssh) } in
            CPR2.$wgo2 sat_st6 l_ssk
        }
        }
        }
        }
        }
    }
 end Rec }
 }}}

 Note that it allocates a pair every go around the loop. If we just ran the
 demand analyser on this code again we could eliminate this allocation, but
 the demand analyser shouldn't be generating code which has these manifest
 problems.

 One way to fix this is to change the ending of dmdTransform to read:

 {{{
    if isTopLevel top_lvl
     then fn_ty -- Don't record top level things
     else case dmd of
            Box (Eval (Poly Abs)) | DmdType _ _ res <- fn_ty,
 returnsCPR res -> addVarDmd fn_ty var (Eval (Poly lazyDmd))
            _
      -> addVarDmd fn_ty var dmd
 }}}

 But this is a hack. Better suggestions welcome.

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