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

为什么这段代码不能在恒定的内存中运行？

1 个答案:

更新