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.

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 41a5fa5..d4863dd 100644 (file)
--- 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 (file)
--- 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)