Allow a longer demand signature than arity

See Note [Demand analysis for trivial right-hand sides] in DmdAnal.
This allows a function with arity 2 to have a DmdSig with 3 args;
which in turn had a knock-on effect, which showed up in the test for
Trac #8963.

In fact it seems entirely reasonable, so this patch removes the
WARN and CoreLint checks that were complaining.

1 files changed, 14 insertions, 6 deletions

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 3294371964..72137c7b4b 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -593,7 +593,7 @@ dmdAnalRhs :: TopLevelFlag
 -- Process the RHS of the binding, add the strictness signature
 -- to the Id, and augment the environment with the signature as well.
 dmdAnalRhs top_lvl rec_flag env id rhs
-  | Just fn <- unpackTrivial rhs   -- See Note [Trivial right-hand sides]
+  | Just fn <- unpackTrivial rhs   -- See Note [Demand analysis for trivial right-hand sides]
   , let fn_str = getStrictness env fn
   = (fn_str, emptyDmdEnv, set_idStrictness env id fn_str, rhs)
 
@@ -638,7 +638,7 @@ dmdAnalRhs top_lvl rec_flag env id rhs
 unpackTrivial :: CoreExpr -> Maybe Id
 -- Returns (Just v) if the arg is really equal to v, modulo
 -- casts, type applications etc 
--- See Note [Trivial right-hand sides]
+-- See Note [Demand analysis for trivial right-hand sides]
 unpackTrivial (Var v)                 = Just v
 unpackTrivial (Cast e _)              = unpackTrivial e
 unpackTrivial (Lam v e) | isTyVar v   = unpackTrivial e
@@ -646,15 +646,23 @@ unpackTrivial (App e a) | isTypeArg a = unpackTrivial e
 unpackTrivial _                       = Nothing
 \end{code}
 
-Note [Trivial right-hand sides]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Demand analysis for trivial right-hand sides]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
 	foo = plusInt |> co
 where plusInt is an arity-2 function with known strictness.  Clearly
 we want plusInt's strictness to propagate to foo!  But because it has
-no manifest lambdas, it won't do so automatically.  So we have a 
+no manifest lambdas, it won't do so automatically, and indeed 'co' might
+have type (Int->Int->Int) ~ T, so we *can't* eta-expand.  So we have a
 special case for right-hand sides that are "trivial", namely variables,
-casts, type applications, and the like. 
+casts, type applications, and the like.
+
+Note that this can mean that 'foo' has an arity that is smaller than that
+indicated by its demand info.  e.g. if co :: (Int->Int->Int) ~ T, then
+foo's arity will be zero (see Note [exprArity invariant] in CoreArity),
+but its demand signature will be that of plusInt. A small example is the
+test case of Trac #8963.
+
 
 Note [Product demands for function body]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~