Почему моя программа Haskell заканчивается ошибкой памяти?

Question

Я пытаюсь написать программу Haskell для синтаксического анализа огромного текстового файла (около 14 Гб), но я не могу понять, как освободить неиспользуемые данные из памяти или нет, чтобы сделать переполнение стека во время 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() 

Текстовый файл содержит строки с тремя числами с плавающей запятой, обозначенными символом пробела. Эта программа всегда пытается занять всю свободную память на компьютере и выходит из строя с ошибкой памяти.

Answer 1

Вы слишком ленивы. Vertex и Extent имеют нестрогие поля, и все ваши функции возвращают Vertex возвращения

Vertex thunk1 thunk2 

без принуждения компонентов для оценки. Также addToExtent непосредственно возвращает

Extent thunk1 thunk2 

без оценки компонентов.

Таким образом, ни один из ByteString s фактически не выпущен раньше, чтобы быть собранным с мусором, так как Double s еще не разбираются в них.

Если это исправлено, сделав поля Vertex и Extent строгими - или функции, возвращающие Vertex соответственно. 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) = ... 

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.

Я также рекомендую изменить определение Extent к

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

(хотя с этими изменениями, то seq вызовы в addToExtent становятся лишними).