为什么我的Haskell程序会出现内存不足错误？

Question

我希望能写一个Haskell程序来解析一个大约14GB的文本文件，但我不知道如何使其释放未使用的内存，也不知道如何避免在foldr期间出现堆栈溢出。下面是程序源代码：

import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Lex.Lazy.Double as BD
import System.Environment


data Vertex = 
    Vertex{
     vertexX :: Double,
     vertexY :: Double,
     vertexZ :: Double}
    deriving (Eq, Show, Read)

data Extent = 
    Extent{
     extentMax :: Vertex,
     extentMin :: Vertex}
    deriving (Eq, Show, Read)

addToExtent :: Extent -> Vertex -> Extent
addToExtent ext vert = Extent vertMax vertMin where
                        (vertMin, vertMax) = (makeCmpVert max (extentMax ext) vert, makeCmpVert min (extentMin ext) vert) where
                            makeCmpVert f v1 v2 = Vertex(f (vertexX v1) (vertexX v2))
                                                        (f (vertexY v1) (vertexY v2))
                                                        (f (vertexZ v1) (vertexZ v2))

readCoord :: LBS.ByteString -> Double
readCoord l = case BD.readDouble l of
                Nothing -> 0
                Just (value, _) -> value

readCoords :: LBS.ByteString -> [Double]
readCoords l | LBS.length l == 0 = []
             | otherwise = let coordWords = LBS.split ' ' l 
                            in map readCoord coordWords

parseLine :: LBS.ByteString -> Vertex
parseLine line = Vertex (head coords) (coords!!1) (coords!!2) where
    coords = readCoords line 

processLines :: [LBS.ByteString] -> Extent -> Extent
processLines strs ext = foldr (\x y -> addToExtent y (parseLine x)) ext strs

processFile :: String -> IO()
processFile name = do
    putStrLn name
    content <- LBS.readFile name
    let (countLine:recordsLines) = LBS.lines content
    case LBS.readInt countLine of
        Nothing -> putStrLn "Can't read records count"
        Just (recordsCount, _) -> do
                                    print recordsCount
                                    let vert = parseLine (head recordsLines)
                                    let ext = Extent vert vert
                                    print $ processLines recordsLines ext

main :: IO()
main = do
        args <- getArgs
        case args of
            [] -> do
                putStrLn "Missing file path"                    
            xs -> do
                    processFile (head xs)
                    return()

文本文件包含用空格字符分隔的三个浮点数的行。该程序总是试图占用计算机上的所有空闲内存，并因内存不足错误而崩溃。

- KolKir

---

注意：我认为你在addToExtent中犯了一个错误，请查看我的答案中添加的注释。 - Daniel Fischer

谢谢，是的，这是一个错误。我会修复它。 - KolKir

你使用的 GHC 版本是什么，以及你是如何编译的？ - jberryman

Answer 1

你太懒了。 Vertex 和 Extent 有非严格字段，并且所有返回 Vertex 的函数都返回。

Vertex thunk1 thunk2

不强制评估组件。另外，addToExtent 直接返回一个

Extent thunk1 thunk2

在不评估组件的情况下。

因此，在尚未从中解析出Double时，没有一个ByteString实际上被提前释放以进行垃圾回收。

当通过使Vertex和Extent的字段严格化或者强制返回Vertex resp. Extent函数的所有部分来解决这个问题时，你会发现问题是

processLines strs ext = foldr (\x y -> addToExtent y (parseLine x)) ext strs

在到达行列表的末尾之前，无法开始组装结果，因为这样做会导致

(\x y -> addToExtent y (parseLine x))

在第二个参数严格的情况下。

然而，除了NaN和未定义的值之外，如果我没有漏掉什么，使用（严格！）左折叠将得到相同的结果，因此：

processLines strs ext = foldl' (\x y -> addToExtent x (parseLine y)) ext strs

如果Vertex和Extent是严格字段，那么应该在不保留数据的情况下产生所需的结果。

---

啊，我漏掉了一些东西：

addToExtent ext vert = Extent vertMax vertMin
  where
    (vertMin, vertMax) = (makeCmpVert max (extentMax ext) vert, makeCmpVert min (extentMin ext)

如果这不是一个打字错误（我认为它是），那么修复它可能会有一定难度。

我觉得应该是：

    (vertMax, vertMin) = ...

- Daniel Fischer

---

谢谢你的答案，当我使数据字段严格并使用了strict fold（我尝试过这些选项分开使用，但没有效果）时，它确实解决了我的问题。但是如何知道惰性将会结束，你能推荐一些阅读材料吗？ - KolKir

我认为《实际的 Haskell》在某种程度上涉及了惰性与严格性的问题，但这主要是通过经验来学习的。你需要通过经验来判断何时使用惰性有益，何时不是，并确定如何修复空间泄漏（在确定它们是由太多惰性还是太多严格性引起之后）。 - Daniel Fischer

我已经读过这本书，但是如何正确使用惰性我还无法理解。正如你所说，似乎我需要更多的实践。 - KolKir

Answer 2

addToExtent过于懒惰。一个可能的替代定义是

addToExtent :: Extent -> Vertex -> Extent
addToExtent ext vert = vertMax `seq` vertMin `seq` Extent vertMax vertMin where
  (vertMin, vertMax) = (makeCmpVert max (extentMax ext) vert, makeCmpVert min (extentMinext) vert) where
    makeCmpVert f v1 v2 = Vertex(f (vertexX v1) (vertexX v2))
                      (f (vertexY v1) (vertexY v2))
                      (f (vertexZ v1) (vertexZ v2))

data Vertex = 
    Vertex{
     vertexX :: {-# UNPACK #-} !Double,
     vertexY :: {-# UNPACK #-} !Double,
     vertexZ :: {-# UNPACK #-} !Double}
    deriving (Eq, Show, Read)

问题在于，直到整个文件被处理完毕，vertMin和vertMax才会被评估——这导致了Extent中的两个巨大的thunk。

我还建议更改Extent的定义为：

data Extent = 
    Extent{
     extentMax :: !Vertex,
     extentMin :: !Vertex}
    deriving (Eq, Show, Read)

（虽然有这些更改，但在addToExtent中的seq调用变得多余。）

- ScootyPuff