[commit: ghc] master: Improve SimplUtils.interestingArg (6ec236b)

[git at git.haskell.org]

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

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

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

commit 6ec236b589d541e72eea8df84628206d26e93862
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Dec 24 14:40:08 2015 +0000

    Improve SimplUtils.interestingArg
    
    There were two problems here:
     - We were looking under a lambda without extending
       the in-scope env, which triggered a WARNING
       But there's no need to look under a lambda.
    
     - We were looking under a letrec without extending
       the in-scope env, which triggered the same WARNING
       Solution: extend the in-scope env


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

6ec236b589d541e72eea8df84628206d26e93862
 compiler/simplCore/SimplUtils.hs | 29 ++++++++++++++++-------------
 1 file changed, 16 insertions(+), 13 deletions(-)

diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 29336c1..09fd1e4 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -633,20 +633,23 @@ interestingArg env e = go env 0 e
            Just (DoneEx e)             -> go (zapSubstEnv env)             n e
            Just (ContEx tvs cvs ids e) -> go (setSubstEnv env tvs cvs ids) n e
 
-    go _   _ (Lit {})              = ValueArg
-    go _   _ (Type _)              = TrivArg
-    go _   _ (Coercion _)          = TrivArg
-    go env n (App fn (Type _))     = go env n fn
-    go env n (App fn (Coercion _)) = go env n fn
-    go env n (App fn _)            = go env (n+1) fn
-    go env n (Tick _ a)            = go env n a
-    go env n (Cast e _)            = go env n e
+    go _   _ (Lit {})          = ValueArg
+    go _   _ (Type _)          = TrivArg
+    go _   _ (Coercion _)      = TrivArg
+    go env n (App fn (Type _)) = go env n fn
+    go env n (App fn _)        = go env (n+1) fn
+    go env n (Tick _ a)        = go env n a
+    go env n (Cast e _)        = go env n e
     go env n (Lam v e)
-       | isTyVar v                 = go env n     e
-       | n>0                       = go env (n-1) e
-       | otherwise                 = ValueArg
-    go env n (Let _ e)             = case go env n e of { ValueArg -> ValueArg; _ -> NonTrivArg }
-    go _ _ (Case {})               = NonTrivArg
+       | isTyVar v             = go env n e
+       | n>0                   = NonTrivArg     -- (\x.b) e   is NonTriv
+       | otherwise             = ValueArg
+    go _ _ (Case {})           = NonTrivArg
+    go env n (Let b e)         = case go env' n e of
+                                   ValueArg -> ValueArg
+                                   _        -> NonTrivArg
+                               where
+                                 env' = env `addNewInScopeIds` bindersOf b
 
     go_var n v
        | isConLikeId v     = ValueArg   -- Experimenting with 'conlike' rather that