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

Fixed this by adding a `rhs_se` parameter, analogous to `simplNonRecE`
and `simplLazyBind`.

Differential Revision: https://phabricator.haskell.org/D4130

1 files changed, 6 insertions, 5 deletions

diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index d6b859aade..adcd017454 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,11 @@ 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  { let rhs_env = rhs_se `setInScopeFromE` env
+        ; rhs' <- simplJoinRhs rhs_env old_bndr rhs cont
         ; completeBind env NotTopLevel (Just cont) old_bndr new_bndr rhs' }
 
 --------------------------
@@ -1471,7 +1472,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') }