Perché il mio programma Haskell termina con un errore di memoria insufficiente?

Question

Sto provando a scrivere un programma Haskell per analizzare un enorme file di testo (circa 14 Gb), ma non riesco a capire come liberare i dati inutilizzati dalla memoria o non fare overflow dello stack durante foldr. Ecco la fonte del programma:

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() 

Il file di testo contiene righe con tre numeri in virgola mobile delimitati da caratteri dello spazio. Questo programma cerca sempre di occupare tutta la memoria libera su un computer e si blocca con un errore di memoria insufficiente.

Answer 1

Sei troppo pigro. Vertex e Extent hanno campi non rigorosi, e tutte le funzioni di restituire un Vertex ritorno

Vertex thunk1 thunk2 

senza forzare i componenti da valutare. Anche addToExtent restituisce direttamente un

Extent thunk1 thunk2 

senza valutare i componenti.

Quindi nessuno degli ByteString s viene effettivamente rilasciato in anticipo per essere sottoposto a raccolta dei dati inutili, poiché gli Double non vengono ancora analizzati da essi.

Quando viene risolto rendendo i campi di Vertex e Extent strict - o le funzioni restituiscono un Vertex resp. Extent costringendo tutte le parti del loro ingresso, si ha il problema che

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

non può iniziare ad assemblare il risultato prima della fine della lista delle linee viene raggiunto perché poi

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

è rigorosa nella sua secondo argomento.

Tuttavia, salvo NaN s e valori non definiti, se non ho perso qualcosa, il risultato sarebbe lo stesso se si utilizza un (stretta!) Sinistra piega, così

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

dovrebbe produrre la desiderata risultato senza aggrapparsi ai dati se Vertex e Extent ottengono campi rigorosi.

---

Ah, mi manca qualcosa:

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

Se questo non è un errore di battitura (quello che mi aspetto che è), fissaggio che sarebbe un po 'difficile.

Penso che dovrebbe essere

(vertMax, vertMin) = ... 

Answer 2

addToExtent è troppo pigro. Una possibile definizione alternativa è

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) 

Il problema è che vertMin e vertMax non sono mai valutati fino a quando l'intero file viene elaborato - portato a due thunk enormi in Extent.

Consiglio anche cambiare la definizione di Extent per

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

(anche se con queste modifiche, le chiamate in seqaddToExtent diventano ridondanti).