为什么我的函数的 pointfree 版本使用更多内存
Why does the pointfree version of my function use much more memory
我正在处理 Project Euler 问题并最终得到一个 Haskell 文件，其中包含一个如下所示的函数：
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f cs = foldr (\(cs', n) a -> fromBool (f cs cs') * n + a) 0
从 Foreign.Marshal.Utils 导入 fromBool 只是为了快速将 True 转换为 1 并将 False 转换为 0。
我试图从我的解决方案中获得更多的速度，所以我尝试从 foldr 切换到 foldl'（在过程中切换参数），因为我假设 foldr用在数字上没有多大意义。
根据 GHC 的分析器，从 foldr 切换到 foldl' 导致我分配了两倍多的内存。
为了好玩，我还决定用函数的无点版本替换 lambda：
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f cs = foldr ((+) . uncurry ((*) . fromBool . f cs)) 0
这导致我的内存分配比 foldr 版本增加了 20 倍。
现在这不是什么大问题，因为即使在 20 倍的情况下，总内存分配也只有大约 135Mb，并且程序的运行时间相对不受影响，如果有的话，更高的内存分配版本 运行稍微快一点。
但我真的很好奇这些结果是如何可能的，以便将来我没有那么多回旋余地时可以选择"right"功能。
编辑：
GHC 版本 7.10.2，使用 -O2 -prof -fprof-auto 编译。使用 +RTS -p.
执行
编辑 2：
好吧，看起来这太难重现了，不能省略其余的代码，下面是整个程序：
以下剧透：
{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Monad
import Data.List
import Foreign.Marshal.Utils
data Color = Red | Green | Blue deriving (Eq, Enum, Bounded, Show)
colors :: [Color]
colors = [Red ..]
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f x = foldr ((+) . uncurry ((*) . fromBool . f x)) 0
-- matches f x = foldr (\(y, n) a -> fromBool (f x y) * n + a) 0
-- matches f x = foldl' (\a (y, n) -> fromBool (f x y) * n + a) 0
invert :: [([Color], Int)] -> [([Color], Int)]
invert rs = (\cs -> (cs, matches valid cs rs)) <$> choices
where
len = maximum $ length . fst <$> rs
choices = replicateM len colors
valid (x : xs) (y : ys) = x /= y && valid xs ys
valid _ _ = True
expand :: [([Color], Int)] -> [([Color], Int)]
expand rs = (\cs -> (cs, matches valid cs rs)) <$> choices
where
len = maximum $ length . fst <$> rs
choices = replicateM (len + 1) colors
valid (x1 : x2 : xs) (y : ys) = x1 /= y && x2 /= y && valid (x2 : xs) ys
valid _ _ = True
getRow :: Int -> [([Color], Int)]
getRow 1 = flip (,) 1 . pure <$> colors
getRow n = expand . invert $ getRow (n - 1)
result :: Int -> Int
result n = sum $ snd <$> getRow n
main :: IO ()
main = print $ result 8
注：这个post写成识字Haskell。将其复制到一个文件中，将其保存为 *.lhs，并在 GHC(i) 中使用 compile/load。另外，我在您编辑代码之前就开始写这个答案，但课程保持不变。
TL;DR
Prelude 函数 uncurry 太懒了，而你的模式匹配就足够严格了。
警告和免责声明
我们正在进入一个神奇而奇怪的地方。谨防。此外，我的 CORE 能力还很初级。既然我已经失去了所有的信誉，让我们开始吧。
测试代码
为了知道我们从哪里得到额外的内存需求，拥有两个以上的函数是很有用的。
> import Control.Monad (forM_)
这是您的原始非无点变体：
> matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matches f cs = foldr (\(cs', n) a -> fromEnum (f cs cs') * n + a) 0
这是一个略微无点的变体，参数 a 减少了 eta。
> matchesPF' :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPF' f cs = foldr (\(cs', n) -> (+) (fromEnum (f cs cs') * n)) 0
这是一个手动内联 uncurry 的变体。
> matchesPFI :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFI f cs = foldr ((+) . (\(cs', n) -> fromEnum (f cs cs') * n)) 0
这是你的 pointfree 版本。
> matchesPF :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPF f cs = foldr ((+) . uncurry ((*) . fromEnum . f cs)) 0
这是一个使用自定义 uncurry 的变体，见下文。
> matchesPFU :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFU f cs = foldr ((+) . uncurryI ((*) . fromEnum . f cs)) 0
这是一个使用自定义惰性 uncurry 的变体，见下文。
> matchesPFL :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFL f cs = foldr ((+) . uncurryL ((*) . fromEnum . f cs)) 0
为了方便地测试函数，我们使用一个列表：
> funcs = [matches, matchesPF', matchesPF, matchesPFL, matchesPFU, matchesPFI]
我们自己写的uncurry:
> uncurryI :: (a -> b -> c) -> (a, b) -> c
> uncurryI f (a,b) = f a b
比较懒uncurry:
> uncurryL :: (a -> b -> c) -> (a, b) -> c
> uncurryL f p = f (fst p) (snd p)
惰性变体 uncurryL 与 Prelude 中的变体具有相同的语义，例如
uncurry (\_ _ -> 0) undefined == 0 == uncurryL (\_ _ -> 0) undefined
而 uncurryI 对两人的脊椎很严格。
> main = do
> let f a b = a < b
> forM_ [1..10] $ \i ->
> forM_ funcs $ \m ->
> print $ m f i (zip (cycle [1..10]) [1..i*100000])
列表 [1..i*100000] 有意依赖于 i，这样我们就不会引入 CAF 并扭曲我们的分配配置文件。
脱糖代码
在我们深入分析之前，让我们先看看每个函数的脱糖代码：
==================== Desugar (after optimization) ====================
Result size of Desugar (after optimization)
= {terms: 221, types: 419, coercions: 0}
uncurryL
uncurryL = \ @ a @ b @ c f p -> f (fst p) (snd p)
uncurryI
uncurryI = \ @ a @ b @ c f ds -> case ds of _ { (a, b) -> f a b }
-- uncurried inlined by hand
matchesPFI =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(\ ds ->
case ds of _ { (cs', n) ->
* $fNumInt (fromEnum $fEnumBool (f cs cs')) n
}))
(I# 0)
-- lazy uncurry
matchesPFL =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurryL (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- stricter uncurry
matchesPFU =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurryI (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- normal uncurry
matchesPF =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurry (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- eta-reduced a
matchesPF' =
\ @ a f cs ->
foldr
$fFoldable[]
(\ ds ->
case ds of _ { (cs', n) ->
+ $fNumInt (* $fNumInt (fromEnum $fEnumBool (f cs cs')) n)
})
(I# 0)
-- non-point-free
matches =
\ @ a f cs ->
foldr
$fFoldable[]
(\ ds a ->
case ds of _ { (cs', n) ->
+ $fNumInt (* $fNumInt (fromEnum $fEnumBool (f cs cs')) n) a
})
(I# 0)
到目前为止，一切似乎都很好。没有什么令人惊讶的事情发生。类型类函数被替换为它们的字典变体，例如foldr 变为 </code>foldr $fFoldable[]`，因为我们在列表中调用它。</p>
<h2>简介</h2>
<pre> Mon Jul 18 15:47 2016 Time and Allocation Profiling Report (Final)
Prof +RTS -s -p -RTS
total time = 1.45 secs (1446 ticks @ 1000 us, 1 processor)
total alloc = 1,144,197,200 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
matchesPF' Main 13.6 0.0
matchesPF Main 13.3 11.5
main.\.\ Main 11.8 76.9
main.f Main 10.9 0.0
uncurryL Main 9.5 11.5
matchesPFU Main 8.9 0.0
matchesPFI Main 7.3 0.0
matches Main 6.9 0.0
matchesPFL Main 6.3 0.0
uncurryI Main 5.3 0.0
matchesPF'.\ Main 2.6 0.0
matchesPFI.\ Main 2.0 0.0
matches.\ Main 1.5 0.0
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 44 0 0.0 0.0 100.0 100.0
main Main 89 0 0.0 0.0 100.0 100.0
main.\ Main 90 10 0.0 0.0 100.0 100.0
main.\.\ Main 92 60 11.8 76.9 100.0 100.0
funcs Main 93 0 0.0 0.0 88.2 23.1
matchesPFI Main 110 10 7.3 0.0 11.7 0.0
matchesPFI.\ Main 111 5500000 2.0 0.0 4.4 0.0
main.f Main 112 5500000 2.4 0.0 2.4 0.0
matchesPFU Main 107 10 8.9 0.0 15.3 0.0
uncurryI Main 108 5500000 5.3 0.0 6.4 0.0
main.f Main 109 5500000 1.1 0.0 1.1 0.0
matchesPFL Main 104 10 6.3 0.0 17.7 11.5
uncurryL Main 105 5500000 9.5 11.5 11.4 11.5
main.f Main 106 5500000 1.9 0.0 1.9 0.0
matchesPF Main 102 10 13.3 11.5 15.4 11.5
main.f Main 103 5500000 2.1 0.0 2.1 0.0
matchesPF' Main 99 10 13.6 0.0 17.2 0.0
matchesPF'.\ Main 100 5500000 2.6 0.0 3.6 0.0
main.f Main 101 5500000 1.0 0.0 1.0 0.0
matches Main 94 10 6.9 0.0 10.9 0.0
matches.\ Main 97 5500000 1.5 0.0 4.0 0.0
main.f Main 98 5500000 2.5 0.0 2.5 0.0
CAF Main 87 0 0.0 0.0 0.0 0.0
funcs Main 91 1 0.0 0.0 0.0 0.0
main Main 88 1 0.0 0.0 0.0 0.0
main.\ Main 95 0 0.0 0.0 0.0 0.0
main.\.\ Main 96 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.FD 84 0 0.0 0.0 0.0 0.0
CAF GHC.Conc.Signal 78 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding 76 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.Text 75 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding.Iconv 59 0 0.0 0.0 0.0 0.0
</pre>
<p>忽略 <code>main\.\. 噪音，它只是列表。但是，有一点应该立即引起注意：matchesPF 和 uncurryL 使用相同的 alloc%:
matchesPF Main 13.3 11.5
uncurryL Main 9.5 11.5
进入核心
现在是检查生成的 CORE (ghc -ddump-simpl) 的时候了。我们会注意到大部分函数都已转换为 worker wrapper，并且它们看起来或多或少相同 (-dsuppress-all -dsuppress-uniques):
$wa5
$wa5 =
\ @ a1 w w1 w2 ->
letrec {
$wgo
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case y of _ { (cs', n) ->
case $wgo ys of ww { __DEFAULT ->
case w w1 cs' of _ {
False -> case n of _ { I# y1 -> ww };
True -> case n of _ { I# y1 -> +# y1 ww }
}
}
}
}; } in
$wgo w2
这是您常用的 worker-wrapper。 $wgo 接受一个列表，检查它是否为空，头部是严格的（case y of _ { (cs', n) ->…），递归结果是惰性的 $wgo ys of ww.
所有功能看起来都一样。嗯，除了 matchesPF（你的变体）
-- matchesPF
$wa3 =
\ @ a1 w w1 w2 ->
letrec {
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case $wgo ys of ww { __DEFAULT ->
case let {
x = case y of _ { (x1, ds) -> x1 } } in
case w w1 x of _ {
False ->
case y of _ { (ds, y1) -> case y1 of _ { I# y2 -> main13 } };
-- main13 is just #I 0
True -> case y of _ { (ds, y1) -> y1 }
}
of _ { I# x ->
+# x ww
}
}
}; } in
$wgo w2
和matchesPFL（使用惰性uncurryL的变体）
-- matchesPFL
$wa2
$wa2 =
\ @ a1 w w1 w2 ->
letrec {
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case $wgo ys of ww { __DEFAULT ->
case snd y of ww1 { I# ww2 ->
case let {
x = fst y } in
case w w1 x of _ {
False -> main13;
True -> ww1
}
of _ { I# x ->
+# x ww
}
}
}
}; } in
$wgo w2
它们几乎是一样的。它们都包含 let 绑定。这将创建一个 thunk，通常会导致更糟糕的 space 要求。
解决方法
我认为此时的罪魁祸首已经很清楚了。是uncurry。 GHC 想要执行
的正确语义
uncurry (const (const 0)) undefined
但是，这会增加惰性和额外的 thunk。您的非 pointfree 变体不会引入该行为，因为您在该对上进行了模式匹配：
foldr (\(cs', n) a -> …)
还是不相信我？使用惰性模式匹配
foldr (\ ~(cs', n) a -> …)
您会注意到 matches 的行为与 matchesPF 相同。所以使用 uncurry 稍微严格一点的变体。 uncurryI 足以给严格性分析器一个提示。
请注意，配对因这种行为而臭名昭著。 RWH spents a whole chapter trying to optimize the behaviour of a single function 中间对会导致问题。
我正在处理 Project Euler 问题并最终得到一个 Haskell 文件，其中包含一个如下所示的函数：
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f cs = foldr (\(cs', n) a -> fromBool (f cs cs') * n + a) 0
从 Foreign.Marshal.Utils 导入 fromBool 只是为了快速将 True 转换为 1 并将 False 转换为 0。
我试图从我的解决方案中获得更多的速度，所以我尝试从 foldr 切换到 foldl'（在过程中切换参数），因为我假设 foldr用在数字上没有多大意义。
根据 GHC 的分析器，从 foldr 切换到 foldl' 导致我分配了两倍多的内存。
为了好玩，我还决定用函数的无点版本替换 lambda：
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f cs = foldr ((+) . uncurry ((*) . fromBool . f cs)) 0
这导致我的内存分配比 foldr 版本增加了 20 倍。
现在这不是什么大问题，因为即使在 20 倍的情况下，总内存分配也只有大约 135Mb，并且程序的运行时间相对不受影响，如果有的话，更高的内存分配版本 运行稍微快一点。
但我真的很好奇这些结果是如何可能的，以便将来我没有那么多回旋余地时可以选择"right"功能。
编辑：
GHC 版本 7.10.2，使用 -O2 -prof -fprof-auto 编译。使用 +RTS -p.
编辑 2：
好吧，看起来这太难重现了，不能省略其余的代码，下面是整个程序：
以下剧透：
{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Monad
import Data.List
import Foreign.Marshal.Utils
data Color = Red | Green | Blue deriving (Eq, Enum, Bounded, Show)
colors :: [Color]
colors = [Red ..]
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f x = foldr ((+) . uncurry ((*) . fromBool . f x)) 0
-- matches f x = foldr (\(y, n) a -> fromBool (f x y) * n + a) 0
-- matches f x = foldl' (\a (y, n) -> fromBool (f x y) * n + a) 0
invert :: [([Color], Int)] -> [([Color], Int)]
invert rs = (\cs -> (cs, matches valid cs rs)) <$> choices
where
len = maximum $ length . fst <$> rs
choices = replicateM len colors
valid (x : xs) (y : ys) = x /= y && valid xs ys
valid _ _ = True
expand :: [([Color], Int)] -> [([Color], Int)]
expand rs = (\cs -> (cs, matches valid cs rs)) <$> choices
where
len = maximum $ length . fst <$> rs
choices = replicateM (len + 1) colors
valid (x1 : x2 : xs) (y : ys) = x1 /= y && x2 /= y && valid (x2 : xs) ys
valid _ _ = True
getRow :: Int -> [([Color], Int)]
getRow 1 = flip (,) 1 . pure <$> colors
getRow n = expand . invert $ getRow (n - 1)
result :: Int -> Int
result n = sum $ snd <$> getRow n
main :: IO ()
main = print $ result 8
注：这个post写成识字Haskell。将其复制到一个文件中，将其保存为 *.lhs，并在 GHC(i) 中使用 compile/load。另外，我在您编辑代码之前就开始写这个答案，但课程保持不变。
TL;DR
Prelude 函数 uncurry 太懒了，而你的模式匹配就足够严格了。
警告和免责声明
我们正在进入一个神奇而奇怪的地方。谨防。此外，我的 CORE 能力还很初级。既然我已经失去了所有的信誉，让我们开始吧。
测试代码
为了知道我们从哪里得到额外的内存需求，拥有两个以上的函数是很有用的。
> import Control.Monad (forM_)
这是您的原始非无点变体：
> matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matches f cs = foldr (\(cs', n) a -> fromEnum (f cs cs') * n + a) 0
这是一个略微无点的变体，参数 a 减少了 eta。
> matchesPF' :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPF' f cs = foldr (\(cs', n) -> (+) (fromEnum (f cs cs') * n)) 0
这是一个手动内联 uncurry 的变体。
> matchesPFI :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFI f cs = foldr ((+) . (\(cs', n) -> fromEnum (f cs cs') * n)) 0
这是你的 pointfree 版本。
> matchesPF :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPF f cs = foldr ((+) . uncurry ((*) . fromEnum . f cs)) 0
这是一个使用自定义 uncurry 的变体，见下文。
> matchesPFU :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFU f cs = foldr ((+) . uncurryI ((*) . fromEnum . f cs)) 0
这是一个使用自定义惰性 uncurry 的变体，见下文。
> matchesPFL :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFL f cs = foldr ((+) . uncurryL ((*) . fromEnum . f cs)) 0
为了方便地测试函数，我们使用一个列表：
> funcs = [matches, matchesPF', matchesPF, matchesPFL, matchesPFU, matchesPFI]
我们自己写的uncurry:
> uncurryI :: (a -> b -> c) -> (a, b) -> c
> uncurryI f (a,b) = f a b
比较懒uncurry:
> uncurryL :: (a -> b -> c) -> (a, b) -> c
> uncurryL f p = f (fst p) (snd p)
惰性变体 uncurryL 与 Prelude 中的变体具有相同的语义，例如
uncurry (\_ _ -> 0) undefined == 0 == uncurryL (\_ _ -> 0) undefined
而 uncurryI 对两人的脊椎很严格。
> main = do
> let f a b = a < b
> forM_ [1..10] $ \i ->
> forM_ funcs $ \m ->
> print $ m f i (zip (cycle [1..10]) [1..i*100000])
列表 [1..i*100000] 有意依赖于 i，这样我们就不会引入 CAF 并扭曲我们的分配配置文件。
脱糖代码
在我们深入分析之前，让我们先看看每个函数的脱糖代码：
==================== Desugar (after optimization) ====================
Result size of Desugar (after optimization)
= {terms: 221, types: 419, coercions: 0}
uncurryL
uncurryL = \ @ a @ b @ c f p -> f (fst p) (snd p)
uncurryI
uncurryI = \ @ a @ b @ c f ds -> case ds of _ { (a, b) -> f a b }
-- uncurried inlined by hand
matchesPFI =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(\ ds ->
case ds of _ { (cs', n) ->
* $fNumInt (fromEnum $fEnumBool (f cs cs')) n
}))
(I# 0)
-- lazy uncurry
matchesPFL =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurryL (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- stricter uncurry
matchesPFU =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurryI (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- normal uncurry
matchesPF =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurry (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- eta-reduced a
matchesPF' =
\ @ a f cs ->
foldr
$fFoldable[]
(\ ds ->
case ds of _ { (cs', n) ->
+ $fNumInt (* $fNumInt (fromEnum $fEnumBool (f cs cs')) n)
})
(I# 0)
-- non-point-free
matches =
\ @ a f cs ->
foldr
$fFoldable[]
(\ ds a ->
case ds of _ { (cs', n) ->
+ $fNumInt (* $fNumInt (fromEnum $fEnumBool (f cs cs')) n) a
})
(I# 0)
到目前为止，一切似乎都很好。没有什么令人惊讶的事情发生。类型类函数被替换为它们的字典变体，例如foldr 变为 </code>foldr $fFoldable[]`，因为我们在列表中调用它。</p>
<h2>简介</h2>
<pre> Mon Jul 18 15:47 2016 Time and Allocation Profiling Report (Final)
Prof +RTS -s -p -RTS
total time = 1.45 secs (1446 ticks @ 1000 us, 1 processor)
total alloc = 1,144,197,200 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
matchesPF' Main 13.6 0.0
matchesPF Main 13.3 11.5
main.\.\ Main 11.8 76.9
main.f Main 10.9 0.0
uncurryL Main 9.5 11.5
matchesPFU Main 8.9 0.0
matchesPFI Main 7.3 0.0
matches Main 6.9 0.0
matchesPFL Main 6.3 0.0
uncurryI Main 5.3 0.0
matchesPF'.\ Main 2.6 0.0
matchesPFI.\ Main 2.0 0.0
matches.\ Main 1.5 0.0
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 44 0 0.0 0.0 100.0 100.0
main Main 89 0 0.0 0.0 100.0 100.0
main.\ Main 90 10 0.0 0.0 100.0 100.0
main.\.\ Main 92 60 11.8 76.9 100.0 100.0
funcs Main 93 0 0.0 0.0 88.2 23.1
matchesPFI Main 110 10 7.3 0.0 11.7 0.0
matchesPFI.\ Main 111 5500000 2.0 0.0 4.4 0.0
main.f Main 112 5500000 2.4 0.0 2.4 0.0
matchesPFU Main 107 10 8.9 0.0 15.3 0.0
uncurryI Main 108 5500000 5.3 0.0 6.4 0.0
main.f Main 109 5500000 1.1 0.0 1.1 0.0
matchesPFL Main 104 10 6.3 0.0 17.7 11.5
uncurryL Main 105 5500000 9.5 11.5 11.4 11.5
main.f Main 106 5500000 1.9 0.0 1.9 0.0
matchesPF Main 102 10 13.3 11.5 15.4 11.5
main.f Main 103 5500000 2.1 0.0 2.1 0.0
matchesPF' Main 99 10 13.6 0.0 17.2 0.0
matchesPF'.\ Main 100 5500000 2.6 0.0 3.6 0.0
main.f Main 101 5500000 1.0 0.0 1.0 0.0
matches Main 94 10 6.9 0.0 10.9 0.0
matches.\ Main 97 5500000 1.5 0.0 4.0 0.0
main.f Main 98 5500000 2.5 0.0 2.5 0.0
CAF Main 87 0 0.0 0.0 0.0 0.0
funcs Main 91 1 0.0 0.0 0.0 0.0
main Main 88 1 0.0 0.0 0.0 0.0
main.\ Main 95 0 0.0 0.0 0.0 0.0
main.\.\ Main 96 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.FD 84 0 0.0 0.0 0.0 0.0
CAF GHC.Conc.Signal 78 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding 76 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.Text 75 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding.Iconv 59 0 0.0 0.0 0.0 0.0
</pre>
<p>忽略 <code>main\.\. 噪音，它只是列表。但是，有一点应该立即引起注意：matchesPF 和 uncurryL 使用相同的 alloc%:
matchesPF Main 13.3 11.5
uncurryL Main 9.5 11.5
进入核心
现在是检查生成的 CORE (ghc -ddump-simpl) 的时候了。我们会注意到大部分函数都已转换为 worker wrapper，并且它们看起来或多或少相同 (-dsuppress-all -dsuppress-uniques):
$wa5
$wa5 =
\ @ a1 w w1 w2 ->
letrec {
$wgo
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case y of _ { (cs', n) ->
case $wgo ys of ww { __DEFAULT ->
case w w1 cs' of _ {
False -> case n of _ { I# y1 -> ww };
True -> case n of _ { I# y1 -> +# y1 ww }
}
}
}
}; } in
$wgo w2
这是您常用的 worker-wrapper。 $wgo 接受一个列表，检查它是否为空，头部是严格的（case y of _ { (cs', n) ->…），递归结果是惰性的 $wgo ys of ww.
所有功能看起来都一样。嗯，除了 matchesPF（你的变体）
-- matchesPF
$wa3 =
\ @ a1 w w1 w2 ->
letrec {
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case $wgo ys of ww { __DEFAULT ->
case let {
x = case y of _ { (x1, ds) -> x1 } } in
case w w1 x of _ {
False ->
case y of _ { (ds, y1) -> case y1 of _ { I# y2 -> main13 } };
-- main13 is just #I 0
True -> case y of _ { (ds, y1) -> y1 }
}
of _ { I# x ->
+# x ww
}
}
}; } in
$wgo w2
和matchesPFL（使用惰性uncurryL的变体）
-- matchesPFL
$wa2
$wa2 =
\ @ a1 w w1 w2 ->
letrec {
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case $wgo ys of ww { __DEFAULT ->
case snd y of ww1 { I# ww2 ->
case let {
x = fst y } in
case w w1 x of _ {
False -> main13;
True -> ww1
}
of _ { I# x ->
+# x ww
}
}
}
}; } in
$wgo w2
它们几乎是一样的。它们都包含 let 绑定。这将创建一个 thunk，通常会导致更糟糕的 space 要求。
解决方法
我认为此时的罪魁祸首已经很清楚了。是uncurry。 GHC 想要执行
uncurry (const (const 0)) undefined
但是，这会增加惰性和额外的 thunk。您的非 pointfree 变体不会引入该行为，因为您在该对上进行了模式匹配：
foldr (\(cs', n) a -> …)
还是不相信我？使用惰性模式匹配
foldr (\ ~(cs', n) a -> …)
您会注意到 matches 的行为与 matchesPF 相同。所以使用 uncurry 稍微严格一点的变体。 uncurryI 足以给严格性分析器一个提示。
请注意，配对因这种行为而臭名昭著。 RWH spents a whole chapter trying to optimize the behaviour of a single function 中间对会导致问题。