我优化多年的 C 语言竟然被 80 行 Haskell 打败了？

Posted 2021-04-25 CSDN

本文并没有说Haskell比C“好”，也不会讨论任何一种语言的相对价值，更不会讨论它们的实现——本文只是简单地探索了高性能Haskell，同时尝试了一些有趣的技巧而已。

作者 | Chris Penner

译者 | 弯月，责编 | 郭芮

出品 | CSDN（ID：CSDNnews）

以下为译文：

尽管题目有些标题党，但我仍希望这篇文章能够对你有所启发，至少是一篇有意思的文章！本文并没有说Haskell比C“好”，也不会讨论任何一种语言的相对价值，更不会讨论它们的实现。本文只是简单地探索了高性能Haskell，同时尝试了一些有趣的技巧而已。

点击这里可以下载本文的源代码（https://github.com/ChrisPenner/wc）。

作为参考，我使用的是Mac版的wc；其参考源代码在此（https://opensource.apple.com/source/text_cmds/text_cmds-68/wc/wc.c.auto.html）。没错，其实还有更快的wc实现。

我们的问题是，利用我们喜欢的某种支持垃圾回收、基于运行时的高级语言——Haskell，编写一个wc工具，它要比手工优化过的C实现更快。听起来很简单，是吧？

下面是该任务的条件：

• 正确性：它应当返回被测试文件的正确的字符数、单词数和行数。

• 速度（真实世界的时间）：与wc的执行时间相比是快是慢？

• 最大常驻内存量：最多使用多少内存？内存使用量是常量还是线性的，或者是其他？

这些是我们需要关心的主要问题。

下面让我们开始吧。

最笨的实现

与往常一样，我们应该从最笨的实现开始，看看情况如何，然后再以此为起点继续前进。那么，用Haskell统计字符数、单词数和行数的最笨的方法是什么？我们可以读入文件，然后运行length、length . words和length . lines来获得计数。

1stupid :: FilePath -> IO (Int, Int, Int)
2stupid fp = do
3    contents <- readFile fp
4    return (length s, length (words s), length (lines s))

很不错，这段代码能正常运行，并且能获得与wc相同的结果——如果你愿意等的话。而我在测试大文件时开始不耐烦（它需要几分钟的时间），但在小文件（90MB）上的测试结果如下：

90MB的测试文件

嗯……不用我说你也知道，改进的空间非常大……

略微好一点的实现

我们来看看为什么上述代码的性能如此差。

首先，我们遍历了三遍整个文件内容！这也意味着，在遍历过程中，GHC不能对列表进行垃圾回收，因为在其他地方依然要用到该列表。结果就是，文件中的每个字符都在链表里存储下来，这也是为什么仅有90MB的文件占据了2.4GB内存的原因！哎呦！

好吧，这个方法实在是不怎么样，我们来看看如果只遍历一次会怎样。我们只需要累加三个数字，所以也许可以同时处理它们？遍历列表获得最终结果，很自然地我想到了fold操作！

用fold来统计字符数或行数非常容易：遇到一个字符给合计值加1，当前字符为新行时给行计数加1，那单词数怎么办？我们无法简单地在遇到空格时加1，因为连续的空给不应该算作一个新单词！我们需要跟踪前一个字符是否为空格，只有当开始一个新单词时才给计数器加1。这并不难实现，下面的实现使用了Data.List中的foldl'：

 1import Data.List
 2import Data.Char
 3
 4simpleFold :: FilePath -> IO (Int, Int, Int)
 5simpleFold fp = do
 6    countFile <$> readFile fp
 7
 8countFile :: String -> (Int, Int, Int)
 9countFile s =
10    let (cs, ws, ls, _) = foldl' go (0, 0, 0, False) s
11     in (cs, ws, ls)
12  where
13    go :: (Int, Int, Int, Bool) -> Char -> (Int, Int, Int, Bool)
14    go (cs, ws, ls, wasSpace) c =
15        let addLine | c == '\n' = 1
16                    | otherwise = 0
17            addWord | wasSpace = 0
18                    | isSpace c = 1
19                    | otherwise = 0
20         in (cs + 1, ws + addWord, ls + addLine, isSpace c)

结果这个版本遇到了更严重的问题！

程序运行花了几分钟，内存占用迅速超过了3GB！为什么会这样呢？我们使用的是严格版本的foldl'（后面的撇号 ' 表示它是严格的），但它只在“Weak Head Normal Form”（WHNF）中是严格的，也就是说，它在元组累加器中是严格的，但在实际的值中不是严格的！

这很讨厌，因为这意味着我们构造了一大堆巨大的加法操作，但只有在整个文件遍历结束后才进行求值！有时候，懒惰求值就会像这样偷偷地给我们挖坑。如果不注意，这种内存泄漏很容易就会搞垮你的Web服务器。

90MB测试文件

改正这一点只需告诉GHC在每次遍历时对内容进行严格求值。最容易的方法就是利用BangPatterns扩展，我们可以在参数列表中用 ! 来强迫在每次函数执行时进行求值。下面是新版本的go：

 1{-# LANGUAGE BangPatterns #-}
 2
 3...
 4    go :: (Int, Int, Int, Bool) -> Char -> (Int, Int, Int, Bool)
 5    go (!cs, !ws, !ls, !wasSpace) c =
 6        let addLine | c == '\n' = 1
 7                    | otherwise = 0
 8            addWord | wasSpace = 0
 9                    | isSpace c = 1
10                    | otherwise = 0
11         in (cs + 1, ws + addWord, ls + addLine, isSpace c)

这一点小改动带来了近乎疯狂的性能提升。新的性能数据如下：

90MB测试文件

好，现在内存方面已经好很多了，90MB文件只需要使用几个MB的内存，意味着文件内容是以流的形式处理的！即使仍然有懒惰求值的坑，但我们把懒惰限制在了正确的局部位置，因此它自然地带来了流式处理！流式处理的原因是，readFile实际上是懒惰IO，有时候对于Web服务器等情况而言，这种方式是非常自然的，因为你永远无法确定IO何时发生，而在我们的例子中，它带来了非常好的内存占用量。

使用ByteStrings进一步优化

暂时我们可以不用考虑内存了，那么回过头来考虑一下性能问题！我能想到的一种方案就是用ByteString取代String。使用String意味着我们在读取文件时隐含地进行了解码，这需要花费时间，而且对一切都使用链表也会造成额外开销。这样做并不能从批量读取或缓冲中得到任何好处。

修改方式实际上非常简单。bytestring包提供了一个模块：Data.ByteString.Lazy.Char8，它提供了一系列操作，可以将懒惰的ByteString当作由字符组成的字符串来处理，同时依然保留ByteString带来的性能优势。注意，它并不会验证每个字节是否为有效的Character，也不会做任何解码，所以我们需要自行保证传递正确的数据给它。默认情况下wc假设输入为ASCII，所以这里我们也可以安全地这样假设。如果输入是ASCII，那么该模块中的函数就非常合理了。

唯一的改动就是将Data.List的导入改成Data.ByteString.Lazy.Char8，然后将readFile和foldl'函数改成相应的ByteString版本：

 1import Data.Char
 2import qualified Data.ByteString.Lazy.Char8 as BS
 3
 4simpleFold :: FilePath -> IO (Int, Int, Int)
 5simpleFold fp = do
 6    simpleFoldCountFile <$> BS.readFile fp
 7
 8simpleFoldCountFile :: BS.ByteString -> (Int, Int, Int)
 9simpleFoldCountFile s =
10    let (cs, ws, ls, _) = BS.foldl' go (0, 0, 0, False) s
11     in (cs, ws, ls)
12  where
13    go :: (Int, Int, Int, Bool) -> Char -> (Int, Int, Int, Bool)
14    go (!cs, !ws, !ls, !wasSpace) c =
15        let addLine | c == '\n' = 1
16                    | otherwise = 0
17            addWord | wasSpace = 0
18                    | isSpace c = 1
19                    | otherwise = 0
20         in (cs + 1, ws + addWord, ls + addLine, isSpace c)

这一点小改动将运行时间缩短到了将近一半！

90MB测试文件

显然我们有了一些进展。内存使用量略微增加，但额外的开销似乎依然是常量级别。不幸的是，我们比wc依然低了几个数量级。我们来看看还能做什么。

使用幺半群

这里我想做一点小实验。现代的电脑通常有多个核心，而且新的电脑似乎核心数量增长要比处理器速度增长还要快，所以利用好这一点肯定会有优势。

但是，像这种拆分计算的工作并不太容易。为了使用多个核心，我们需要将任务分解成小块。理论上很容易，只需将文件拆分成小块，然后将每个小块分配给一个核心即可！但仔细想想就会发现问题：合并字符计数非常容易，只需计算每块计数的总和即可。行数也一样，但单词数就有问题了！如果在某个单词中间拆分，或者在连续的空格之间拆分会怎样？为了合并单词计数，我们需要跟踪每块的开头和结尾的状态，合并时需要考虑这些问题。我可不想做这些记录的工作。

这时就轮到幺半群出场了！幺半群的结合律意味着，我们可以设计一个合法的幺半群，能在这种并行处理的情况下正确工作。但是，真的能写一个幺半群来处理类似单词数统计这种复杂的任务吗？

当然可以！一眼看上去似乎这种情况并不适合使用幺半群，但一系列计数问题都可以归到同一个类别下，很幸运的是我以前做过类似的问题。简单来说，我们需要统计一个序列从头到尾的过程中，某个不变量改变的次数。我以前曾经做过这类幺半群的通用形式，叫做flux幺半群（http://hackage.haskell.org/package/flux-monoid）。我们需要做的就是，统计字符从空格变成非空格的次数。我们可以利用Flux幺半群来表示它，但由于我们需要谨慎地处理严格性和性能，所以我要为这里的问题定义一个特殊的Flux幺半群。看下面：

1data CharType = IsSpace | NotSpace
2    deriving Show
3
4data Flux =
5    Flux !CharType
6         {-# UNPACK #-} !Int
7         !CharType
8    | Unknown
9    deriving Show

这些类型只有在统计单词数时才需要。

CharType表示给定的字符是否为空格；然后Flux类型表示一段文本块，它的字段包括子一个字符是否为空格、整个块中包含多少单词，以及最后一个字符是否为空格。我们不保存实际的文本内容，对于本问题而言这些信息是不必要的。这里UNPACK了Int，并将所有字段标记为严格，来保证不会遇到前面的懒惰元组的问题。使用严格数据类型意味着在计算时不需要使用BangPatterns了。

接下来需要一个半群，以及该类型的一个Monoid实例！

1instance Semigroup Flux where
2  Unknown <> x = x
3  x <> Unknown = x
4  Flux l n NotSpace <> Flux NotSpace n' r = Flux l (n + n' - 1) r
5  Flux l n _ <> Flux _ n' r = Flux l (n + n') r
6
7instance Monoid Flux where
8  mempty = Unknown

这里的Unknown构造函数表示Monoidal幺元，实际上我们可以不用它，而是用Maybe将Semigroupo提升为Monoid，但Maybe会给半群添加操作带来不必要的懒惰性！所以为了简单起见，我只是将其定义为类型的一部分。

这里定义的(<>)操作符用来检查两个文本块的连接点是否发生在某个单词的中间，如果发生了，就表明我们对同一个单词的前半部分和后半部分统计了两次，所以在统计单词总数时要减去1，来保证平衡。

最后需要根据单个字符构建Flux对象。

1flux :: Char -> Flux
2flux c | isSpace c = Flux IsSpace 0 IsSpace
3       | otherwise = Flux NotSpace 1 NotSpace

这很简单，非空格字符统计为“单词”，所谓单词就是以非空格开始并结束，所谓空白，就是一个长度为零的单词，两侧被空格字符包围。

似乎不是那么明显，但这些就足以用幺半群的方式实现单词统计了！

1>>> foldMap flux "testing one two three"
2Flux NotSpace 4 NotSpace
3
4>>> foldMap flux "testing on" <> foldMap flux "e two three"
5Flux NotSpace 4 NotSpace
6
7>>> foldMap flux "testing one " <> foldMap flux " two three"
8Flux NotSpace 4 NotSpace

似乎能正常工作！

现在单词数已经实现了，接下来需要幺半群版本的字符数和行数。代码如下：

 1data Counts =
 2    Counts { charCount :: {-# UNPACK #-} !Int
 3
 4           , wordCount ::  !Flux
 5           , lineCount :: {-# UNPACK #-} !Int
 6           }
 7    deriving (Show)
 8
 9instance Semigroup Counts where
10  (Counts a b c) <> (Counts a' b' c') = Counts (a + a') (b <> b') (c + c')
11
12instance Monoid Counts where
13  mempty = Counts 0 mempty 0

没问题！类似地，我们需要将单个字符变成Counts对象：

1countChar :: Char -> Counts
2countChar c =
3    Counts { charCount = 1
4           , wordCount = flux c
5           , lineCount = if (c == '\n') then 1 else 0
6           }

尝试一下：

1>>> foldMap countChar "one two\nthree"
2Counts {charCount = 13, wordCount = Flux NotSpace 3 NotSpace, lineCount = 1}

看起来不错！你可以用喜欢的内容来证实这个幺半群是正确的。

在继续之前，我们在已有代码中使用这个幺半群，确保能获得同样的结果：

 1module MonoidBSFold where
 2
 3import Data.Char
 4import qualified Data.ByteString.Lazy.Char8 as BS
 5
 6monoidBSFold :: FilePath -> IO Counts
 7monoidBSFold paths = monoidFoldFile <$> BS.readFile fp
 8
 9monoidFoldFile :: BS.ByteString -> Counts
10monoidFoldFile = BS.foldl' (\a b -> a <> countChar b) mempty

我们将一部分复杂的内容移动到了Counts类型中，这样能大幅简化实现。一般来说这样做很好，因为测试单一数据类型比测试每个使用fold的地方要容易得多。

附带的好处是，这一改变使得速度更快了！

来庆祝一下吧！

90MB测试文件

这个修改在时间和内存两方面都获得了非常好的结果……我承认我不知道这是为什么，但意外之喜我就不挑剔了。很可能是因为我们使用了完全严格的数据结构，限制了某些地方的懒惰性；但我不敢确信。如果你知道为什么，那么请一定告诉我！

更新：guibou指出，这里的Flux和Counts类型使用了UNPACK指令，而之前使用的是正常的ol'元组。显然GHC有时候能够UNPACK元组，但这里似乎它并没有。通过UNPACK我们节省了一些指针间接操作，也节省了内存！

使用内联！

下一个任务就是将一些定义改成内联！为什么呢？因为需要性能时就要这么做！我们可以用INLINE指令告诉GHC，函数的性能很重要，这样它就会采用内联方式；还可能会触发更多的优化。

1monoidBSFold :: FilePath -> IO Counts
2monoidBSFold paths = monoidBSFoldFile <$> BS.readFile fp
3{-# INLINE monoidBSFold #-}
4
5monoidBSFoldFile :: BS.ByteString -> Counts
6monoidBSFoldFile = BS.foldl' (\a b -> a <> countChar b) mempty
7{-# INLINE monoidBSFoldFile #-}
8

我还给countChar和flux函数添加了INLINE。我们来看看有没有效果：

90MB测试文件

有意思的是，似乎内联将执行时间缩短了75%！我不确定这是不是意外之喜，或者只是幸运而已，不过很不错！尽管内存使用量上涨了一些，但还不至于达到担心的程度。

现在与C语言比较的结果如下：

90MB测试文件

现在已经与wc很接近了，但我们但目标是缩小秒以下级别的差距，所以我想增加测试文件的尺寸，多运行几次，看看有没有新的发现。

我使用了543MB的纯文本文件运行了几次，以便预热缓存。这一点十分重要，因为运行几次之后运行时间整整下降了33%。我知道我的测试方法并不是完全“科学”，但它能够很好地估计出效果。不论如何，在大文件上的测试结果如下：

543MB测试文件

这里可以看出，我们已经非常接近了！考虑到我们使用的是支持垃圾回收的高级语言，而且代码只有80行左右，我认为我们已经做得很好了！

使用核心

我们没办法使用多核心将这个任务完全并行化，因为整个操作是IO密集的，但我还是要试试看。

我们已经将问题表达成了一个幺半群，也就是说分割计算应该相当容易了！这里的难度在于读取数据部分。如果将所有数据读进来，再分隔成小块，那就不得不将整个文件全部读入内存，从而导致非常高的内存占用量，也很可能会影响性能！我们也可以用流式方法来分割，但就得处理完第一块之后才能处理第二块。我想你应该明白问题在哪儿了。我的做法是，在每个核心上启动一个线程，然后每个线程打开一个单独的文件描述符。然后将文件描述符跳转到各个互不重叠的块的位置。

完整的代码如下。我之前有没有说过我很喜欢在Haskell中编写并行代码？

 1import Types
 2import Control.Monad
 3import Data.Traversable
 4import Data.Bits
 5import GHC.Conc (numCapabilities)
 6import Control.Concurrent.Async
 7import Data.Foldable
 8import System.IO
 9import System.Posix.Files
10import qualified Data.ByteString.Lazy.Char8 as BL
11import Data.ByteString.Internal (c2w)
12import GHC.IO.Handle
13
14multiCoreCount :: FilePath -> IO Counts
15multiCoreCount fp = do
16    putStrLn ("Using available cores: " <> show numCapabilities)
17    size <- fromIntegral . fileSize <$> getFileStatus fp
18    let chunkSize = fromIntegral (size `div` numCapabilities)
19    fold <$!> (forConcurrently [0..numCapabilities-1] $ \n -> do
20        -- Take all remaining bytes on the last capability due to integer division anomolies
21        let limiter = if n == numCapabilities - 1
22                         then id
23                         else BL.take (fromIntegral chunkSize)
24        let offset = fromIntegral (n * chunkSize)
25        fileHandle <- openBinaryFile fp ReadMode
26        hSeek fileHandle AbsoluteSeek offset
27        countBytes . limiter <$!> BL.hGetContents fileHandle)
28{-# INLINE handleSplitUTF #-}
29
30countBytes :: BL.ByteString -> Counts
31countBytes = BL.foldl' (\a b -> a <> countChar b) mempty
32{-# INLINE countBytes #-}
33

这里涉及了很多东西，我尽量详细地解释一下。

我们可以从GHC.Conc中导入“能力”的数量（即能够访问的核心数量）。然后，在需要计数的文件上运行fileStat来获得文件的字节数。然后使用整数除法来决定每个核心要处理多少字节。整数除法会向下取整，所以在处理剩余的字节数时要格外小心。然后使用Control.Concurrent.Async提供的forConcurrently在每个核心上运行一个单独的线程。

在每个线程内，我们检查该线程是否在处理最后一块文件，如果是，则应该一直读取到EOF，从而避免前面提到的取整问题，否则就只处理chunkSize字节。然后，将块的尺寸和线程编号相乘，得到偏移量。然后以二进制方式打开文件，使用hSeek将描述符移动到偏移量的位置。然后只需简单地读入所需的字节数，然后使用与前面相同的逻辑进行fold。在所有线程处理完毕后，只需使用fold将每个块的计数合并在一起即可。

有几个地方使用了<$!>来增加额外的严格性，因为我们希望保证fold操作在各个线程中执行而不是在线程归并之后再进行。也许我有点过度使用严格性标注了，但写多一点总比找出哪里漏了写要容易得多。

我们来尝试一下吧！

预热缓存之后，在我的4核心、带有SSD的MacBook Pro 2013版上分别运行了两个版本几次，然后平均结果：

543MB测试文件

看起来效果很好！我们实际上比某些手工优化了几十年的C代码还要快。当然这些结果要有条件地来看，很难说这里是不是有某些缓存的因素。可能有多层磁盘缓存生效了。也许，多线程只有在从缓存中读取文件时才有效果？

我做了很多测试，发现并行执行在某些存储设备上会产生加速，但在一些存储设备上甚至会变慢。所以你的情况可能不一样。希望有SSD的专家能够指出这里的问题。不过不管怎么说，这个结果让我非常满意。

更新：貌似的确有一些SSD的专家！Paul Tanner给我写了一封邮件来解释现代的NVME驱动器的确会从并行中受益，只要并行访问的不是一个块（这里我们并没有这样做）。不幸的是，我的老MacBook没有NVME驱动器，但这意味着，这段代码在现代设备上可能会运行得更快。感谢Paul！

此外，该程序实际的用户时间为4.22s（被分配到了4个核心上），这意味着从处理器周期的角度来看，并行版本实际上不如简单版本有效，但能够利用多个核心，能够降低真实的运行时间。

处理Unicode

我们一直都在忽略一个问题：我们假设每个文件都是ASCII！而真实世界并非如此。许多文档都是用UTF-8编码的，也就是说，当且仅当文件只包含有效的ASCII字符时，整个文件才和ASCII文件一样。但是如果年轻人使用了表情符号，那就乱了。

这个问题有两面性：首先，我们现在计算的是字节数而不是字符数，因为在ASCII的世界中，字符和字节在语义上是相同的。对于我们现在的代码而言，如果它遇到UTF-8编码的“皱眉”符号，那么至少会被计算成两个字符，而实际上应该计算成一个字符。好吧，也许我们应该尝试进行解码，但这件事说起来容易做起来难，因为我们分割文件的位置是任意挑选的，也就是说有可能会将“皱眉”符号分割到两个块中，导致非法编码！真是噩梦啊。

这也是为什么多线程wc也许不是个好主意，但我不会轻易放弃的。我将做一些假设：

• 输入可以是ASCII或UTF-8编码。当然还有其他流行的编码方式，但根据我有限的经验，绝大部分现代文本文件都采用两者之一。实际上，有许多网站都在致力于让UTF-8成为唯一的编码格式。

• 我们仅把ASCII中的空格和换行当做空格和换行处理；MONGOLIAN VOWEL SEPARATOR等字符就不考虑了。

有了这两个假设，我们可以看看UTF-8编码定义，来尝试解决问题。首先，从UTF-8规格中我们知道，它与ASCII完全向后兼容。这就是说，每个ASCII字符在UTF-8中的编码就是字节本身。其次，我们知道，文件中的任何字节都不会与有效的ASCII字节冲突，从UTF-8的维基百科页面（https://en.wikipedia.org/wiki/UTF-8）的这张表上就可以看出。后续字节开头是“1”，而ASCII字节永远不会以1开头。

这两个事实表明，我们不需要改变检测“空格”的逻辑！绝无可能将空格或换行“分割”，因为它们都被编码为单字节，我们也知道，不可能将其他代码点的一部分错误地进行统计，因为它们的编码与ASCII字节没有交集。但是，我们需要改变字符计数的逻辑。

关于UTF-8的最后一点是，每个UTF-8编码的代码点都必然包含下述集合中的一个字节：0xxxxxxx，110xxxxx，1110xxxx，11110xxx。后续字节均以10开始，所以只要统计开头不是10的所有字节，就能精确地将每个代码点只统计一次，即使从代码点中间拆分也是如此！

将以上这些综合起来，我们可以编写一个逐字符进行处理的幺半群，它既可以统计UTF-8的代码点，也可以统计ASCII字符！

注意，理论上讲Unicode的代码点并不等价于“字符”，有许多代码点（比如声调符号）会与其他字符“融合”并显示为一个字符，但据我所知，wc也没有单独考虑它们。

实际上，我们现在的Counts幺半群不需要改动，只需要修改一下countChar函数：

 1import Data.Bits
 2import Data.ByteString.Internal (c2w)
 3countByte :: Char -> Counts
 4countByte c =
 5  Counts {
 6            -- Only count bytes at the START of a codepoint, not continuation bytes
 7            charCount = if (bitAt 7 && not (bitAt 6)) then 0 else 1
 8            , wordCount = flux c
 9            , lineCount = if (c == '\n') then 1 else 0
10            }
11    where
12      bitAt = testBit (c2w c)
13{-# INLINE countByte #-}

这样就好了！现在我们可以处理UTF-8和ASCII了，我们甚至都不需要知道处理的是什么编码，就能永远给出正确的结果。

而wc，至少在我的MacBook上的这个版本，有一个-m选项用于在计数时处理多字节字符。进行几次实验就会发现，wc处理多字节字符会严重地拖慢处理速度（它会解码每个字节）；我们来看看我们的实现。（我已确认过，每次在大型UTF-8文件上运行都会得到相同的结果）

543MB文件

如我们猜测的那样，我们已经远远超过了C！我们的新版本比简单地统计每个字节要慢一些（因为现在要做一些额外的位检查），所以最好还是在程序上加一个utf标记，以便在任何情况下都能达到最好的性能。

这篇文章发表后，Harendra Kumar提供了一条新的提升性能的技巧，从而获得了更好的内存占用量和性能，同时还能支持从stdin读取流输入！哇！代码也十分优雅！

秘密就在streamly库中。这个库是个非常好的高级、高性能流处理库。我以前见过它，但有了这次经历，以后我一定会进一步了解它！闲话少说，直接上代码。再次感谢Harendra Kumar提供的实现！

 1module Streaming where
 2
 3import Types
 4import Data.Traversable
 5import GHC.Conc (numCapabilities)
 6import System.IO (openFile, IOMode(..))
 7import qualified Streamly as S
 8import qualified Streamly.Data.String as S
 9import qualified Streamly.Prelude as S
10import qualified Streamly.Internal.Memory.Array as A
11import qualified Streamly.Internal.FileSystem.Handle as FH
12
13streamingBytestream :: FilePath -> IO Counts
14streamingBytestream fp = do
15    src <- openFile fp ReadMode
16    S.foldl' mappend mempty
17        $ S.aheadly
18        $ S.maxThreads numCapabilities
19        $ S.mapM countBytes
20        $ FH.toStreamArraysOf 1024000 src
21    where
22    countBytes =
23          S.foldl' (\acc c -> acc <> countByte c) mempty
24        . S.decodeChar8
25        . A.toStream
26
27{-# INLINE streamingBytestream #-}

注意：这里用的streamly版本7.10是直接从Github代码库中获得的，很可能它很快就会被发不到hackage上。这段代码还使用了几个内部模块，我希望看到，像这段代码中的用例能够证明，这些模块应该暴露出来。

首先，我们要打开文件，这里没有什么神秘的地方。

其次是流处理的代码，我们从底向上来阅读：

1FH.toStreamArraysOf 1024000 src

这一段从文件描述符中读取字节块放到Byte数组的流中。使用Byte数组可以比使用Lazy ByteString等更快！每1MB文件内容我们会使用一个单独的数组，这一点你可以根据情况调整。

1S.mapM countBytes

这里使用mapM在数组上运行countBytes函数；countBytes本身会根据数组创建流，然后使用我们的幺半群字节计数器来运行流fold：

1countBytes =
2      S.foldl' (\acc c -> acc <> countByte c) mempty
3    . S.decodeChar8
4    . A.toStream

接下来，我们告诉streamly在数组上并行运行map，从而实现让每个线程处理一个1MB的文件块。这里将线程的数量限制在了核心数量。一旦读入所有数据，就可以立即进行处理，我们的统计代码没有任何阻塞的理由，所以增加更多的线程只会给调度器带来额外的负担而已。

1S.maxThreads numCapabilities

Streamly提供了许多流求值策略。这里使用了aheadly，它可以并行处理流元素，但依然能保证输出与输入的顺序相同。由于我们使用了幺半群，所以只要它们能保证适当的顺序，我们就可以用任何方式来实现计算：

1S.aheadly

此时我们已经统计了1MB的输入块，但我们依然需要累加所有输入块。这一点可以在另一个流fold中通过mappend实现：

1S.foldl' mappend mempty

就这些！来看看效果吧！

下面是非utf版本在543MB测试文件上的表现：

可以看到它更快，代价是占用了大量内存。我认为可以通过改变分块策略来减少内存用量。我们来试一下。下面是100KB分块和1MB分块的比较：

如我所料，我们可以用一点点性能来换取不错的内存占用量。对于这个结果我已经相当满意了，不过你也可以继续试验其他的策略。

最后，我们在543MB测试文件上试一下UTF8版本。下面是结果：

我们依然比wc块！尽管在最终版本中可能需要减少一些内存占用！

总体而言，我认为力流版本是最好的，它从高层着手，非常易读，而且可以支持从任意文件描述符读取，其中包括stdin，这是wc非常常见的用例。streamly太酷了。

总结

那么，我们这个支持垃圾回收的、基于运行时的高级语言Haskell究竟怎样？我要说，它非常棒！我们的单核lazy-bytestring版本wc就达到了非常接近的性能。换成多核心之后就能超过wc！我们应当考虑在没有磁盘缓存预热的情况下的性能，但纯粹就性能而言，我们成功地构建了比C语言还快的东西！而流版本应该不会依赖于磁盘缓存。

作为一门语言，Haskell并不完美，但如果我能写出性能媲美C语言的程序，同时保持使用高层逻辑，使用完全支持类型的代码，那我认为就非常好了。

原文：https://chrispenner.ca/posts/wc

本文为 CSDN 翻译，转载请注明来源出处。

【END】

 热 文 推 荐 

！

☞

☞

点击阅读原文，参与中国开发者现状调查问卷！

你点的每个“在看”，我都认真当成了喜欢