[commit: ghc] master: Teach DmdAnal that coercions are value arguments! (d5773a4)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d5773a4939b1feea51ec0db6624c9462751e948a/ghc

>---------------------------------------------------------------

commit d5773a4939b1feea51ec0db6624c9462751e948a
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Apr 20 15:43:32 2015 +0100

    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


>---------------------------------------------------------------

d5773a4939b1feea51ec0db6624c9462751e948a
 compiler/stranal/DmdAnal.hs | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index bf6ca7d..2520f2a 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