Full laziness breaks common zip pattern

Summary

The common idiom

zip [0..] xs

can go wrong even when the numbers are Ints, leading to a space leak and poor performance.

Steps to reproduce

This showed up in indexed-traversable. A simple reproduction:

itraverseList :: Applicative f => (Int -> a -> f b) -> [a] -> f [b]
itraverseList f = traverse (uncurry' f) . zip [0..]

uncurry' :: (a -> b -> c) -> (a, b) -> c
uncurry' f (a, b) = f a b
{-# INLINE uncurry' #-}

Compiling with -O -ddump-simpl (-O2 gives something similar) produces

Rec {
-- RHS size: {terms: 13, types: 4, coercions: 0, joins: 0/0}
ZipBug.itraverseList_go3 [Occ=LoopBreaker]
  :: GHC.Prim.Int# -> [Int]
[GblId, Arity=1, Str=<L>, Unf=OtherCon []]
ZipBug.itraverseList_go3
  = \ (x_a1k0 :: GHC.Prim.Int#) ->
      GHC.Types.:
        @Int
        (GHC.Types.I# x_a1k0)
        (case x_a1k0 of wild_X1 {
           __DEFAULT -> ZipBug.itraverseList_go3 (GHC.Prim.+# wild_X1 1#);
           9223372036854775807# -> GHC.Types.[] @Int
         })
end Rec }

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
ZipBug.itraverseList1 :: [Int]
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}]
ZipBug.itraverseList1 = ZipBug.itraverseList_go3 0#

-- RHS size: {terms: 35, types: 47, coercions: 0, joins: 0/2}
itraverseList
  :: forall (f :: * -> *) a b.
     Applicative f =>
     (Int -> a -> f b) -> [a] -> f [b]
[GblId,
 Arity=2,
 Str=<LP(A,MCM(L),A,LCL(C1(C1(L))),A,A)><LCL(C1(L))>,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60] 260 60}]
itraverseList
  = \ (@(f_aKs :: * -> *))
      (@a_aKt)
      (@b_aKu)
      ($dApplicative_aKv :: Applicative f_aKs)
      (f1_auu :: Int -> a_aKt -> f_aKs b_aKu) ->
      let {
        f2_s1jK :: f_aKs [b_aKu]
        [LclId]
        f2_s1jK
          = pure @f_aKs $dApplicative_aKv @[b_aKu] (GHC.Types.[] @b_aKu) } in
      letrec {
        go_s1kP [Occ=LoopBreaker, Dmd=LCL(C1(L))]
          :: [Int] -> [a_aKt] -> f_aKs [b_aKu]
        [LclId, Arity=2, Str=<1L><ML>, Unf=OtherCon []]
        go_s1kP
          = \ (ds_a1kj :: [Int]) (_ys_a1kk :: [a_aKt]) ->
              case ds_a1kj of {
                [] -> f2_s1jK;
                : ipv_a1kn ipv1_a1ko ->
                  case _ys_a1kk of {
                    [] -> f2_s1jK;
                    : ipv2_a1ks ipv3_a1kt ->
                      GHC.Base.liftA2
                        @f_aKs
                        $dApplicative_aKv
                        @b_aKu
                        @[b_aKu]
                        @[b_aKu]
                        (ZipBug.itraverseList2 @b_aKu)
                        (f1_auu ipv_a1kn ipv2_a1ks)
                        (go_s1kP ipv1_a1ko ipv3_a1kt)
                  }
              }; } in
      \ (x_a128 :: [a_aKt]) -> go_s1kP ZipBug.itraverseList1 x_a128

Note that itraverseList1 is the list [0..], and may expand without bound.

Expected behavior

I expect

1. That zip would fuse with the enumeration generator, erasing the list of Ints.
2. That if zip failed to fuse with the enumeration generator, then GHC would at least recognize that an Int enumeration is too cheap to float to the top.

Note that expanding the definition of itraverseList seems to magically fix the problem:

itraverseList :: Applicative f => (Int -> a -> f b) -> [a] -> f [b]
itraverseList f xs = traverse (uncurry' f) . zip [0..] $ xs

gives

-- RHS size: {terms: 6, types: 5, coercions: 0, joins: 0/0}
ZipBug.itraverseList1 :: forall {b}. b -> [b] -> [b]
[GblId,
 Arity=2,
 Str=<L><L>,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}]
ZipBug.itraverseList1
  = \ (@b_aKs) (ds_a12W :: b_aKs) (ds1_a12X :: [b_aKs]) ->
      GHC.Types.: @b_aKs ds_a12W ds1_a12X

-- RHS size: {terms: 38, types: 41, coercions: 0, joins: 0/2}
itraverseList
  :: forall (f :: * -> *) a b.
     Applicative f =>
     (Int -> a -> f b) -> [a] -> f [b]
[GblId,
 Arity=3,
 Str=<LP(A,MCM(L),A,LCL(C1(C1(L))),A,A)><LCL(C1(L))><1L>,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60 0] 261 0}]
itraverseList
  = \ (@(f_aKq :: * -> *))
      (@a_aKr)
      (@b_aKs)
      ($dApplicative_aKt :: Applicative f_aKq)
      (f1_aur :: Int -> a_aKr -> f_aKq b_aKs)
      (xs_aus :: [a_aKr]) ->
      let {
        n_s1k2 :: f_aKq [b_aKs]
        [LclId]
        n_s1k2
          = pure @f_aKq $dApplicative_aKt @[b_aKs] (GHC.Types.[] @b_aKs) } in
      letrec {
        go3_a1kb [Occ=LoopBreaker, Dmd=SCS(C1(L))]
          :: GHC.Prim.Int# -> [a_aKr] -> f_aKq [b_aKs]
        [LclId, Arity=2, Str=<L><1L>, Unf=OtherCon []]
        go3_a1kb
          = \ (x_a1kc :: GHC.Prim.Int#) (eta_B0 :: [a_aKr]) ->
              case eta_B0 of {
                [] -> n_s1k2;
                : y_a1jT ys_a1jU ->
                  GHC.Base.liftA2
                    @f_aKq
                    $dApplicative_aKt
                    @b_aKs
                    @[b_aKs]
                    @[b_aKs]
                    (ZipBug.itraverseList1 @b_aKs)
                    (f1_aur (GHC.Types.I# x_a1kc) y_a1jT)
                    (case x_a1kc of wild1_X1 {
                       __DEFAULT -> go3_a1kb (GHC.Prim.+# wild1_X1 1#) ys_a1jU;
                       9223372036854775807# -> n_s1k2
                     })
              }; } in
      go3_a1kb 0# xs_aus

which is exactly what we want.

Environment

• GHC version used: 9.4.3

Optional:

• Operating System:
• System Architecture: