为什么我的Haskell程序以内存不足错误结束?

Kol*_*Kir 5 memory haskell

我正在尝试编写一个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()
Run Code Online (Sandbox Code Playgroud)

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

Dan*_*her 5

你太懒了.Vertex并且Extent具有非严格字段,并且所有函数都返回Vertex返回

Vertex thunk1 thunk2
Run Code Online (Sandbox Code Playgroud)

无需强制评估组件.也addToExtent直接返回一个

Extent thunk1 thunk2
Run Code Online (Sandbox Code Playgroud)

没有评估组件.

因此,ByteString实际上没有一个s被提前释放以进行垃圾收集,因为Doubles尚未从它们中解析出来.

当通过使字段VertexExtent严格 - 或函数返回Vertexresp 来修复它.Extent迫使他们输入的所有部分,你有问题

processLines strs ext = foldr (\x y -> addToExtent y (parseLine x)) ext strs
Run Code Online (Sandbox Code Playgroud)

因为那时,在到达行列表的末尾之前无法开始汇编结果

(\x y -> addToExtent y (parseLine x))
Run Code Online (Sandbox Code Playgroud)

第二个论点是严格的.

但是,除非NaNs和未定义的值,如果我没有错过任何东西,如果你使用(严格!)左折叠,结果将是相同的,所以

processLines strs ext = foldl' (\x y -> addToExtent x (parseLine y)) ext strs
Run Code Online (Sandbox Code Playgroud)

应该产生期望的结果,而不持有的数据,如果VertexExtent得到严格的领域.


啊,我确实错过了一些东西:

addToExtent ext vert = Extent vertMax vertMin
  where
    (vertMin, vertMax) = (makeCmpVert max (extentMax ext) vert, makeCmpVert min (extentMin ext)
Run Code Online (Sandbox Code Playgroud)

如果这不是一个拼写错误(我期望它),修复这将有点困难.

我认为应该是

    (vertMax, vertMin) = ...
Run Code Online (Sandbox Code Playgroud)