堆棧空間溢出（可能與mapM有關）

Question

我正在編寫一個程序，它爲目錄中的每個映像文件創建一個包含一個命令的shell腳本。目錄中有667,944張圖片，所以我需要正確處理嚴格性/懶惰問題。

下面是一個簡單的例子，它給我Stack space overflow。如果我使用+RTS -Ksize -RTS給它更多的空間，它確實有效，但是應該能夠在內存很小的情況下運行，立即生成輸出。所以我一直在閱讀關於Haskell wiki和Haskell上的wikibook的嚴格內容，試圖找出如何解決這個問題，並且我認爲它是mapM命令之一，它讓我感到悲傷，但我仍然對解決問題的嚴格程度不夠了解。

我發現了一些其他問題似乎相關（Is mapM in Haskell strict? Why does this program get a stack overflow?和Is Haskell's mapM not lazy?），但啓發仍然沒有我。

import System.Environment (getArgs) 
import System.Directory (getDirectoryContents) 

genCommand :: FilePath -> FilePath -> FilePath -> IO String 
genCommand indir outdir file = do 
    let infile = indir ++ '/':file 
    let angle = 0 -- have to actually read the file to calculate this for real 
    let outfile = outdir ++ '/':file 
    return $! "convert " ++ infile ++ " -rotate " ++ show angle ++ 
    " -crop 143x143+140+140 " ++ outfile 

main :: IO() 
main = do 
    putStrLn "#!/bin/sh" 
    (indir:outdir:_) <- getArgs 
    files <- getDirectoryContents indir 
    let imageFiles = filter (`notElem` [".", ".."]) files 
    commands <- mapM (genCommand indir outdir) imageFiles 
    mapM_ putStrLn commands 

---

編輯：TEST＃1

這裏的例子的最新版本。我使用ghc --make -O2 amy2.hs -rtsopts命令編譯它。如果我用命令./amy2 ~/nosync/GalaxyZoo/table2/images/ wombat運行它，我得到

TEST 1 
Stack space overflow: current size 8388608 bytes. 
Use `+RTS -Ksize -RTS' to increase it. 

如果我不是用命令./amy2 ~/nosync/GalaxyZoo/table2/images/ wombat +RTS -K20M運行它，我得到正確的輸出...最後：

TEST 1 
667946 
convert /home/amy/nosync/GalaxyZoo/table2/images//587736546846572812.jpeg -rotate 0 -crop 143x143+140+140 wombat/587736546846572812.jpeg 
convert /home/amy/nosync/GalaxyZoo/table2/images//587736542558617814.jpeg -rotate 0 -crop 143x143+140+140 wombat/587736542558617814.jpeg 

...等上。

Answer 1

這不是一個嚴格的問題（*），而是一個評估問題的順序。與懶惰評估的純粹價值觀不同，單子效應必須以確定性的順序發生。 mapM執行給定列表中的每個動作並收集結果，但在執行整個動作列表之前它不能返回，因此您不會獲得與純列表函數相同的流動行爲。

在這種情況下的簡單解決方法是在相同的mapM_內同時運行genCommand和putStrLn。請注意，由於mapM_未構建中間列表，因此不會遇到同樣的問題。

mapM_ (genCommand indir outdir >=> putStrLn) imageFiles 

上面使用了「kleisli組合物運算符」 >=>從Control.Monad這就好比功能組合物操作者.除了一元函數。您也可以使用普通綁定和lambda。

mapM_ (\filename -> genCommand indir outdir filename >>= putStrLn) imageFiles 

對於您要小，單子流處理器之間更好的組合性更復雜的I/O的應用程序，你應該使用一個庫如conduit或pipes。

此外，請確保您正在編譯-O或-O2。

（*）確切地說，它是也一個嚴格的問題，因爲除了在內存中建立一個大型的，中間列表，懶惰導致mapM建立不必要的thunk，並使用了棧。

編輯：所以它似乎主要的罪魁禍首可能是getDirectoryContents。查看函數source code，它實質上在內部執行與mapM相同類型的列表累積。

爲了做流式目錄列表，我們需要使用System.Posix.Directory，這不幸使得該程序與非POSIX系統（如Windows）不兼容。你可以通過例如流式傳輸目錄內容。使用延續傳遞風格

import System.Environment (getArgs) 
import Control.Monad ((>=>)) 

import System.Posix.Directory (openDirStream, readDirStream, closeDirStream) 
import Control.Exception (bracket) 

genCommand :: FilePath -> FilePath -> FilePath -> IO String 
genCommand indir outdir file = do 
    let infile = indir ++ '/':file 
    let angle = 0 -- have to actually read the file to calculate this for real 
    let outfile = outdir ++ '/':file 
    return $! "convert " ++ infile ++ " -rotate " ++ show angle ++ 
    " -crop 143x143+140+140 " ++ outfile 

streamingDirContents :: FilePath -> (FilePath -> IO()) -> IO() 
streamingDirContents root cont = do 
    let loop stream = do 
      fp <- readDirStream stream 
      case fp of 
       [] -> return() 
       _ | fp `notElem` [".", ".."] -> cont fp >> loop stream 
        | otherwise -> loop stream 
    bracket (openDirStream root) loop closeDirStream 


main :: IO() 
main = do 
    putStrLn "TEST 1" 
    (indir:outdir:_) <- getArgs 
    streamingDirContents indir (genCommand indir outdir >=> putStrLn) 

這裏是你如何能使用conduit做同樣的事情：

import System.Environment (getArgs) 

import System.Posix.Directory (openDirStream, readDirStream, closeDirStream) 

import Data.Conduit 
import qualified Data.Conduit.List as L 
import Control.Monad.IO.Class (liftIO, MonadIO) 

genCommand :: FilePath -> FilePath -> FilePath -> IO String 
genCommand indir outdir file = do 
    let infile = indir ++ '/':file 
    let angle = 0 -- have to actually read the file to calculate this for real 
    let outfile = outdir ++ '/':file 
    return $! "convert " ++ infile ++ " -rotate " ++ show angle ++ 
    " -crop 143x143+140+140 " ++ outfile 

dirSource :: (MonadResource m, MonadIO m) => FilePath -> Source m FilePath 
dirSource root = do 
    bracketP (openDirStream root) closeDirStream $ \stream -> do 
     let loop = do 
       fp <- liftIO $ readDirStream stream 
       case fp of 
        [] -> return() 
        _ -> yield fp >> loop 
     loop 

main :: IO() 
main = do 
    putStrLn "TEST 1" 
    (indir:outdir:_) <- getArgs 
    let files = dirSource indir $= L.filter (`notElem` [".", ".."]) 
     commands = files $= L.mapM (liftIO . genCommand indir outdir) 

    runResourceT $ commands $$ L.mapM_ (liftIO . putStrLn) 

的好處約conduit是你重獲撰寫的功能件事情像導管版本的功能filter和mapM。 $=運算符在鏈中向前流式傳輸，$$將流連接到消費者。

不太好的事情是，現實世界很複雜，編寫高效且健壯的代碼需要我們跳過一些資源管理的ho ho。這就是爲什麼所有的操作都在ResourceT monad變壓器中工作，這個變壓器可以跟蹤例如打開文件句柄，並在不再需要時例如確定性地清理它們，或者例如如果計算被異常中止（這與使用惰性I/O並依靠垃圾回收器最終釋放稀缺資源形成對比）。

然而，這意味着我們一）需要與runResourceT和B）我們需要運行最終導致管道操作使用liftIO，而不是能夠直接明確地解除I/O操作的轉化單子寫例如L.mapM_ putStrLn。