CorePrep: Don't speculatively evaluate recursive calls (#20836)

In #20836 we have optimised a terminating program into an endless loop,
because we speculated the self-recursive call of a recursive DFun.
Now we track the set of enclosing recursive binders in CorePrep to prevent
speculation of such self-recursive calls.

See the updates to Note [Speculative evaluation] for details.

Fixes #20836.

2 files changed, 24 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_run/T20836.hs b/testsuite/tests/simplCore/should_run/T20836.hs
new file mode 100644
index 0000000000..462fdb3ac7
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T20836.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+
+import Data.Kind (Type)
+
+class (Monad m, MonadFoo (FooM m)) => MonadFoo m where
+  type FooM m :: Type -> Type
+  runFoo :: FooM m a -> m a
+
+newtype MyMonad m a = MyMonad { runMyMonad :: m a }
+  deriving (Functor, Applicative, Monad)
+
+instance Monad m => MonadFoo (MyMonad m) where
+  type FooM (MyMonad m) = MyMonad m
+  runFoo = id
+
+main :: IO ()
+main = runMyMonad foo
+
+foo :: MonadFoo m => m ()
+foo = runFoo $ return ()
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 509ae1ff57..bebd839724 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -105,3 +105,4 @@ test('T19313', normal, compile_and_run, [''])
 test('UnliftedArgRule', normal, compile_and_run, [''])
 test('T21229', normal, compile_and_run, ['-O'])
 test('T21575', normal, compile_and_run, ['-O'])
+test('T20836', normal, compile_and_run, ['-O0']) # Should not time out; See #20836