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

[daniel.is.fischer]

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.

[igloo]

Thanks for the report.

This reminds me of #3403.

[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 }