[commit: ghc] late-lam-lift: was not ignoring tyco arguments when determing argument strictness (c445412)

[Nicolas Frisby]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : late-lam-lift

https://github.com/ghc/ghc/commit/c445412c196909f0892a90ae85792ea3e0e507bb

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

commit c445412c196909f0892a90ae85792ea3e0e507bb
Author: Nicolas Frisby <nicolas.frisby at gmail.com>
Date:   Thu Mar 21 18:52:25 2013 +0000

    was not ignoring tyco arguments when determing argument strictness

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

 compiler/simplCore/SetLevels.lhs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index 74691be..b092801 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -1967,7 +1967,9 @@ analyzeFVsM  env app@(App fun arg) = do
         Nothing   -> computeArgumentDemands app
         Just dmds -> dmds
 
-  let (argIsStrictlyDemanded, dmds') = case argDmds of
+  let (argIsStrictlyDemanded, dmds')
+        | isTyCoArg arg = (False, argDmds)
+        | otherwise     = case argDmds of
         [] -> (False, []) -- for some reason, we couldn't determine
                           -- argument strictness for this application
         isStrDmd : dmds -> (isStrDmd, dmds)
@@ -1985,7 +1987,7 @@ analyzeFVsM  env app@(App fun arg) = do
   x <- gensymFVM
   arg2 <- return $
     let arg_fvis = fvisOf arg2
-        new_arg_fvis = if argIsAClosure
+        new_arg_fvis = if fve_isFinal env && argIsAClosure
                    then closureBindingFVIs x env Nothing arg_fvis
                    else arg_fvis
     in (new_arg_fvis, snd arg2)