Eta expansion and HasCallStack

Look at these two programs, discovered in #20097:

One using HasCallStack

module Main where

import GHC.Stack

foo :: HasCallStack => Int -> Int
foo 0 = length . fst . head $ getCallStack callStack
foo n = foo (n-1)

main :: IO ()
main = print (foo 500000)

One using implicit parameters

{-# LANGUAGE ImplicitParams #-}

module Main where

type Stack = [(String, Bool)]

foo :: (?stk::Stack) => Int -> Int
foo 0 = length . fst . head $ ?stk
foo n =
  let ?stk = ("foo", True) : ?stk
   in foo (n-1)

main :: IO ()
main = let ?stk = [] in print (foo 500000)

The implicit parameter version generates an arity-2 foo. But the former generates an arity-1 foo which is much less efficent.

Specifics here:

Rec {
-- RHS size: {terms: 68, types: 49, coercions: 14, joins: 0/2}
foo [Occ=LoopBreaker] :: HasCallStack => Int -> Int
[GblId, Arity=1, Unf=OtherCon []]
foo
  = \ ($dIP_a15z :: HasCallStack) ->
      let {
        $dIP1_s1ft :: CallStack
        [LclId]
        $dIP1_s1ft
          = pushCallStack
              (GHC.CString.unpackCString# "foo"#,
               GHC.Stack.Types.SrcLoc
                 (GHC.CString.unpackCString# "main"#)
                 (GHC.CString.unpackCString# "Main"#)
                 (GHC.CString.unpackCString# "T20097.hs"#)
                 (GHC.Types.I# 7#)
                 (GHC.Types.I# 9#)
                 (GHC.Types.I# 7#)
                 (GHC.Types.I# 12#))
              ($dIP_a15z
               `cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N
                       :: (?callStack::CallStack) ~R# CallStack)) } in
      let {
        $dIP2_s1fu :: CallStack
        [LclId]
        $dIP2_s1fu
          = pushCallStack
              (GHC.CString.unpackCString# "callStack"#,
               GHC.Stack.Types.SrcLoc
                 (GHC.CString.unpackCString# "main"#)
                 (GHC.CString.unpackCString# "Main"#)
                 (GHC.CString.unpackCString# "T20097.hs"#)
                 (GHC.Types.I# 6#)
                 (GHC.Types.I# 44#)
                 (GHC.Types.I# 6#)
                 (GHC.Types.I# 53#))
              ($dIP_a15z
               `cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N
                       :: (?callStack::CallStack) ~R# CallStack)) } in
      \ (ds_d1fl :: Int) ->
        case ds_d1fl of wild_X1E { GHC.Types.I# ds1_d1fo ->
        case ds1_d1fo of {
          __DEFAULT ->
            foo
              ($dIP1_s1ft
               `cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N)
                       :: CallStack ~R# (?callStack::CallStack)))
              (- @Int GHC.Num.$fNumInt wild_X1E (GHC.Types.I# 1#));
          0# ->
            $ @GHC.Types.LiftedRep
              @[([Char], SrcLoc)]
              @Int
              (. @[Char]
                 @Int
                 @[([Char], SrcLoc)]
                 (length @[] Data.Foldable.$fFoldable[] @Char)
                 (. @([Char], SrcLoc)
                    @[Char]
                    @[([Char], SrcLoc)]
                    (fst @[Char] @SrcLoc)
                    (head @([Char], SrcLoc))))
              (getCallStack
                 (callStack
                    ($dIP2_s1fu
                     `cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N)
                             :: CallStack ~R# (?callStack::CallStack)))))
        }
        }
end Rec }

The two lambdas are separated. They really should not be, because this imposes a performance cost from the HaskCallStack constraint that is, I think, unnecessary.

Somehow, we should generate an arity-2 foo, even with the HasCallStack constraint.