performance - 提高基于文本的 XML 渲染器的生产力和性能

Question

我正在尝试为 XML.Light 数据类型编写高效的 XML 呈现器，并且我正在尝试使用 Data.Text.Lazy.Builder 来实现这一点，因为这似乎是一个显而易见的选择。但是，我很难从我的解决方案中获得任何性能:

{-# LANGUAGE OverloadedStrings #-}
import Data.Text (Text, unpack)
import Text.XML.Light
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as LB

import Data.Foldable (foldMap)
import Data.Monoid (mconcat)

data Tag = Tag !Text

data Artist = Artist { artistName :: !Text , artistTags :: ![Tag] }

class ToXML a where toXML :: a -> Content

instance ToXML Artist where
  toXML a = Elem $
    Element (unqual "artist") []
      [ text (artistName a)
      , Elem $ Element (unqual "tag-list") []
          (map toXML (artistTags a))
          Nothing
      ]
      Nothing

instance ToXML Tag where
  toXML (Tag t) = Elem $ Element (unqual "tag") [] [ text t ] Nothing

text :: Text -> Content
text t = Text $ CData CDataText (unpack t) Nothing

render :: Content -> LB.Builder
render (Elem e) = renderElement e
render (Text s) = LB.fromString (cdData s)

renderElement :: Element -> LB.Builder
renderElement element = mconcat
  [ LB.singleton '<'
  , LB.fromString . qName . elName $ element
  , LB.singleton '>'
  , foldMap render (elContent element)
  , LB.fromText "</"
  , LB.fromString . qName .elName $ element
  , LB.singleton '>'
  ]

main :: IO ()
main = let artist = Artist "Nirvana" (replicate 5000000 (Tag "Hi"))
           xml = Element (unqual "metadata") [] [ toXML artist ] Nothing
       in print (LT.length . LB.toLazyText . renderElement $ xml)

根据+RTS -s:

   7,368,153,472 bytes allocated in the heap
   2,625,983,944 bytes copied during GC
     708,149,024 bytes maximum residency (13 sample(s))
      21,954,496 bytes maximum slop
            1443 MB total memory in use (0 MB lost due to fragmentation)

                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0     14270 colls,     0 par    1.65s    1.69s     0.0001s    0.0009s
  Gen  1        13 colls,     0 par    2.57s    2.80s     0.2157s    1.2388s

  TASKS: 3 (1 bound, 2 peak workers (2 total), using -N1)

  SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)

  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    1.81s  (  1.84s elapsed)
  GC      time    4.22s  (  4.50s elapsed)
  EXIT    time    0.07s  (  0.09s elapsed)
  Total   time    6.11s  (  6.43s elapsed)

  Alloc rate    4,064,658,288 bytes per MUT second

  Productivity  30.8% of total user, 29.3% of total elapsed

这太糟糕了。不仅生产力最低，而且在堆中分配了超过 7GiB 来呈现 64MB 的 XML。这似乎非常低效!但是，我不知道所有这些垃圾实际上是从哪里来的。我用 +RTS -p 生成了一个堆配置文件并用 hp2ps 渲染它:

我还使用 +RTS -l 运行它并使用 ThreadScope 渲染它:

遗憾的是，我现在不知道该怎么做，是将这些部分组合在一起以提高工作效率并降低内存使用量。我确实想知道 XML.Light 中的类型是否不是最佳的(没有严格性，String over Text)但仍然 - this 慢？

---

我还观察到一些我觉得有点奇怪的东西。如果我将 main 更改为:

main :: IO ()
main = let artist = Artist "Nirvana" (replicate 5000000 (Tag "Hi"))
           xml = Element (unqual "metadata") [] [ toXML artist ] Nothing
       in print (LT.length $ LB.toLazyText $ mconcat $ map (render.toXML) $ artistTags artist)

生产力飙升至 94%，所以这可能与 toXML 中的递归有关，这是有问题的并且过于懒惰。

Answer 1

我解决了这个问题，我认为这是 GHC 中的一个错误。

如果我们改变这一行:

, LB.fromString . qName . elName $ element

进入这个:

, LB.fromString $ qName . elName $ element

然后我们得到了我们期望的性能。似乎将 LB.fromString 与 qName 组合在一起可以防止一些内联，因此不会发生融合。我认为这真的很危险，所以我打算将这个问题移至 GHC 错误跟踪器的错误报告中，看看那里的聪明人是怎么想的。

谈谈陷阱!