Unwanted eta-expansion
Roman Cheplyaka
roma at ro-che.info
Tue Oct 4 08:39:59 CEST 2011
Suppose I want a foldl which is evaluated many times on the same
list but with different folding functions.
I would write something like this, to perform pattern-matching on the
list only once:
module F where
myFoldl :: [a] -> (b -> a -> b) -> b -> b
myFoldl [] = \f a -> a
myFoldl (x:xs) = let y = myFoldl xs in \f a -> y f (f a x)
However, for some reason GHC eta-expands it back. Here's what I see in
the core:
% ghc -O2 -ddump-simpl -fforce-recomp -dsuppress-module-prefixes \
-dsuppress-uniques -dsuppress-coercions F.hs
==================== Tidy Core ====================
Rec {
myFoldl [Occ=LoopBreaker]
:: forall a b. [a] -> (b -> a -> b) -> b -> b
[GblId, Arity=3, Caf=NoCafRefs, Str=DmdType SLL]
myFoldl =
\ (@ a) (@ b) (ds :: [a]) (eta :: b -> a -> b) (eta1 :: b) ->
case ds of _ {
[] -> eta1; : x xs -> myFoldl @ a @ b xs eta (eta eta1 x)
}
end Rec }
Why does it happen and can it be suppressed?
This is GHC 7.0.4.
--
Roman I. Cheplyaka :: http://ro-che.info/
More information about the Glasgow-haskell-users
mailing list