Opened 10 years ago
Closed 8 years ago
#2353 closed bug (fixed)
GHC inliner doesn't
Reported by: | guest | Owned by: | |
---|---|---|---|
Priority: | low | Milestone: | 7.0.1 |
Component: | Compiler | Version: | 6.9 |
Keywords: | Cc: | lennart@… | |
Operating System: | Unknown/Multiple | Architecture: | Unknown/Multiple |
Type of failure: | None/Unknown | Test Case: | |
Blocked By: | Blocking: | ||
Related Tickets: | Differential Rev(s): | ||
Wiki Page: |
Description
Compile this program
{-# OPTIONS_GHC -O2 -ddump-simpl #-} module Foo where class C a where to' :: a -> Int from' :: Int -> a {-# NOINLINE to #-} to :: (C a) => a -> Int to = to' {-# NOINLINE from #-} from :: (C a) => Int -> a from = from' {-# INLINE foo #-} foo :: (C a) => (Int -> Int) -> a -> a foo f x = from (f (to x)) bar :: (C a) => (Int -> Int) -> a -> a bar f = foo f . foo f
Study the output. It contains
... Foo.foo = __inline_me (\ (@ a_a6n) ($dC_a6t :: Foo.C a_a6n) -> ...
and
... Foo.bar = \ (@ a_a6w) ($dC_a6G :: Foo.C a_a6w) -> let { foo1_s7S [ALWAYS Just L] :: (GHC.Base.Int -> GHC.Base.Int) -> a_a6w -> a_a6w [Str: DmdType] foo1_s7S = Foo.foo @ a_a6w $dC_a6G ...
Why isn't foo inlined?
Note that if the export list is changed to only export bar, then foo does get inlined.
Change History (17)
comment:1 Changed 10 years ago by
difficulty: | → Unknown |
---|
comment:2 Changed 10 years ago by
If it is deliberate, why does exporting foo make a difference? That's rather unintuitive.
I'm not sure I buy that argument that not inlining foo is the right decision here. Look at the difference in code without and with inlining. I think the inlined version looks better.
-- No inline Foo.bar = \ (@ a_a6v) ($dC_a6F :: Foo.C a_a6v) -> let { foo1_s7R [Just L] :: (GHC.Base.Int -> GHC.Base.Int) -> a_a6v -> a_a6v [Str: DmdType] foo1_s7R = Foo.foo @ a_a6v $dC_a6F } in \ (f_a5Y :: GHC.Base.Int -> GHC.Base.Int) -> let { f1_s7T [Just L] :: a_a6v -> a_a6v [Str: DmdType] f1_s7T = foo1_s7R f_a5Y } in \ (x_a6R :: a_a6v) -> f1_s7T (f1_s7T x_a6R) -- Inline (because foo was not exported) Foo.bar = \ (@ a_a6v) ($dC_a6F :: Foo.C a_a6v) -> let { from1_s7I [Just L] :: GHC.Base.Int -> a_a6v [Str: DmdType] from1_s7I = Foo.from @ a_a6v $dC_a6F } in let { to1_s7G [Just L] :: a_a6v -> GHC.Base.Int [Str: DmdType] to1_s7G = Foo.to @ a_a6v $dC_a6F } in \ (f_a5Y :: GHC.Base.Int -> GHC.Base.Int) (eta_s6T :: a_a6v) -> from1_s7I (f_a5Y (to1_s7G (from1_s7I (f_a5Y (to1_s7G eta_s6T)))))
Also, if INLINE doesn't really inline, then I'd like a REALLYINLINE pragma. Sometimes I know what I'm doing, and I'd like the compiler to obey.
comment:3 Changed 10 years ago by
Add the rule below to the example above. With the code as given above the rule doesn't fire since foo isn't inlined. With just bar exported the rule does fire, because foo is inlined.
-- XXX Add -fno-method-sharing to the command line. It's a static flag. :( {-# RULES "to/from" forall x . to (from x) = x #-}
comment:4 Changed 10 years ago by
A function that is only called once (and not exported) is always inlined, since that causes no code duplication. Does that explain the difference.
Simon
comment:5 Changed 10 years ago by
As you can see, the original program uses foo twice, so that doesn't explain the inlining.
comment:6 Changed 10 years ago by
Yes, but as you point out, the "method-sharing" thing commons up the two occurrences of 'foo'. If we export foo, we get
Foo.bar = \ (@ a_a6x) ($dC_a6H :: Foo.C a_a6x) -> let { foo1_s7T [ALWAYS Just L] :: (GHC.Base.Int -> GHC.Base.Int) -> a_a6x -> a_a6x [Str: DmdType] foo1_s7T = Foo.foo @ a_a6x $dC_a6H } in \ (f_a60 :: GHC.Base.Int -> GHC.Base.Int) -> let { f1_s7V [ALWAYS Just L] :: a_a6x -> a_a6x [Str: DmdType] f1_s7V = foo1_s7T f_a60 } in \ (x_a6T :: a_a6x) -> f1_s7V (f1_s7V x_a6T)
Notice just one call to foo
. If foo
is not exported, this is the only call to foo
so it gets inlined.
It's delicate, I grant you. Maybe I should experiment with making INLINE inline always (at least if saturated). I'm a bit reluctant to further complicate the interface with REALLYINLINE.
Simon
comment:7 Changed 10 years ago by
In this case you need to inline foo, and then there will be a second opportunity to inline foo inside the inlined body. It's the first and second inlining of foo that meet in the rule. This indicates that current heuristic for not inlining is broken.
I don't really want REALLYINLINE either, but in this case inlining must happen for the rule to apply, so there has to be a way to make the compiler obey the pragma.
As you say, it's delicate. Far too delicate.
comment:8 Changed 10 years ago by
IIRC, one can use RULES (and duplicate the function implementation) as a inline-for-sure equivalent. Not very pleasant, obviously.
comment:9 Changed 10 years ago by
Milestone: | → 6.10 branch |
---|
comment:10 Changed 10 years ago by
Architecture: | Unknown → Unknown/Multiple |
---|
comment:11 Changed 10 years ago by
Operating System: | Unknown → Unknown/Multiple |
---|
comment:12 Changed 9 years ago by
Milestone: | 6.10 branch → 6.12 branch |
---|
comment:13 Changed 9 years ago by
I think I've just tripped over this one. In Data.Foldable, there is
toList :: Foldable t => t a -> [a] toList t = build (\ c n -> Data.Foldable.foldr c n t)
so I would expect
f :: Foldable t => t a -> [a] f xs = last (map (:[]) (toList xs))
(only using last to simplify the example) to deforest to the equivalent of
f xs = last (Data.Foldable.foldr (\ x -> [x]:) [] xs)
but it doesn't, because toList isn't inlined until too late, even if I give it an INLINE pragma.
comment:14 Changed 8 years ago by
Milestone: | 6.12 branch → 6.12.3 |
---|
comment:15 Changed 8 years ago by
Milestone: | 6.12.3 → 6.14.1 |
---|---|
Priority: | normal → low |
comment:16 Changed 8 years ago by
Type of failure: | → None/Unknown |
---|
With 7.0.0-rc1, foo
is inlined. The core for bar
is (a wrapper of)
Foo.$wbar = \ (@ a_acS) (ww_sl0 :: a_acS -> GHC.Types.Int) (ww1_sl1 :: GHC.Types.Int -> a_acS) (w_sl3 :: GHC.Types.Int -> GHC.Types.Int) (w1_sl4 :: a_acS) -> let { $dC_sld :: Foo.C a_acS [LclId] $dC_sld = Foo.D:C @ a_acS ww_sl0 ww1_sl1 } in Foo.from @ a_acS $dC_sld (w_sl3 (Foo.to @ a_acS $dC_sld (Foo.from @ a_acS $dC_sld (w_sl3 (Foo.to @ a_acS $dC_sld w1_sl4)))))
Also with ghc-7.0.0-rc1, ross's code behaves as desired: f
has Core
Foo.$wf = \ (@ t_acQ::* -> *) (@ a_acR) (ww_skO :: forall a1_ag3 b_ag4. (a1_ag3 -> b_ag4 -> b_ag4) -> b_ag4 -> t_acQ a1_ag3 -> b_ag4) (w_skT :: t_acQ a_acR) -> case ww_skO @ a_acR @ [[a_acR]] (Foo.f1 @ a_acR) (GHC.Types.[] @ [a_acR]) w_skT of _ { [] -> GHC.List.last2 @ [a_acR]; : x_aeY xs_aeZ -> GHC.List.last1 @ [a_acR] x_aeY xs_aeZ }
comment:17 Changed 8 years ago by
Resolution: | → fixed |
---|---|
Status: | new → closed |
Thank you for testing this. This is all part of the great INLINE fix.
It's tricky to think of a regression test for this, so I think I'll just close it.
Simon
GHC deliberately doesn't inline a function, even if there's an INLINE pragma, if there is nothing "interesting" about the arguments or context. For example
Here GHC won't inline
h
even ifh
has an INLINE pragma. Why? Because doing so just increases code duplication.However, GHC does take account of context too. If
g
has a RULE, thenh
will be inlined in case that inlining allows g's RULE to match.It's possible that even this isn't enough in some circumstances. Perhaps you have such a case in mind.
But as things stand, it's deliberate.
Simon