Opened 9 years ago

Last modified 4 years ago

#4301 new bug

Optimisations give bad core for foldl' (flip seq) ()

Reported by: daniel.is.fischer Owned by:
Priority: low Milestone:
Component: Compiler Version: 6.12.3
Keywords: Cc: dfeuer, michal.palka@…
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

I'm not sure whether it's one freak case or a symptom of a problem that occurs more often. Compiled with optimisations, the code

foo :: [a] -> ()
foo = foldl' (flip seq) ()

produces the core

Rec {
FSeq.foo1 :: forall a_af0. [a_af0] -> (##)
GblId
[Arity 1
 NoCafRefs
 Str: DmdType S]
FSeq.foo1 =
  \ (@ a_af0) (w_sg9 :: [a_af0]) ->
    case case w_sg9 of _ {
           [] -> GHC.Unit.();
           : x_afz xs_afA ->
             case x_afz of _ { __DEFAULT ->
             case FSeq.foo1 @ a_af0 xs_afA of _ { (# #) -> GHC.Unit.() }
             }
         }
    of _ { () ->
    GHC.Prim.(##)
    }
end Rec }

for the worker (ghc-6.12.3, similar core from HEAD). Due to the boxing and unboxing between (##) and (), there's a case on the recursive call, hence it produces a stack overflow on long enough lists.

The problem was reported in http://www.haskell.org/pipermail/beginners/2010-September/005287.html, my attempt at understanding it here: http://www.haskell.org/pipermail/beginners/2010-September/005293.html.

So far, I've only managed to produce it for the very special combination of foldl' (flip seq) and a single (non-bottom) value datatype; any other function to be folded or a multiple value type produce a tail-recursive two-argument worker.

Nevertheless, on the off chance that it's a symptom of a real problem, I'm reporting it.

Change History (12)

comment:1 Changed 9 years ago by igloo

Milestone: 7.0.2

Thanks for the report.

This reminds me of #3403.

comment:2 Changed 9 years ago by daniel.is.fischer

Looks closely related.

Experimenting a bit more, we get good core if we manually provide the worker:

fseq :: [a] -> ()
fseq = lgo ()
  where
    lgo z [] = z
    lgo z (x:xs) = (x `seq` z) `seq` lgo z xs

produces

Rec {
FSeq.fseq_lgo :: forall a_ag2 t_ag9 a1_age.
                 a1_age -> [t_ag9] -> a1_age
GblId
[Arity 2
 NoCafRefs
 Str: DmdType SS]
FSeq.fseq_lgo =
  \ (@ a_ag2)
    (@ t_ag9)
    (@ a1_age)
    (z_afd :: a1_age)
    (ds_dgC :: [t_ag9]) ->
    case ds_dgC of _ {
      [] -> z_afd;
      : x_aff xs_afg ->
        case x_aff of _ { __DEFAULT ->
        FSeq.fseq_lgo @ a_ag2 @ t_ag9 @ a1_age z_afd xs_afg
        }
    }
end Rec }

with a phantom type argument a_ag2. Presumably, that's to prevent the elimination of the constant argument? But if we give the worker the more restricted type,

spseq :: [a] -> ()
spseq = sgo ()
  where
    sgo :: () -> [a] -> ()
    sgo z [] = z
    sgo z (x:xs) = (x `seq` z) `seq` sgo z xs

we get the non-tail-call worker again:

Rec {
FSeq.$wsgo :: forall a_afS a1_afr. [a1_afr] -> (##)
GblId
[Arity 1
 NoCafRefs
 Str: DmdType S]
FSeq.$wsgo =
  \ (@ a_afS) (@ a1_afr) (w_shQ :: [a1_afr]) ->
    case case w_shQ of _ {
           [] -> GHC.Unit.();
           : x_afu xs_afv ->
             case x_afu of _ { __DEFAULT ->
             case FSeq.$wsgo @ a_afS @ a1_afr xs_afv of _ { (# #) ->
             GHC.Unit.()
             }
             }
         }
    of _ { () ->
    GHC.Prim.(##)
    }
end Rec }

making the worker strict in z,

okseq :: [a] -> ()
okseq = okgo ()
  where
    okgo :: () -> [a] -> ()
    okgo !z [] = z
    okgo z (x:xs) = (x `seq` z) `seq` okgo z xs

we get perfect core again:

Rec {
FSeq.$wokgo :: forall a_afI a1_afx. [a1_afx] -> ()
GblId
[Arity 1
 NoCafRefs
 Str: DmdType S]
FSeq.$wokgo =
  \ (@ a_afI) (@ a1_afx) (w_shJ :: [a1_afx]) ->
    case w_shJ of _ {
      [] -> GHC.Unit.();
      : ipv_sgL ipv1_sgM ->
        case ipv_sgL of _ { __DEFAULT ->
        FSeq.$wokgo @ a_afI @ a1_afx ipv1_sgM
        }
    }
end Rec }

comment:3 Changed 9 years ago by igloo

Milestone: 7.0.27.2.1

comment:4 Changed 8 years ago by igloo

Milestone: 7.2.17.4.1

comment:5 Changed 8 years ago by michal.palka

Cc: michal.palka@… added

comment:6 Changed 8 years ago by igloo

Milestone: 7.4.17.6.1
Priority: normallow

comment:7 Changed 7 years ago by igloo

Milestone: 7.6.17.6.2

comment:8 Changed 5 years ago by thoughtpolice

Milestone: 7.6.27.10.1

Moving to 7.10.1.

comment:9 Changed 5 years ago by thomie

Cc: dfeuer added
difficulty: Unknown

foldl' doesn't seem to get inlined with HEAD. I don't know if this ticket is still relevant.

$ cat test.hs
module Foo where
import Data.List

foo :: [a] -> ()
foo = foldl' (flip seq) ()

$ ghc-7.9.20141125 -ddump-simpl -dsuppress-all -fforce-recomp -O test.hs
...
foo1
foo1 =
  \ @ a_aua x_auY y_auZ -> case y_auZ of _ { __DEFAULT -> x_auY }

foo
foo = \ @ a_aua -> foldl' (foo1) ()

With 7.8.3:

$ ghc-7.8.3 -ddump-simpl -dsuppress-all -fforce-recomp -O test.hs
...
Rec {
foo1
foo1 =
  \ @ a_avy w_sP6 ->
    case case w_sP6 of _ {
           [] -> ();
           : x_aOm xs_aOn ->
             case x_aOm of _ { __DEFAULT ->
             case foo1 xs_aOn of _ { (# #) -> () }
             }
         }
    of _ { () ->
    (##)
    }
end Rec }

foo
foo = \ @ a_avy w_sPd -> case foo1 w_sPd of _ { (# #) -> () }

comment:10 Changed 5 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:11 Changed 4 years ago by thoughtpolice

Milestone: 7.12.18.0.1

Milestone renamed

comment:12 Changed 4 years ago by thomie

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