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.