Синтаксис Proc в Haskell Arrows приводит к серьезному снижению производительности

Использование обозначения proc для Arrow, похоже, приводит к снижению производительности в моем проекте. Вот пример игры:

Мы определяем newtype для Coroutine (главным образом, копируем из Обобщение потоков в Coroutines) для представления машин Мили (т.е. функций которые несут какое-то состояние) с экземплярами Category и Arrow, напишите scan функцию-обертку и evalList функцию runner для списков.

Тогда мы имеем функции sumArr и sumArr', где последний является первым, называемым в блоке proc.

Компиляция с помощью stack ghc -- --make test.hs -O2 с использованием ghc-8.0.2 на OS X Я получаю время выполнения 0,087 сек для sumArr и 3.263 с для sumArr' (с большой нагрузкой на память).

Я хотел бы знать, действительно ли это вызвано использованием 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

Ответ 1

Да, это, вероятно, вызвано нотой proc. Desugaring очень низкоуровневый, вводя много (ненужно) 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, которые используют законы стрелок, чтобы помочь объяснить это.

Ответ 2

Я нашел arrowp-qq, который обертывает proc блоки внутри квазикоктов и, кажется, дает лучший результат, чем собственный desugarer. Производительность восстанавливается в следующей версии нашего примера:

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