{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{- |
Type classes that give a uniform interface to
storable signals, stateful signals, lists, fusable lists.
Some of the signal types require constraints on the element type.
Storable signals require Storable elements.
Thus we need multiparameter type classes.
In this module we collect functions
where the element type is not altered by the function.
-}
module Synthesizer.Generic.Signal (
   module Synthesizer.Generic.Signal,
   Cut.null,
   Cut.length,
   Cut.empty,
   Cut.cycle,
   Cut.append,
   Cut.concat,
   Cut.take,
   Cut.drop,
   Cut.dropMarginRem,
   Cut.splitAt,
   Cut.reverse,
   Cut.lengthAtLeast,
   Cut.lengthAtMost,
   Cut.sliceVertical,
   ) where

import qualified Synthesizer.Generic.Cut as Cut
import Synthesizer.Generic.Cut (append, )

import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV

import qualified Synthesizer.Plain.Modifier as Modifier

import Foreign.Storable (Storable)

import Control.Monad.Trans.State (runState, runStateT, )

import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Function (fix, )
import Data.Tuple.HT (mapPair, mapFst, fst3, snd3, thd3, )
import Data.Monoid (Monoid, mappend, mempty, )
import Data.Semigroup (Semigroup, (<>), )

import qualified Algebra.ToInteger    as ToInteger
import qualified Algebra.ToRational   as ToRational
import qualified Algebra.Absolute     as Absolute
import qualified Algebra.RealIntegral as RealIntegral
import qualified Algebra.IntegralDomain as Integral
import qualified Algebra.NonNegative  as NonNeg
import qualified Algebra.ZeroTestable as ZeroTestable

import qualified Algebra.Module   as Module
import qualified Algebra.Ring     as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.Monoid   as Monoid
import Algebra.Additive ((+), (-), )

import qualified Data.EventList.Relative.BodyTime as EventList

import qualified Numeric.NonNegative.Class as NonNeg98

import qualified Test.QuickCheck as QC

import qualified Prelude as P
import Prelude
   (Bool, Int, Maybe(Just), maybe, fst, snd,
    (==), (<), (>), (<=), (>=), compare, Ordering(..),
    flip, uncurry, const, (.), ($), (&&), id, (++),
    fmap, return, error, show,
    Eq, Ord, Show, min, max, )



class Storage signal where

   data Constraints signal :: *

   constraints :: signal -> Constraints signal


class Read0 sig where
   toList :: Storage (sig y) => sig y -> [y]
   toState :: Storage (sig y) => sig y -> SigS.T y
--   toState :: Storage (sig y) => StateT (sig y) Maybe y
   foldL :: Storage (sig y) => (s -> y -> s) -> s -> sig y -> s
   foldR :: Storage (sig y) => (y -> s -> s) -> s -> sig y -> s
   index :: Storage (sig y) => sig y -> Int -> y

class (Cut.Read (sig y), Read0 sig, Storage (sig y)) => Read sig y where

class (Read0 sig) => Transform0 sig where
   cons :: Storage (sig y) => y -> sig y -> sig y
   takeWhile :: Storage (sig y) => (y -> Bool) -> sig y -> sig y
   dropWhile :: Storage (sig y) => (y -> Bool) -> sig y -> sig y
   span :: Storage (sig y) => (y -> Bool) -> sig y -> (sig y, sig y)

   {- |
   When using 'viewL' for traversing a signal,
   it is certainly better to convert to State signal first,
   since this might involve optimized traversing
   like in case of Storable signals.
   -}
   viewL :: Storage (sig y) => sig y -> Maybe (y, sig y)
   viewR :: Storage (sig y) => sig y -> Maybe (sig y, y)

   zipWithAppend :: Storage (sig y) => (y -> y -> y) -> sig y -> sig y -> sig y

   -- functions from Transform2 that are oftenly used with only one type variable
   map ::
      (Storage (sig y0), Storage (sig y1)) =>
      (y0 -> y1) -> (sig y0 -> sig y1)
   scanL ::
      (Storage (sig y0), Storage (sig y1)) =>
      (y1 -> y0 -> y1) -> y1 -> sig y0 -> sig y1
   crochetL ::
      (Storage (sig y0), Storage (sig y1)) =>
      (y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1

class (Cut.Transform (sig y), Transform0 sig, Read sig y) => Transform sig y where


{- |
This type is used for specification of the maximum size of strict packets.
Packets can be smaller, can have different sizes in one signal.
In some kinds of streams, like lists and stateful generators,
the packet size is always 1.
The packet size is not just a burden caused by efficiency,
but we need control over packet size in applications with feedback.

ToDo: Make the element type of the corresponding signal a type parameter.
This helps to distinguish chunk sizes of scalar and vectorised signals.
-}
newtype LazySize = LazySize Int
   deriving (LazySize -> LazySize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LazySize -> LazySize -> Bool
$c/= :: LazySize -> LazySize -> Bool
== :: LazySize -> LazySize -> Bool
$c== :: LazySize -> LazySize -> Bool
Eq, Eq LazySize
LazySize -> LazySize -> Bool
LazySize -> LazySize -> Ordering
LazySize -> LazySize -> LazySize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LazySize -> LazySize -> LazySize
$cmin :: LazySize -> LazySize -> LazySize
max :: LazySize -> LazySize -> LazySize
$cmax :: LazySize -> LazySize -> LazySize
>= :: LazySize -> LazySize -> Bool
$c>= :: LazySize -> LazySize -> Bool
> :: LazySize -> LazySize -> Bool
$c> :: LazySize -> LazySize -> Bool
<= :: LazySize -> LazySize -> Bool
$c<= :: LazySize -> LazySize -> Bool
< :: LazySize -> LazySize -> Bool
$c< :: LazySize -> LazySize -> Bool
compare :: LazySize -> LazySize -> Ordering
$ccompare :: LazySize -> LazySize -> Ordering
Ord, Int -> LazySize -> ShowS
[LazySize] -> ShowS
LazySize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LazySize] -> ShowS
$cshowList :: [LazySize] -> ShowS
show :: LazySize -> String
$cshow :: LazySize -> String
showsPrec :: Int -> LazySize -> ShowS
$cshowsPrec :: Int -> LazySize -> ShowS
Show,
             LazySize
LazySize -> LazySize
LazySize -> LazySize -> LazySize
forall a. a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> C a
negate :: LazySize -> LazySize
$cnegate :: LazySize -> LazySize
- :: LazySize -> LazySize -> LazySize
$c- :: LazySize -> LazySize -> LazySize
+ :: LazySize -> LazySize -> LazySize
$c+ :: LazySize -> LazySize -> LazySize
zero :: LazySize
$czero :: LazySize
Additive.C, C LazySize
LazySize
Integer -> LazySize
LazySize -> Integer -> LazySize
LazySize -> LazySize -> LazySize
forall a.
C a
-> (a -> a -> a)
-> a
-> (Integer -> a)
-> (a -> Integer -> a)
-> C a
^ :: LazySize -> Integer -> LazySize
$c^ :: LazySize -> Integer -> LazySize
fromInteger :: Integer -> LazySize
$cfromInteger :: Integer -> LazySize
one :: LazySize
$cone :: LazySize
* :: LazySize -> LazySize -> LazySize
$c* :: LazySize -> LazySize -> LazySize
Ring.C, LazySize -> Bool
forall a. (a -> Bool) -> C a
isZero :: LazySize -> Bool
$cisZero :: LazySize -> Bool
ZeroTestable.C,
             C LazySize
C LazySize
LazySize -> Integer
forall a. C a -> C a -> (a -> Integer) -> C a
toInteger :: LazySize -> Integer
$ctoInteger :: LazySize -> Integer
ToInteger.C, Ord LazySize
C LazySize
C LazySize
LazySize -> Rational
forall a. C a -> C a -> Ord a -> (a -> Rational) -> C a
toRational :: LazySize -> Rational
$ctoRational :: LazySize -> Rational
ToRational.C, C LazySize
LazySize -> LazySize
forall a. C a -> (a -> a) -> (a -> a) -> C a
signum :: LazySize -> LazySize
$csignum :: LazySize -> LazySize
abs :: LazySize -> LazySize
$cabs :: LazySize -> LazySize
Absolute.C,
             Ord LazySize
C LazySize
C LazySize
C LazySize
LazySize -> LazySize -> (LazySize, LazySize)
LazySize -> LazySize -> LazySize
forall a.
C a
-> C a
-> Ord a
-> C a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> C a
quotRem :: LazySize -> LazySize -> (LazySize, LazySize)
$cquotRem :: LazySize -> LazySize -> (LazySize, LazySize)
rem :: LazySize -> LazySize -> LazySize
$crem :: LazySize -> LazySize -> LazySize
quot :: LazySize -> LazySize -> LazySize
$cquot :: LazySize -> LazySize -> LazySize
RealIntegral.C, C LazySize
LazySize -> LazySize -> (LazySize, LazySize)
LazySize -> LazySize -> LazySize
forall a.
C a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> (a, a)) -> C a
divMod :: LazySize -> LazySize -> (LazySize, LazySize)
$cdivMod :: LazySize -> LazySize -> (LazySize, LazySize)
mod :: LazySize -> LazySize -> LazySize
$cmod :: LazySize -> LazySize -> LazySize
div :: LazySize -> LazySize -> LazySize
$cdiv :: LazySize -> LazySize -> LazySize
Integral.C)

instance Semigroup LazySize where
   LazySize Int
a <> :: LazySize -> LazySize -> LazySize
<> LazySize Int
b = Int -> LazySize
LazySize (Int
a forall a. C a => a -> a -> a
+ Int
b)

instance Monoid LazySize where
   mempty :: LazySize
mempty = Int -> LazySize
LazySize Int
0
   mappend :: LazySize -> LazySize -> LazySize
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid.C LazySize where
   idt :: LazySize
idt = Int -> LazySize
LazySize Int
0
   LazySize Int
a <*> :: LazySize -> LazySize -> LazySize
<*> LazySize Int
b = Int -> LazySize
LazySize (Int
a forall a. C a => a -> a -> a
+ Int
b)

instance NonNeg.C LazySize where
   split :: LazySize -> LazySize -> (LazySize, (Bool, LazySize))
split = forall b a.
(Ord b, C b) =>
(a -> b) -> (b -> a) -> a -> a -> (a, (Bool, a))
NonNeg.splitDefault (\(LazySize Int
n) -> Int
n) Int -> LazySize
LazySize

instance QC.Arbitrary LazySize where
   arbitrary :: Gen LazySize
arbitrary =
      case LazySize
defaultLazySize of
         LazySize Int
n -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> LazySize
LazySize (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
1, Int
2 forall a. Num a => a -> a -> a
P.* Int
n))

instance Cut.Read LazySize where
   null :: LazySize -> Bool
null (LazySize Int
n) = Int
nforall a. Eq a => a -> a -> Bool
==Int
0
   length :: LazySize -> Int
length (LazySize Int
n) = Int
n

instance Cut.Transform LazySize where
   {-# INLINE take #-}
   take :: Int -> LazySize -> LazySize
take Int
m (LazySize Int
n) = Int -> LazySize
LazySize forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
max Int
0 Int
m) Int
n
   {-# INLINE drop #-}
   drop :: Int -> LazySize -> LazySize
drop Int
m (LazySize Int
n) = Int -> LazySize
LazySize forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
n forall a. C a => a -> a -> a
- forall a. Ord a => a -> a -> a
max Int
0 Int
m
   {-# INLINE splitAt #-}
   splitAt :: Int -> LazySize -> (LazySize, LazySize)
splitAt Int
m LazySize
x =
      let y :: LazySize
y = forall sig. Transform sig => Int -> sig -> sig
Cut.take Int
m LazySize
x
      in  (LazySize
y, LazySize
xforall a. C a => a -> a -> a
-LazySize
y)
   {-# INLINE dropMarginRem #-}
   dropMarginRem :: Int -> Int -> LazySize -> (Int, LazySize)
dropMarginRem Int
n Int
m x :: LazySize
x@(LazySize Int
xs) =
      let d :: Int
d = forall a. Ord a => a -> a -> a
min Int
m forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
xs forall a. C a => a -> a -> a
- Int
n
      in  (Int
mforall a. C a => a -> a -> a
-Int
d, forall sig. Transform sig => Int -> sig -> sig
Cut.drop Int
d LazySize
x)
   {-# INLINE reverse #-}
   reverse :: LazySize -> LazySize
reverse = forall a. a -> a
id


{- |
This can be used for internal signals
that have no observable effect on laziness.
E.g. when you construct a list
by @repeat defaultLazySize zero@
we assume that 'zero' is defined for all Additive types.
-}
defaultLazySize :: LazySize
defaultLazySize :: LazySize
defaultLazySize =
   let (SVL.ChunkSize Int
size) = ChunkSize
SVL.defaultChunkSize
   in  Int -> LazySize
LazySize Int
size

{- |
We could provide the 'LazySize' by a Reader monad,
but we don't do that because we expect that the choice of the lazy size
is more local than say the choice of the sample rate.
E.g. there is no need to have the same laziness coarseness
for multiple signal processors.
-}
class Transform0 sig => Write0 sig where
   fromList :: Storage (sig y) => LazySize -> [y] -> sig y
--   fromState :: Storage (sig y) => LazySize -> SigS.T y -> sig y
--   fromState :: Storage (sig y) => LazySize -> StateT s Maybe y -> s -> sig y
   repeat :: Storage (sig y) => LazySize -> y -> sig y
   replicate :: Storage (sig y) => LazySize -> Int -> y -> sig y
   iterate :: Storage (sig y) => LazySize -> (y -> y) -> y -> sig y
   iterateAssociative :: Storage (sig y) => LazySize -> (y -> y -> y) -> y -> sig y
   unfoldR :: Storage (sig y) => LazySize -> (s -> Maybe (y,s)) -> s -> sig y

class (Write0 sig, Transform sig y) => Write sig y where


instance (Storable y) => Storage (SVL.Vector y) where
   data Constraints (SVL.Vector y) = Storable y => StorableLazyConstraints
   constraints :: Vector y -> Constraints (Vector y)
constraints Vector y
_ = forall y. Storable y => Constraints (Vector y)
StorableLazyConstraints


readSVL ::
   (Storable a => SVL.Vector a -> b) ->
   (Storage (SVL.Vector a) => SVL.Vector a -> b)
readSVL :: forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL Storable a => Vector a -> b
f Vector a
x = case forall signal. Storage signal => signal -> Constraints signal
constraints Vector a
x of Constraints (Vector a)
R:ConstraintsVector1 a
StorableLazyConstraints -> Storable a => Vector a -> b
f Vector a
x

writeSVL ::
   (Storable a => SVL.Vector a) ->
   (Storage (SVL.Vector a) => SVL.Vector a)
writeSVL :: forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL Storable a => Vector a
x =
   let z :: Vector a
z = case forall signal. Storage signal => signal -> Constraints signal
constraints Vector a
z of Constraints (Vector a)
R:ConstraintsVector1 a
StorableLazyConstraints -> Storable a => Vector a
x
   in  Vector a
z

{-
getSVL ::
   Storable a =>
   (Storage SVL.Vector a => SVL.Vector a) ->
   (SVL.Vector a)
getSVL x = case constraints x of StorableLazyConstraints -> x
-}

instance Storable y => Read SVL.Vector y where

-- instance Storable y => Read SigSt.T y where
instance Read0 SVL.Vector where
   {-# INLINE toList #-}
   toList :: forall y. Storage (Vector y) => Vector y -> [y]
toList = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL forall a. Storable a => Vector a -> [a]
SVL.unpack
   {-# INLINE toState #-}
   toState :: forall y. Storage (Vector y) => Vector y -> T y
toState = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL forall a. Storable a => T a -> T a
SigS.fromStorableSignal
   {-# INLINE foldL #-}
   foldL :: forall y s.
Storage (Vector y) =>
(s -> y -> s) -> s -> Vector y -> s
foldL s -> y -> s
f s
x = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall b a. Storable b => (a -> b -> a) -> a -> Vector b -> a
SVL.foldl s -> y -> s
f s
x)
   {-# INLINE foldR #-}
   foldR :: forall y s.
Storage (Vector y) =>
(y -> s -> s) -> s -> Vector y -> s
foldR y -> s -> s
f s
x = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall b a. Storable b => (b -> a -> a) -> a -> Vector b -> a
SVL.foldr y -> s -> s
f s
x)
   {-# INLINE index #-}
   index :: forall y. Storage (Vector y) => Vector y -> Int -> y
index = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL forall a. Storable a => Vector a -> Int -> a
SVL.index


instance Storable y => Transform SVL.Vector y where

instance Transform0 SVL.Vector where
   {-# INLINE cons #-}
   cons :: forall y. Storage (Vector y) => y -> Vector y -> Vector y
cons y
x = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall a. Storable a => a -> Vector a -> Vector a
SVL.cons y
x)
   {-# INLINE takeWhile #-}
   takeWhile :: forall y. Storage (Vector y) => (y -> Bool) -> Vector y -> Vector y
takeWhile y -> Bool
p = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
SVL.takeWhile y -> Bool
p)
   {-# INLINE dropWhile #-}
   dropWhile :: forall y. Storage (Vector y) => (y -> Bool) -> Vector y -> Vector y
dropWhile y -> Bool
p = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
SVL.dropWhile y -> Bool
p)
   {-# INLINE span #-}
   span :: forall y.
Storage (Vector y) =>
(y -> Bool) -> Vector y -> (Vector y, Vector y)
span y -> Bool
p = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall a.
Storable a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
SVL.span y -> Bool
p)

   {-# INLINE viewL #-}
   viewL :: forall y. Storage (Vector y) => Vector y -> Maybe (y, Vector y)
viewL = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL forall a. Storable a => Vector a -> Maybe (a, Vector a)
SVL.viewL
   {-# INLINE viewR #-}
   viewR :: forall y. Storage (Vector y) => Vector y -> Maybe (Vector y, y)
viewR = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL forall a. Storable a => Vector a -> Maybe (Vector a, a)
SVL.viewR

   {-# INLINE map #-}
   map :: forall y0 y1.
(Storage (Vector y0), Storage (Vector y1)) =>
(y0 -> y1) -> Vector y0 -> Vector y1
map y0 -> y1
f Vector y0
x = forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall x y.
(Storable x, Storable y) =>
(x -> y) -> Vector x -> Vector y
SVL.map y0 -> y1
f) Vector y0
x)
   {-# INLINE scanL #-}
   scanL :: forall y0 y1.
(Storage (Vector y0), Storage (Vector y1)) =>
(y1 -> y0 -> y1) -> y1 -> Vector y0 -> Vector y1
scanL y1 -> y0 -> y1
f y1
a Vector y0
x = forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall a b.
(Storable a, Storable b) =>
(a -> b -> a) -> a -> Vector b -> Vector a
SVL.scanl y1 -> y0 -> y1
f y1
a) Vector y0
x)
   {-# INLINE crochetL #-}
   crochetL :: forall y0 y1 s.
(Storage (Vector y0), Storage (Vector y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> Vector y0 -> Vector y1
crochetL y0 -> s -> Maybe (y1, s)
f s
a Vector y0
x = forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall x y acc.
(Storable x, Storable y) =>
(x -> acc -> Maybe (y, acc)) -> acc -> Vector x -> Vector y
SVL.crochetL y0 -> s -> Maybe (y1, s)
f s
a) Vector y0
x)
   {-# INLINE zipWithAppend #-}
   zipWithAppend :: forall y.
Storage (Vector y) =>
(y -> y -> y) -> Vector y -> Vector y -> Vector y
zipWithAppend y -> y -> y
f = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (forall x. Storable x => (x -> x -> x) -> T x -> T x -> T x
SigSt.zipWithAppend y -> y -> y
f)



withStorableContext ::
   (SVL.ChunkSize -> a) -> (LazySize -> a)
withStorableContext :: forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext ChunkSize -> a
f =
   \(LazySize Int
size) -> ChunkSize -> a
f (Int -> ChunkSize
SVL.ChunkSize Int
size)

instance Storable y => Write SVL.Vector y where

instance Write0 SVL.Vector where
   {-# INLINE fromList #-}
   fromList :: forall y. Storage (Vector y) => LazySize -> [y] -> Vector y
fromList = forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext forall a b. (a -> b) -> a -> b
$ \ChunkSize
size [y]
x -> forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall a. Storable a => ChunkSize -> [a] -> Vector a
SVL.pack ChunkSize
size [y]
x)
   {-# INLINE repeat #-}
   repeat :: forall y. Storage (Vector y) => LazySize -> y -> Vector y
repeat = forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext forall a b. (a -> b) -> a -> b
$ \ChunkSize
size y
x -> forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall a. Storable a => ChunkSize -> a -> Vector a
SVL.repeat ChunkSize
size y
x)
   {-# INLINE replicate #-}
   replicate :: forall y. Storage (Vector y) => LazySize -> Int -> y -> Vector y
replicate = forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext forall a b. (a -> b) -> a -> b
$ \ChunkSize
size Int
n y
x -> forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall a. Storable a => ChunkSize -> Int -> a -> Vector a
SVL.replicate ChunkSize
size Int
n y
x)
   {-# INLINE iterate #-}
   iterate :: forall y.
Storage (Vector y) =>
LazySize -> (y -> y) -> y -> Vector y
iterate = forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext forall a b. (a -> b) -> a -> b
$ \ChunkSize
size y -> y
f y
x -> forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall a. Storable a => ChunkSize -> (a -> a) -> a -> Vector a
SVL.iterate ChunkSize
size y -> y
f y
x)
   {-# INLINE unfoldR #-}
   unfoldR :: forall y s.
Storage (Vector y) =>
LazySize -> (s -> Maybe (y, s)) -> s -> Vector y
unfoldR = forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext forall a b. (a -> b) -> a -> b
$ \ChunkSize
size s -> Maybe (y, s)
f s
x -> forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall b a.
Storable b =>
ChunkSize -> (a -> Maybe (b, a)) -> a -> Vector b
SVL.unfoldr ChunkSize
size s -> Maybe (y, s)
f s
x)
   {-# INLINE iterateAssociative #-}
   iterateAssociative :: forall y.
Storage (Vector y) =>
LazySize -> (y -> y -> y) -> y -> Vector y
iterateAssociative = forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext forall a b. (a -> b) -> a -> b
$ \ChunkSize
size y -> y -> y
op y
x -> forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (forall a. Storable a => ChunkSize -> (a -> a) -> a -> Vector a
SVL.iterate ChunkSize
size (y -> y -> y
op y
x) y
x) -- should be optimized



instance (Storable y) => Storage (SV.Vector y) where
   data Constraints (SV.Vector y) = Storable y => StorableConstraints
   constraints :: Vector y -> Constraints (Vector y)
constraints Vector y
_ = forall y. Storable y => Constraints (Vector y)
StorableConstraints

readSV ::
   (Storable a => SV.Vector a -> b) ->
   (Storage (SV.Vector a) => SV.Vector a -> b)
readSV :: forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV Storable a => Vector a -> b
f Vector a
x = case forall signal. Storage signal => signal -> Constraints signal
constraints Vector a
x of Constraints (Vector a)
R:ConstraintsVector a
StorableConstraints -> Storable a => Vector a -> b
f Vector a
x

writeSV ::
   (Storable a => SV.Vector a) ->
   (Storage (SV.Vector a) => SV.Vector a)
writeSV :: forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSV Storable a => Vector a
x =
   let z :: Vector a
z = case forall signal. Storage signal => signal -> Constraints signal
constraints Vector a
z of Constraints (Vector a)
R:ConstraintsVector a
StorableConstraints -> Storable a => Vector a
x
   in  Vector a
z


instance Storable y => Read SV.Vector y where

instance Read0 SV.Vector where
   {-# INLINE toList #-}
   toList :: forall y. Storage (Vector y) => Vector y -> [y]
toList = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV forall a. Storable a => Vector a -> [a]
SV.unpack
   {-# INLINE toState #-}
   toState :: forall y. Storage (Vector y) => Vector y -> T y
toState = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV forall a. Storable a => Vector a -> T a
SigS.fromStrictStorableSignal
   {-# INLINE foldL #-}
   foldL :: forall y s.
Storage (Vector y) =>
(s -> y -> s) -> s -> Vector y -> s
foldL s -> y -> s
f s
x = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall a b. Storable a => (b -> a -> b) -> b -> Vector a -> b
SV.foldl s -> y -> s
f s
x)
   {-# INLINE foldR #-}
   foldR :: forall y s.
Storage (Vector y) =>
(y -> s -> s) -> s -> Vector y -> s
foldR y -> s -> s
f s
x = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall a b. Storable a => (a -> b -> b) -> b -> Vector a -> b
SV.foldr y -> s -> s
f s
x)
   {-# INLINE index #-}
   index :: forall y. Storage (Vector y) => Vector y -> Int -> y
index = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV forall a. Storable a => Vector a -> Int -> a
SV.index

instance Storable y => Transform SV.Vector y where

instance Transform0 SV.Vector where
   {-# INLINE cons #-}
   cons :: forall y. Storage (Vector y) => y -> Vector y -> Vector y
cons y
x = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall a. Storable a => a -> Vector a -> Vector a
SV.cons y
x)
   {-# INLINE takeWhile #-}
   takeWhile :: forall y. Storage (Vector y) => (y -> Bool) -> Vector y -> Vector y
takeWhile y -> Bool
p = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
SV.takeWhile y -> Bool
p)
   {-# INLINE dropWhile #-}
   dropWhile :: forall y. Storage (Vector y) => (y -> Bool) -> Vector y -> Vector y
dropWhile y -> Bool
p = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
SV.dropWhile y -> Bool
p)
   {-# INLINE span #-}
   span :: forall y.
Storage (Vector y) =>
(y -> Bool) -> Vector y -> (Vector y, Vector y)
span y -> Bool
p = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall a.
Storable a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
SV.span y -> Bool
p)

   {-# INLINE viewL #-}
   viewL :: forall y. Storage (Vector y) => Vector y -> Maybe (y, Vector y)
viewL = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV forall a. Storable a => Vector a -> Maybe (a, Vector a)
SV.viewL
   {-# INLINE viewR #-}
   viewR :: forall y. Storage (Vector y) => Vector y -> Maybe (Vector y, y)
viewR = forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV forall a. Storable a => Vector a -> Maybe (Vector a, a)
SV.viewR

   {-# INLINE map #-}
   map :: forall y0 y1.
(Storage (Vector y0), Storage (Vector y1)) =>
(y0 -> y1) -> Vector y0 -> Vector y1
map y0 -> y1
f Vector y0
x = forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSV (forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map y0 -> y1
f) Vector y0
x)
   {-# INLINE scanL #-}
   scanL :: forall y0 y1.
(Storage (Vector y0), Storage (Vector y1)) =>
(y1 -> y0 -> y1) -> y1 -> Vector y0 -> Vector y1
scanL y1 -> y0 -> y1
f y1
a Vector y0
x = forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSV (forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall a b.
(Storable a, Storable b) =>
(a -> b -> a) -> a -> Vector b -> Vector a
SV.scanl y1 -> y0 -> y1
f y1
a) Vector y0
x)
   {-# INLINE crochetL #-}
   crochetL :: forall y0 y1 s.
(Storage (Vector y0), Storage (Vector y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> Vector y0 -> Vector y1
crochetL y0 -> s -> Maybe (y1, s)
f s
a Vector y0
x =
      forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSV (forall a b. (a, b) -> a
fst (forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (forall x y acc.
(Storable x, Storable y) =>
(x -> acc -> Maybe (y, acc))
-> acc -> Vector x -> (Vector y, Maybe acc)
SV.crochetLResult y0 -> s -> Maybe (y1, s)
f s
a) Vector y0
x))
      -- fst . SV.crochetContL f acc
   {-# INLINE zipWithAppend #-}
   zipWithAppend :: forall y.
Storage (Vector y) =>
(y -> y -> y) -> Vector y -> Vector y -> Vector y
zipWithAppend y -> y -> y
f =
      forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (\Vector y
xs Vector y
ys ->
         case forall a. Ord a => a -> a -> Ordering
compare (forall a. Vector a -> Int
SV.length Vector y
xs) (forall a. Vector a -> Int
SV.length Vector y
ys) of
            Ordering
EQ -> forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
SV.zipWith y -> y -> y
f Vector y
xs Vector y
ys
            Ordering
LT -> forall a. Storable a => Vector a -> Vector a -> Vector a
SV.append (forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
SV.zipWith y -> y -> y
f Vector y
xs Vector y
ys) (forall a. Storable a => Int -> Vector a -> Vector a
SV.drop (forall a. Vector a -> Int
SV.length Vector y
xs) Vector y
ys)
            Ordering
GT -> forall a. Storable a => Vector a -> Vector a -> Vector a
SV.append (forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
SV.zipWith y -> y -> y
f Vector y
xs Vector y
ys) (forall a. Storable a => Int -> Vector a -> Vector a
SV.drop (forall a. Vector a -> Int
SV.length Vector y
ys) Vector y
xs))



instance Storage [y] where
   data Constraints [y] = ListConstraints
   constraints :: [y] -> Constraints [y]
constraints [y]
_ = forall y. Constraints [y]
ListConstraints

instance Read [] y where

instance Read0 [] where
   {-# INLINE toList #-}
   toList :: forall y. Storage [y] => [y] -> [y]
toList = forall a. a -> a
id
   {-# INLINE toState #-}
   toState :: forall y. Storage [y] => [y] -> T y
toState = forall y. [y] -> T y
SigS.fromList
   {-# INLINE foldL #-}
   foldL :: forall y s. Storage [y] => (s -> y -> s) -> s -> [y] -> s
foldL = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl
   {-# INLINE foldR #-}
   foldR :: forall y s. Storage [y] => (y -> s -> s) -> s -> [y] -> s
foldR = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr
   {-# INLINE index #-}
   index :: forall y. Storage [y] => [y] -> Int -> y
index = forall a. [a] -> Int -> a
(List.!!)


instance Transform [] y where

instance Transform0 [] where
   {-# INLINE cons #-}
   cons :: forall y. Storage [y] => y -> [y] -> [y]
cons = (:)
   {-# INLINE takeWhile #-}
   takeWhile :: forall y. Storage [y] => (y -> Bool) -> [y] -> [y]
takeWhile = forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile
   {-# INLINE dropWhile #-}
   dropWhile :: forall y. Storage [y] => (y -> Bool) -> [y] -> [y]
dropWhile = forall a. (a -> Bool) -> [a] -> [a]
List.dropWhile
   {-# INLINE span #-}
   span :: forall y. Storage [y] => (y -> Bool) -> [y] -> ([y], [y])
span = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span

   {-# INLINE viewL #-}
   viewL :: forall y. Storage [y] => [y] -> Maybe (y, [y])
viewL = forall a. [a] -> Maybe (a, [a])
ListHT.viewL
   {-# INLINE viewR #-}
   viewR :: forall y. Storage [y] => [y] -> Maybe ([y], y)
viewR = forall a. [a] -> Maybe ([a], a)
ListHT.viewR

   {-# INLINE map #-}
   map :: forall y0 y1.
(Storage [y0], Storage [y1]) =>
(y0 -> y1) -> [y0] -> [y1]
map = forall a b. (a -> b) -> [a] -> [b]
List.map
   {-# INLINE scanL #-}
   scanL :: forall y0 y1.
(Storage [y0], Storage [y1]) =>
(y1 -> y0 -> y1) -> y1 -> [y0] -> [y1]
scanL = forall b a. (b -> a -> b) -> b -> [a] -> [b]
List.scanl
   {-# INLINE crochetL #-}
   crochetL :: forall y0 y1 s.
(Storage [y0], Storage [y1]) =>
(y0 -> s -> Maybe (y1, s)) -> s -> [y0] -> [y1]
crochetL = forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
Sig.crochetL
   {-# INLINE zipWithAppend #-}
   zipWithAppend :: forall y. Storage [y] => (y -> y -> y) -> [y] -> [y] -> [y]
zipWithAppend = forall y. (y -> y -> y) -> T y -> T y -> T y
Sig.zipWithAppend


instance Write [] y where

instance Write0 [] where
   {-# INLINE fromList #-}
   fromList :: forall y. Storage [y] => LazySize -> [y] -> [y]
fromList LazySize
_ = forall a. a -> a
id
   {-# INLINE repeat #-}
   repeat :: forall y. Storage [y] => LazySize -> y -> [y]
repeat LazySize
_ = forall a. a -> [a]
List.repeat
   {-# INLINE replicate #-}
   replicate :: forall y. Storage [y] => LazySize -> Int -> y -> [y]
replicate LazySize
_ = forall a. Int -> a -> [a]
List.replicate
   {-# INLINE iterate #-}
   iterate :: forall y. Storage [y] => LazySize -> (y -> y) -> y -> [y]
iterate LazySize
_ = forall a. (a -> a) -> a -> [a]
List.iterate
   {-# INLINE unfoldR #-}
   unfoldR :: forall y s.
Storage [y] =>
LazySize -> (s -> Maybe (y, s)) -> s -> [y]
unfoldR LazySize
_ = forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr
   {-# INLINE iterateAssociative #-}
   iterateAssociative :: forall y. Storage [y] => LazySize -> (y -> y -> y) -> y -> [y]
iterateAssociative LazySize
_ = forall a. (a -> a -> a) -> a -> [a]
ListHT.iterateAssociative



instance Storage (SigS.T y) where
   data Constraints (SigS.T y) = StateConstraints
   constraints :: T y -> Constraints (T y)
constraints T y
_ = forall y. Constraints (T y)
StateConstraints

instance Read SigS.T y

instance Read0 SigS.T where
   {-# INLINE toList #-}
   toList :: forall y. Storage (T y) => T y -> [y]
toList = forall y. T y -> [y]
SigS.toList
   {-# INLINE toState #-}
   toState :: forall y. Storage (T y) => T y -> T y
toState = forall a. a -> a
id
   {-# INLINE foldL #-}
   foldL :: forall y s. Storage (T y) => (s -> y -> s) -> s -> T y -> s
foldL = forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
SigS.foldL
   {-# INLINE foldR #-}
   foldR :: forall y s. Storage (T y) => (y -> s -> s) -> s -> T y -> s
foldR = forall x acc. (x -> acc -> acc) -> acc -> T x -> acc
SigS.foldR
   {-# INLINE index #-}
   index :: forall y. Storage (T y) => T y -> Int -> y
index = forall (sig :: * -> *) a. Transform sig a => sig a -> Int -> a
indexByDrop


instance Transform SigS.T y

instance Transform0 SigS.T where
   {-# INLINE cons #-}
   cons :: forall y. Storage (T y) => y -> T y -> T y
cons = forall a. a -> T a -> T a
SigS.cons
   {-# INLINE takeWhile #-}
   takeWhile :: forall y. Storage (T y) => (y -> Bool) -> T y -> T y
takeWhile = forall a. (a -> Bool) -> T a -> T a
SigS.takeWhile
   {-# INLINE dropWhile #-}
   dropWhile :: forall y. Storage (T y) => (y -> Bool) -> T y -> T y
dropWhile = forall a. (a -> Bool) -> T a -> T a
SigS.dropWhile
   {-# INLINE span #-}
   span :: forall y. Storage (T y) => (y -> Bool) -> T y -> (T y, T y)
span y -> Bool
p =
      -- This implementation is slow. Better leave it unimplemented?
      forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall y. [y] -> T y
SigS.fromList, forall y. [y] -> T y
SigS.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span y -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y. T y -> [y]
SigS.toList

   {-# INLINE viewL #-}
   viewL :: forall y. Storage (T y) => T y -> Maybe (y, T y)
viewL = forall a. T a -> Maybe (a, T a)
SigS.viewL
   {-# INLINE viewR #-}
   viewR :: forall y. Storage (T y) => T y -> Maybe (T y, y)
viewR =
      -- This implementation is slow. Better leave it unimplemented?
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall y. [y] -> T y
SigS.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. [a] -> Maybe ([a], a)
ListHT.viewR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y. T y -> [y]
SigS.toList

   {-# INLINE map #-}
   map :: forall y0 y1.
(Storage (T y0), Storage (T y1)) =>
(y0 -> y1) -> T y0 -> T y1
map = forall a b. (a -> b) -> T a -> T b
SigS.map
   {-# INLINE scanL #-}
   scanL :: forall y0 y1.
(Storage (T y0), Storage (T y1)) =>
(y1 -> y0 -> y1) -> y1 -> T y0 -> T y1
scanL = forall acc x. (acc -> x -> acc) -> acc -> T x -> T acc
SigS.scanL
   {-# INLINE crochetL #-}
   crochetL :: forall y0 y1 s.
(Storage (T y0), Storage (T y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> T y0 -> T y1
crochetL = forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
SigS.crochetL
   {-# INLINE zipWithAppend #-}
   zipWithAppend :: forall y. Storage (T y) => (y -> y -> y) -> T y -> T y -> T y
zipWithAppend = forall y. (y -> y -> y) -> T y -> T y -> T y
SigS.zipWithAppend


instance Write SigS.T y

instance Write0 SigS.T where
   {-# INLINE fromList #-}
   fromList :: forall y. Storage (T y) => LazySize -> [y] -> T y
fromList LazySize
_ = forall y. [y] -> T y
SigS.fromList
   {-# INLINE repeat #-}
   repeat :: forall y. Storage (T y) => LazySize -> y -> T y
repeat LazySize
_ = forall a. a -> T a
SigS.repeat
   {-# INLINE replicate #-}
   replicate :: forall y. Storage (T y) => LazySize -> Int -> y -> T y
replicate LazySize
_ = forall a. Int -> a -> T a
SigS.replicate
   {-# INLINE iterate #-}
   iterate :: forall y. Storage (T y) => LazySize -> (y -> y) -> y -> T y
iterate LazySize
_ = forall a. (a -> a) -> a -> T a
SigS.iterate
   {-# INLINE unfoldR #-}
   unfoldR :: forall y s.
Storage (T y) =>
LazySize -> (s -> Maybe (y, s)) -> s -> T y
unfoldR LazySize
_ = forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
SigS.unfoldR
   {-# INLINE iterateAssociative #-}
   iterateAssociative :: forall y. Storage (T y) => LazySize -> (y -> y -> y) -> y -> T y
iterateAssociative LazySize
_ = forall a. (a -> a -> a) -> a -> T a
SigS.iterateAssociative


instance Storage (EventList.T time y) where
   data Constraints (EventList.T time y) = EventListConstraints
   constraints :: T time y -> Constraints (T time y)
constraints T time y
_ = forall time y. Constraints (T time y)
EventListConstraints

instance (NonNeg98.C time, P.Integral time) =>
      Read (EventList.T time) y where

instance (NonNeg98.C time, P.Integral time) =>
      Read0 (EventList.T time) where
   {-# INLINE toList #-}
   toList :: forall y. Storage (T time y) => T time y -> [y]
toList =
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall i a. Integral i => i -> a -> [a]
List.genericReplicate)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall time body. T time body -> [(body, time)]
EventList.toPairList
   {-# INLINE toState #-}
   toState :: forall y. Storage (T time y) => T time y -> T y
toState = forall time a. (C time, Integral time) => T time a -> T a
SigS.fromPiecewiseConstant
   {-# INLINE foldL #-}
   foldL :: forall y s.
Storage (T time y) =>
(s -> y -> s) -> s -> T time y -> s
foldL s -> y -> s
f s
x = forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
SigS.foldL s -> y -> s
f s
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState
   {-# INLINE foldR #-}
   foldR :: forall y s.
Storage (T time y) =>
(y -> s -> s) -> s -> T time y -> s
foldR y -> s -> s
f s
x = forall x acc. (x -> acc -> acc) -> acc -> T x -> acc
SigS.foldR y -> s -> s
f s
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState
   {-# INLINE index #-}
   index :: forall y. Storage (T time y) => T time y -> Int -> y
index T time y
sig Int
n =
      forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventList.foldrPair
         (\y
b time
t time -> y
go time
k ->
            if time
k forall a. Ord a => a -> a -> Bool
< time
t
              then y
b
              else time -> y
go (time
t forall a. C a => a -> a -> a
NonNeg98.-| time
k))
         (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"EventList.index: positions " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" out of range")
         T time y
sig
         (forall a b. (Integral a, Num b) => a -> b
P.fromIntegral Int
n)

instance (NonNeg98.C time, P.Integral time) =>
      Transform (EventList.T time) y where

instance (NonNeg98.C time, P.Integral time) =>
      Transform0 (EventList.T time) where
   {-# INLINE cons #-}
   cons :: forall y. Storage (T time y) => y -> T time y -> T time y
cons y
b = forall body time. body -> time -> T time body -> T time body
EventList.cons y
b (forall a. Num a => Integer -> a
P.fromInteger Integer
1)
   {-# INLINE takeWhile #-}
   takeWhile :: forall y. Storage (T time y) => (y -> Bool) -> T time y -> T time y
takeWhile y -> Bool
p =
      forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventList.foldrPair
         (\y
b time
t T time y
rest ->
            if y -> Bool
p y
b
              then forall body time. body -> time -> T time body -> T time body
EventList.cons y
b time
t T time y
rest
              else forall time body. T time body
EventList.empty)
         forall time body. T time body
EventList.empty
   {-# INLINE dropWhile #-}
   dropWhile :: forall y. Storage (T time y) => (y -> Bool) -> T time y -> T time y
dropWhile y -> Bool
p =
      let recourse :: T time y -> T time y
recourse T time y
xs =
             forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL forall time body. T time body
EventList.empty) T time y
xs forall a b. (a -> b) -> a -> b
$ \y
b time
_t T time y
rest ->
             if y -> Bool
p y
b
               then T time y -> T time y
recourse T time y
rest
               else T time y
xs
      in  T time y -> T time y
recourse
   {-# INLINE span #-}
   span :: forall y.
Storage (T time y) =>
(y -> Bool) -> T time y -> (T time y, T time y)
span y -> Bool
p =
      let recourse :: T time y -> (T time y, T time y)
recourse T time y
xs =
             forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL (forall time body. T time body
EventList.empty,forall time body. T time body
EventList.empty)) T time y
xs forall a b. (a -> b) -> a -> b
$ \y
b time
t T time y
rest ->
             if y -> Bool
p y
b
               then forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall body time. body -> time -> T time body -> T time body
EventList.cons y
b time
t) forall a b. (a -> b) -> a -> b
$ T time y -> (T time y, T time y)
recourse T time y
rest
               else (forall time body. T time body
EventList.empty, T time y
xs)
      in  T time y -> (T time y, T time y)
recourse

   {-# INLINE viewL #-}
   viewL :: forall y. Storage (T time y) => T time y -> Maybe (y, T time y)
viewL T time y
xs = do
      ((y
b,time
t),T time y
ys) <- forall time body. T time body -> Maybe ((body, time), T time body)
EventList.viewL T time y
xs
      if time
tforall a. Ord a => a -> a -> Bool
>time
0
        then forall a. a -> Maybe a
Just (y
b, if time
tforall a. Eq a => a -> a -> Bool
==time
1 then T time y
ys else forall body time. body -> time -> T time body -> T time body
EventList.cons y
b (time
t forall a. C a => a -> a -> a
NonNeg98.-|time
1) T time y
ys)
        else forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL T time y
ys
   {-# INLINE viewR #-}
   viewR :: forall y. Storage (T time y) => T time y -> Maybe (T time y, y)
viewR =
      let dropTrailingZeros :: T time body -> T time body
dropTrailingZeros =
             forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventList.foldrPair
                (\body
b time
t T time body
rest ->
                   if time
tforall a. Eq a => a -> a -> Bool
==time
0 Bool -> Bool -> Bool
&& forall time body. T time body -> Bool
EventList.null T time body
rest
                     then forall time body. T time body
EventList.empty
                     else forall body time. body -> time -> T time body -> T time body
EventList.cons body
b time
t T time body
rest)
                forall time body. T time body
EventList.empty
          recourse :: (a, b) -> T b a -> (T b a, a)
recourse (a
b,b
t) =
             forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL
                (if b
tforall a. Ord a => a -> a -> Bool
<=b
1
                   then forall time body. T time body
EventList.empty
                   else forall body time. body -> time -> T time body
EventList.singleton a
b (b
t forall a. C a => a -> a -> a
NonNeg98.-| b
1),
                 a
b)
                (\a
b0 b
t0 T b a
xs0 ->
                   forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall body time. body -> time -> T time body -> T time body
EventList.cons a
b b
t) forall a b. (a -> b) -> a -> b
$ (a, b) -> T b a -> (T b a, a)
recourse (a
b0,b
t0) T b a
xs0)
      in  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {b} {a}. (Num b, C b) => (a, b) -> T b a -> (T b a, a)
recourse) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> Maybe ((body, time), T time body)
EventList.viewL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {body}. T time body -> T time body
dropTrailingZeros

   {-# INLINE map #-}
   map :: forall y0 y1.
(Storage (T time y0), Storage (T time y1)) =>
(y0 -> y1) -> T time y0 -> T time y1
map = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
   {-# INLINE scanL #-}
   scanL :: forall y0 y1.
(Storage (T time y0), Storage (T time y1)) =>
(y1 -> y0 -> y1) -> y1 -> T time y0 -> T time y1
scanL y1 -> y0 -> y1
f y1
x =
      forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
fromState (Int -> LazySize
LazySize Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall acc x. (acc -> x -> acc) -> acc -> T x -> T acc
SigS.scanL y1 -> y0 -> y1
f y1
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState
   {-# INLINE crochetL #-}
   crochetL :: forall y0 y1 s.
(Storage (T time y0), Storage (T time y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> T time y0 -> T time y1
crochetL y0 -> s -> Maybe (y1, s)
f s
x =
      forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
fromState (Int -> LazySize
LazySize Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
SigS.crochetL y0 -> s -> Maybe (y1, s)
f s
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState
   {-# INLINE zipWithAppend #-}
   zipWithAppend :: forall y.
Storage (T time y) =>
(y -> y -> y) -> T time y -> T time y -> T time y
zipWithAppend y -> y -> y
f =
      let recourse :: T time y -> T time y -> T time y
recourse T time y
xs T time y
ys =
             forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL T time y
ys) T time y
xs forall a b. (a -> b) -> a -> b
$ \y
x time
xn T time y
xs0 ->
             forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL T time y
xs) T time y
ys forall a b. (a -> b) -> a -> b
$ \y
y time
yn T time y
ys0 ->
             let n :: time
n = forall a. Ord a => a -> a -> a
min time
xn time
yn
                 drop_ :: y -> time -> T time y -> T time y
drop_ y
a time
an T time y
as0 =
                    if time
nforall a. Ord a => a -> a -> Bool
>=time
an
                      then T time y
as0
                      else forall body time. body -> time -> T time body -> T time body
EventList.cons y
a (time
an forall a. C a => a -> a -> a
NonNeg98.-| time
n) T time y
as0
             in  forall body time. body -> time -> T time body -> T time body
EventList.cons (y -> y -> y
f y
x y
y) time
n forall a b. (a -> b) -> a -> b
$
                 T time y -> T time y -> T time y
recourse
                    (y -> time -> T time y -> T time y
drop_ y
x time
xn T time y
xs0)
                    (y -> time -> T time y -> T time y
drop_ y
y time
yn T time y
ys0)
      in  T time y -> T time y -> T time y
recourse



instance (NonNeg98.C time, P.Integral time) => Write (EventList.T time) y where

instance (NonNeg98.C time, P.Integral time) => Write0 (EventList.T time) where
   {-# INLINE fromList #-}
   fromList :: forall y. Storage (T time y) => LazySize -> [y] -> T time y
fromList LazySize
_ =
      forall body time. [(body, time)] -> T time body
EventList.fromPairList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a b. (a -> b) -> [a] -> [b]
List.map (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (forall a. Num a => Integer -> a
P.fromInteger Integer
1))
   {-# INLINE repeat #-}
   repeat :: forall y. Storage (T time y) => LazySize -> y -> T time y
repeat (LazySize Int
n) y
a =
      let xs :: T time y
xs = forall body time. body -> time -> T time body -> T time body
EventList.cons y
a (forall a b. (Integral a, Num b) => a -> b
P.fromIntegral Int
n) T time y
xs
      in  T time y
xs
   {-# INLINE replicate #-}
   replicate :: forall y. Storage (T time y) => LazySize -> Int -> y -> T time y
replicate LazySize
size Int
m y
a =
      forall sig. Transform sig => Int -> sig -> sig
Cut.take Int
m (forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> y -> sig y
repeat LazySize
size y
a)
   {-# INLINE iterate #-}
   iterate :: forall y.
Storage (T time y) =>
LazySize -> (y -> y) -> y -> T time y
iterate LazySize
size y -> y
f =
      forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
fromState LazySize
size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> T a
SigS.iterate y -> y
f
   {-# INLINE unfoldR #-}
   unfoldR :: forall y s.
Storage (T time y) =>
LazySize -> (s -> Maybe (y, s)) -> s -> T time y
unfoldR LazySize
_size s -> Maybe (y, s)
f =
      let recourse :: s -> T time y
recourse =
             forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall time body. T time body
EventList.empty
                (\(y
x,s
s) -> forall body time. body -> time -> T time body -> T time body
EventList.cons y
x
                   (forall a. Num a => Integer -> a
P.fromInteger Integer
1) (s -> T time y
recourse s
s)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (y, s)
f
      in  s -> T time y
recourse
   {-# INLINE iterateAssociative #-}
   iterateAssociative :: forall y.
Storage (T time y) =>
LazySize -> (y -> y -> y) -> y -> T time y
iterateAssociative LazySize
size y -> y -> y
f y
x = forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> (y -> y) -> y -> sig y
iterate LazySize
size (y -> y -> y
f y
x) y
x


{-# INLINE switchL #-}
switchL :: (Transform sig y) =>
   a -> (y -> sig y -> a) -> sig y -> a
switchL :: forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
switchL a
nothing y -> sig y -> a
just =
   forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
nothing (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry y -> sig y -> a
just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL

{-# INLINE switchR #-}
switchR :: (Transform sig y) =>
   a -> (sig y -> y -> a) -> sig y -> a
switchR :: forall (sig :: * -> *) y a.
Transform sig y =>
a -> (sig y -> y -> a) -> sig y -> a
switchR a
nothing sig y -> y -> a
just =
   forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
nothing (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry sig y -> y -> a
just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (sig y, y)
viewR

{-# INLINE runViewL #-}
runViewL ::
   (Read sig y) =>
   sig y ->
   (forall s. (s -> Maybe (y, s)) -> s -> x) ->
   x
runViewL :: forall (sig :: * -> *) y x.
Read sig y =>
sig y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL sig y
xs =
   forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
SigS.runViewL (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState sig y
xs)

{-# INLINE runSwitchL #-}
runSwitchL ::
   (Read sig y) =>
   sig y ->
   (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x) ->
   x
runSwitchL :: forall (sig :: * -> *) y x.
Read sig y =>
sig y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
runSwitchL sig y
xs =
   forall y x.
T y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
SigS.runSwitchL (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState sig y
xs)


{-# INLINE singleton #-}
singleton :: (Transform sig y) => y -> sig y
singleton :: forall (sig :: * -> *) y. Transform sig y => y -> sig y
singleton y
x = forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
y -> sig y -> sig y
cons y
x forall a. Monoid a => a
mempty

{-# INLINE mix #-}
mix :: (Additive.C y, Transform sig y) =>
   sig y -> sig y -> sig y
mix :: forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
mix = forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
(y -> y -> y) -> sig y -> sig y -> sig y
zipWithAppend forall a. C a => a -> a -> a
(Additive.+)

{-# INLINE zip #-}
zip :: (Read sig a, Transform sig b, Transform sig (a,b)) =>
   sig a -> sig b -> sig (a,b)
zip :: forall (sig :: * -> *) a b.
(Read sig a, Transform sig b, Transform sig (a, b)) =>
sig a -> sig b -> sig (a, b)
zip = forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
zipWith (,)

{-# INLINE zipWith #-}
zipWith :: (Read sig a, Transform sig b, Transform sig c) =>
   (a -> b -> c) -> (sig a -> sig b -> sig c)
zipWith :: forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
zipWith a -> b -> c
h = forall (sig :: * -> *) b c a.
(Transform sig b, Transform sig c) =>
(a -> b -> c) -> T a -> sig b -> sig c
zipWithState a -> b -> c
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState

{-# INLINE zipWith3 #-}
zipWith3 :: (Read sig a, Read sig b, Transform sig c) =>
   (a -> b -> c -> c) -> (sig a -> sig b -> sig c -> sig c)
zipWith3 :: forall (sig :: * -> *) a b c.
(Read sig a, Read sig b, Transform sig c) =>
(a -> b -> c -> c) -> sig a -> sig b -> sig c -> sig c
zipWith3 a -> b -> c -> c
h sig a
as sig b
bs = forall (sig :: * -> *) c d a b.
(Transform sig c, Transform sig d) =>
(a -> b -> c -> d) -> T a -> T b -> sig c -> sig d
zipWithState3 a -> b -> c -> c
h (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState sig a
as) (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState sig b
bs)

{-# INLINE zipWithState #-}
zipWithState :: (Transform sig b, Transform sig c) =>
   (a -> b -> c) -> SigS.T a -> sig b -> sig c
zipWithState :: forall (sig :: * -> *) b c a.
(Transform sig b, Transform sig c) =>
(a -> b -> c) -> T a -> sig b -> sig c
zipWithState a -> b -> c
f T a
sig =
   forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
SigS.runViewL T a
sig (\s -> Maybe (a, s)
next ->
   forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
crochetL (\b
b s
as0 ->
      do (a
a,s
as1) <- s -> Maybe (a, s)
next s
as0
         forall a. a -> Maybe a
Just (a -> b -> c
f a
a b
b, s
as1)))

{-# INLINE zipWithState3 #-}
zipWithState3 :: (Transform sig c, Transform sig d) =>
   (a -> b -> c -> d) -> (SigS.T a -> SigS.T b -> sig c -> sig d)
zipWithState3 :: forall (sig :: * -> *) c d a b.
(Transform sig c, Transform sig d) =>
(a -> b -> c -> d) -> T a -> T b -> sig c -> sig d
zipWithState3 a -> b -> c -> d
h T a
a T b
b =
   forall (sig :: * -> *) b c a.
(Transform sig b, Transform sig c) =>
(a -> b -> c) -> T a -> sig b -> sig c
zipWithState forall a b. (a -> b) -> a -> b
($) (forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith a -> b -> c -> d
h T a
a T b
b)



{-# INLINE unzip #-}
unzip :: (Transform sig (a,b), Transform sig a, Transform sig b) =>
   sig (a,b) -> (sig a, sig b)
unzip :: forall (sig :: * -> *) a b.
(Transform sig (a, b), Transform sig a, Transform sig b) =>
sig (a, b) -> (sig a, sig b)
unzip sig (a, b)
xs =
   (forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map forall a b. (a, b) -> a
fst sig (a, b)
xs, forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map forall a b. (a, b) -> b
snd sig (a, b)
xs)

{-# INLINE unzip3 #-}
unzip3 :: (Transform sig (a,b,c), Transform sig a, Transform sig b, Transform sig c) =>
   sig (a,b,c) -> (sig a, sig b, sig c)
unzip3 :: forall (sig :: * -> *) a b c.
(Transform sig (a, b, c), Transform sig a, Transform sig b,
 Transform sig c) =>
sig (a, b, c) -> (sig a, sig b, sig c)
unzip3 sig (a, b, c)
xs =
   (forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map forall a b c. (a, b, c) -> a
fst3 sig (a, b, c)
xs, forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map forall a b c. (a, b, c) -> b
snd3 sig (a, b, c)
xs, forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map forall a b c. (a, b, c) -> c
thd3 sig (a, b, c)
xs)



{- |
@takeStateMatch len xs@
keeps a prefix of @xs@ of the same length and block structure as @len@
and stores it in the same type of container as @len@.
-}
{-# INLINE takeStateMatch #-}
takeStateMatch :: (Transform sig a, Transform sig b) =>
   sig a -> SigS.T b -> sig b
takeStateMatch :: forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
sig a -> T b -> sig b
takeStateMatch sig a
x T b
y =
   forall (sig :: * -> *) b c a.
(Transform sig b, Transform sig c) =>
(a -> b -> c) -> T a -> sig b -> sig c
zipWithState forall a b. a -> b -> a
const T b
y sig a
x


{-# INLINE delay #-}
delay :: (Write sig y) =>
   LazySize -> y -> Int -> sig y -> sig y
delay :: forall (sig :: * -> *) y.
Write sig y =>
LazySize -> y -> Int -> sig y -> sig y
delay LazySize
size y
z Int
n =
   forall sig. Monoid sig => sig -> sig -> sig
append (forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> Int -> y -> sig y
replicate LazySize
size Int
n y
z)

{-# INLINE delayLoop #-}
delayLoop ::
   (Transform sig y) =>
      (sig y -> sig y)
            -- ^ processor that shall be run in a feedback loop
   -> sig y -- ^ prefix of the output, its length determines the delay
   -> sig y
delayLoop :: forall (sig :: * -> *) y.
Transform sig y =>
(sig y -> sig y) -> sig y -> sig y
delayLoop sig y -> sig y
proc sig y
prefix =
   forall a. (a -> a) -> a
fix (forall sig. Monoid sig => sig -> sig -> sig
append sig y
prefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig y -> sig y
proc)


{-# INLINE delayLoopOverlap #-}
delayLoopOverlap ::
   (Additive.C y, Write sig y) =>
      Int
   -> (sig y -> sig y)
            {- ^ Processor that shall be run in a feedback loop.
                 It's absolutely necessary that this function preserves the chunk structure
                 and that it does not look a chunk ahead.
                 That's guaranteed for processes that do not look ahead at all,
                 like 'SVL.map', 'SVL.crochetL' and
                 all of type @Causal.Process@. -}
   -> sig y -- ^ input
   -> sig y -- ^ output has the same length as the input
delayLoopOverlap :: forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> (sig y -> sig y) -> sig y -> sig y
delayLoopOverlap Int
time sig y -> sig y
proc sig y
xs =
   forall a. (a -> a) -> a
fix (forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
zipWith forall a. C a => a -> a -> a
(Additive.+) sig y
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall (sig :: * -> *) y.
Write sig y =>
LazySize -> y -> Int -> sig y -> sig y
delay LazySize
defaultLazySize forall a. C a => a
Additive.zero Int
time forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig y -> sig y
proc)



{-# INLINE sum #-}
sum :: (Additive.C a, Read sig a) => sig a -> a
sum :: forall a (sig :: * -> *). (C a, Read sig a) => sig a -> a
sum = forall (sig :: * -> *) y s.
(Read0 sig, Storage (sig y)) =>
(s -> y -> s) -> s -> sig y -> s
foldL forall a. C a => a -> a -> a
(Additive.+) forall a. C a => a
Additive.zero

{-# INLINE sum1 #-}
sum1 :: (Additive.C a, Read sig a) => sig a -> a
sum1 :: forall a (sig :: * -> *). (C a, Read sig a) => sig a -> a
sum1 = forall x. (x -> x -> x) -> T x -> x
SigS.foldL1 forall a. C a => a -> a -> a
(Additive.+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState
{-
sum1 :: (Additive.C a, Transform sig a) => sig a -> a
sum1 =
   switchL
      (error "Generic.Signal.sum1: signal must be non-empty in order to avoid to use a non-existing zero")
      (foldL (Additive.+))
-}


{-# INLINE foldMap #-}
foldMap :: (Read sig a, Monoid m) => (a -> m) -> sig a -> m
foldMap :: forall (sig :: * -> *) a m.
(Read sig a, Monoid m) =>
(a -> m) -> sig a -> m
foldMap a -> m
f = forall (sig :: * -> *) y s.
(Read0 sig, Storage (sig y)) =>
(y -> s -> s) -> s -> sig y -> s
foldR (forall sig. Monoid sig => sig -> sig -> sig
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) forall a. Monoid a => a
mempty

{-# DEPRECATED monoidConcatMap "Use foldMap instead." #-}
{-# INLINE monoidConcatMap #-}
monoidConcatMap :: (Read sig a, Monoid m) => (a -> m) -> sig a -> m
monoidConcatMap :: forall (sig :: * -> *) a m.
(Read sig a, Monoid m) =>
(a -> m) -> sig a -> m
monoidConcatMap = forall (sig :: * -> *) a m.
(Read sig a, Monoid m) =>
(a -> m) -> sig a -> m
foldMap


{-# INLINE tails #-}
tails :: (Transform sig y) => sig y -> SigS.T (sig y)
tails :: forall (sig :: * -> *) y. Transform sig y => sig y -> T (sig y)
tails =
   forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
SigS.unfoldR (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\sig y
x -> (sig y
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig y
x)))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

{- |
Like 'tail', but for an empty signal it simply returns an empty signal.
-}
{-# INLINE laxTail #-}
laxTail :: (Transform sig y) => sig y -> sig y
laxTail :: forall (sig :: * -> *) y. Transform sig y => sig y -> sig y
laxTail sig y
xs =
   forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
switchL sig y
xs (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const) sig y
xs

{-# INLINE mapAdjacent #-}
mapAdjacent :: (Read sig a, Transform sig a) =>
   (a -> a -> a) -> sig a -> sig a
mapAdjacent :: forall (sig :: * -> *) a.
(Read sig a, Transform sig a) =>
(a -> a -> a) -> sig a -> sig a
mapAdjacent a -> a -> a
f sig a
xs0 =
   let xs1 :: sig a
xs1 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe sig a
xs0 forall a b. (a, b) -> b
snd (forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig a
xs0)
   in  forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
zipWith a -> a -> a
f sig a
xs0 sig a
xs1

{-# INLINE modifyStatic #-}
modifyStatic :: (Transform sig a) =>
   Modifier.Simple s ctrl a a -> ctrl -> sig a -> sig a
modifyStatic :: forall (sig :: * -> *) a s ctrl.
Transform sig a =>
Simple s ctrl a a -> ctrl -> sig a -> sig a
modifyStatic (Modifier.Simple s
state ctrl -> a -> State s a
proc) ctrl
control =
   forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
crochetL (\a
a s
acc -> forall a. a -> Maybe a
Just (forall s a. State s a -> s -> (a, s)
runState (ctrl -> a -> State s a
proc ctrl
control a
a) s
acc)) s
state

{-| Here the control may vary over the time. -}
{-# INLINE modifyModulated #-}
modifyModulated :: (Transform sig a, Transform sig b, Read sig ctrl) =>
   Modifier.Simple s ctrl a b -> sig ctrl -> sig a -> sig b
modifyModulated :: forall (sig :: * -> *) a b ctrl s.
(Transform sig a, Transform sig b, Read sig ctrl) =>
Simple s ctrl a b -> sig ctrl -> sig a -> sig b
modifyModulated (Modifier.Simple s
state ctrl -> a -> State s b
proc) sig ctrl
control =
   forall (sig :: * -> *) y x.
Read sig y =>
sig y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL sig ctrl
control (\s -> Maybe (ctrl, s)
next s
c0 ->
   forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
crochetL
      (\a
x (s
acc0,s
cs0) ->
         do (ctrl
c,s
cs1) <- s -> Maybe (ctrl, s)
next s
cs0
            let (b
y,s
acc1) = forall s a. State s a -> s -> (a, s)
runState (ctrl -> a -> State s b
proc ctrl
c a
x) s
acc0
            forall (m :: * -> *) a. Monad m => a -> m a
return (b
y,(s
acc1,s
cs1)))
      (s
state, s
c0))
{-
modifyModulated (Modifier.Simple state proc) control x =
   crochetL
      (\ca acc -> Just (runState (uncurry proc ca) acc))
      state (zip control x)
-}

-- cf. Module.linearComb
{-# INLINE linearComb #-}
linearComb ::
   (Module.C t y, Read sig t, Read sig y) =>
   sig t -> sig y -> y
linearComb :: forall t y (sig :: * -> *).
(C t y, Read sig t, Read sig y) =>
sig t -> sig y -> y
linearComb sig t
ts sig y
ys =
   forall a. C a => T a -> a
SigS.sum (forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a v. C a v => a -> v -> v
(Module.*>) (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState sig t
ts) (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState sig y
ys))


fromState :: (Write sig y) =>
   LazySize -> SigS.T y -> sig y
fromState :: forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
fromState LazySize
size (SigS.Cons StateT s Maybe y
f s
x) =
   forall (sig :: * -> *) y s.
(Write0 sig, Storage (sig y)) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
unfoldR LazySize
size (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe y
f) s
x

{-# INLINE extendConstant #-}
extendConstant :: (Write sig y) =>
   LazySize -> sig y -> sig y
extendConstant :: forall (sig :: * -> *) y. Write sig y => LazySize -> sig y -> sig y
extendConstant LazySize
size sig y
xt =
   forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      sig y
xt
      (forall sig. Monoid sig => sig -> sig -> sig
append sig y
xt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> y -> sig y
repeat LazySize
size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
      (forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (sig y, y)
viewR sig y
xt)

snoc :: (Transform sig y) => sig y -> y -> sig y
snoc :: forall (sig :: * -> *) y. Transform sig y => sig y -> y -> sig y
snoc sig y
xs y
x = forall sig. Monoid sig => sig -> sig -> sig
append sig y
xs forall a b. (a -> b) -> a -> b
$ forall (sig :: * -> *) y. Transform sig y => y -> sig y
singleton y
x


-- comonadic 'bind'
-- only non-empty suffixes are processed
{-# INLINE mapTails #-}
mapTails :: (Transform sig a) =>
   (sig a -> a) -> sig a -> sig a
mapTails :: forall (sig :: * -> *) a.
Transform sig a =>
(sig a -> a) -> sig a -> sig a
mapTails sig a -> a
f sig a
x =
   forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
crochetL (\a
_ sig a
xs0 ->
      do (a
_,sig a
xs1) <- forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig a
xs0
         forall a. a -> Maybe a
Just (sig a -> a
f sig a
xs0, sig a
xs1))
      sig a
x sig a
x
{-
Implementation with unfoldR is more natural,
but it could not preserve the chunk structure of the input signal.
Thus we prefer crochetL, although we do not consume single elements of the input signal.
-}
mapTailsAlt ::
   (Transform sig a, Write sig b) =>
   LazySize -> (sig a -> b) -> sig a -> sig b
mapTailsAlt :: forall (sig :: * -> *) a b.
(Transform sig a, Write sig b) =>
LazySize -> (sig a -> b) -> sig a -> sig b
mapTailsAlt LazySize
size sig a -> b
f =
   forall (sig :: * -> *) y s.
(Write0 sig, Storage (sig y)) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
unfoldR LazySize
size (\sig a
xs ->
      do (a
_,sig a
ys) <- forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig a
xs
         forall a. a -> Maybe a
Just (sig a -> b
f sig a
xs, sig a
ys))

{- |
Only non-empty suffixes are processed.
More oftenly we might need

> zipWithTails :: (Read sig b, Transform2 sig a) =>
>    (b -> sig a -> a) -> sig b -> sig a -> sig a

this would preserve the chunk structure of @sig a@,
but it is a bit more hassle to implement that.
-}
{-# INLINE zipWithTails #-}
zipWithTails :: (Transform sig a, Transform sig b, Transform sig c) =>
   (a -> sig b -> c) -> sig a -> sig b -> sig c
zipWithTails :: forall (sig :: * -> *) a b c.
(Transform sig a, Transform sig b, Transform sig c) =>
(a -> sig b -> c) -> sig a -> sig b -> sig c
zipWithTails a -> sig b -> c
f =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
crochetL (\a
x sig b
ys0 ->
      do (b
_,sig b
ys) <- forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig b
ys0
         forall a. a -> Maybe a
Just (a -> sig b -> c
f a
x sig b
ys0, sig b
ys)))

{-
instance (Additive.C y, Sample.C y, C sig) => Additive.C (sig y) where
   (+) = mix
   negate = map Additive.negate
-}


indexByDrop :: (Transform sig a) => sig a -> Int -> a
indexByDrop :: forall (sig :: * -> *) a. Transform sig a => sig a -> Int -> a
indexByDrop sig a
xs Int
n =
   if Int
nforall a. Ord a => a -> a -> Bool
<Int
0
     then forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Generic.index: negative index " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
     else forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
switchL
             (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Generic.index: index too large " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
             forall a b. a -> b -> a
const
             (forall sig. Transform sig => Int -> sig -> sig
Cut.drop Int
n sig a
xs)


{-
This does not work, because we can constrain only the instances of Data
but this is not checked when implementing methods of C.

class Data sig y where

class C sig where
   add :: (Data sig y, Additive.C y) => sig y -> sig y -> sig y
   map :: (Data sig a, Data sig b) => (a -> b) -> (sig a -> sig b)
   zipWith :: (Data sig a, Data sig b, Data sig c) =>
                  (a -> b -> c) -> (sig a -> sig b -> sig c)
-}

{-
This does not work, because we would need type parameters for all occuring element types.

class C sig y where
   add :: (Additive.C y) => sig y -> sig y -> sig y
   map :: C sig a => (a -> y) -> (sig a -> sig y)
   zipWith :: (a -> b -> y) -> (sig a -> sig b -> sig y)
-}