如何处理具有恒定内存的两条长线?

How to process two long lines with constant memory?

输入文件由两行组成,每行包含许多数字

1 2 3 4... 
5 6 7 8... 

我想处理每一行的数据,像这样:

doSomething :: [Int] -> [Int] -> Int
doSomething [] y = 0 -- stop execution. I'm concerted in memory behavior only.
doSomething (x:xs) y = doSomething xs y
main = do
    inputdata <- getContents
    let (x:xs) = lines inputdata
        firstLine = map (read ::String->Int) $ words $ x
        secondLine = map (read ::String->Int) $ words $ head xs
    print $ doSomething firstLine secondLine

当我运行这个程序时,堆分析显示如下:

如果我不使用 secondLine (xs),那么此程序 运行s 具有常量内存。 列表 firstLine 的每个条目都被 GC 处理然后丢弃。

  1. 为什么消耗的内存这么大? 我看到分配的内存量约为 100MB,但实际输入数据大小为 5MB。

  2. 是否head xs强制将整个第一行读入内存, 甚至 secondLine 根本不用?这是主要原因吗 堆分析图的内存增加?

  3. 我怎样才能像后面的执行图那样用常量内存处理两行?

  4. 如果3)的答案取决于处理顺序,我如何才能先处理第二行,然后再处理第一行?

Q1) Why the consumed memory is so large? I see the amount of allocated memory is ~100MB, but actual input data size is 5MB.

String in Haskell 是 [Char] 的类型别名,所以沿着实际的字节,编译器还必须保留一个构造函数,一个指向装箱字符的指针和一个指向内存中每个字符的下一个构造函数,结果内存使用量是 C-style 字符串的 10 倍以上。更糟糕的是,文本在内存中存储了多次。

Q3) How can I process two lines with constant memory, like latter execution graph?
Q4) If the answer to Q3) depends on processing order, how can I process second line first, and then first line?

不,您不能先处理第二行,因为 lines 函数必须评估第一行中的每个字节以命中“\n”换行符。

Q2) Does head xs force reading entire first line into memory, even secondLine is not used at all? And is this the main cause of memory increase of heap profiling graph?

并不是 head 阻止了第一行被 GC。如果您调整 doSomething 的类型签名并将 xs 直接传递给它,space 泄漏仍然会发生。关键是(未优化)编译器不会知道 secondLinedoSomething 最终达到第一个模式之前未被使用,因此程序保留对 xs 的引用。顺便说一句,如果使用 -O2 编译,您的程序将以常量内存运行。

造成你程序space泄露的主要是这一行:

let (x:xs) = lines inputdata

当丢弃 xxs 时,此 let 子句将在转储的 Core 中为 in-lined。只有在稍后引用它们时,核心才会表现得很奇怪:它构造一个元组,通过模式匹配破坏它,然后再次将两部分构造成一个元组,因此通过保留对 secondLine 的引用,程序实际上保留了对元组的引用 (x, xs) 所以第一行永远不会被 GC。

secondLine 的核心被注释掉:

Rec {
doSomething_rjH
doSomething_rjH =
  \ ds_d1lv y_alG ->
    case ds_d1lv of _ {
      [] -> I# 0;
      : x_alH xs_alI -> doSomething_rjH xs_alI y_alG
    }
end Rec }

main
main =
  >>=
    $fMonadIO
    getContents
    (\ inputdata_app ->
       print
         $fShowInt
         (doSomething_rjH
            (map
               (read $fReadInt)
               (words
                  (case lines inputdata_app of _ {
                     [] -> case irrefutPatError "a.hs:6:9-32|(x : xs)"# of wild1_00 { };
                     : x_auf xs_aug -> x_auf
                   })))
            ([])))

main
main = runMainIO main

核心 space 泄漏:

Rec {
doSomething_rjH
doSomething_rjH =
  \ ds_d1ol y_alG ->
    case ds_d1ol of _ {
      [] -> I# 0;
      : x_alH xs_alI -> doSomething_rjH xs_alI y_alG
    }
end Rec }

main
main =
  >>=
    $fMonadIO
    getContents
    (\ inputdata_app ->
       -- *** Construct ***
       let {
         ds_d1op
         ds_d1op =
           case lines inputdata_app of _ {
             [] -> irrefutPatError "a.hs:6:9-30|x : xs"#;
             : x_awM xs_awN -> (x_awM, xs_awN)
           } } in
       -- *** Destruct ***
       let {
         xs_awN
         xs_awN = case ds_d1op of _ { (x_awM, xs1_XwZ) -> xs1_XwZ } } in
       let {
         x_awM
         x_awM = case ds_d1op of _ { (x1_XwZ, xs1_XwU) -> x1_XwZ } } in
       -- *** Construct ***
       let {
         ds1_d1oq
         ds1_d1oq = (x_awM, xs_awN) } in
       print
         $fShowInt
         -- *** Destruct ***
         (doSomething_rjH
            (map
               (read $fReadInt)
               (words (case ds1_d1oq of _ { (x1_Xx1, xs1_Xx3) -> x1_Xx1 })))
            (map
               (read $fReadInt)
               (words
                  (head (case ds1_d1oq of _ { (x1_Xx1, xs1_Xx3) -> xs1_Xx3 }))))))

main
main = runMainIO main

case .. of 子句替换 let 子句将修复 space 漏洞:

doSomething :: [Int] -> [Int] -> Int
doSomething [] _ = 0 -- stop execution. I'm concerted in memory behavior only.
doSomething (_:xs) y = doSomething xs y

main :: IO ()
main = do
  inputdata <- getContents
  case lines inputdata of
    x:xs -> do
      let
        firstLine = map (read ::String->Int) $ words x
        secondLine = map (read ::String->Int) $ words $ head xs
      print $ doSomething firstLine secondLine

被抛弃的核心。 "construct then destruct" 模式这次没有发生:

Rec {
doSomething_rjG
doSomething_rjG =
  \ ds_d1o6 ds1_d1o7 ->
    case ds_d1o6 of _ {
      [] -> I# 0;
      : ds2_d1o8 xs_alG -> doSomething_rjG xs_alG ds1_d1o7
    }
end Rec }

main
main =
  >>=
    $fMonadIO
    getContents
    (\ inputdata_apn ->
       case lines inputdata_apn of _ {
         [] -> patError "a.hs:(8,3)-(13,46)|case"#;
         : x_asI xs_asJ ->
           print
             $fShowInt
             (doSomething_rjG
                (map (read $fReadInt) (words x_asI))
                (map (read $fReadInt) (words (head xs_asJ))))
       })

main
main = runMainIO main