GitLab

{-# LANGUAGE BangPatterns #-}
module Foo (sum') where

foldl' :: (a -> b -> a) -> a -> [b] -> a
{-# INLINE foldl' #-}
foldl' f !z xs = loop z xs
  where
    loop !z [] = z
    loop !z (x:xs) = loop (f z x) xs

sum' :: Num a => [a] -> a
sum' xs = foldl' (+) 0 xs

This is the code before !LiberateCase:

Foo.sum' =
  \ (@ a_a9T) ($dNum_aa1 [ALWAYS Just L] :: GHC.Num.Num a_a9T) ->
    let {
      lit_scm [ALWAYS Just L] :: a_a9T
      [Str: DmdType]
      lit_scm =
        case $dNum_aa1
        of tpl_B1 [ALWAYS Just A]
        { GHC.Num.:DNum tpl_B2 [ALWAYS Just A]
                        tpl_B3 [ALWAYS Just A]
                        tpl_B4 [ALWAYS Just A]
                        tpl_B5 [ALWAYS Just A]
                        tpl_B6 [ALWAYS Just A]
                        tpl_B7 [ALWAYS Just A]
                        tpl_B8 [ALWAYS Just A]
                        tpl_B9 [ALWAYS Just A]
                        tpl_Ba [ALWAYS Just C(S)] ->
        tpl_Ba lvl_sbH
        } } in
    letrec {
      loop_sck [ALWAYS LoopBreaker Nothing] :: a_a9T -> [a_a9T] -> a_a9T
      [Arity 2
       Str: DmdType SS]
      loop_sck =
        \ (z_a6Y :: a_a9T) (ds_db7 :: [a_a9T]) ->
          case z_a6Y of z_X7h [ALWAYS Just L] { __DEFAULT ->
          case ds_db7 of wild_B1 [ALWAYS Just A] {
            [] -> z_a6Y;
            : x_a72 [ALWAYS Just L] xs_a74 [ALWAYS Just S] ->
              case $dNum_aa1
              of tpl_Xl [ALWAYS Just A]
              { GHC.Num.:DNum tpl_B2 [ALWAYS Just A]
                              tpl_B3 [ALWAYS Just A]
                              tpl_B4 [ALWAYS Just C(C(S))]
                              tpl_B5 [ALWAYS Just A]
                              tpl_B6 [ALWAYS Just A]
                              tpl_B7 [ALWAYS Just A]
                              tpl_B8 [ALWAYS Just A]
                              tpl_B9 [ALWAYS Just A]
                              tpl_Ba [ALWAYS Just A] ->
              loop_sck (tpl_B4 z_a6Y x_a72) xs_a74
              }
          }
          }; } in
    \ (xs_a76 :: [a_a9T]) -> loop_sck lit_scm xs_a76

Note that the Num dictionary is scrutinised in the loop even though sum' is actually strict in the dictionary (by virtue of being strict in lit_scm) and it would make sense to take it apart before entering the loop. !LiberateCase does nail this but only if the loop is small enough and at the expense of code size.

Trac metadata

Trac field	Value
Version	6.9
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system	Unknown
Architecture	Unknown