haskell - 为什么这段代码不在常量内存中运行？

Question

我正在使用 Data.Text.Lazy 来处理一些文本文件。我读入 2 个文件并根据某些标准将它们的文本分发到 3 个文件。执行处理的循环是 go'。我以一种方式设计它，它应该以增量方式处理文件并且不会在内存中保留任何内容。然而，一旦执行到 go' 部分，内存就会继续增加，直到最后达到大约 90MB，从 2MB 开始。

有人可以解释为什么会发生这种内存增加以及如何避免这种情况吗？

import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as TI
import System.IO
import System.Environment
import Control.Monad

main = do
  [in_en, in_ar] <- getArgs
  [h_en, h_ar] <- mapM (`openFile` ReadMode) [in_en, in_ar]
  hSetEncoding h_en utf8
  en_txt <- TI.hGetContents h_en
  let len = length $ T.lines en_txt
  len `seq` hClose h_en
  h_en <- openFile in_en ReadMode
  hs@[hO_lm, hO_en, hO_ar] <- mapM (`openFile` WriteMode) ["lm.txt", "tun_"++in_en, "tun_"++in_ar]
  mapM_ (`hSetEncoding` utf8) [h_en, h_ar, hO_lm, hO_en, hO_ar]
  [en_txt, ar_txt] <- mapM TI.hGetContents [h_en, h_ar]
  let txts@[_, _, _] = map T.unlines $ go len en_txt ar_txt
  zipWithM_ TI.hPutStr hs txts
  mapM_ (liftM2 (>>) hFlush hClose) hs
  print "success"
  where
    go len en_txt ar_txt = go' (T.lines en_txt) (T.lines ar_txt)
      where (q,r) = len `quotRem` 3000
            go' [] [] = [[],[],[]]
            go' en ar = let (h:bef, aft)    = splitAt q en 
                            (hA:befA, aftA) = splitAt q ar 
                            ~[lm,en',ar']   = go' aft aftA
                        in [bef ++ lm, h:en', hA:ar']

编辑

根据@kosmikus 的建议，我尝试用一​​个逐行打印的循环替换 zipWithM_ TI.hPutStr hs txts，如下所示。内存消耗现在是 2GB+!

fix (\loop lm en ar -> do
  case (en,ar,lm) of
    ([],_,lm) -> TI.hPutStr hO_lm $ T.unlines lm
    (h:t,~(h':t'),~(lh:lt)) -> do
      TI.hPutStrLn hO_en h
      TI.hPutStrLn hO_ar h'
      TI.hPutStrLn hO_lm lh
      loop lt t t')
  lm en ar

这是怎么回事？

Answer 1

go' 函数构建了一个包含三个元素的[T.Text]。该列表是惰性构建的:在 go 的每一步中，三个列表中的每一个都在一定程度上已知。但是，您可以使用以下行按顺序将每个元素打印到文件中来使用此结构:

zipWithM_ TI.hPutStr hs txts

因此，您使用数据的方式与您生成数据的方式不匹配。在将三个列表元素中的第一个打印到文件时，另外两个被构建并保存在内存中。因此空间泄漏。

更新

我认为对于当前示例，最简单的解决方法是在循环期间写入目标文件，即在 go' 循环中。我将修改 go' 如下:

go' :: [T.Text] -> [T.Text] -> IO ()
go' [] [] = return ()
go' en ar = let (h:bef, aft)    = splitAt q en
                (hA:befA, aftA) = splitAt q ar
            in do
              TI.hPutStrLn hO_en h
              TI.hPutStrLn hO_ar hA
              mapM_ (TI.hPutStrLn hO_lm) bef
              go' aft aftA

然后将对 go 的调用和随后的 zipWithM_ 调用替换为对以下内容的简单调用:

go hs len en_txt ar_txt