Fix interaction of exprIsCheap and the lone-variable inlining check

See Note [Interaction of exprIsCheap and lone variables] in CoreUnfold

This buglet meant that a nullary definition with an INLINE pragma
counter-intuitively didn't get inlined at all.  Roman identified
the bug.

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index c443c10..e645fab 100644 (file)
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -745,7 +745,7 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info
        NoUnfolding      -> Nothing ;
        OtherCon _       -> Nothing ;
        DFunUnfolding {} -> Nothing ;   -- Never unfold a DFun
        NoUnfolding      -> Nothing ;
        OtherCon _       -> Nothing ;
        DFunUnfolding {} -> Nothing ;   -- Never unfold a DFun

-       CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top, uf_is_value = is_value,
+       CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top, 

                        uf_is_cheap = is_cheap, uf_arity = uf_arity, uf_guidance = guidance } ->
                        -- uf_arity will typically be equal to (idArity id), 
                        -- but may be less for InlineRules
                        uf_is_cheap = is_cheap, uf_arity = uf_arity, uf_guidance = guidance } ->
                        -- uf_arity will typically be equal to (idArity id), 
                        -- but may be less for InlineRules

@@ -775,10 +775,10 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info
 
        interesting_saturated_call 
          = case cont_info of
 
        interesting_saturated_call 
          = case cont_info of

-             BoringCtxt -> not is_top && uf_arity > 0          -- Note [Nested functions]
-             CaseCtxt   -> not (lone_variable && is_value)     -- Note [Lone variables]
-             ArgCtxt {} -> uf_arity > 0                        -- Note [Inlining in ArgCtxt]
-             ValAppCtxt -> True                                -- Note [Cast then apply]
+             BoringCtxt -> not is_top && uf_arity > 0        -- Note [Nested functions]
+             CaseCtxt   -> not (lone_variable && is_cheap)   -- Note [Lone variables]
+             ArgCtxt {} -> uf_arity > 0                      -- Note [Inlining in ArgCtxt]
+             ValAppCtxt -> True                              -- Note [Cast then apply]

 
        (yes_or_no, extra_doc)
          = case guidance of
 
        (yes_or_no, extra_doc)
          = case guidance of

@@ -805,7 +805,6 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info
                        text "uf arity" <+> ppr uf_arity,
                        text "interesting continuation" <+> ppr cont_info,
                        text "some_benefit" <+> ppr some_benefit,
                        text "uf arity" <+> ppr uf_arity,
                        text "interesting continuation" <+> ppr cont_info,
                        text "some_benefit" <+> ppr some_benefit,

-                       text "is value:" <+> ppr is_value,

                         text "is cheap:" <+> ppr is_cheap,
                        text "guidance" <+> ppr guidance,
                        extra_doc,
                         text "is cheap:" <+> ppr is_cheap,
                        text "guidance" <+> ppr guidance,
                        extra_doc,

@@ -919,8 +918,8 @@ call is at least CONLIKE.  At least for the cases where we use ArgCtxt
 for the RHS of a 'let', we only profit from the inlining if we get a 
 CONLIKE thing (modulo lets).
 
 for the RHS of a 'let', we only profit from the inlining if we get a 
 CONLIKE thing (modulo lets).
 

-Note [Lone variables]
-~~~~~~~~~~~~~~~~~~~~~
+Note [Lone variables]  See also Note [Interaction of exprIsCheap and lone variables]
+~~~~~~~~~~~~~~~~~~~~~   which appears below

 The "lone-variable" case is important.  I spent ages messing about
 with unsatisfactory varaints, but this is nice.  The idea is that if a
 variable appears all alone
 The "lone-variable" case is important.  I spent ages messing about
 with unsatisfactory varaints, but this is nice.  The idea is that if a
 variable appears all alone

@@ -929,7 +928,7 @@ variable appears all alone
        as scrutinee of a case          CaseCtxt
        as arg of a fn                  ArgCtxt
 AND
        as scrutinee of a case          CaseCtxt
        as arg of a fn                  ArgCtxt
 AND

-       it is bound to a value
+       it is bound to a cheap expression

 
 then we should not inline it (unless there is some other reason,
 e.g. is is the sole occurrence).  That is what is happening at 
 
 then we should not inline it (unless there is some other reason,
 e.g. is is the sole occurrence).  That is what is happening at 

@@ -981,6 +980,27 @@ However, watch out:
    There's no advantage in inlining f here, and perhaps
    a significant disadvantage.  Hence some_val_args in the Stop case
 
    There's no advantage in inlining f here, and perhaps
    a significant disadvantage.  Hence some_val_args in the Stop case
 

+Note [Interaction of exprIsCheap and lone variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The lone-variable test says "don't inline if a case expression
+scrutines a lone variable whose unfolding is cheap".  It's very 
+important that, under these circumstances, exprIsConApp_maybe
+can spot a constructor application. So, for example, we don't
+consider
+       let x = e in (x,x)
+to be cheap, and that's good because exprIsConApp_maybe doesn't
+think that expression is a constructor application.
+
+I used to test is_value rather than is_cheap, which was utterly
+wrong, because the above expression responds True to exprIsHNF.
+
+This kind of thing can occur if you have
+
+       {-# INLINE foo #-}
+       foo = let x = e in (x,x)
+
+which Roman did.
+

 \begin{code}
 computeDiscount :: Int -> [Int] -> Int -> [ArgSummary] -> CallCtxt -> Int
 computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info
 \begin{code}
 computeDiscount :: Int -> [Int] -> Int -> [ArgSummary] -> CallCtxt -> Int
 computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 58d662e..05ef9a3 100644 (file)
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -469,8 +469,8 @@ dupAppSize = 4              -- Size of application we are prepared to duplicate
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-Note [exprIsCheap]
-~~~~~~~~~~~~~~~~~~
+Note [exprIsCheap]   See also Note [Interaction of exprIsCheap and lone variables]
+~~~~~~~~~~~~~~~~~~   in CoreUnfold.lhs

 @exprIsCheap@ looks at a Core expression and returns \tr{True} if
 it is obviously in weak head normal form, or is cheap to get to WHNF.
 [Note that that's not the same as exprIsDupable; an expression might be
 @exprIsCheap@ looks at a Core expression and returns \tr{True} if
 it is obviously in weak head normal form, or is cheap to get to WHNF.
 [Note that that's not the same as exprIsDupable; an expression might be

@@ -499,6 +499,13 @@ shared.  The main examples of things which aren't WHNF but are
 Notice that a variable is considered 'cheap': we can push it inside a lambda,
 because sharing will make sure it is only evaluated once.
 
 Notice that a variable is considered 'cheap': we can push it inside a lambda,
 because sharing will make sure it is only evaluated once.
 

+Note [exprIsCheap and exprIsHNF]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note that exprIsHNF does not imply exprIsCheap.  Eg
+       let x = fac 20 in Just x
+This responds True to exprIsHNF (you can discard a seq), but
+False to exprIsCheap.
+

 \begin{code}
 exprIsCheap :: CoreExpr -> Bool
 exprIsCheap = exprIsCheap' isCheapApp
 \begin{code}
 exprIsCheap :: CoreExpr -> Bool
 exprIsCheap = exprIsCheap' isCheapApp

@@ -524,11 +531,12 @@ exprIsCheap' good_app (Case e _ _ alts) = exprIsCheap' good_app e &&
        -- there is only dictionary selection (no construction) involved
 
 exprIsCheap' good_app (Let (NonRec x _) e)  
        -- there is only dictionary selection (no construction) involved
 
 exprIsCheap' good_app (Let (NonRec x _) e)  

-      | isUnLiftedType (idType x) = exprIsCheap' good_app e
-      | otherwise                = False
+  | isUnLiftedType (idType x) = exprIsCheap' good_app e
+  | otherwise                = False

        -- Strict lets always have cheap right hand sides,
        -- and do no allocation, so just look at the body
        -- Non-strict lets do allocation so we don't treat them as cheap
        -- Strict lets always have cheap right hand sides,
        -- and do no allocation, so just look at the body
        -- Non-strict lets do allocation so we don't treat them as cheap

+       -- See also 

 
 exprIsCheap' good_app other_expr       -- Applications and variables
   = go other_expr []
 
 exprIsCheap' good_app other_expr       -- Applications and variables
   = go other_expr []

@@ -625,11 +633,8 @@ it's applied only to dictionaries.
 -- Precisely, it returns @True@ iff:
 --
 --  * The expression guarantees to terminate, 
 -- Precisely, it returns @True@ iff:
 --
 --  * The expression guarantees to terminate, 

---

 --  * soon, 
 --  * soon, 

---

 --  * without raising an exception,
 --  * without raising an exception,

---

 --  * without causing a side effect (e.g. writing a mutable variable)
 --
 -- Note that if @exprIsHNF e@, then @exprOkForSpecuation e@.
 --  * without causing a side effect (e.g. writing a mutable variable)
 --
 -- Note that if @exprIsHNF e@, then @exprOkForSpecuation e@.

@@ -741,7 +746,7 @@ The inner case is redundant, and should be nuked.
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

--- Note [exprIsHNF]
+-- Note [exprIsHNF]            See also Note [exprIsCheap and exprIsHNF]

 -- ~~~~~~~~~~~~~~~~
 -- | exprIsHNF returns true for expressions that are certainly /already/ 
 -- evaluated to /head/ normal form.  This is used to decide whether it's ok 
 -- ~~~~~~~~~~~~~~~~
 -- | exprIsHNF returns true for expressions that are certainly /already/ 
 -- evaluated to /head/ normal form.  This is used to decide whether it's ok