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

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