Teach DmdAnal that coercions are value arguments!

The demand analyser was treating coercion args like type args,
which meant that the arguments in a strictness signature got
out of step with the arguments of a call.  Result chaos and
disaster.  Trac #10288 showed it up.

It's hard to get this bug to show up in practice because
 - functions abstracted over coercions are usually abstracted
   over *boxed* coercions
 - we don't currently unbox a boxed-coercion arg because it's
   GADT (I see how to fix this too)

But after floating, optimisation, and so on, Trac #10288 did
get a function abstracted over an unboxed coercion, and then
the -flate-dmd-anal pass went wrong.

I don't think I can come up with a test case, but I don't think
it matters too much.

Still to come
 - Fix a second bug, namely that coercion variables are wrongly
   marked as absent because DmdAnal doesn't check the the free
   variables of casts. I think this never bites in practice
   (see the follow-up commit)

 - Make GADT products work with strictness analysis

1 files changed, 5 insertions, 7 deletions

diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index bf6ca7d21b..2520f2afa9 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -164,15 +164,13 @@ dmdAnal' env dmd (App fun (Type ty))
   where
     (fun_ty, fun') = dmdAnal env dmd fun
 
-dmdAnal' sigs dmd (App fun (Coercion co))
-  = (fun_ty, App fun' (Coercion co))
-  where
-    (fun_ty, fun') = dmdAnal sigs dmd fun
-
 -- Lots of the other code is there to make this
 -- beautiful, compositional, application rule :-)
-dmdAnal' env dmd (App fun arg)  -- Non-type arguments
-  = let                         -- [Type arg handled above]
+dmdAnal' env dmd (App fun arg)
+  =  -- This case handles value arguments (type args handled above)
+     -- Crucially, coercions /are/ handled here, because they are
+     -- value arguments (Trac #10288)
+  = let
         call_dmd          = mkCallDmd dmd
         (fun_ty, fun')    = dmdAnal env call_dmd fun
         (arg_dmd, res_ty) = splitDmdTy fun_ty