Take care to not eta-reduce jumps in CorePrep

CorePrep already had a check to prevent it from eta-reducing Ids that
respond true to hasNoBinding (foreign calls, constructors for unboxed
sums and products, and Ids with compulsory unfoldings). It did not,
however, consider join points as ids that 'must be saturated'.

Checking whether the Id responds True to 'isJoinId' should prevent
CorePrep from turning saturated jumps like the following (from #17429)
into undersaturated ones:

      (\ eta_XP ->
         join { mapped_s1vo _ = lvl_s1vs } in jump mapped_s1vo eta_XP)

2 files changed, 24 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T17429.hs b/testsuite/tests/simplCore/should_compile/T17429.hs
new file mode 100644
index 0000000000..bd01c140ff
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T17429.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T17429
+  ( zoomAcceptor
+  ) where
+
+type Zoom m = ( m ~ Emitter Int )
+
+zoomAcceptor :: Zoom m => Emitter w a -> m w
+zoomAcceptor = fmap id . zoomEmitter
+
+zoomEmitter :: Emitter w a -> Emitter b w
+zoomEmitter (Emitter go) =
+  Emitter $ const ([], fst $ go ())
+
+newtype Emitter w a = Emitter (() -> ([w], [a]))
+
+instance Functor (Emitter w) where
+  fmap f (Emitter go) = Emitter mapped
+    where
+    {-# INLINE mapped #-}
+    mapped _ = fmap f <$> go ()
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 5867a11a29..7146b76e6d 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -311,3 +311,4 @@ test('T17140',
 test('T17409',
      normal,
      makefile_test, ['T17409'])
+test('T17429', normal, compile, ['-dcore-lint -O2'])