[commit: ghc] wip/T14152: simplNonRecJoinPoint: Handle Shadowing correctly (ef5fa5d)

[git at git.haskell.org]

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

On branch  : wip/T14152
Link       : http://ghc.haskell.org/trac/ghc/changeset/ef5fa5d7105c5a0ccc7cb067a2db70771052d6dc/ghc

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

commit ef5fa5d7105c5a0ccc7cb067a2db70771052d6dc
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Thu Oct 26 19:36:24 2017 -0400

    simplNonRecJoinPoint: Handle Shadowing correctly
    
    Previously, (since 33452df), simplNonRecJoinPoint would do the wrong
    thing in the presence of shadowing: It analyzed the RHS of a join
    binding with the environment for the body. In particular, with
    
        foo x =
          join x = x * x
          in x
    
    where there is shadowing, it renames the inner x to x1, and should
    produce
    
        foo x =
          join x1 = x * x
          in x1
    
    but because the substitution (x ↦ x1) is also used on the RHS we get the
    bogus
    
        foo x =
          join x1 = x1 * x1
          in x1
    
    The corresponding function for non-join-points, i.e. simplNonRecE, does
    the right thing and has done so forever, so I’ll skip creating a test
    case or a note for this.
    
    Differential Revision: https://phabricator.haskell.org/D4130


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

ef5fa5d7105c5a0ccc7cb067a2db70771052d6dc
 compiler/simplCore/Simplify.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index d6b859a..3497e67 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -204,7 +204,7 @@ simplRecOrTopPair env top_lvl is_rec mb_cont old_bndr new_bndr rhs
   | Just cont <- mb_cont
   = ASSERT( isNotTopLevel top_lvl && isJoinId new_bndr )
     trace_bind "join" $
-    simplJoinBind env cont old_bndr new_bndr rhs
+    simplJoinBind env cont old_bndr new_bndr rhs env
 
   | otherwise
   = trace_bind "normal" $
@@ -300,10 +300,10 @@ simplJoinBind :: SimplEnv
               -> InId -> OutId          -- Binder, both pre-and post simpl
                                         -- The OutId has IdInfo, except arity,
                                         --   unfolding
-              -> InExpr
+              -> InExpr -> SimplEnv     -- The right hand side and its env
               -> SimplM (SimplFloats, SimplEnv)
-simplJoinBind env cont old_bndr new_bndr rhs
-  = do  { rhs' <- simplJoinRhs env old_bndr rhs cont
+simplJoinBind env cont old_bndr new_bndr rhs rhs_se
+  = do  { rhs' <- simplJoinRhs rhs_se old_bndr rhs cont
         ; completeBind env NotTopLevel (Just cont) old_bndr new_bndr rhs' }
 
 --------------------------
@@ -1471,7 +1471,7 @@ simplNonRecJoinPoint env bndr rhs body cont
         ; let res_ty = contResultType cont
         ; (env1, bndr1)    <- simplNonRecJoinBndr env res_ty bndr
         ; (env2, bndr2)    <- addBndrRules env1 bndr bndr1
-        ; (floats1, env3)  <- simplJoinBind env2 cont bndr bndr2 rhs
+        ; (floats1, env3)  <- simplJoinBind env2 cont bndr bndr2 rhs env
         ; (floats2, body') <- simplExprF env3 body cont
         ; return (floats1 `addFloats` floats2, body') }