Haskell Arrows 中的 Proc 语法导致严重的性能损失
Proc syntax in Haskell Arrows leads to severe performance penalty
对 Arrow
使用 proc
符号似乎会降低我项目的性能。这是问题的玩具示例:
我们定义协程新类型(主要是从 Generalizing Streams into Coroutines 复制)来表示具有 Category
和 Arrow
实例的 Mealy 机器(即携带某些状态的函数),写 scan
包装函数和 evalList
列表的运行函数。
然后我们有 sumArr
和 sumArr'
函数,后者是在 proc
块中调用的前者。
在 OS X 上使用 ghc-8.0.2 与 stack ghc -- --make test.hs -O2
编译我得到的运行时间为 sumArr
的 0.087 秒和 sumArr'
的 3.263 秒(内存很大)足迹)。
我想知道这是否实际上是由使用 proc
引起的,以及在使用 proc
符号时我是否可以做一些事情来获得正常的运行时行为(没有它的箭头代码很痛苦) .谢谢。
{-# LANGUAGE Arrows #-}
{-# LANGUAGE BangPatterns #-}
import Prelude hiding (id, (.))
import Control.Arrow
import Control.Category
import qualified Data.List as L
newtype Coroutine i o = Coroutine { runC :: i -> (o, Coroutine i o) }
instance Category Coroutine where
id = Coroutine $ \i -> (i, id)
cof . cog = Coroutine $ \i ->
let (x, cog') = runC cog i
(y, cof') = runC cof x
in (y, cof' . cog')
instance Arrow Coroutine where
arr f = Coroutine $ \i -> (f i, arr f)
first co = Coroutine $ \(a,b) ->
let (c, co') = runC co a in ((c,b), first co')
scan :: (o -> t -> o) -> o -> Coroutine t o
scan f = go where
go i = Coroutine $ step i where
step a b = let !a' = f a b in (a', go a')
evalList :: Coroutine a b -> [a] -> [b]
evalList a = L.map fst . L.drop 1 . L.scanl' (\(_, acc) v -> let !x = runC acc v in x) (undefined, a)
sumArr, sumArr' :: Coroutine Int Int
sumArr = scan (\acc x -> let !newAcc = acc + x in newAcc) 0
sumArr' = proc v -> do sumArr -< v
testData :: [Int]
testData = [1..1000000]
main = print $ L.last $ evalList sumArr' testData
是的,这可能是由 proc
符号引起的。脱糖是非常低级的,引入了很多(不必要的)arr
并且根本没有利用 &&&
或 ***
。
例如,上次我检查过,这个:
mulA f g = proc x -> do
a <- f -< x
b <- g -< x
returnA -< a * b
被脱糖成这样的东西:
mulA f g = arr dup
>>> first f
>>> arr swap
>>> first g
>>> arr mul
where
dup x = (x, x)
swap (x, y) = (y, x)
mul = uncurry (*)
什么时候可以这样:
mulA f g = f &&& g >>> arr mul
还有这个:
proc x -> do
a <- f -< x
b <- g -< a
returnA -< b
变成这样:
arr id
>>> f
>>> arr id
>>> g
>>> arr id
>>> returnA
而不是这个:
f >>> g
此外,我认为没有任何 GHC 重写规则利用箭头定律来帮助解决这个问题。
我发现 arrowp-qq 将 proc
块包装在准引号内,并且似乎比本地脱糖器产生更好的输出。我们示例的以下版本恢复了性能:
{-# LANGUAGE QuasiQuotes #-}
...
import Control.Arrow.QuasiQuoter
...
sumArrQQ = [proc| x -> do sumArr -< x |]
我遇到的一个问题是这些准引号与引号内的原始数字不能很好地搭配。
sumArrQQ' = [proc| x -> do sumArr -< x + 2 |] -- gives an error
sumArrQQ'' = [proc| x -> do sumArr -< plus2 x |] -- compiles fine
where plus2 = (+) 2
对 Arrow
使用 proc
符号似乎会降低我项目的性能。这是问题的玩具示例:
我们定义协程新类型(主要是从 Generalizing Streams into Coroutines 复制)来表示具有 Category
和 Arrow
实例的 Mealy 机器(即携带某些状态的函数),写 scan
包装函数和 evalList
列表的运行函数。
然后我们有 sumArr
和 sumArr'
函数,后者是在 proc
块中调用的前者。
在 OS X 上使用 ghc-8.0.2 与 stack ghc -- --make test.hs -O2
编译我得到的运行时间为 sumArr
的 0.087 秒和 sumArr'
的 3.263 秒(内存很大)足迹)。
我想知道这是否实际上是由使用 proc
引起的,以及在使用 proc
符号时我是否可以做一些事情来获得正常的运行时行为(没有它的箭头代码很痛苦) .谢谢。
{-# LANGUAGE Arrows #-}
{-# LANGUAGE BangPatterns #-}
import Prelude hiding (id, (.))
import Control.Arrow
import Control.Category
import qualified Data.List as L
newtype Coroutine i o = Coroutine { runC :: i -> (o, Coroutine i o) }
instance Category Coroutine where
id = Coroutine $ \i -> (i, id)
cof . cog = Coroutine $ \i ->
let (x, cog') = runC cog i
(y, cof') = runC cof x
in (y, cof' . cog')
instance Arrow Coroutine where
arr f = Coroutine $ \i -> (f i, arr f)
first co = Coroutine $ \(a,b) ->
let (c, co') = runC co a in ((c,b), first co')
scan :: (o -> t -> o) -> o -> Coroutine t o
scan f = go where
go i = Coroutine $ step i where
step a b = let !a' = f a b in (a', go a')
evalList :: Coroutine a b -> [a] -> [b]
evalList a = L.map fst . L.drop 1 . L.scanl' (\(_, acc) v -> let !x = runC acc v in x) (undefined, a)
sumArr, sumArr' :: Coroutine Int Int
sumArr = scan (\acc x -> let !newAcc = acc + x in newAcc) 0
sumArr' = proc v -> do sumArr -< v
testData :: [Int]
testData = [1..1000000]
main = print $ L.last $ evalList sumArr' testData
是的,这可能是由 proc
符号引起的。脱糖是非常低级的,引入了很多(不必要的)arr
并且根本没有利用 &&&
或 ***
。
例如,上次我检查过,这个:
mulA f g = proc x -> do
a <- f -< x
b <- g -< x
returnA -< a * b
被脱糖成这样的东西:
mulA f g = arr dup
>>> first f
>>> arr swap
>>> first g
>>> arr mul
where
dup x = (x, x)
swap (x, y) = (y, x)
mul = uncurry (*)
什么时候可以这样:
mulA f g = f &&& g >>> arr mul
还有这个:
proc x -> do
a <- f -< x
b <- g -< a
returnA -< b
变成这样:
arr id
>>> f
>>> arr id
>>> g
>>> arr id
>>> returnA
而不是这个:
f >>> g
此外,我认为没有任何 GHC 重写规则利用箭头定律来帮助解决这个问题。
我发现 arrowp-qq 将 proc
块包装在准引号内,并且似乎比本地脱糖器产生更好的输出。我们示例的以下版本恢复了性能:
{-# LANGUAGE QuasiQuotes #-}
...
import Control.Arrow.QuasiQuoter
...
sumArrQQ = [proc| x -> do sumArr -< x |]
我遇到的一个问题是这些准引号与引号内的原始数字不能很好地搭配。
sumArrQQ' = [proc| x -> do sumArr -< x + 2 |] -- gives an error
sumArrQQ'' = [proc| x -> do sumArr -< plus2 x |] -- compiles fine
where plus2 = (+) 2