#6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Now that I understand ticky profiling better I also took another look at `cse` again. The difference is is these two functions: {{{ Entries Alloc Alloc'd Non-void Arguments STG Name -------------------------------------------------------------------------------- 524 12072 0 2 Li $wgo1{v r6T8} (main:Main) (fun) 394 9984 0 2 LL $wdraw{v r6Tg} (main:Main) (fun) total: 918 22056 }}} after late demand analysis this becomes: {{{ Entries Alloc Alloc'd Non-void Arguments STG Name -------------------------------------------------------------------------------- 524 11424 0 2 Li $w$wgo{v r71J} (main:Main) (fun) 394 12768 0 2 LL $wdraw{v r71R} (main:Main) (fun) total: 918 24192 }}} Definitions: (common parts in `wdraw` functions removed) {{{ $wgo1_r6T8 :: [GHC.Types.Char] -> GHC.Prim.Int# -> [GHC.Types.Char] [GblId, Arity=2, Str=<S,1*U><S,1*U>m2, Unf=OtherCon []] = sat-only [] \r [w_s6XW ww_s6XX] case w_s6XW of { [] -> $wxs1_r6T7 ww_s6XX; : y_s6XZ [Occ=Once*] ys_s6Y0 [Occ=Once] -> case ww_s6XX of ds11_s6Y1 { __DEFAULT -> let { sat_s6Y3 [Occ=Once] :: [GHC.Types.Char] [LclId] = [ys_s6Y0 ds11_s6Y1] \u [] case -# [ds11_s6Y1 1#] of sat_s6Y2 { __DEFAULT -> $wgo1_r6T8 ys_s6Y0 sat_s6Y2; }; } in : [y_s6XZ sat_s6Y3]; 1# -> : [y_s6XZ n_r6T1]; }; }; $wdraw_r6Tg :: [GHC.Types.Char] -> [Main.GenTree [GHC.Types.Char]] -> [[GHC.Types.Char]] [GblId, Arity=2, Str=<L,1*U><S,1*U>, Unf=OtherCon []] = sat-only [] \r [ww_s6ZI ww1_s6ZJ] let { sat_s70m [Occ=Once, Dmd=<L,1*U>] :: [GHC.Types.Char] [LclId] = [ww_s6ZI] \s [] let { sat_s70l [Occ=Once, Dmd=<L,1*U>] :: [GHC.Types.Char] [LclId] = [ww_s6ZI] \s [] $wgo1_r6T8 ww_s6ZI 4#; } in GHC.Base.++ ds10_r6SZ sat_s70l; } in case case ww1_s6ZJ of { [] -> lvl23_r6Tc; : t_s6ZL [Occ=Once*!] ds11_s6ZM [Occ=Once!] -> case ds11_s6ZM of { [] -> case case t_s6ZL of { Main.Node ww3_s6ZP [Occ=Once] ww4_s6ZQ [Occ=Once] -> $wdraw_r6Tg ww3_s6ZP ww4_s6ZQ; } of sat_s6ZR { __DEFAULT -> $sgo1_r6SJ sat_s6ZR ds9_r6SX xs2_r6Tf; }; : ipv_s6ZS [Occ=Once] ipv1_s6ZT [Occ=Once] -> let { z_s6ZU [Occ=OnceL] :: [[GHC.Types.Char]] [LclId] = [ipv_s6ZS ipv1_s6ZT] \u [] $srsLoop_r6Th ipv_s6ZS ipv1_s6ZT; } in let { z1_s6ZV :: [[GHC.Types.Char]] [LclId, Unf=OtherCon []] = CCCS :! [ds5_r6SS z_s6ZU]; } in let { go4_s6ZX [Occ=LoopBreaker] :: [[GHC.Types.Char]] -> [[GHC.Types.Char]] -> [[GHC.Types.Char]] } in let { $sgo6_s6ZW [Occ=Once!T[3]] :: [[GHC.Types.Char]] -> [GHC.Types.Char] -> [[GHC.Types.Char]] -> [[GHC.Types.Char]] } in case case t_s6ZL of { Main.Node ww3_s70h [Occ=Once] ww4_s70i [Occ=Once] -> $wdraw_r6Tg ww3_s70h ww4_s70i; } of sat_s70j { __DEFAULT -> $sgo6_s6ZW sat_s70j ds7_r6SV xs_r6ST; }; }; } of sat_s70k { __DEFAULT -> $sgo2_r6SH sat_s70k sat_s70m xs1_r6T5; }; }}} after late demand analysis: {{{ $w$wgo_r71J :: [GHC.Types.Char] -> GHC.Prim.Int# -> (# GHC.Types.Char, [GHC.Types.Char] #) [GblId, Arity=2, Str=<S,1*U><S,1*U>, Unf=OtherCon []] = sat-only [] \r [w_s76A w1_s76B] case w_s76A of { [] -> $w$wxs_r71I w1_s76B; : y_s76D [Occ=Once*] ys_s76E [Occ=Once] -> case w1_s76B of ds11_s76F { __DEFAULT -> let { sat_s76K [Occ=Once] :: [GHC.Types.Char] [LclId] = [ys_s76E ds11_s76F] \u [] case -# [ds11_s76F 1#] of sat_s76G { __DEFAULT -> case $w$wgo_r71J ys_s76E sat_s76G of { (#,#) ww1_s76I [Occ=Once] ww2_s76J [Occ=Once] -> : [ww1_s76I ww2_s76J]; }; }; } in (#,#) [y_s76D sat_s76K]; 1# -> (#,#) [y_s76D n_r71D]; }; }; $wdraw_r71R :: [GHC.Types.Char] -> [Main.GenTree [GHC.Types.Char]] -> [[GHC.Types.Char]] [GblId, Arity=2, Str=<L,1*U><S,1*U>, Unf=OtherCon []] = sat-only [] \r [ww_s78p ww1_s78q] let { karg_s78r [Occ=Once*, Dmd=<L,1*U>] :: [GHC.Types.Char] [LclId] = [ww_s78p] \s [] let { sat_s78v [Occ=Once, Dmd=<L,1*U>] :: [GHC.Types.Char] [LclId] = [ww_s78p] \s [] case $w$wgo_r71J ww_s78p 4# of { (#,#) ww3_s78t [Occ=Once] ww4_s78u [Occ=Once] -> : [ww3_s78t ww4_s78u]; }; } in GHC.Base.++ ds10_r71B sat_s78v; } in case ww1_s78q of { [] -> $sgo2_r71j lvl22_r71N karg_s78r xs1_r71H; : t_s78x [Occ=Once*!] ds11_s78y [Occ=Once!] -> case ds11_s78y of { [] -> case t_s78x of { Main.Node ww3_s78B [Occ=Once] ww4_s78C [Occ=Once] -> case $wdraw_r71R ww3_s78B ww4_s78C of sat_s78D { __DEFAULT -> case $sgo1_r71l sat_s78D ds9_r71z xs2_r71Q of sat_s78E { __DEFAULT -> $sgo2_r71j sat_s78E karg_s78r xs1_r71H; }; }; }; : ipv_s78F [Occ=Once!] ipv1_s78G [Occ=Once] -> let { z_s78H [Occ=OnceL] :: [[GHC.Types.Char]] [LclId] = [ipv_s78F ipv1_s78G] \u [] case ipv_s78F of { Main.Node ww3_s78J [Occ=Once] ww4_s78K [Occ=Once] -> $w$srsLoop_r71S ww3_s78J ww4_s78K ipv1_s78G; }; } in let { z1_s78L :: [[GHC.Types.Char]] [LclId, Unf=OtherCon []] = CCCS :! [ds5_r71u z_s78H]; } in let { go4_s78N [Occ=LoopBreaker] :: [[GHC.Types.Char]] -> [[GHC.Types.Char]] -> [[GHC.Types.Char]] } in let { $sgo6_s78M [Occ=Once!] :: [[GHC.Types.Char]] -> [GHC.Types.Char] -> [[GHC.Types.Char]] -> [[GHC.Types.Char]] } in case t_s78x of { Main.Node ww3_s797 [Occ=Once] ww4_s798 [Occ=Once] -> case $wdraw_r71R ww3_s797 ww4_s798 of sat_s799 { __DEFAULT -> case $sgo6_s78M sat_s799 ds7_r71x xs_r71v of sat_s79a { __DEFAULT -> $sgo2_r71j sat_s79a karg_s78r xs1_r71H; }; }; }; }; }; }}} Somehow new `wdraw` function should be doing more allocation but I couldn't figure how yet. Also attached the whole STG dumps. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/6087#comment:28> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler