Haskell Arrows 中的 Proc 语法导致严重的性能损失

Proc syntax in Haskell Arrows leads to severe performance penalty

Arrow 使用 proc 符号似乎会降低我项目的性能。这是问题的玩具示例:

我们定义协程新类型(主要是从 Generalizing Streams into Coroutines 复制)来表示具有 CategoryArrow 实例的 Mealy 机器(即携带某些状态的函数),写 scan 包装函数和 evalList 列表的运行函数。

然后我们有 sumArrsumArr' 函数,后者是在 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-qqproc 块包装在准引号内,并且似乎比本地脱糖器产生更好的输出。我们示例的以下版本恢复了性能:

{-# 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