diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs
index c5958a4342db3c065d2e50d17b6f4f445557d8d7..055c68d672f8508bf264064d7789a4b01b712f06 100644
--- a/compiler/simplCore/CSE.hs
+++ b/compiler/simplCore/CSE.hs
@@ -17,7 +17,7 @@ import Var              ( Var )
 import VarEnv           ( elemInScopeSet, mkInScopeSet )
 import Id               ( Id, idType, idInlineActivation, isDeadBinder
                         , zapIdOccInfo, zapIdUsageInfo, idInlinePragma
-                        , isJoinId )
+                        , isJoinId, isJoinId_maybe )
 import CoreUtils        ( mkAltExpr, eqExpr
                         , exprIsTickedString
                         , stripTicksE, stripTicksT, mkTicks )
@@ -274,7 +274,28 @@ compiling ppHtml in Haddock.Backends.Xhtml).
 
 We could try and be careful by tracking which join points are still valid at
 each subexpression, but since join points aren't allocated or shared, there's
-less to gain by trying to CSE them.
+less to gain by trying to CSE them. (#13219)
+
+Note [Don’t tryForCSE the RHS of a Join Point]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Another way how CSE for joint points is tricky is
+
+  let join foo x = (x, 42)
+      join bar x = (x, 42)
+  in … jump foo 1 … jump bar 2 …
+
+naively, CSE would turn this into
+
+  let join foo x = (x, 42)
+      join bar = foo
+  in … jump foo 1 … jump bar 2 …
+
+but now bar is a join point that claims arity one, but its right-hand side
+is not a lambda, breaking the join-point invariant (this was #15002).
+
+Therefore, `cse_bind` will zoom past the lambdas of a join point (using
+`collectNBinders`) and resume searching for CSE opportunities only in the body
+of the join point.
 
 Note [CSE for recursive bindings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -353,6 +374,13 @@ cse_bind toplevel env (in_id, in_rhs) out_id
       -- See Note [Take care with literal strings]
   = (env', (out_id, in_rhs))
 
+  | Just arity <- isJoinId_maybe in_id
+      -- See Note [Don’t tryForCSE the RHS of a Join Point]
+  = let (params, in_body) = collectNBinders arity in_rhs
+        (env', params') = addBinders env params
+        out_body = tryForCSE env' in_body
+    in (env, (out_id, mkLams params' out_body))
+
   | otherwise
   = (env', (out_id', out_rhs))
   where
@@ -392,6 +420,8 @@ addBinding env in_id out_id rhs'
                    Var {} -> True
                    _      -> False
 
+-- | Given a binder `let x = e`, this function
+-- determines whether we should add `e -> x` to the cs_map
 noCSE :: InId -> Bool
 noCSE id =  not (isAlwaysActive (idInlineActivation id)) &&
             not (noUserInlineSpec (inlinePragmaSpec (idInlinePragma id)))
diff --git a/testsuite/tests/simplCore/should_compile/T15002.hs b/testsuite/tests/simplCore/should_compile/T15002.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a5918c523447dc94f4efafbbee72c0d84b18d4ee
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T15002.hs
@@ -0,0 +1,12 @@
+module T15002 where
+
+import Control.Concurrent.MVar (MVar, modifyMVar_, putMVar)
+import Data.Foldable (for_)
+
+broadcastThen :: Either [MVar a] a -> MVar (Either [MVar a] a) -> a -> IO ()
+broadcastThen finalState mv x =
+    modifyMVar_ mv $ \mx -> do
+      case mx of
+        Left ls -> do for_ ls (`putMVar` x)
+                      return finalState
+        Right _ -> return finalState
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index e68f49cfb65816715bf6cf3720543bc76cd571ac..c4b2f30d1fa8c3af6cf4439fff69348835ec3d43 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -295,3 +295,4 @@ test('T14152a', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile,
 test('T13990', normal, compile, ['-dcore-lint -O'])
 test('T14650', normal, compile, ['-O2'])
 test('T14959', normal, compile, ['-O'])
+test('T15002', [ req_profiling ], compile, ['-O -fprof-auto -prof'])