och*_*les 10 performance parsing haskell memory-leaks
我正在尝试为Wavefront .obj文件格式编写一个解析器,这是一种非常愚蠢的基于行的格式.希望维基百科文章应该总结它是如何工作的,但基本上你有行记录顶点,普通和其他数组中的条目.最后,面定义是这些单独数组中的三个(或更多)索引.
我的解析器是
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module WavefrontObj where
import Control.Applicative
import Data.Attoparsec.Text
import Data.Foldable (toList)
import Data.List (foldl')
import Data.List.Split
import Data.Monoid
import Data.NonEmpty ((!:))
import Data.Sequence (Seq)
import Geometry
import Graphics.GL
import Linear
import Linear.Affine
import qualified Data.Sequence as Seq
data Obj =
Obj {objVertices :: !(Seq (V3 Double))
,objNormals :: !(Seq (V3 Double))
,objFaces :: !(Seq (V2 (V3 Int)))}
deriving (Show)
instance Monoid Obj where
mempty = Obj mempty mempty mempty
Obj a b c `mappend` Obj x y z =
Obj (a <> x)
(b <> y)
(c <> z)
parseLine :: Parser Obj
parseLine =
vertex <|> normal <|> face <|>
(mempty <$ skipWhile (not . isEndOfLine))
where vertex =
do string "v"
skipSpace
v <- v3
return $!
Obj (Seq.singleton v) mempty mempty
normal =
do string "vn"
skipSpace
v <- v3
return $!
Obj mempty (Seq.singleton v) mempty
face =
do string "f"
skipSpace
let v =
(,) <$> decimal <* char '/' <* decimal <* char '/' <*> decimal
(v1,n1) <- v
skipSpace
(v2,n2) <- v
skipSpace
(v3,n3) <- v
mv4 <-
optional (do skipSpace
v)
return $!
Obj mempty
mempty
(Seq.singleton
(V2 (V3 v1 v2 v3)
(V3 n1 n2 n3)) <>
case mv4 of
Just (v4,n4) ->
Seq.singleton
(V2 (V3 v1 v3 v4)
(V3 n1 n3 n4))
Nothing -> mempty)
v3 =
do x <- double
skipSpace
y <- double
skipSpace
z <- double
return $! V3 x y z
parseObj :: Parser Obj
parseObj = go mempty
where go !acc =
do !l <- parseLine
acc' <- return $! acc <> l
endOfLine *> go acc' <|> acc' <$ endOfInput
使用36MB obj文件运行它可以成功解析,但是
21,342,866,200 bytes allocated in the heap
1,263,590,520 bytes copied during GC
290,617,624 bytes maximum residency (10 sample(s))
56,958,112 bytes maximum slop
547 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 41177 colls, 0 par 0.711s 0.708s 0.0000s 0.0008s
Gen 1 10 colls, 0 par 0.241s 0.241s 0.0241s 0.1669s
INIT time 0.000s ( 0.000s elapsed)
MUT time 5.071s ( 5.077s elapsed)
GC time 0.952s ( 0.949s elapsed)
RP time 0.000s ( 0.000s elapsed)
PROF time 0.000s ( 0.000s elapsed)
EXIT time 0.020s ( 0.020s elapsed)
Total time 6.055s ( 6.046s elapsed)
%GC time 15.7% (15.7% elapsed)
Alloc rate 4,208,709,362 bytes per MUT second
Productivity 84.3% of total user, 84.4% of total elapsed
虽然生产力很好,但打开一个.obj总内存使用量为547MB 的文件需要6秒钟.我在这里上传了一个堆配置文件.该.prof文件是
Fri Jun 5 22:36 2015 Time and Allocation Profiling Report (Final)
Deferred +RTS -p -RTS
total time = 5.17 secs (5173 ticks @ 1000 us, 1 processor)
total alloc = 13,142,553,520 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
parseLine.v3 WavefrontObj 69.8 69.5
parseLine.face.v WavefrontObj 8.4 13.7
parseLine.face WavefrontObj 7.0 6.1
timeLog Deferred 3.3 1.2
parseLine WavefrontObj 2.8 1.7
parseLine.normal WavefrontObj 2.5 3.6
readTextDevice Data.Text.Internal.IO 2.2 0.1
parseLine.vertex WavefrontObj 1.7 2.6
mappend WavefrontObj 1.4 1.1
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 85 0 0.0 0.0 100.0 100.0
main Deferred 171 0 0.0 0.0 100.0 100.0
timeLog Deferred 173 0 3.3 1.2 100.0 100.0
parseObj WavefrontObj 178 0 0.0 0.0 94.4 98.7
parseObj.go WavefrontObj 179 1080806 0.6 0.5 94.4 98.7
parseLine WavefrontObj 181 0 2.8 1.7 93.8 98.2
parseLine.v3 WavefrontObj 190 0 69.7 69.5 70.8 70.3
mappend WavefrontObj 191 667027 1.0 0.8 1.0 0.8
parseLine.face WavefrontObj 187 0 7.0 6.1 16.9 21.3
parseLine.face.v WavefrontObj 195 0 8.4 13.7 9.7 15.2
parseLine.normal WavefrontObj 196 0 0.9 1.3 1.2 1.5
mappend WavefrontObj 197 127769 0.3 0.3 0.3 0.3
parseLine.normal WavefrontObj 193 0 0.0 0.0 0.0 0.0
mappend WavefrontObj 188 286011 0.1 0.0 0.1 0.0
parseLine.normal WavefrontObj 185 0 1.5 2.3 1.6 2.3
parseLine.v3 WavefrontObj 192 0 0.1 0.0 0.1 0.0
parseLine.vertex WavefrontObj 183 0 1.7 2.6 1.7 2.6
readTextDevice Data.Text.Internal.IO 174 18260 2.2 0.1 2.2 0.1
CAF Deferred 169 0 0.0 0.0 0.0 0.0
main Deferred 170 1 0.0 0.0 0.0 0.0
timeLog Deferred 172 1 0.0 0.0 0.0 0.0
CAF WavefrontObj 166 0 0.0 0.0 0.0 0.0
parseLine WavefrontObj 180 1 0.0 0.0 0.0 0.0
parseLine.v3 WavefrontObj 189 1 0.0 0.0 0.0 0.0
parseLine.face WavefrontObj 186 1 0.0 0.0 0.0 0.0
parseLine.face.v WavefrontObj 194 1 0.0 0.0 0.0 0.0
parseLine.normal WavefrontObj 184 1 0.0 0.0 0.0 0.0
parseLine.vertex WavefrontObj 182 1 0.0 0.0 0.0 0.0
mempty WavefrontObj 176 1 0.0 0.0 0.0 0.0
parseObj WavefrontObj 175 1 0.0 0.0 0.0 0.0
parseObj.go WavefrontObj 177 1 0.0 0.0 0.0 0.0
CAF Data.Attoparsec.Text.Internal 153 0 0.0 0.0 0.0 0.0
CAF Data.Scientific 152 0 0.0 0.0 0.0 0.0
CAF Data.Text.Array 150 0 0.0 0.0 0.0 0.0
CAF Data.Text.Internal 148 0 0.0 0.0 0.0 0.0
CAF GHC.Err 135 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.FD 132 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.Internals 131 0 0.0 0.0 0.0 0.0
CAF GHC.Conc.Signal 125 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding 121 0 0.0 0.0 0.0 0.0
CAF GHC.IO.FD 120 0 0.0 0.0 0.0 0.0
CAF GHC.Conc.Sync 108 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding.Iconv 106 0 0.0 0.0 0.0 0.0
CAF GHC.Integer.Type 92 0 0.0 0.0 0.0 0.0
我猜测看到我的热点是v3解析器,这可能与使用double解析器有关.
根据我的经验，基于行的格式解析的答案是使用BS.linesand BS.wordsfrom Data.ByteString.Char8。它并不是很漂亮，但是没有解析器组合器方法同时具有同样的速度或内存效率。就像是 ：
parseLine :: BS.ByteString -> [Either Xxx Obj]
parseLine = map prs . BS.lines
prs :: BS.ByteString -> Either Xxx Obj
prs l = case BS.words l of
["v", x, y, z] -> do
v <- V3 <$> parseDouble x <*> parseDouble y <*> parseDouble z
return $ Obj (Seq.singleton v) mempty mempty
...
_ -> Left "blah"
那是为了性能。对于内存使用，您可能通常需要使用原始向量和解包数据类型。在您的示例中似乎并非如此，但您还需要检查您使用的库如何实现其数据类型。例如UTCTime来自time包使用大量内存。
最后提示：我通常使用它们使用的“字符串”类型来参数化我的数据类型。我的解析器函数返回Foo ByteString，然后我将其转换为Foo Text将保留在内存中并进行操作的子集。