6

正如我之前的问题一样,我试图将 Data.Binary.Put monad 包装到另一个 monad 中,以便稍后我可以问它诸如“它将写入多少字节”或“文件中的当前位置是什么”之类的问题.

以前,我认为理解为什么它在使用琐碎的(IdentityT?)包装器时会泄漏内存将引导我解决我的问题。但是,即使你们帮助我解决了琐碎包装器的问题,用像 StateT 或 WriterT 这样有用的东西来包装它仍然会消耗太多内存(并且通常会崩溃)。

例如,这是我试图包装它的一种方式,它会泄漏大量输入的内存:

输入输出 = StateT 整数 P.PutM ()

writeToFile::String -> Out -> IO()
writeToFile 路径输出 = BL.writeFile 路径 $P.runPut $do runStateT out 0
                                                         返回 ()

是演示问题的更完整的代码示例。

我想知道的是:

  1. 导致内存泄漏的程序内部发生了什么?
  2. 我能做些什么来修复它?

对于我的第二个问题,我想我应该更详细地解释我希望数据在磁盘上看到的内容:它基本上是一个树结构,其中树的每个节点都表示为其子节点的偏移表(加上一些额外的数据)。因此,要计算第 n 个子节点的偏移量到偏移表中,我需要知道子节点 0 到 n-1 的大小加上当前偏移量(为简化起见,假设每个节点都有固定数量的子节点)。

感谢您的关注。

更新:感谢 nominolo,我现在可以创建一个环绕 Data.Binary.Put 的 monad,跟踪当前偏移量并且几乎不使用内存。这是通过放弃使用 StateT 转换器来支持使用 Continuations 的不同状态线程机制来完成的。

像这样:

类型偏移 = Int

新类型 MyPut a = MyPut
  { unS :: forall r 。(偏移量 -> a -> P.PutM r) -> 偏移量 -> P.PutM r }

实例 Monad MyPut 在哪里
  返回 a = MyPut $ \fs -> fsa
  ma >>= f = MyPut $ \fb s -> unS ma (\s' a -> unS (fa) fb s') s

writeToFile::String -> MyPut() -> IO()
writeToFile 路径 put =
  BL.writeFile 路径 $P.runPut $peal put >> return()
  其中peal myput = unS myput (\o -> return) 0

getCurrentOffset :: MyPut Int
getCurrentOffset = MyPut $ \fo -> foo

提升' n ma = MyPut $ \fs -> ma >>= f (s+n)

但是,我仍然无法跟踪 MyPut 将在磁盘上写入多少字节。特别是,我需要一个带有这样签名的函数:

getSize :: MyPut a -> MyPut Int
或者
getSize :: MyPut a -> Int

我的方法是将 MyPut monad 包装在 WriterT 转换器中(类似这样的东西)。但这又开始消耗过多的内存。正如 sclv 在 nominolos 答案下的评论中提到的那样,WriterT 以某种方式抵消了延续的影响。他还提到应该可以直接从我已经拥有的 MyPut monad 中获取大小,但是我所有这样做的尝试都以不可编译的代码或无限循环结束:-|。

有人可以进一步帮助吗?

4

2 回答 2

8

看起来 monad 转换器太懒了。您可以通过运行以下程序来创建堆配置文件(无需专门构建它):

$ ./myprog +RTS -hT
$ hp2ps myprog.hp
$ open hp2ps.ps    # Or whichever viewer you have

在这种情况下,它并不是特别有用,因为它只显示了很多PAPs、FUN_1_0s 和FUN_2_0s。这意味着堆由许多部分应用的函数以及一个参数和两个参数的函数组成。这通常意味着某些东西没有得到足够的评估。Monad 转换器在这方面有点臭名昭著。

解决方法是使用更严格的 monad 转换器,使用延续传递样式。(他的要求{-# LANGUAGE Rank2Types #-}

newtype MyStateT s m a =
  MyStateT { unMyStateT :: forall r. (s -> a -> m r) -> s -> m r }

延续传递风格意味着我们不是直接返回结果,而是调用另一个函数continuation和我们的结果,在这种情况下是sand a。实例定义看起来有点滑稽。要理解它,请阅读上面的链接(维基百科)。

instance Monad m => Monad (MyStateT s m) where
  return x = MyStateT (\k s -> k s x)
  MyStateT f >>= kk = MyStateT (\k s ->
    f (\s' a -> unMyStateT (kk a) k s') s)

runMyStateT :: Monad m => MyStateT s m a -> s -> m (a, s)
runMyStateT (MyStateT f) s0 = f (\s a -> return (a, s)) s0

instance MonadTrans (MyStateT s) where
  lift act = MyStateT (\k s -> do a <- act; k s a)

type Out = MyStateT Integer P.PutM ()

现在运行它会给出恒定的空间(“最大驻留”位):

$ ./so1 +RTS -s 
begin
end
   8,001,343,308 bytes allocated in the heap
     877,696,096 bytes copied during GC
          46,628 bytes maximum residency (861 sample(s))
          33,196 bytes maximum slop
            2 MB total memory in use (0 MB lost due to fragmentation)

Generation 0: 14345 collections,     0 parallel,  3.32s,  3.38s elapsed
Generation 1:   861 collections,     0 parallel,  0.08s,  0.08s elapsed

使用这种严格的转换器的缺点是您不能再定义MonadFix实例并且某些惰性技巧不再起作用。

于 2011-02-16T17:58:54.117 回答
2

我开始玩这个,并意识到更大的问题是——你的算法非常复杂。每次调用 getSize 时计算一次,而不是计算每个子树的大小。你递归地调用 getSize 。对于每个叶节点,每次在其父节点上调用 getSize 时都会调用一次 getSize。并且 getSize 在每个父级上调用一次 + 每次在任何父级上调用 getSize 一次。所以 getsize 至少在树的深度几何上被调用。您需要缓存大小以获得类似于合理运行时的东西。

也就是说,这是一个核心功能的版本,它似乎可以正常运行而没有泄漏,尽管由于上述原因它确实在爬行:

type MyPut = S (Offset,Size) P.PutM

peal_1 :: (Monad m, Num t, Num t1) => S (t, t1) m a -> m a
peal_1 put = unS put (\o -> return) (0,0)

writeToFile :: String -> MyPut () -> IO ()
writeToFile path put =
  BL.writeFile path $ P.runPut $ (peal_1 put) >> return ()

getSize :: MyPut a -> MyPut Int
getSize x = S $ \f os -> unS (x >> getCurrentSize) f os

getCurrentOffset :: MyPut Int
getCurrentOffset = S $ \f os -> f os (fst os)

getCurrentSize :: MyPut Int
getCurrentSize = S $ \f os -> f os (snd os)

我还不得不说我不确定您的逻辑总体上是否正确。我的代码在修复泄漏的同时保留了当前行为。我通过在缩减的数据集上运行它和您的代码并生成逐位相同的文件来测试这一点。

但是对于您的大型测试数据,这段代码在我杀死它之前写了6.5G(提供的代码在那之前就已经耗尽了堆)。我怀疑但没有测试过 put monad 中的底层调用在每次调用 getSize 时都会运行一次,即使 getSize 的结果被丢弃了。

我提出的正确解决方案作为对您其他问题的回答发布:How do you save a tree data structure to binary file in Haskell

于 2011-03-02T15:58:33.930 回答