From f55f5574c12ff8dfe57994219eee0702ac8aba2e Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <p.capriotti@gmail.com>
Date: Mon, 20 Aug 2012 16:35:38 +0100
Subject: [PATCH] Improve definition of forever (#5205)

The previous implementation was:

    forever a = a >> forever a

which can create a space leak in some cases, even with optimizations.
The current implementation:

    forever a = let a' = a >> a' in a'

prevents repeated thunk allocations by creating a single thunk for the
final result, even without optimizations.
---
 Control/Monad.hs | 23 ++++-------------------
 GHC/ST.lhs       |  4 ----
 2 files changed, 4 insertions(+), 23 deletions(-)

diff --git a/Control/Monad.hs b/Control/Monad.hs
index 21f01538..eec94652 100644
--- a/Control/Monad.hs
+++ b/Control/Monad.hs
@@ -190,25 +190,10 @@ f >=> g     = \x -> f x >>= g
 
 -- | @'forever' act@ repeats the action infinitely.
 forever     :: (Monad m) => m a -> m b
-{-# INLINABLE forever #-}  -- See Note [Make forever INLINABLE]
-forever a   = a >> forever a
-
-{- Note [Make forever INLINABLE]
-
-If you say   x = forever a
-you'll get   x = a >> a >> a >> a >> ... etc ...
-and that can make a massive space leak (see Trac #5205)
-
-In some monads, where (>>) is expensive, this might be the right
-thing, but not in the IO monad.  We want to specialise 'forever' for
-the IO monad, so that eta expansion happens and there's no space leak.
-To achieve this we must make forever INLINABLE, so that it'll get
-specialised at call sites.
-
-Still delicate, though, because it depends on optimisation.  But there
-really is a space/time tradeoff here, and only optimisation reveals
-the "right" answer.
--}
+{-# INLINE forever #-}
+forever a   = let a' = a >> a' in a'
+-- Use explicit sharing here, as it is prevents a space leak regardless of
+-- optimizations.
 
 -- | @'void' value@ discards or ignores the result of evaluation, such as the return value of an 'IO' action.
 void :: Functor f => f a -> f ()
diff --git a/GHC/ST.lhs b/GHC/ST.lhs
index 5983e945..74a299ab 100644
--- a/GHC/ST.lhs
+++ b/GHC/ST.lhs
@@ -27,7 +27,6 @@ module GHC.ST (
 
 import GHC.Base
 import GHC.Show
-import Control.Monad( forever )
 
 default ()
 \end{code}
@@ -82,9 +81,6 @@ instance Monad (ST s) where
 
 data STret s a = STret (State# s) a
 
-{-# SPECIALISE forever :: ST s a -> ST s b #-}
--- See Note [Make forever INLINABLE] in Control.Monad
-
 -- liftST is useful when we want a lifted result from an ST computation.  See
 -- fixST below.
 liftST :: ST s a -> State# s -> STret s a