第二十五章：性能分析与优化
Haskell 是一门高级编程语言，一门真正的高级编程语言。 我们可以一直使用抽象概念、幺半群、函子、以及多态进行编程，而不必与任何特定的硬件模型打交道。Haskell 在语言规范方面下了很大的功夫，力求语言可以不受制于某个特定的求值模型。这几层抽象使得我们可以把 Haskell 作为计算本身的记号，让编程人员关心他们问题的关键点，而不用操心低层次的实现细节，使得人们可以心无旁骛地进行编程。
但是，本书介绍的是真实世界中的编程行为，而真实世界中的代码都运行在资源有限的硬件之上，并且程序也会有时间和空间上的限制。因此，我们需要掌握好表达程序数据的方法，准确地理解使用惰性求值和严格求值策略带来的后果，并学会如何分析和控制程序在执行时的时间和空间。
在这一章，我们将看到 Haskell 编程中可能遇到的典型空间和时间问题，并且如何有条理地分析、理解并解决它们。为此我们将研究使用一系列的技术：时间和空间使用分析，运行时统计，以及对严格求值和惰性求值。我们也会看下编译器优化对性能的影响，以及高级优化技术在纯函数式编程语言中的应用。那么，让我们用一个挑战开始吧：调查一个简单程序中不必要内存的使用问题。
Haskell程序性能分析¶
请看下面这个列表处理程序，它用于计算某个大型列表的平均值。这里展示的只是程序的其中一部分代码（并且具体的实现算法我们并不关心），这是我们经常会在真实的 Haskell 程序中看到的典型的简单列表操作代码，这些代码大量地使用标准库函数，并且包含了一些因为疏忽大意而导致的性能问题。这里也展示了几种因疏忽而易出现的性能问题。
-- file: ch25/A.hs
import System.Environment
import Text.Printf
main = do
[d] <- map read `fmap` getArgs
printf "%f\n" (mean [1..d])
mean :: [Double] -> Double
mean xs = sum xs / fromIntegral (length xs)
这个程序非常简单：我们引用了访问系统环境的函数（即 getArgs ），和 Haskell 版的 printf 函数来格式化输出。接着这个程序从命令行读入一个数字来构建一个由浮点数组成的列表。我们用这个列表的和除以列表的长度得到平均值，然后以字符串的形式打印出来。我们来将此代码编译成机器代码（打开优化开关）然后用 time 执行它看看情况吧：
$ ghc --make -rtsopts -O2 A.hs
[1 of 1] Compiling Main ( A.hs, A.o )
Linking A ...
$ time ./A 1e5
50000.5
./A 1e5 0.05s user 0.01s system 102% cpu 0.059 total
$ time ./A 1e6
500000.5
./A 1e6 0.26s user 0.04s system 99% cpu 0.298 total
$ time ./A 1e7
5000000.5
./A 1e7 63.80s user 0.62s system 99% cpu 1:04.53 total
程序在处理少量输入时运行得非常好，但是当输入的列表元素数量达到一千万个时，程序的运行速度就会变得相当缓慢。从这点我们就能感觉到应该有什么地方做得不对，但我们并不清楚它的资源使用情况。 我们需要研究下。
记录运行时统计数据¶
为了能收集这些情报，GHC支持传入 +RTS 和 -RTS 这些特殊选项。这些选项是传给 Haskell 运行时本身的，Haskell程序为会感知到它们的存在。
特别地，我们可以用 -s 选项来让运行时系统收集内存和垃圾收集性能参数（并可以用 -N来控制系统线程的数量，或调整栈和堆的大小）。我们将用运行时选项来打开性能分析的几种不同变量。Haskell 运行时所能接受的所有选项列表可以参见GHC用户手册。
那么让我们用 +RTS -sstderr 来运行程序收集我们所需要的结果吧。
$ ./A 1e7 +RTS -sstderr
5000000.5
1,689,133,824 bytes allocated in the heap
697,882,192 bytes copied during GC (scavenged)
465,051,008 bytes copied during GC (not scavenged)
382,705,664 bytes maximum residency (10 sample(s))
3222 collections in generation 0 ( 0.91s)
10 collections in generation 1 ( 18.69s)
742 Mb total memory in use
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.63s ( 0.71s elapsed)
GC time 19.60s ( 20.73s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 20.23s ( 21.44s elapsed)
%GC time 96.9% (96.7% elapsed)
Alloc rate 2,681,318,018 bytes per MUT second
Productivity 3.1% of total user, 2.9% of total elapsed
当使用 -sstderr 时，程序的性能数字会输出到标准错误流里，告诉我们很多关于程序在具体做什么的信息。具体地说，它告诉我们GC用了多少时间以及最大活动内存使用情况。原来程序计算一千万个元素的平均值在堆上使用了多达742M的你内存，并且 96.9% 的时间是花费到垃圾收集上的！总共只有 3.1% 的时间是程序用来干正事的。
那么为什么我们的程序运行情况这么差？我们如何来提高它呢？毕竟，Haskell是一个惰性语言：它不应该只用恒定的内存空间来处理列表吗？
时间消耗分析¶
庆幸的是，GHC提供了几个工具可以分析程序的时间和空间使用情况。尤其是，我们可以在编写程序时打开性能调试选项，这样程序在执行时会得到每个函数所使用的资源使用的信息。性能调试过程分为三步：以性能调试方式编译程序；用性能调试模式执行程序；最后是分析收集到的结果数据。
编译程序时，我们可以打开 -prof 选项来记录基本时间和空间性能信息。我们也需要给感兴趣的函数标记为 “cost centres” 以便让性能分析程序知晓。一个 cost centre 即是一个信息收集点。GHC会生成代码来计算这些地方的资源消耗。我们可以用 SCC 语法使得任何语句成为 cost centre。
-- file: ch25/SCC.hs
mean :: [Double] -> Double
mean xs = {-# SCC "mean" #-} sum xs / fromIntegral (length xs)
另外我们也可以用 -auto-all 选项来让编译器将所有顶级函数设为 cost centre。手动添加 cost centre 的能力作为自动 cost centre 性能调试的辅助，使得我们可以在发现某个热点（hot spot）有问题时，针对性地分析一个函数的资源消耗。
另外需要注意的一个难点是：在 Haskell 这类惰性、纯函数式编程语言里，没有参数的值只会被计算一次（比如之前的程序展示过的巨大的列表），而计算的结果会被之后的所有其他计算所共享。这些值不是程序调用的其中一部分，因此它们不会每次都被计算。当然我们仍然需要评估它们的唯一一次计算的资源占用情况。这些只会计算一次的值被成为 CAF （Constant Applicative Forms），它们的确切数量可以通过 -caf-all 选项来得到。
那么以分析性能的方式来编译我们的程序吧（用 -fforce-recomp 选项来强制重新编译所有部分）：
$ ghc -O2 --make A.hs -prof -auto-all -caf-all -fforce-recomp
[1 of 1] Compiling Main ( A.hs, A.o )
Linking A ...
现在我们可以执行这个标记了性能分析点的程序了 （标记了性能分析的程序会变慢，所以我们用一个较小的输入来执行）：
$ time ./A 1e6 +RTS -p
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize' to increase it.
./A 1e6 +RTS -p 1.11s user 0.15s system 95% cpu 1.319 total
程序竟然把栈空间耗完了！这就是使用 profiling 时需要注意的主要影响：给程序加Cost Centre会使它的优化发生变化，甚至改变它的运行时行为，因为每一个表达式都被附加了额外代码来检测它们的执行情况。对于我们这样情况，修正起来很简单 —— 只需要用GHC运行时标记 -K 来增加栈空间上限即可（并附带指示大小的后缀）：
$ time ./A 1e6 +RTS -p -K100M
500000.5
./A 1e6 +RTS -p -K100M 4.27s user 0.20s system 99% cpu 4.489 total
运行时会将性能信息生成到一个名字为 A.prof （以程序本身名字命名） 的文件中。其中含有以下信息：
$ cat A.prof
Time and Allocation Profiling Report (Final)
A +RTS -p -K100M -RTS 1e6
total time = 0.28 secs (14 ticks @ 20 ms)
total alloc = 224,041,656 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
CAF:sum Main 78.6 25.0
CAF GHC.Float 21.4 75.0
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 1 0 0.0 0.0 100.0 100.0
main Main 166 2 0.0 0.0 0.0 0.0
mean Main 168 1 0.0 0.0 0.0 0.0
CAF:sum Main 160 1 78.6 25.0 78.6 25.0
CAF:lvl Main 158 1 0.0 0.0 0.0 0.0
main Main 167 0 0.0 0.0 0.0 0.0
CAF Numeric 136 1 0.0 0.0 0.0 0.0
CAF Text.Read.Lex 135 9 0.0 0.0 0.0 0.0
CAF GHC.Read 130 1 0.0 0.0 0.0 0.0
CAF GHC.Float 129 1 21.4 75.0 21.4 75.0
CAF GHC.Handle 110 4 0.0 0.0 0.0 0.0
这些信息呈现给一些我们关于程序的运行时行为的情况。里面包含了程序的名字以及执行程序时用到的选项和参数。『total time』是运行时系统视角所见的程序运行的确切总时长。『Total allocation』是程序在运行过程中分配的内存总字节数（不是程序运行时内存使用的峰值；那个峰值大概是700MB）
报告中的第二小节是各个函数所消耗的时间和空间部分。第三小节是Cost Centre报告：其结构为调用关系树（比如我们可以看到 mean 是被 main 调用的）。“individual”和”inherited”列提供了每个Cost Centre其本身、其整体、以及其子节点所消耗的资源。最下面那些 CAF 是执行一些常量的一次性消耗（例如大列表中浮点数以及列表本身）。
我们能从这些信息得出什么结论呢？我们可以看出两个 CAF 占用了大多数时间。分别是计算总和相关和浮点数相关。这基本解释了所有程序运行的消耗。加上之前我们观察到的关于GC的压力，我们就可以推测出列表节点和浮点数值可能是问题之源。
简单的性能热点检测，特别是对于我们难以知道时间花费点的大型程序，这个时间分析会突出一些特定的问题模块或高层函数。这往往足够显示出问题所在了。就像我们的程序，一旦我们窄化了问题所在，我们就可以用更加成熟的分析工具来拿到更多的信息。
空间性能调试¶
GHC除了可以进行基本的时间和空间分析外，还能为程序整个执行期间的堆内存使用情况生成图表。这能完美检测内存泄露问题。内存泄露是指不再需要的内存没有被释放。这会对GC造成压力，就像在我们的例子程序中见到的那样。
构建内存占用情况的性能调试和构建一般时间占用调试的步骤是一样，都需要用到 -prof -auto-all -caf-all 选项。 但当执行程序时，我们会让运行时系统收集关于堆使用的最多细节。堆使用信息能够以几种方式分解：cost-centre，模块(module)，构建器，数据类型。不同分解可以展现不同信息。对 A.hs 进行内存调试所得的原始信息会被记录到一个名为 A.hp 的文件里面，之后只要使用 hp2ps 处理这个文件，就可以得到一个基于 PostScript 的内存占用历史可视图像。
程序的一般内存占用情况可以通过使用 -hc 选项来获取：
$ time ./A 1e6 +RTS -hc -p -K100M
500000.5
./A 1e6 +RTS -hc -p -K100M 4.15s user 0.27s system 99% cpu 4.432 total
一个内存使用的性能调试的log文件 A.hp 被会创建，其内容为以下形式：
JOB "A 1e6 +RTS -hc -p -K100M"
SAMPLE_UNIT "seconds"
VALUE_UNIT "bytes"
BEGIN_SAMPLE 0.00
END_SAMPLE 0.00
BEGIN_SAMPLE 0.24
(167)main/CAF:lvl 48
(136)Numeric.CAF 112
(166)main 8384
(110)GHC.Handle.CAF 8480
(160)CAF:sum 10562000
(129)GHC.Float.CAF 10562080
END_SAMPLE 0.24
这些样本是以程序的正常执行步长取得的。我们可以用 -iN 选项来增加取样频率，这里的 N 是内存取样之间相隔的秒数（如 0.01 秒）。很明显，取样越多，得到的结果越精确，但程序会执行得更慢。我们可以用 hp2ps 将调试结果生成一张图表：
$ hp2ps -e8in -c A.hp
这就是生成的图表 A.ps ：
[IMG#TODO]
我们能从图片中看出什么？第一点，程序执行分两个阶段：在计算总和的同时， 前一阶段不断分配大量的内存，后一半清理释放这些内存。内存初始化分配的同时， sum 也开始干活，并消耗大量的内存。如果用 -hy 调试选项来按类型分解的话，我们会得到一个稍有不同的图像：
$ time ./A 1e6 +RTS -hy -p -K100M
500000.5
./A 1e6 +RTS -i0.001 -hy -p -K100M 34.96s user 0.22s system 99% cpu 35.237 total
$ hp2ps -e8in -c A.hp
以下是生成的图像：
[IMG#TODO]
这里最有趣的是有很大部分的内存被list类型([])和Double类型所占用；我们看到未知类型(图中用 * 标记)也占用了一些内存。最后，让我们用 -hd 选项来按构建器分解一下结果：
$ time ./A 1e6 +RTS -hd -p -K100M
$ time ./A 1e6 +RTS -i0.001 -hd -p -K100M
500000.5
./A 1e6 +RTS -i0.001 -hd -p -K100M 27.85s user 0.31s system 99% cpu 28.222 total
下面就是我们最后一张展示了程序执行的所有情况的图像：
[IMG#TODO]
程序在分配双精度浮点数列表上面花了不少功夫。列表在 Haskell 语言中的惰性的，所以含有上百万个元素的列表都是在程序执行过程中一点点地构建出来的。但这些元素在被遍历的同时并没有被逐步释放，所以导致内存占用变得越来越大。最终，在程序执行稍稍超过一半时，终于将列表总和计算出来，并开始计算其长度。如果看下关于 mean 的程序片断的话，我们就会知道内存没被释放的确切原因：
-- file: ch25/Fragment.hs
mean :: [Double] -> Double
mean xs = sum xs / fromIntegral (length xs)
首先我们计算列表的总和，这会使得所有列表元素被分配到内存。但我们现在还不能释放列表元素，因为 length 还需要整个列表。一旦 sum 结束， length 会马上开始访问列表，同时 GC 会跟进，逐步释放列表元素，直到 length 结束。这两个计算阶段展示了两种明显不同的分配与释放，并指出我们需要改进的确切思路：只对列表遍历一次，遍历过程中同时计算总和与平均值。
-- file: ch25/B.hs
mean :: [Double] -> Double
mean xs = s / fromIntegral n
where
(n, s) = foldl k (0, 0) xs
k (n, s) x = (n+1, s+x)
$ ghc -O2 --make B.hs -fforce-recomp
$ time ./B 1e6
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize' to increase it.
./B 1e6 0.44s user 0.10s system 96% cpu 0.565 total
$ ghc -O2 --make B.hs -prof -auto-all -caf-all -fforce-recomp
[1 of 1] Compiling Main ( B.hs, B.o )
Linking B ...
$ time ./B 1e6 +RTS -i0.001 -hc -p -K100M
500000.5
./B 1e6 +RTS -i0.001 -hc -p -K100M 38.70s user 0.27s system 99% cpu 39.241 total
-- file: ch25/C.hs
mean :: [Double] -> Double
mean xs = s / fromIntegral n
where
(n, s) = foldl' k (0, 0) xs
k (n, s) x = (n+1, s+x)
$ ghc -O2 --make C.hs
[1 of 1] Compiling Main ( C.hs, C.o )
Linking C ...
$ time ./C 1e6
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize' to increase it.
./C 1e6 0.44s user 0.13s system 94% cpu 0.601 total
-- file: ch25/Foldl.hs
foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' f z xs = lgo z xs
where lgo z [] = z
lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
-- file: ch25/D.hs
mean :: [Double] -> Double
mean xs = s / fromIntegral n
where
(n, s) = foldl' k (0, 0) xs
k (n, s) x = n `seq` s `seq` (n+1, s+x)
$ ghc -O2 D.hs --make
[1 of 1] Compiling Main ( D.hs, D.o )
Linking D ...
$ time ./D 1e6 +RTS -sstderr
./D 1e6 +RTS -sstderr
500000.5
256,060,848 bytes allocated in the heap
43,928 bytes copied during GC (scavenged)
23,456 bytes copied during GC (not scavenged)
45,056 bytes maximum residency (1 sample(s))
489 collections in generation 0 ( 0.00s)
1 collections in generation 1 ( 0.00s)
1 Mb total memory in use
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.12s ( 0.13s elapsed)
GC time 0.00s ( 0.00s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 0.13s ( 0.13s elapsed)
%GC time 2.6% (2.6% elapsed)
Alloc rate 2,076,309,329 bytes per MUT second
Productivity 97.4% of total user, 94.8% of total elapsed
./D 1e6 +RTS -sstderr 0.13s user 0.00s system 95% cpu 0.133 total
-- file: ch25/E.hs
import System.Environment
import Text.Printf
import Control.Parallel.Strategies
main = do
[d] <- map read `fmap` getArgs
printf "%f\n" (mean [1..d])
foldl'rnf :: NFData a => (a -> b -> a) -> a -> [b] -> a
foldl'rnf f z xs = lgo z xs
where
lgo z [] = z
lgo z (x:xs) = lgo z' xs
where
z' = f z x `using` rnf
mean :: [Double] -> Double
mean xs = s / fromIntegral n
where
(n, s) = foldl'rnf k (0, 0) xs
k (n, s) x = (n+1, s+x) :: (Int, Double)
-- file: ch25/F.hs
{-# LANGUAGE BangPatterns #-}
-- file: ch25/F.hs
mean :: [Double] -> Double
mean xs = s / fromIntegral n
where
(n, s) = foldl' k (0, 0) xs
k (!n, !s) x = (n+1, s+x)
$ ghc -O2 F.hs --make
$ time ./F 1e6 +RTS -sstderr
./F 1e6 +RTS -sstderr
500000.5
256,060,848 bytes allocated in the heap
43,928 bytes copied during GC (scavenged)
23,456 bytes copied during GC (not scavenged)
45,056 bytes maximum residency (1 sample(s))
489 collections in generation 0 ( 0.00s)
1 collections in generation 1 ( 0.00s)
1 Mb total memory in use
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.14s ( 0.15s elapsed)
GC time 0.00s ( 0.00s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 0.14s ( 0.15s elapsed)
%GC time 0.0% (2.3% elapsed)
Alloc rate 1,786,599,833 bytes per MUT second
Productivity 100.0% of total user, 94.6% of total elapsed
./F 1e6 +RTS -sstderr 0.14s user 0.01s system 96% cpu 0.155 total
-- file: ch25/G.hs
data Pair a b = Pair !a !b
-- file: ch25/G.hs
mean :: [Double] -> Double
mean xs = s / fromIntegral n
where
Pair n s = foldl' k (Pair 0 0) xs
k (Pair n s) x = Pair (n+1) (s+x)
$ ghc -O2 -ddump-simpl G.hs
lgo :: Integer -> [Double] -> Double# -> (# Integer, Double #)
lgo = \ n xs s ->
case xs of
[] -> (# n, D# s #);
(:) x ys ->
case plusInteger n 1 of
n' -> case x of
D# y -> lgo n' ys (+## s y)
-- file: ch25/H.hs
data Pair = Pair !Int !Double
mean :: [Double] -> Double
mean xs = s / fromIntegral n
where
Pair n s = foldl' k (Pair 0 0) xs
k (Pair n s) x = Pair (n+1) (s+x)
lgo :: Int# -> Double# -> [Double] -> (# Int#, Double# #)
lgo = \ n s xs ->
case xs of
[] -> (# n, s #)
(:) x ys ->
case x of
D# y -> lgo (+# n 1) (+## s y) ys
$ time ./H 1e7 +RTS -sstderr
./H 1e7 +RTS -sstderr
5000000.5
1,689,133,824 bytes allocated in the heap
284,432 bytes copied during GC (scavenged)
32 bytes copied during GC (not scavenged)
45,056 bytes maximum residency (1 sample(s))
3222 collections in generation 0 ( 0.01s)
1 collections in generation 1 ( 0.00s)
1 Mb total memory in use
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.63s ( 0.63s elapsed)
GC time 0.01s ( 0.02s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 0.64s ( 0.64s elapsed)
%GC time 1.0% (2.4% elapsed)
Alloc rate 2,667,227,478 bytes per MUT second
Productivity 98.4% of total user, 98.2% of total elapsed
./H 1e7 +RTS -sstderr 0.64s user 0.00s system 99% cpu 0.644 total
-- file: ch25/I.hs
import System.Environment
import Text.Printf
import Data.Array.Vector
main = do
[d] <- map read `fmap` getArgs
printf "%f\n" (mean (enumFromToFracU 1 d))
data Pair = Pair !Int !Double
mean :: UArr Double -> Double
mean xs = s / fromIntegral n
where
Pair n s = foldlU k (Pair 0 0) xs
k (Pair n s) x = Pair (n+1) (s+x)
fold :: Int# -> Double# -> Double# -> (# Int#, Double# #)
fold = \ n s t ->
case >## t limit of {
False -> fold (+# n 1) (+## s t) (+## t 1.0)
True -> (# n, s #)
$ time ./I 1e7
5000000.5
./I 1e7 0.06s user 0.00s system 72% cpu 0.083 total
$ ghc -fforce-recomp --make -O2 -funbox-strict-fields -fvia-C -optc-O2 I.hs
[1 of 1] Compiling Main ( I.hs, I.o )
Linking I ...
$ time ./I 1e7
5000000.5
./I 1e7 0.04s user 0.00s system 98% cpu 0.047 total
go:
ucomisd 5(%rbx), %xmm6
ja .L31
addsd %xmm6, %xmm5
addq $1, %rsi
addsd .LC0(%rip), %xmm6
jmp go
更多建议：