module Sound.Signal.Block where import Data.Array (Array, (!), listArray) import qualified Sound.Signal as Signal import qualified Synthesizer.Plain.Signal as ListSignal import qualified Data.List as List import NumericPrelude.Condition (toMaybe) import Prelude hiding ((++), iterate, foldl, zipWith, tail, head) instance Signal.C T where singleton = singleton unfoldR = unfoldR defaultChunkSize reduceL = reduceL mapAccumL = mapAccumL defaultChunkSize (++) = append zipWith = zipWith defaultChunkSize type ChunkSize = Int defaultChunkSize :: ChunkSize defaultChunkSize = 256 newtype T a = Cons { chunks :: [Chunk a] } deriving (Show) {- | The array starts with index 0. We always consider a subarray of 'body' starting at 'offset' with size 'size'. This way we safe copy operations and we can efficiently 'drop', 'take' and 'append' chunk lists. Unfortunately, 'Data.Array' does not provide subarrays with sharing. Every chunk must have at least size 1. -} data Chunk a = Chunk { offset :: Int, size :: ChunkSize, body :: Array Int a } deriving (Show) singleton :: a -> T a singleton x = Cons [Chunk 0 1 (listArray (0,0) [x])] isEmpty :: T a -> Bool isEmpty (Cons x) = null x head :: T a -> a head (Cons xt) = case xt of [] -> error "Signal.Block.head: empty list" (Chunk start _ arr : _) -> arr ! start tail :: T a -> T a tail (Cons xt) = case xt of [] -> error "Signal.Block.tail: empty list" (Chunk start sz arr : xs) -> Cons (if sz>1 then Chunk (succ start) (pred sz) arr : xs else xs) tails :: T a -> [T a] tails = List.unfoldr (\x -> toMaybe (not (isEmpty x)) (let tailX = tail x in (tailX,tailX))) toList :: T a -> [a] toList = List.concatMap (\(Chunk start sz arr) -> take sz (map (arr!) [start..])) . chunks toListAlt :: T a -> [a] toListAlt = List.init . map head . tails fromList :: ChunkSize -> [a] -> T a fromList chunkSize = let recurse [] = [] recurse xs = let actSize = minLength chunkSize xs in Chunk 0 actSize (listArray (0,actSize-1) xs) : if actSize < chunkSize then [] else recurse (drop chunkSize xs) in Cons . recurse {- @minLength n x = min n (length x)@, but 'minLength' is more lazy than 'length'. -} minLength :: Int -> [a] -> Int minLength = let recurse seenSoFar expected xt = case xt of [] -> seenSoFar (_:xs) -> if expected == 0 then seenSoFar else recurse (succ seenSoFar) (pred expected) xs in recurse 0 {- poor man's implementation via lists I do not know which array function could be of help here. -} unfoldR :: ChunkSize -> (acc -> Maybe (y, acc)) -> acc -> (acc, T y) unfoldR chunkSize f acc = let (accEnd, xs) = ListSignal.unfoldR f acc in (accEnd, fromList chunkSize xs) reduceL :: (a -> acc -> Maybe acc) -> acc -> T a -> acc reduceL f start = ListSignal.reduceL f start . toList {- when running on array separately it would be complicated to distinguish between termination because the signal is finished and because the abort condition is fulfilled. -} -- List.foldl' (\acc -> List.reduceL f acc . elems) start . toChunkList mapAccumL :: ChunkSize -> (x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y) mapAccumL chunkSize f accStart xs = let (accEnd, ys) = ListSignal.mapAccumL f accStart (toList xs) in (accEnd, fromList chunkSize ys) append :: T a -> T a -> T a append (Cons x) (Cons y) = Cons (x List.++ y) zipWith :: ChunkSize -> (a -> b -> c) -> (T a -> T b -> T c) zipWith chunkSize f x y = fromList chunkSize $ List.zipWith f (toList x) (toList y)