[commit: ghc] master: Fix #13382: Put join ceiling underneath lambdas (08e73cc)

[git at git.haskell.org]

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

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

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

commit 08e73ccf4c75a7d7a8b8167d2ccf8bc505fe1130
Author: Luke Maurer <maurerl at cs.uoregon.edu>
Date:   Mon Mar 13 18:49:25 2017 -0400

    Fix #13382: Put join ceiling underneath lambdas
    
    Test Plan: No new test (bug is latent)
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3285


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

08e73ccf4c75a7d7a8b8167d2ccf8bc505fe1130
 compiler/simplCore/SetLevels.hs     | 3 ++-
 testsuite/tests/perf/compiler/all.T | 4 +++-
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index 8822019..90e1d53 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -1167,7 +1167,8 @@ lvlFloatRhs abs_vars dest_lvl env rec is_bot mb_join_arity rhs
     (body_env, bndrs') | Just _ <- mb_join_arity
                       = lvlJoinBndrs env1 dest_lvl rec all_bndrs
                       | otherwise
-                      = lvlLamBndrs (placeJoinCeiling env1) dest_lvl all_bndrs
+                      = case lvlLamBndrs env1 dest_lvl all_bndrs of
+                          (env2, bndrs') -> (placeJoinCeiling env2, bndrs')
         -- The important thing here is that we call lvlLamBndrs on
         -- all these binders at once (abs_vars and bndrs), so they
         -- all get the same major level.  Otherwise we create stupid
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 5a7614b..8b4ac08 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -746,10 +746,12 @@ test('T9675',
           # 2015-07-11    56         (x86/Linux, 64-bit machine) use +RTS -G1
           ]),
        compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 731171072, 10)
+          [(wordsize(64), 656137960, 10)
           # 2014-10-13    544489040
           # 2015-10-28    608284152  emit Typeable at definition site
           # 2017-02-17    731171072  Type-indexed Typeable
+          # 2017-03-13    656137960  Put join ceiling underneath lambdas?
+
           ,(wordsize(32), 279480696, 10)
           # 2015-07-11    279480696  (x86/Linux, 64-bit machine) use +RTS -G1
           ]),