我有一个37MB正在尝试转换为 ppm 序列的 bin 文件。它工作得很好，我试图用它作为练习来学习一些分析和更多关于 Haskell 中惰性字节串的信息。我的程序似乎在concatMap, 用于复制每个字节 3 次，所以我有 R、G 和 B。代码相当简单——每 2048 个字节我写一个新的标头：
{-# LANGUAGE OverloadedStrings #-}
import System.IO
import System.Environment
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as B
main :: IO ()
main = do [from, to] <- getArgs
withFile from ReadMode $ \inH ->
withFile to WriteMode $ \outH ->
loop (B.hGet inH 2048) (process outH) B.null
loop :: (Monad m) => m a -> (a -> m ()) -> (a -> Bool) -> m ()
loop inp outp done = inp >>= \x -> unless (done x) (outp x >> loop inp outp done)
process :: Handle -> B.ByteString -> IO ()
process h bs | B.null bs = return ()
| otherwise = B.hPut h header >> B.hPut h bs'
where header = "P6\n32 64\n255\n" :: B.ByteString
bs' = B.concatMap (B.replicate 3) bs
这有点过头了5s。这并不可怕，我唯一的比较是我非常幼稚的 C 实现，它做得有点差4s- 所以这或理想情况下是我的目标。
这是来自上述代码的 RTS：
33,435,345,688 bytes allocated in the heap
14,963,640 bytes copied during GC
54,640 bytes maximum residency (77 sample(s))
21,136 bytes maximum slop
2 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 64604 colls, 0 par 0.20s 0.25s 0.0000s 0.0001s
Gen 1 77 colls, 0 par 0.00s 0.01s 0.0001s 0.0006s
INIT time 0.00s ( 0.00s elapsed)
MUT time 5.09s ( 5.27s elapsed)
GC time 0.21s ( 0.26s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 5.29s ( 5.52s elapsed)
%GC time 3.9% (4.6% elapsed)
Alloc rate 6,574,783,667 bytes per MUT second
Productivity 96.1% of total user, 92.1% of total elapsed
相当粗糙的结果。当我删除 concatMap 并每隔 2048 字节复制所有内容时，它实际上是即时的：
70,983,992 bytes allocated in the heap
48,912 bytes copied during GC
54,640 bytes maximum residency (2 sample(s))
19,744 bytes maximum slop
1 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 204 colls, 0 par 0.00s 0.00s 0.0000s 0.0000s
Gen 1 2 colls, 0 par 0.00s 0.00s 0.0001s 0.0001s
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.01s ( 0.07s elapsed)
GC time 0.00s ( 0.00s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 0.02s ( 0.07s elapsed)
%GC time 9.6% (2.9% elapsed)
Alloc rate 5,026,838,892 bytes per MUT second
Productivity 89.8% of total user, 22.3% of total elapsed
所以我想我的问题有两个：
- 如何提高整体性能？
- 如果瓶颈不是那么明显，我可以通过哪些方法找到它？
谢谢你。
编辑
如果有人感兴趣，这是最终代码和 RTS！-prof -auto-all -caf-all在阅读了Real World Haskell的Profiling and optimization一章后，我还能够通过使用 ghc 的分析器找到额外的瓶颈。
{-# LANGUAGE OverloadedStrings #-}
import System.IO
import System.Environment
import Control.Monad
import Data.Monoid
import qualified Data.ByteString.Builder as BU
import qualified Data.ByteString.Lazy.Char8 as BL
main :: IO ()
main = do [from, to] <- getArgs
withFile from ReadMode $ \inH ->
withFile to WriteMode $ \outH ->
loop (BL.hGet inH 2048) (process outH) BL.null
loop :: (Monad m) => m a -> (a -> m ()) -> (a -> Bool) -> m ()
loop inp outp done = inp >>= \x -> unless (done x) (outp x >> loop inp outp done)
upConcatMap :: Monoid c => (Char -> c) -> BL.ByteString -> c
upConcatMap f bs = mconcat . map f $ BL.unpack bs
process :: Handle -> BL.ByteString -> IO ()
process h bs | BL.null bs = return ()
| otherwise = BU.hPutBuilder h frame
where header = "P6\n32 64\n255\n"
bs' = BU.toLazyByteString $ upConcatMap trip bs
frame = BU.lazyByteString $ mappend header bs'
trip c = let b = BU.char8 c in mconcat [b, b, b]
6,383,263,640 bytes allocated in the heap
18,596,984 bytes copied during GC
54,640 bytes maximum residency (2 sample(s))
31,056 bytes maximum slop
1 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 11165 colls, 0 par 0.06s 0.06s 0.0000s 0.0001s
Gen 1 2 colls, 0 par 0.00s 0.00s 0.0001s 0.0002s
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.69s ( 0.83s elapsed)
GC time 0.06s ( 0.06s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 0.75s ( 0.89s elapsed)
%GC time 7.4% (7.2% elapsed)
Alloc rate 9,194,103,284 bytes per MUT second
Productivity 92.6% of total user, 78.0% of total elapsed