From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Thu, 9 Jun 2011 19:44:21 +0000 (+0100)
Subject: Make 'forever' inlinable (fixes Trac #5205)
X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=f339b08cbf4c79a33b850c1279779e06b4013dfc

Make 'forever' inlinable (fixes Trac #5205)

See Note [Make forever INLINABLE] in Control.Monad
---

diff --git a/Control/Monad.hs b/Control/Monad.hs
index 2bbfc57..75b9d0b 100644
--- a/Control/Monad.hs
+++ b/Control/Monad.hs
@@ -189,8 +189,26 @@ 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.
+-}
+
 -- | @'void' value@ discards or ignores the result of evaluation, such as the return value of an 'IO' action.
 void :: Functor f => f a -> f ()
 void = fmap (const ())
diff --git a/GHC/ST.lhs b/GHC/ST.lhs
index dc62000..a66a5f8 100644
--- a/GHC/ST.lhs
+++ b/GHC/ST.lhs
@@ -20,6 +20,7 @@ module GHC.ST where
 
 import GHC.Base
 import GHC.Show
+import Control.Monad( forever )
 
 default ()
 \end{code}
@@ -74,6 +75,9 @@ 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