用 StateT 包装的 IO 中的无限递归导致堆栈 space 溢出

Question

我正在 Haskell 中开发图形（类游戏）程序（使用 SDL 进行图形处理）。作为其中的一部分，必然有一个 'main' 无限循环，它处理状态更新和绘图，跟踪过程中的时间。我以前让它在将状态作为参数的地方工作，如下面的简化示例：

loop :: State -> Int -> IO ()
loop state prevTime = do
  time <- getTicks
  let state' = updateState state (time - prevTime)
  loop state' time

在此，updateState 函数本身使用了一个 monad 转换器堆栈，包括用于状态的 StateT、用于配置的 ReaderT、用于日志记录的 WriterT 和用于随机数生成的 RandT，因此我必须通过所有通过updateState所需的参数，并将随机数生成器取回。并且有多个不同的 updateState 相关函数，所有这些都需要在它们之间完成一些 IO，因此我的主循环中的很多代码只是通过线程状态和参数。

当然，我很快意识到那种代码很糟糕，并决定我可以通过在不同的转换器堆栈中制作整个循环运行来消除它，这个 IO 在底部。然后，我可以运行在我的纯 monad 中编写代码，并让它通过以下函数自动线程化其状态：

promoteContext :: PureContext a -> IOContext a
promoteContext ctx = do
  state <- get
  config <- ask
  gen <- liftIO getStdGen
  let (result, state', log, gen') = runContext ctx gen rules state
  liftIO $ setStdGen gen'
  put state'
  tell log
  return result

这极大地清理了我的代码，一开始它似乎是一个更好的解决方案，但我很快遇到了一个大问题：运行我的程序运行了大约一分钟左右突然开始导致堆栈space溢出。

我设法在一定程度上解决了这个问题，同时让我的代码比以前更干净，方法是直接在 IO monad 中创建主循环方法运行并将状态线程化，这意味着每个循环我只需要处理一次该样板文件。这显然是每次循环都强制对状态进行完全评估，这意味着堆栈没有填满，但仍然感觉 'dirty'.

我的问题是：有没有什么办法可以在每次循环时强制对状态进行全面评估，而不必求助于 IO 并显式 leaving/re-entering 变压器堆？

编辑：感谢 Petr Pudlák 的建议，我花了一些时间试图找出问题所在，并最终找到了导致问题的代码：

import Control.Monad.Writer.Strict
import Control.Monad.State.Strict

import Control.DeepSeq
import Exception

type ContextT s m = StateT s (WriterT [String] m)

evalContext ctx state = do
  (a, log) <- runWriterT (evalStateT ctx state)
  liftIO $ evaluate (rnf log)
  return a

problem :: ContextT Double IO ()
problem = do modify (+ 0.001)
             s <- get
             liftIO $ print s
             problem

main :: IO ()
main = evalContext problem 0

{对代码的小修改：我添加了日志的强制评估，但问题仍然存在。}

运行这会导致堆栈 space 在状态达到大约 500 时溢出。但是，摆脱 WriterT 会阻止溢出的发生，这表明一直都是 Writer 的错。不过，我不明白这是怎么回事，因为在这个孤立的代码中甚至没有使用编写器。我想我现在的问题是，为什么 WriterT 的存在会导致这种情况发生？

Answer 1

更新： 我无法重现该问题，不同的 GHC 版本可能会以不同方式优化代码。不过下面有一些想法：

您添加的强制计算不会执行任何操作 - 它永远不会执行，因为 problem 运行无限期地执行。

之所以将WriterT加到栈中导致内存泄漏，可能恰恰是因为它从来没有被用于任何事情。这是 Writers 的常见问题。使用 State 您可以在任何时候强制当前状态，但不能使用 Writer.

我要做的是创建一个单独的原语，用于在 ContextT 中永远循环，以确保在每次循环后都对状态和日志进行全面评估：

 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.RWS.Strict

 import Control.Exception (evaluate)
 import Control.DeepSeq

 import qualified Data.Sequence as Seq

 type ContextT s m = RWST () (Seq.Seq String) s m

 evaluate' :: (MonadIO m, NFData a) => a -> m a
 evaluate' = liftIO . evaluate . force

 forever' :: (MonadIO m, NFData s) => ContextT s m a -> ContextT s m b
 forever' k = RWST $ \_ -> loop mempty
   where
     loop w s = do
         (_, s', w') <- runRWST k () s
         let w'' = w <> w'
         evaluate' s'
         evaluate' w''
         loop w'' s'

 evalContext ctx state = do
   (a, _, _) <- runRWST ctx () state
   return a

 problem :: ContextT Double IO ()
 problem = do modify (+ 0.001)
              s <- get
              liftIO $ print s

 main :: IO ()
 main = evalContext (forever' problem) 0

一些注意事项和注意事项：

将一步计算与循环分开可以让您更好地控制如何确保循环的严格性或其他属性。
使用 [String] 作为 Writer 中的幺半群很可能具有 O(n^2) 性能，因为您要从获得不断增加的当前条目列表的权利。因此，我会使用 Seq 将其降低到 O(n log n).
但是，在每个循环中强制执行日志仍然是 O(n^2) - 我们每次都会遍历完整的日志。解决这个问题可能超出了这个答案的范围，我可能会为此实现一个具有宽松树结构的我自己的幺半群。
我建议对 ContextT 使用 newtype，而不是将其内部导出到模块之外。尽管这需要很少的样板代码来添加所有必需的实例，但我看到了两个优点：
- 封装 - 这会强制您的代码的所有其他部分仅使用提供的原语，这允许您稍后更改内部结构（例如将 StateT + WriterT 更改为 RWST）不接触模块外的任何东西。
- 您可以更好地控制 monadic 操作 - 例如，通过定义自定义 >>= 您可以强制在每个 monadic 操作后将状态评估为其 NF。

旧答案： 如果可能，请包括 a self-contained code sample 来证明问题，否则很难猜测原因。

我会尝试的一些一般性建议：

泄漏也可能是由写入器部分引起的，因此请尝试 tell $! log 或 tell $!! log。
如果您在 IO monad 中，强制求值的规范方式是 evaluate。如果你想要一个正常的形式，那么你会使用 evaluate (rnf value).
如果您的堆栈使用 StateT、ReaderT 以及 WriterT，您可以改用 `RWST。
您的 promoteContext 看起来非常接近 hoist。更具体地说：您可以创建一个由基本 monad 参数化的 monad 转换器：
```
newtype ContextT m a = ...
```
并实施 MFunctor。那么纯计算将是 ContextT Identity 中的运行，基于 IO 的计算将是 ContextT IO 中的运行，你可以从 ContextT Identity 提升到ContextT IO 使用 hoist generalize.
另一种方法可能是运行 ContextT m 中的纯部分用于任意 m（或受类型 class 约束，例如 MonadRandom m => ... ).如果 m 是任意的，那么可以用 Identity 代替 m，所以代码确实是纯粹的，但是你可以将它与基于 IO 的部分无缝地结合在一起（也IO 实施 MonadRandom).

我会尝试将强制评估所有内部状态和编写器输出的部分分离到一个单独的函数中，如

forceContext :: ContextT IO () -- or MonadIO m => ContextT m ()
forceContext = do
  -- state
  s <- -- read the internal state
  liftIO $ evaluate (rnf s)
  ...

那么您可以将主循环表达为类似于

main = runContextT (forever (step >> forceContext))

Answer 2

问题是 Writer 没有正确的尾调用；它的 >>= 类似于（忽略 newtype 构造函数/提取器等次要细节）：

a >>= f = do
    (w0, x) <- a
    (w1, y) <- f x
    return (w0 `mappend` w1, y)

所以 f 在这里并不是真正的尾部上下文；因此，像您使用的无限尾递归循环将在每个循环中累积堆栈 space。

Writer 是一个问题，即使你“没有使用它”，因为 do 总是使用你的计算类型的 >>= 去糖，并且问题出在 >>= 你选择的那个。

用 StateT 包装的 IO 中的无限递归导致堆栈 space 溢出

Infinite recursion in IO wrapped with StateT causing stack space overflow

haskell

monad-transformers

state-monad