LFSR 实现中的高效位摆弄
Efficient bit-fiddling in a LFSR implementation
虽然我有一个很好的 LSFR C 实现，但我想我会在 Haskell 中尝试相同的实现 - 只是为了看看效果如何。到目前为止，我得出的结果比 C 实现慢了两个数量级，这引出了一个问题：如何提高性能？ 显然，位操作是瓶颈，探查器证实了这一点。
这是使用列表和 Data.Bits:
的基线 Haskell 代码
import Control.Monad (when)
import Data.Bits (Bits, shift, testBit, xor, (.&.), (.|.))
import System.Environment (getArgs)
import System.Exit (exitFailure, exitSuccess)
tap :: [[Int]]
tap = [
[], [], [], [3, 2],
[4, 3], [5, 3], [6, 5], [7, 6],
[8, 6, 5, 4], [9, 5], [10, 7], [11, 9],
[12, 6, 4, 1], [13, 4, 3, 1], [14, 5, 3, 1], [15, 14],
[16,15,13,4], [17, 14], [18, 11], [19, 6, 2, 1],
[20, 17], [21, 19], [22, 21], [23, 18],
[24,23,22,17], [25, 22], [26, 6, 2, 1], [27, 5, 2, 1],
[28, 25], [29, 27], [30, 6, 4, 1], [31, 28],
[32,22,2,1], [33,20], [34,27,2,1], [35,33],
[36,25], [37,5,4,3,2,1],[38,6,5,1], [39,35],
[40,38,21,19], [41,38], [42,41,20,19], [43,42,38,37],
[44,43,18,17], [45,44,42,41], [46,45,26,25], [47,42],
[48,47,21,20], [49,40], [50,49,24,23], [51,50,36,35],
[52,49], [53,52,38,37], [54,53,18,17], [55,31],
[56,55,35,34], [57,50], [58,39], [59,58,38,37],
[60,59], [61,60,46,45], [62,61,6,5], [63,62] ]
xor' :: [Bool] -> Bool
xor' = foldr xor False
mask :: (Num a, Bits a) => Int -> a
mask len = shift 1 len - 1
advance :: Int -> [Int] -> Int -> Int
advance len tap lfsr
| d0 = shifted
| otherwise = shifted .|. 1
where
shifted = shift lfsr 1 .&. mask len
d0 = xor' $ map (testBit lfsr) tap'
tap' = map (subtract 1) tap
main :: IO ()
main = do
args <- getArgs
when (null args) $ fail "Usage: lsfr <number-of-bits>"
let len = read $ head args
when (len < 8) $ fail "No need for LFSR"
let out = last $ take (shift 1 len) $ iterate (advance len (tap!!len)) 0
if out == 0 then do
putStr "OK\n"
exitSuccess
else do
putStr "FAIL\n"
exitFailure
基本上，它测试在 tap :: [[Int]] 中为任何给定的位长度定义的 LSFR 是否为最大长度。 （更准确地说，它只是检查 LSFR 是否在 2n 次迭代后达到初始状态（零）。）
根据分析器，成本最高的线路是反馈位 d0 = xor' $ map (testBit lfsr) tap'。
到目前为止我尝试过的：
- 使用
Data.Array：尝试放弃，因为没有foldl/r
- 使用
Data.Vector：比基线 稍快
我使用的编译器选项是：-O2、LTS Haskell 8.12 (GHC-8.0.2).
可在 gist.github.com.
上找到参考 C++ 程序
Haskell 代码不能指望（？）到 运行 和 C 代码一样快，但是两个数量级太多了，必须有更好的方法来做小摆弄。
更新：应用答案中建议的优化结果
- 输入为 28 的参考 C++ 程序，使用 LLVM 8.0.0 编译，运行s 在我的机器上用了 0.67s（与 clang 3.7 相同，稍慢，0.68s）
- 基线 Haskell 代码 运行 慢了大约 100 倍（由于 space 效率低下，请勿尝试使用大于 25 的输入）
- 随着
的重写，仍然使用默认的GHC后端，执行时间下降到5.2s
- 随着 @Thomas M. DuBuisson 的重写，现在使用 LLVM 后端（GHC 选项
-O2 -fllvm），执行时间下降到 1.7s
- 使用 GHC 选项
-O2 -fllvm -optlc -mcpu=native 将其缩短为 0.73s
- 用@cirdec 的
iterate' 替换iterate 在使用Thomas 的代码时没有任何区别（默认的'native' 后端和LLVM）。但是，确实 使用基线代码时有所不同。
所以，我们从 100 倍到 8 倍再到 1.09 倍，即只比 C 慢 9%！
备注
GHC 8.0.2 的 LLVM 后端需要 LLVM 3.7。在 Mac OS X 上，这意味着使用 brew 安装此版本，然后符号链接 opt 和 llc。参见 7.10. GHC Backends。
前期很重要
首先，我在 Intel I5 ~2.5GHz 上使用 GHC 8.0.1，linux x86-64。
初稿：哦不！变慢了！
您运行参数为 25 的起始代码：
% ghc -O2 orig.hs && time ./orig 25
[1 of 1] Compiling Main ( orig.hs, orig.o )
Linking orig ...
OK
./orig 25 7.25s user 0.50s system 99% cpu 7.748 total
所以击败的时间是 77 毫秒 - 比这个 Haskell 代码好两个数量级。让我们开始吧。
问题 1：Shifty 代码
我发现代码有几个奇怪之处。首先是在高性能代码中使用 shift。 Shift 同时支持左移和右移，为此它需要一个分支。让我们用 2 的更多可读性来杀死它 (shift 1 x ~> 2^x 和 shift x 1 ~> 2*x):
% ghc -O2 noShift.hs && time ./noShift 25
[1 of 1] Compiling Main ( noShift.hs, noShift.o )
Linking noShift ...
OK
./noShift 25 0.64s user 0.00s system 99% cpu 0.637 total
（正如您在评论中指出的那样：是的，这需要进行调查。可能是先前代码的某些奇怪之处阻止了重写规则的触发，结果导致了更糟糕的代码）
问题 2：位列表？国际行动拯救世界！
一个变化，一个数量级。耶。还有什么？好吧，你有这个尴尬的位位置列表，你正在窃听它似乎是在乞求低效率 and/or 依赖于脆弱的优化。在这一点上，我会注意到对该列表中的任何一个选择进行硬编码会产生非常好的性能（例如 testBit lsfr 24 `xor` testBit lsfr 21），但我们需要一个更通用的快速解决方案。
我建议我们计算 所有 抽头位置的掩码，然后进行单指令弹出计数。为此，我们只需要将单个 Int 传递给 advance 而不是整个列表。 popcount 指令需要良好的汇编生成，这需要 llvm 和可能 -optlc-mcpu=native 或其他非悲观的指令集选择。
这一步为我们提供了下面的 pc。我已经放弃了评论中提到的 advance 的守卫移除：
let tp = sum $ map ((2^) . subtract 1) (tap !! len)
pc lfsr = fromEnum (even (popCount (lfsr .&. tp)))
mask = 2^len - 1
advance' :: Int -> Int
advance' lfsr = (2*lfsr .&. mask) .|. pc lfsr
out :: Int
out = last $ take (2^len) $ iterate advance' 0
我们最终的表现是：
% ghc -O2 so.hs -fforce-recomp -fllvm -optlc-mcpu=native && time ./so 25
[1 of 1] Compiling Main ( so.hs, so.o )
Linking so ...
OK
./so 25 0.06s user 0.00s system 96% cpu 0.067 total
从头到尾超过两个数量级，所以希望它与您的 C 相匹配。最后，在部署的代码中，使用 C 绑定的 Haskell 包实际上是很常见的，但这通常是一种教育运动所以我希望你玩得开心。
编辑：现在可用的 C++ 代码需要我的系统 0.10 (g++ -O3) 和 0.12 (clang++ -O3 -march=native) 秒，所以看起来我们已经取得了相当大的成绩。
编译器是否将 tap !! len 移出了循环？我怀疑它确实如此，但将其移出以保证不会造成伤害：
let tap1 = tap !! len
let out = last $ take (shift 1 len) $ iterate (advance len tap1) 0
在评论中你说“2^len 只需要一次”，但这是错误的。您每次都在 advance 中执行此操作。所以你可以试试
advance len tap mask lfsr
| d0 = shifted
| otherwise = shifted .|. 1
where
shifted = shift lfsr 1 .&. mask
d0 = xor' $ map (testBit lfsr) tap'
tap' = map (subtract 1) tap
-- in main
let tap1 = tap !! len
let numIterations = 2^len
let mask = numIterations - 1
let out = iterate (advance len tap1 mask) 0 !! (numIterations - 1)
（编译器通常不能将 last $ take ... 优化为 !!，因为它们对于有限列表是不同的，但是 iterate 总是 returns 一个无限列表。 )
您将 foldr 与 foldl 进行了比较，但 foldl is almost never what you need；因为 xor 总是需要两个参数并且是关联的，所以 foldl' 很可能是正确的选择（编译器可以优化它，但是如果 foldl 和 foldr 而不仅仅是随机变化，在这种情况下它可能已经失败了）。
我怀疑以下行在评估之前在内存中构建了一个类似列表的大型 thunk。
let out = last $ take (shift 1 len) $ iterate (advance len (tap!!len)) 0` is
让我们看看我是否正确，如果我是正确的，我们将修复它。调试的第一步是了解程序使用的内存。为此，除了 -O2 之外，我们还要使用选项 -rtsopts 进行编译。这将启用 运行 具有 RTS options 的程序，包括 +RTS -s 输出一个小的内存摘要。
初始性能
运行 你的程序 lfsr 25 +RTS -s 我得到以下输出
OK
5,420,148,768 bytes allocated in the heap
6,705,977,216 bytes copied during GC
1,567,511,384 bytes maximum residency (20 sample(s))
357,862,432 bytes maximum slop
3025 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 10343 colls, 0 par 2.453s 2.522s 0.0002s 0.0009s
Gen 1 20 colls, 0 par 2.281s 3.065s 0.1533s 0.7128s
INIT time 0.000s ( 0.000s elapsed)
MUT time 1.438s ( 1.162s elapsed)
GC time 4.734s ( 5.587s elapsed)
EXIT time 0.016s ( 0.218s elapsed)
Total time 6.188s ( 6.967s elapsed)
%GC time 76.5% (80.2% elapsed)
Alloc rate 3,770,538,273 bytes per MUT second
Productivity 23.5% of total user, 19.8% of total elapsed
一次性使用大量内存。很可能那里某处有一个巨大的砰砰声。
正在尝试减小 thunk 大小
我假设 thunk 是在 iterate (advance ...) 中构建的。如果是这种情况，我们可以尝试通过在其 lsfr 参数中使 advance 更严格来减小 thunk 的大小。这不会删除 thunk 的脊柱（连续迭代），但它可能会减少在评估脊柱时建立的状态的大小。
BangPatterns 是在参数中使函数严格的一种简单方法。 f !x = .. 是 shorthand 对于 f x = seq x $ ...
{-# LANGUAGE BangPatterns #-}
advance :: Int -> [Int] -> Int -> Int
advance len tap = go
where
go !lfsr
| d0 = shifted
| otherwise = shifted .|. 1
where
shifted = shift lfsr 1 .&. mask len
d0 = xor' $ map (testBit lfsr) tap'
tap' = map (subtract 1) tap
让我们看看这有什么不同...
>lfsr 25 +RTS -s
OK
5,420,149,072 bytes allocated in the heap
6,705,979,368 bytes copied during GC
1,567,511,448 bytes maximum residency (20 sample(s))
357,862,448 bytes maximum slop
3025 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 10343 colls, 0 par 2.688s 2.711s 0.0003s 0.0059s
Gen 1 20 colls, 0 par 2.438s 3.252s 0.1626s 0.8013s
INIT time 0.000s ( 0.000s elapsed)
MUT time 1.328s ( 1.146s elapsed)
GC time 5.125s ( 5.963s elapsed)
EXIT time 0.000s ( 0.226s elapsed)
Total time 6.484s ( 7.335s elapsed)
%GC time 79.0% (81.3% elapsed)
Alloc rate 4,081,053,418 bytes per MUT second
Productivity 21.0% of total user, 18.7% of total elapsed
None 很明显。
消除脊柱
我猜这是正在构建的 iterate (advance ...) 的主干。毕竟，对于我是 运行 的命令，列表将是 2^25，或者超过 3300 万个项目。该列表本身可能已被 list fusion 删除，但列表最后一项的 thunk 已超过 3300 万 advance ...
的应用程序
为了解决这个问题，我们需要 iterate 的严格版本，以便在再次应用 advance 函数之前将值强制为 Int。这应该将内存保持在一次只有一个 lfsr 值，以及当前计算的 advance.
应用程序。
不幸的是，Data.List 中没有严格的 iterate。这是一个不放弃列表融合的方法，它为这个问题提供了其他重要的（我认为）性能优化。
{-# LANGUAGE BangPatterns #-}
import GHC.Base (build)
{-# NOINLINE [1] iterate' #-}
iterate' :: (a -> a) -> a -> [a]
iterate' f = go
where go !x = x : go (f x)
{-# NOINLINE [0] iterateFB' #-}
iterateFB' :: (a -> b -> b) -> (a -> a) -> a -> b
iterateFB' c f = go
where go !x = x `c` go (f x)
{-# RULES
"iterate'" [~1] forall f x. iterate' f x = build (\c _n -> iterateFB' c f x)
"iterateFB'" [1] iterateFB' (:) = iterate'
#-}
这只是 iterate from GHC.List（连同其所有重写规则），但在累积参数中变得严格。
配备严格迭代，iterate'，我们可以将麻烦的行更改为
let out = last $ take (shift 1 len) $ iterate' (advance len (tap!!len)) 0
我希望这会表现得更好。让我们看看...
>lfsr 25 +RTS -s
OK
3,758,156,184 bytes allocated in the heap
297,976 bytes copied during GC
43,800 bytes maximum residency (1 sample(s))
21,736 bytes maximum slop
1 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 7281 colls, 0 par 0.047s 0.008s 0.0000s 0.0000s
Gen 1 1 colls, 0 par 0.000s 0.000s 0.0002s 0.0002s
INIT time 0.000s ( 0.000s elapsed)
MUT time 0.750s ( 0.783s elapsed)
GC time 0.047s ( 0.008s elapsed)
EXIT time 0.000s ( 0.000s elapsed)
Total time 0.797s ( 0.792s elapsed)
%GC time 5.9% (1.0% elapsed)
Alloc rate 5,010,874,912 bytes per MUT second
Productivity 94.1% of total user, 99.0% of total elapsed
这使用了 0.00002 倍的内存和 运行 10 倍的速度。
我不知道这是否会改进 Thomas DeBuisson 的 ，但仍然保留了一个惰性的 iterate advance'。这很容易检查；将 iterate' 代码添加到该答案并使用 iterate' 代替该答案中的 iterate。
虽然我有一个很好的 LSFR C 实现，但我想我会在 Haskell 中尝试相同的实现 - 只是为了看看效果如何。到目前为止，我得出的结果比 C 实现慢了两个数量级，这引出了一个问题：如何提高性能？ 显然，位操作是瓶颈，探查器证实了这一点。
这是使用列表和 Data.Bits:
import Control.Monad (when)
import Data.Bits (Bits, shift, testBit, xor, (.&.), (.|.))
import System.Environment (getArgs)
import System.Exit (exitFailure, exitSuccess)
tap :: [[Int]]
tap = [
[], [], [], [3, 2],
[4, 3], [5, 3], [6, 5], [7, 6],
[8, 6, 5, 4], [9, 5], [10, 7], [11, 9],
[12, 6, 4, 1], [13, 4, 3, 1], [14, 5, 3, 1], [15, 14],
[16,15,13,4], [17, 14], [18, 11], [19, 6, 2, 1],
[20, 17], [21, 19], [22, 21], [23, 18],
[24,23,22,17], [25, 22], [26, 6, 2, 1], [27, 5, 2, 1],
[28, 25], [29, 27], [30, 6, 4, 1], [31, 28],
[32,22,2,1], [33,20], [34,27,2,1], [35,33],
[36,25], [37,5,4,3,2,1],[38,6,5,1], [39,35],
[40,38,21,19], [41,38], [42,41,20,19], [43,42,38,37],
[44,43,18,17], [45,44,42,41], [46,45,26,25], [47,42],
[48,47,21,20], [49,40], [50,49,24,23], [51,50,36,35],
[52,49], [53,52,38,37], [54,53,18,17], [55,31],
[56,55,35,34], [57,50], [58,39], [59,58,38,37],
[60,59], [61,60,46,45], [62,61,6,5], [63,62] ]
xor' :: [Bool] -> Bool
xor' = foldr xor False
mask :: (Num a, Bits a) => Int -> a
mask len = shift 1 len - 1
advance :: Int -> [Int] -> Int -> Int
advance len tap lfsr
| d0 = shifted
| otherwise = shifted .|. 1
where
shifted = shift lfsr 1 .&. mask len
d0 = xor' $ map (testBit lfsr) tap'
tap' = map (subtract 1) tap
main :: IO ()
main = do
args <- getArgs
when (null args) $ fail "Usage: lsfr <number-of-bits>"
let len = read $ head args
when (len < 8) $ fail "No need for LFSR"
let out = last $ take (shift 1 len) $ iterate (advance len (tap!!len)) 0
if out == 0 then do
putStr "OK\n"
exitSuccess
else do
putStr "FAIL\n"
exitFailure
基本上，它测试在 tap :: [[Int]] 中为任何给定的位长度定义的 LSFR 是否为最大长度。 （更准确地说，它只是检查 LSFR 是否在 2n 次迭代后达到初始状态（零）。）
根据分析器，成本最高的线路是反馈位 d0 = xor' $ map (testBit lfsr) tap'。
到目前为止我尝试过的：
- 使用
Data.Array：尝试放弃，因为没有foldl/r - 使用
Data.Vector：比基线 稍快
我使用的编译器选项是：-O2、LTS Haskell 8.12 (GHC-8.0.2).
可在 gist.github.com.
上找到参考 C++ 程序Haskell 代码不能指望（？）到 运行 和 C 代码一样快，但是两个数量级太多了，必须有更好的方法来做小摆弄。
更新：应用答案中建议的优化结果
- 输入为 28 的参考 C++ 程序，使用 LLVM 8.0.0 编译，运行s 在我的机器上用了 0.67s（与 clang 3.7 相同，稍慢，0.68s）
- 基线 Haskell 代码 运行 慢了大约 100 倍（由于 space 效率低下，请勿尝试使用大于 25 的输入）
- 随着
- 随着 @Thomas M. DuBuisson 的重写，现在使用 LLVM 后端（GHC 选项
-O2 -fllvm），执行时间下降到 1.7s- 使用 GHC 选项
-O2 -fllvm -optlc -mcpu=native将其缩短为 0.73s
- 使用 GHC 选项
- 用@cirdec 的
iterate'替换iterate在使用Thomas 的代码时没有任何区别（默认的'native' 后端和LLVM）。但是，确实 使用基线代码时有所不同。
所以，我们从 100 倍到 8 倍再到 1.09 倍，即只比 C 慢 9%！
备注
GHC 8.0.2 的 LLVM 后端需要 LLVM 3.7。在 Mac OS X 上，这意味着使用 brew 安装此版本，然后符号链接 opt 和 llc。参见 7.10. GHC Backends。
前期很重要
首先，我在 Intel I5 ~2.5GHz 上使用 GHC 8.0.1，linux x86-64。
初稿：哦不！变慢了！
您运行参数为 25 的起始代码：
% ghc -O2 orig.hs && time ./orig 25
[1 of 1] Compiling Main ( orig.hs, orig.o )
Linking orig ...
OK
./orig 25 7.25s user 0.50s system 99% cpu 7.748 total
所以击败的时间是 77 毫秒 - 比这个 Haskell 代码好两个数量级。让我们开始吧。
问题 1：Shifty 代码
我发现代码有几个奇怪之处。首先是在高性能代码中使用 shift。 Shift 同时支持左移和右移，为此它需要一个分支。让我们用 2 的更多可读性来杀死它 (shift 1 x ~> 2^x 和 shift x 1 ~> 2*x):
% ghc -O2 noShift.hs && time ./noShift 25
[1 of 1] Compiling Main ( noShift.hs, noShift.o )
Linking noShift ...
OK
./noShift 25 0.64s user 0.00s system 99% cpu 0.637 total
（正如您在评论中指出的那样：是的，这需要进行调查。可能是先前代码的某些奇怪之处阻止了重写规则的触发，结果导致了更糟糕的代码）
问题 2：位列表？国际行动拯救世界！
一个变化，一个数量级。耶。还有什么？好吧，你有这个尴尬的位位置列表，你正在窃听它似乎是在乞求低效率 and/or 依赖于脆弱的优化。在这一点上，我会注意到对该列表中的任何一个选择进行硬编码会产生非常好的性能（例如 testBit lsfr 24 `xor` testBit lsfr 21），但我们需要一个更通用的快速解决方案。
我建议我们计算 所有 抽头位置的掩码，然后进行单指令弹出计数。为此，我们只需要将单个 Int 传递给 advance 而不是整个列表。 popcount 指令需要良好的汇编生成，这需要 llvm 和可能 -optlc-mcpu=native 或其他非悲观的指令集选择。
这一步为我们提供了下面的 pc。我已经放弃了评论中提到的 advance 的守卫移除：
let tp = sum $ map ((2^) . subtract 1) (tap !! len)
pc lfsr = fromEnum (even (popCount (lfsr .&. tp)))
mask = 2^len - 1
advance' :: Int -> Int
advance' lfsr = (2*lfsr .&. mask) .|. pc lfsr
out :: Int
out = last $ take (2^len) $ iterate advance' 0
我们最终的表现是：
% ghc -O2 so.hs -fforce-recomp -fllvm -optlc-mcpu=native && time ./so 25
[1 of 1] Compiling Main ( so.hs, so.o )
Linking so ...
OK
./so 25 0.06s user 0.00s system 96% cpu 0.067 total
从头到尾超过两个数量级，所以希望它与您的 C 相匹配。最后，在部署的代码中，使用 C 绑定的 Haskell 包实际上是很常见的，但这通常是一种教育运动所以我希望你玩得开心。
编辑：现在可用的 C++ 代码需要我的系统 0.10 (g++ -O3) 和 0.12 (clang++ -O3 -march=native) 秒，所以看起来我们已经取得了相当大的成绩。
编译器是否将
tap !! len移出了循环？我怀疑它确实如此，但将其移出以保证不会造成伤害：let tap1 = tap !! len let out = last $ take (shift 1 len) $ iterate (advance len tap1) 0在评论中你说“
2^len只需要一次”，但这是错误的。您每次都在advance中执行此操作。所以你可以试试advance len tap mask lfsr | d0 = shifted | otherwise = shifted .|. 1 where shifted = shift lfsr 1 .&. mask d0 = xor' $ map (testBit lfsr) tap' tap' = map (subtract 1) tap -- in main let tap1 = tap !! len let numIterations = 2^len let mask = numIterations - 1 let out = iterate (advance len tap1 mask) 0 !! (numIterations - 1)（编译器通常不能将
last $ take ...优化为!!，因为它们对于有限列表是不同的，但是iterate总是 returns 一个无限列表。 )您将
foldr与foldl进行了比较，但foldlis almost never what you need；因为xor总是需要两个参数并且是关联的，所以foldl'很可能是正确的选择（编译器可以优化它，但是如果foldl和foldr而不仅仅是随机变化，在这种情况下它可能已经失败了）。
我怀疑以下行在评估之前在内存中构建了一个类似列表的大型 thunk。
let out = last $ take (shift 1 len) $ iterate (advance len (tap!!len)) 0` is
让我们看看我是否正确，如果我是正确的，我们将修复它。调试的第一步是了解程序使用的内存。为此，除了 -O2 之外，我们还要使用选项 -rtsopts 进行编译。这将启用 运行 具有 RTS options 的程序，包括 +RTS -s 输出一个小的内存摘要。
初始性能
运行 你的程序 lfsr 25 +RTS -s 我得到以下输出
OK
5,420,148,768 bytes allocated in the heap
6,705,977,216 bytes copied during GC
1,567,511,384 bytes maximum residency (20 sample(s))
357,862,432 bytes maximum slop
3025 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 10343 colls, 0 par 2.453s 2.522s 0.0002s 0.0009s
Gen 1 20 colls, 0 par 2.281s 3.065s 0.1533s 0.7128s
INIT time 0.000s ( 0.000s elapsed)
MUT time 1.438s ( 1.162s elapsed)
GC time 4.734s ( 5.587s elapsed)
EXIT time 0.016s ( 0.218s elapsed)
Total time 6.188s ( 6.967s elapsed)
%GC time 76.5% (80.2% elapsed)
Alloc rate 3,770,538,273 bytes per MUT second
Productivity 23.5% of total user, 19.8% of total elapsed
一次性使用大量内存。很可能那里某处有一个巨大的砰砰声。
正在尝试减小 thunk 大小
我假设 thunk 是在 iterate (advance ...) 中构建的。如果是这种情况，我们可以尝试通过在其 lsfr 参数中使 advance 更严格来减小 thunk 的大小。这不会删除 thunk 的脊柱（连续迭代），但它可能会减少在评估脊柱时建立的状态的大小。
BangPatterns 是在参数中使函数严格的一种简单方法。 f !x = .. 是 shorthand 对于 f x = seq x $ ...
{-# LANGUAGE BangPatterns #-}
advance :: Int -> [Int] -> Int -> Int
advance len tap = go
where
go !lfsr
| d0 = shifted
| otherwise = shifted .|. 1
where
shifted = shift lfsr 1 .&. mask len
d0 = xor' $ map (testBit lfsr) tap'
tap' = map (subtract 1) tap
让我们看看这有什么不同...
>lfsr 25 +RTS -s
OK
5,420,149,072 bytes allocated in the heap
6,705,979,368 bytes copied during GC
1,567,511,448 bytes maximum residency (20 sample(s))
357,862,448 bytes maximum slop
3025 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 10343 colls, 0 par 2.688s 2.711s 0.0003s 0.0059s
Gen 1 20 colls, 0 par 2.438s 3.252s 0.1626s 0.8013s
INIT time 0.000s ( 0.000s elapsed)
MUT time 1.328s ( 1.146s elapsed)
GC time 5.125s ( 5.963s elapsed)
EXIT time 0.000s ( 0.226s elapsed)
Total time 6.484s ( 7.335s elapsed)
%GC time 79.0% (81.3% elapsed)
Alloc rate 4,081,053,418 bytes per MUT second
Productivity 21.0% of total user, 18.7% of total elapsed
None 很明显。
消除脊柱
我猜这是正在构建的 iterate (advance ...) 的主干。毕竟，对于我是 运行 的命令，列表将是 2^25，或者超过 3300 万个项目。该列表本身可能已被 list fusion 删除，但列表最后一项的 thunk 已超过 3300 万 advance ...
为了解决这个问题，我们需要 iterate 的严格版本，以便在再次应用 advance 函数之前将值强制为 Int。这应该将内存保持在一次只有一个 lfsr 值，以及当前计算的 advance.
不幸的是，Data.List 中没有严格的 iterate。这是一个不放弃列表融合的方法，它为这个问题提供了其他重要的（我认为）性能优化。
{-# LANGUAGE BangPatterns #-}
import GHC.Base (build)
{-# NOINLINE [1] iterate' #-}
iterate' :: (a -> a) -> a -> [a]
iterate' f = go
where go !x = x : go (f x)
{-# NOINLINE [0] iterateFB' #-}
iterateFB' :: (a -> b -> b) -> (a -> a) -> a -> b
iterateFB' c f = go
where go !x = x `c` go (f x)
{-# RULES
"iterate'" [~1] forall f x. iterate' f x = build (\c _n -> iterateFB' c f x)
"iterateFB'" [1] iterateFB' (:) = iterate'
#-}
这只是 iterate from GHC.List（连同其所有重写规则），但在累积参数中变得严格。
配备严格迭代，iterate'，我们可以将麻烦的行更改为
let out = last $ take (shift 1 len) $ iterate' (advance len (tap!!len)) 0
我希望这会表现得更好。让我们看看...
>lfsr 25 +RTS -s
OK
3,758,156,184 bytes allocated in the heap
297,976 bytes copied during GC
43,800 bytes maximum residency (1 sample(s))
21,736 bytes maximum slop
1 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 7281 colls, 0 par 0.047s 0.008s 0.0000s 0.0000s
Gen 1 1 colls, 0 par 0.000s 0.000s 0.0002s 0.0002s
INIT time 0.000s ( 0.000s elapsed)
MUT time 0.750s ( 0.783s elapsed)
GC time 0.047s ( 0.008s elapsed)
EXIT time 0.000s ( 0.000s elapsed)
Total time 0.797s ( 0.792s elapsed)
%GC time 5.9% (1.0% elapsed)
Alloc rate 5,010,874,912 bytes per MUT second
Productivity 94.1% of total user, 99.0% of total elapsed
这使用了 0.00002 倍的内存和 运行 10 倍的速度。
我不知道这是否会改进 Thomas DeBuisson 的 iterate advance'。这很容易检查；将 iterate' 代码添加到该答案并使用 iterate' 代替该答案中的 iterate。