优化一个被多次调用的简单解析器

Question

我使用attoparsec为自定义文件编写了一个解析器。分析报告指出，大约67%的内存分配是在一个名为tab的函数中完成的，这个函数也消耗了最多的时间。tab函数非常简单:

tab :: Parser Char
tab = char 't'

整个分析报告如下:

       ASnapshotParser +RTS -p -h -RTS
    total time  =       37.88 secs   (37882 ticks @ 1000 us, 1 processor)
    total alloc = 54,255,105,384 bytes  (excludes profiling overheads)
COST CENTRE    MODULE                %time %alloc
tab            Main                   83.1   67.7
main           Main                    6.4    4.2
readTextDevice Data.Text.IO.Internal   5.5   24.0
snapshotParser Main                    4.7    4.0

                                                             individual     inherited
COST CENTRE        MODULE                  no.     entries  %time %alloc   %time %alloc
MAIN               MAIN                     75           0    0.0    0.0   100.0  100.0
 CAF               Main                    149           0    0.0    0.0   100.0  100.0
  tab              Main                    156           1    0.0    0.0     0.0    0.0
  snapshotParser   Main                    153           1    0.0    0.0     0.0    0.0
  main             Main                    150           1    6.4    4.2   100.0  100.0
   doStuff         Main                    152     1000398    0.3    0.0    88.1   71.8
    snapshotParser Main                    154           0    4.7    4.0    87.7   71.7
     tab           Main                    157           0   83.1   67.7    83.1   67.7
   readTextDevice  Data.Text.IO.Internal   151       40145    5.5   24.0     5.5   24.0
 CAF               Data.Text.Array         142           0    0.0    0.0     0.0    0.0
 CAF               Data.Text.Internal      140           0    0.0    0.0     0.0    0.0
 CAF               GHC.IO.Handle.FD        122           0    0.0    0.0     0.0    0.0
 CAF               GHC.Conc.Signal         103           0    0.0    0.0     0.0    0.0
 CAF               GHC.IO.Encoding         101           0    0.0    0.0     0.0    0.0
 CAF               GHC.IO.FD               100           0    0.0    0.0     0.0    0.0
 CAF               GHC.IO.Encoding.Iconv    89           0    0.0    0.0     0.0    0.0
  main             Main                    155           0    0.0    0.0     0.0    0.0

我如何优化这个?

解析器的完整代码在这里。我解析的文件大约77MB。

Answer 1

tab是替罪羊。如果您定义boo :: Parser (); boo = return ()并在snapshotParser定义中的每个绑定之前插入boo，则成本分配将变成如下内容:

 main             Main                    255           0   11.8   13.8   100.0  100.0
  doStuff         Main                    258     2097153    1.1    0.5    86.2   86.2
   snapshotParser Main                    260           0    0.4    0.1    85.1   85.7
    boo           Main                    262           0   71.0   73.2    84.8   85.5
     tab          Main                    265           0   13.8   12.3    13.8   12.3

因此，似乎分析器正在转移解析结果分配的责任，可能是由于attoparsec代码的广泛内联，正如John L在评论中建议的那样。

至于性能问题，关键在于，当您解析一个77MB的文本文件以构建一个包含一百万个元素的列表时，您希望文件处理是惰性的，而不是严格的。一旦解决了这个问题，在doStuff中解耦I/O和解析以及构建不带累加器的快照列表也会很有帮助。这是你的程序的修改版本，考虑到这一点。

{-# LANGUAGE BangPatterns #-}
module Main where
import Data.Maybe
import Data.Attoparsec.Text.Lazy
import Control.Applicative
import qualified Data.Text.Lazy.IO as TL
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
buildStuff :: TL.Text -> [Snapshot]
buildStuff text = case maybeResult (parse endOfInput text) of
  Just _ -> []
  Nothing -> case parse snapshotParser text of
      Done !i !r -> r : buildStuff i
      Fail _ _ _ -> []
main :: IO ()
main = do
  text <- TL.readFile "./snap.dat"
  let ss = buildStuff text
  print $ listToMaybe ss
    >> Just (fromIntegral (length $ show ss) / fromIntegral (length ss))
newtype VehicleId = VehicleId Int deriving Show
newtype Time = Time Int deriving Show
newtype LinkID = LinkID Int deriving Show
newtype NodeID = NodeID Int deriving Show
newtype LaneID = LaneID Int deriving Show
tab :: Parser Char
tab = char 't'
-- UNPACK pragmas. GHC 7.8 unboxes small strict fields automatically;
-- however, it seems we still need the pragmas while profiling. 
data Snapshot = Snapshot {
  vehicle :: {-# UNPACK #-} !VehicleId,
  time :: {-# UNPACK #-} !Time,
  link :: {-# UNPACK #-} !LinkID,
  node :: {-# UNPACK #-} !NodeID,
  lane :: {-# UNPACK #-} !LaneID,
  distance :: {-# UNPACK #-} !Double,
  velocity :: {-# UNPACK #-} !Double,
  vehtype :: {-# UNPACK #-} !Int,
  acceler :: {-# UNPACK #-} !Double,
  driver :: {-# UNPACK #-} !Int,
  passengers :: {-# UNPACK #-} !Int,
  easting :: {-# UNPACK #-} !Double,
  northing :: {-# UNPACK #-} !Double,
  elevation :: {-# UNPACK #-} !Double,
  azimuth :: {-# UNPACK #-} !Double,
  user :: {-# UNPACK #-} !Int
  } deriving (Show)
-- No need for bang patterns here.
snapshotParser :: Parser Snapshot
snapshotParser = do
  sveh <- decimal
  tab
  stime <- decimal
  tab
  slink <- decimal
  tab
  snode <- decimal
  tab
  slane <- decimal
  tab
  sdistance <- double
  tab
  svelocity <- double
  tab
  svehtype <- decimal
  tab
  sacceler <- double
  tab
  sdriver <- decimal
  tab
  spassengers <- decimal
  tab
  seasting <- double
  tab
  snorthing <- double
  tab
  selevation <- double
  tab
  sazimuth <- double
  tab
  suser <- decimal
  endOfLine <|> endOfInput
  return $ Snapshot
    (VehicleId sveh) (Time stime) (LinkID slink) (NodeID snode)
    (LaneID slane) sdistance svelocity svehtype sacceler sdriver
    spassengers seasting snorthing selevation sazimuth suser

这个版本应该具有可接受的性能，即使您强制将整个快照列表放入内存中，就像我在main中所做的那样。要衡量什么是"可接受的"，请记住，给定每个Snapshot中的16个(小的，未装箱的)字段加上Snapshot和列表构造器的开销，我们谈论的是每个列表单元格152字节，对于您的测试数据，这归结为~152MB。在任何情况下，这个版本都是尽可能的懒惰，你可以看到在main中删除除法，或者用last ss替换它。

注意:我的测试用的是atoparsec -0.12。

Answer 2

将attoparsec更新到最新版本(0.12.0.0)后，执行所需的时间从38秒减少到16秒。这是超过50%的加速。此外，它所消耗的内存也大大减少了。正如@JohnL所指出的，启用了分析后，结果会有很大的不同。当我尝试使用最新版本的attoparsec库对其进行分析时，执行整个程序大约需要64秒。