From 9adc50f67cad200f5848ede1849b1e4b9158f915 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Mon, 10 May 2010 13:30:05 +0000 Subject: [PATCH] Make arity of INLINE things consistent We eta-expand things with INLINE pragmas; see Note [Eta-expanding INLINE things]. But I eta-expanded it the wrong amount when the function was overloaded. Ooops. --- compiler/basicTypes/BasicTypes.lhs | 7 +++++++ compiler/deSugar/DsBinds.lhs | 7 ++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index 41a5fa5..d4863dd 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -626,9 +626,16 @@ data InlinePragma -- Note [InlinePragma] = InlinePragma { inl_inline :: Bool -- True <=> INLINE, -- False <=> no pragma at all, or NOINLINE + , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n -- explicit (non-type, non-dictionary) args + -- That is, inl_sat describes the number of *source-code* + -- arguments the thing must be applied to. We add on the + -- number of implicit, dictionary arguments when making + -- the InlineRule, and don't look at inl_sat further + , inl_act :: Activation -- Says during which phases inlining is allowed + , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor? } deriving( Eq, Data, Typeable ) \end{code} diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 797d55e..bfe4323 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -261,9 +261,10 @@ makeCorePair gbl_id is_default_method dict_arity rhs | Just arity <- inlinePragmaSat inline_prag -- Add an Unfolding for an INLINE (but not for NOINLINE) -- And eta-expand the RHS; see Note [Eta-expanding INLINE things] - = (gbl_id `setIdUnfolding` mkInlineRule rhs (Just (dict_arity + arity)), - -- NB: The arity in the InlineRule takes account of the dictionaries - etaExpand arity rhs) + , let real_arity = dict_arity + arity + -- NB: The arity in the InlineRule takes account of the dictionaries + = (gbl_id `setIdUnfolding` mkInlineRule rhs (Just real_arity), + etaExpand real_arity rhs) | otherwise = (gbl_id `setIdUnfolding` mkInlineRule rhs Nothing, rhs) -- 1.7.10.4