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.

2 files changed, 42 insertions, 17 deletions

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index c443c10e4b..e645fab4bb 100644
--- 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
-	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
@@ -775,10 +775,10 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info
 
 	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
@@ -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 "is value:" <+> ppr is_value,
                         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).
 
-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
@@ -929,7 +928,7 @@ variable appears all alone
 	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 
@@ -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
 
+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
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 58d662eac2..05ef9a376d 100644
--- 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
@@ -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.
 
+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
@@ -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)  
-      | 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
+	-- See also 
 
 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, 
---
 --  * soon, 
---
 --  * without raising an exception,
---
 --  * 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}
--- 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