Постоянно увеличивающееся потребление ресурсов процессора с помощью Haskell и Stream-Fusion

Question

Вот короткая программа на Haskell, которая генерирует звук 440 Гц. Он использует pulseaudio в качестве аудио-бэкенда.

import GHC.Float
import Control.Arrow
import Sound.Pulse.Simple
import qualified Data.List.Stream as S
import Data.List

type Time = Double
type Frequency = Double
type Sample = Double
type CV = Double

chunksize = 441 * 2
sampleRate :: (Fractional a) => a
sampleRate = 44100

integral :: [Double] -> [Double]
integral = scanl1  (\acc x -> acc + x / sampleRate)

chunks :: Int -> [a] -> [[a]]
chunks n = S.takeWhile (not . S.null) . S.unfoldr (Just . S.splitAt n)

pulseaudioOutput :: [Sample] -> IO ()
pulseaudioOutput sx = do

    pa <- simpleNew Nothing "Synths" Play Nothing "Synths PCM output"
         (SampleSpec (F32 LittleEndian) 44100 1) Nothing Nothing

    mapM_ (simpleWrite pa . S.map double2Float) $ chunks 1000 sx

    simpleDrain pa
    simpleFree pa

oscSine :: Frequency -> [CV] ->  [Sample]
oscSine f = S.map sin <<< integral <<< S.map ((2 * pi * f *) . (2**))

music ::[Sample]
music = oscSine 440 (S.repeat 0)

main = do
    pulseaudioOutput music

Если я скомпилирую и запуском этого, я вижу растущее потребление процессора.

Если я изменил "S.splitAt" на "splitAt" в определении "куски", все в порядке.

Кто-нибудь может догадаться, почему это может быть?

Спасибо.

Обновить

В следующем коде все три версии чанков могут производить вышеупомянутое поведение:

import GHC.Float
import Control.Arrow
import Sound.Pulse.Simple
import Data.List.Stream

import Prelude hiding ( unfoldr
                      , map
                      , null
                      , scanl1
                      , takeWhile
                      , repeat
                      , splitAt
                      , drop
                      , take
                      )

type Time = Double
type Frequency = Double
type Sample = Double
type CV = Double

chunksize = 441 * 2
sampleRate :: (Fractional a) => a
sampleRate = 44100

integral :: [Double] -> [Double]
integral = scanl1  (\acc x -> acc + x / sampleRate)

chunks :: Int -> [a] -> [[a]]
--chunks n = takeWhile (not . null) . unfoldr (Just . splitAt n)
--chunks n xs = take n xs : chunks n (drop n xs)
chunks n xs = h : chunks n t
    where
        (h, t) = splitAt n xs

pulseaudioOutput :: [Sample] -> IO ()
pulseaudioOutput sx = do

    pa <- simpleNew Nothing "Synths" Play Nothing "Synths PCM output"
         (SampleSpec (F32 LittleEndian) 44100 1) Nothing Nothing

    mapM_ (simpleWrite pa . map double2Float) $ chunks 1000 sx

    simpleDrain pa
    simpleFree pa

oscSine :: Frequency -> [CV] ->  [Sample]
oscSine f = map sin <<< integral <<< map ((2 * pi * f *) . (2**))

music ::[Sample]
music = oscSine 440 (repeat 0)

main = do
    pulseaudioOutput music

Я очистил код, чтобы избежать смешивания старых и старых списков потоков. Утечка памяти / процессора все еще там. Чтобы увидеть, что код работает со старыми списками, просто удалите импорт Prelude и ".Stream" после "Data.List".

Answer 1

splitAt для потоков, заменяемых правилами объединения ( http://hackage.haskell.org/package/stream-fusion-0.1.2.5/docs/Data-Stream.html), имеет следующую подпись:

splitAt :: Int -> Stream a -> ([a], [a])

Из этого мы можем видеть, что, поскольку он создает списки, а не потоки, это препятствует дальнейшему объединению. Я думаю, что правильнее всего сделать splitAt который генерирует потоки, или еще лучше написать chunks функционировать непосредственно в потоках с соответствующими правилами слияния из версии списка.

Вот splitAt на потоках, которые я думаю, должно быть хорошо. Вам, конечно, нужно соединить его с соответствующими правилами перезаписи splitAt в списках, и если эти правила переписать сложно, возможно, напишите chunks работать напрямую, хотя это тоже кажется немного сложным:

splitAt :: Int -> Stream a -> (Stream a, Stream a)
splitAt n0 (Stream next s0)
  | n0 < 0    = (nilStream, (Stream next s0))
  | otherwise = loop_splitAt n0 s0
  where
    nilStream = Stream (const Done) s0
    loop_splitAt  0 !s = (nilStream, (Stream next s))
    loop_splitAt !n !s = case next s of
      Done            -> (nilStream, nilStream)
      Skip    s'      -> loop_splitAt n s'
      Yield x s'      -> (cons x xs', xs'')
        where
          (xs', xs'') = loop_splitAt (n-1) s'