@@ -34,7 +34,7 @@ import Data.Maybe (isJust)
3434import Data.Typeable (Typeable)
3535import Control.Category ((>>>))
3636import Control.Applicative ((<$>))
37−import Control.Monad (void, when, forever)
37+import Control.Monad (void, when)
3838import Control.Monad.IO.Class (MonadIO, liftIO)
3939import Control.Monad.State.Strict (MonadState, StateT, evalStateT, gets)
4040import qualified Control.Monad.State.Strict as StateT (get, put)
@@ -166,11 +166,17 @@ createBareLocalNode endPoint rtable = do
166166 void . forkIO $ handleIncomingMessages node
167167 return node
168168
169+-- Like 'Control.Monad.forever' but sans space leak
170+{-# INLINE forever' #-}
171+forever' :: Monad m => m a -> m b
172+-- forever' a = let a' = a >> a' in a'
173+forever' a = a >> forever' a
174+
169175-- | Start and register the service processes on a node
170176-- (for now, this is only the logger)
171177startServiceProcesses :: LocalNode -> IO ()
172178startServiceProcesses node = do
173− logger <- forkProcess node . forever $ do
179+ logger <- forkProcess node . forever' $ do
174180 (time, pid, string) <- expect :: Process (String, ProcessId, String)
175181 liftIO . hPutStrLn stderr $ time ++ " " ++ show pid ++ ": " ++ string
176182 runProcess node $ register "logger" logger
@@ -402,7 +408,7 @@ initNCState = NCState { _links = Map.empty
402408nodeController :: NC ()
403409nodeController = do
404410 node <- ask
405− forever $ do
411+ forever' $ do
406412 msg <- liftIO $ readChan (localCtrlChan node)
407413
408414 -- [Unified: Table 7, rule nc_forward]