@@ -34,7 +34,7 @@ import Data.Maybe (isJust)
34import Data.Typeable (Typeable)
34import Data.Typeable (Typeable)
35import Control.Category ((>>>))
35import Control.Category ((>>>))
36import Control.Applicative ((<$>))
36import Control.Applicative ((<$>))
37−import Control.Monad (void, when, forever)
37+import Control.Monad (void, when)
38import Control.Monad.IO.Class (MonadIO, liftIO)
38import Control.Monad.IO.Class (MonadIO, liftIO)
39import Control.Monad.State.Strict (MonadState, StateT, evalStateT, gets)
39import Control.Monad.State.Strict (MonadState, StateT, evalStateT, gets)
40import qualified Control.Monad.State.Strict as StateT (get, put)
40import qualified Control.Monad.State.Strict as StateT (get, put)
@@ -166,11 +166,17 @@ createBareLocalNode endPoint rtable = do
166 void . forkIO $ handleIncomingMessages node
166 void . forkIO $ handleIncomingMessages node
167 return node
167 return node
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
169-- | Start and register the service processes on a node
175-- | Start and register the service processes on a node
170-- (for now, this is only the logger)
176-- (for now, this is only the logger)
171startServiceProcesses :: LocalNode -> IO ()
177startServiceProcesses :: LocalNode -> IO ()
172startServiceProcesses node = do
178startServiceProcesses node = do
173− logger <- forkProcess node . forever $ do
179+ logger <- forkProcess node . forever' $ do
174 (time, pid, string) <- expect :: Process (String, ProcessId, String)
180 (time, pid, string) <- expect :: Process (String, ProcessId, String)
175 liftIO . hPutStrLn stderr $ time ++ " " ++ show pid ++ ": " ++ string
181 liftIO . hPutStrLn stderr $ time ++ " " ++ show pid ++ ": " ++ string
176 runProcess node $ register "logger" logger
182 runProcess node $ register "logger" logger
@@ -402,7 +408,7 @@ initNCState = NCState { _links = Map.empty
402nodeController :: NC ()
408nodeController :: NC ()
403nodeController = do
409nodeController = do
404 node <- ask
410 node <- ask
405− forever $ do
411+ forever' $ do
406 msg <- liftIO $ readChan (localCtrlChan node)
412 msg <- liftIO $ readChan (localCtrlChan node)
408 -- [Unified: Table 7, rule nc_forward]
414 -- [Unified: Table 7, rule nc_forward]