{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{- |
ToDo:
Better name for the module is certainly
  Synthesizer.Generator.Signal
-}
module Synthesizer.State.Signal where

import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Data.List as List

import qualified Algebra.Module   as Module
import qualified Algebra.Additive as Additive
import Algebra.Module ((*>))
import Algebra.Additive (zero)

import qualified Synthesizer.Format as Format

import qualified Data.EventList.Relative.BodyTime as EventList
import qualified Numeric.NonNegative.Class as NonNeg98
import Numeric.NonNegative.Class ((-|), )

import Control.Monad.Trans.State
          (runState, StateT(StateT), runStateT, )
import Control.Monad (Monad, mplus, msum,
           (>>), (>>=), fail, return, (=<<),
           liftM2,
           Functor, fmap, )

import qualified Control.Applicative as App

import Data.Foldable (Foldable, foldr, )
import Data.Monoid (Monoid, mappend, mempty, )
import Data.Semigroup (Semigroup, (<>), )

import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy.Pattern as SVL
import qualified Data.StorableVector.Lazy.Pointer as PtrSt
import qualified Data.StorableVector as V
import Foreign.Storable (Storable)

import qualified Data.List.HT as ListHT
import Data.Tuple.HT (mapFst, mapSnd, mapPair, fst3, snd3, thd3, )
import Data.Function.HT (nest, )
import Data.Maybe.HT (toMaybe, )
import Data.Bool.HT (if', )
import NumericPrelude.Numeric (Float, Double, fromInteger, )

import Text.Show (Show(showsPrec), show, showParen, showString, )
import Data.Maybe (Maybe(Just, Nothing), maybe, fromMaybe, )
import qualified Prelude as P
import Prelude
   ((.), ($), id, const, flip, curry, uncurry, fst, snd, error,
    (>), (>=), max, Ord, (==), Eq,
    succ, pred, Bool(True,False), (&&), not, Int,
--    fromInteger,
    (++),
    seq,
    )


-- | Cf. StreamFusion  Data.Stream
data T a =
   forall s. -- Seq s =>
      Cons !(StateT s Maybe a)  -- compute next value
           !s                   -- initial state


instance (Show y) => Show (T y) where
   showsPrec :: Int -> T y -> ShowS
showsPrec Int
p T y
x =
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10)
         (String -> ShowS
showString String
"StateSignal.fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [y] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (T y -> [y]
forall y. T y -> [y]
toList T y
x))

instance (Eq y) => Eq (T y) where
   == :: T y -> T y -> Bool
(==) = T y -> T y -> Bool
forall y. Eq y => T y -> T y -> Bool
equal

instance Format.C T where
   format :: forall y. Show y => Int -> T y -> ShowS
format = Int -> T x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec

instance Functor T where
   fmap :: forall a b. (a -> b) -> T a -> T b
fmap a -> b
g (Cons StateT s Maybe a
f s
s) = StateT s Maybe b -> s -> T b
forall a s. StateT s Maybe a -> s -> T a
Cons ((a -> b) -> StateT s Maybe a -> StateT s Maybe b
forall a b. (a -> b) -> StateT s Maybe a -> StateT s Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g StateT s Maybe a
f) s
s

instance Foldable T where
   foldr :: forall a b. (a -> b -> b) -> b -> T a -> b
foldr = (a -> b -> b) -> b -> T a -> b
forall a b. (a -> b -> b) -> b -> T a -> b
foldR

instance App.Applicative T where
   pure :: forall a. a -> T a
pure = a -> T a
forall a. a -> T a
singleton
   T (a -> b)
x <*> :: forall a b. T (a -> b) -> T a -> T b
<*> T a
y = ((a -> b) -> a -> b) -> T (a -> b) -> T a -> T b
forall a b c. (a -> b -> c) -> T a -> T b -> T c
liftA2 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) T (a -> b)
x T a
y

instance Monad T where
   return :: forall a. a -> T a
return = a -> T a
forall a. a -> T a
singleton
   T a
x >>= :: forall a b. T a -> (a -> T b) -> T b
>>= a -> T b
k =
      T a -> (forall {s}. (s -> Maybe (a, s)) -> s -> T b) -> T b
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T a
x ((forall {s}. (s -> Maybe (a, s)) -> s -> T b) -> T b)
-> (forall {s}. (s -> Maybe (a, s)) -> s -> T b) -> T b
forall a b. (a -> b) -> a -> b
$ \s -> Maybe (a, s)
f s
s0 ->
      ((Maybe (T b, s) -> Maybe (b, Maybe (T b, s)))
 -> Maybe (T b, s) -> T b)
-> Maybe (T b, s)
-> (Maybe (T b, s) -> Maybe (b, Maybe (T b, s)))
-> T b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe (T b, s) -> Maybe (b, Maybe (T b, s)))
-> Maybe (T b, s) -> T b
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate (((a, s) -> (T b, s)) -> Maybe (a, s) -> Maybe (T b, s)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> T b) -> (a, s) -> (T b, s)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst a -> T b
k) (Maybe (a, s) -> Maybe (T b, s)) -> Maybe (a, s) -> Maybe (T b, s)
forall a b. (a -> b) -> a -> b
$ s -> Maybe (a, s)
f s
s0) ((Maybe (T b, s) -> Maybe (b, Maybe (T b, s))) -> T b)
-> (Maybe (T b, s) -> Maybe (b, Maybe (T b, s))) -> T b
forall a b. (a -> b) -> a -> b
$ \Maybe (T b, s)
m ->
      Maybe (T b, s)
m Maybe (T b, s)
-> ((T b, s) -> Maybe (b, Maybe (T b, s)))
-> Maybe (b, Maybe (T b, s))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      let go :: (T b, s) -> Maybe (b, Maybe (T b, s))
go (T b
y,s
s) =
             Maybe (b, Maybe (T b, s))
-> Maybe (b, Maybe (T b, s)) -> Maybe (b, Maybe (T b, s))
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
                (((b, T b) -> (b, Maybe (T b, s)))
-> Maybe (b, T b) -> Maybe (b, Maybe (T b, s))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
y1,T b
ys) -> (b
y1, (T b, s) -> Maybe (T b, s)
forall a. a -> Maybe a
Just (T b
ys,s
s))) (T b -> Maybe (b, T b)
forall a. T a -> Maybe (a, T a)
viewL T b
y))
                (((a, s) -> (T b, s)) -> Maybe (a, s) -> Maybe (T b, s)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> T b) -> (a, s) -> (T b, s)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst a -> T b
k) (s -> Maybe (a, s)
f s
s) Maybe (T b, s)
-> ((T b, s) -> Maybe (b, Maybe (T b, s)))
-> Maybe (b, Maybe (T b, s))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (T b, s) -> Maybe (b, Maybe (T b, s))
go)
      in  (T b, s) -> Maybe (b, Maybe (T b, s))
go


{- |
It is a common pattern to use @switchL@ or @viewL@ in a loop
in order to traverse a signal.
However this needs repeated packing and unpacking
of the 'viewL' function and the state.
It seems that GHC is not clever enough to detect,
that the 'view' function does not change.
With 'runViewL' you can unpack a stream once
and use an efficient 'viewL' in the loop.
-}
{-# INLINE runViewL #-}
runViewL ::
   T y ->
   (forall s. (s -> Maybe (y, s)) -> s -> x) ->
   x
runViewL :: forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL (Cons StateT s Maybe y
f s
s) forall s. (s -> Maybe (y, s)) -> s -> x
cont =
   (s -> Maybe (y, s)) -> s -> x
forall s. (s -> Maybe (y, s)) -> s -> x
cont (StateT s Maybe y -> s -> Maybe (y, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe y
f) s
s

{-# INLINE runSwitchL #-}
runSwitchL ::
   T y ->
   (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x) ->
   x
runSwitchL :: forall y x.
T y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
runSwitchL T y
sig forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x
cont =
   T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T y
sig (\s -> Maybe (y, s)
next ->
      (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x
forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x
cont (\z
n y -> s -> z
j -> z -> ((y, s) -> z) -> Maybe (y, s) -> z
forall b a. b -> (a -> b) -> Maybe a -> b
maybe z
n ((y -> s -> z) -> (y, s) -> z
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry y -> s -> z
j) (Maybe (y, s) -> z) -> (s -> Maybe (y, s)) -> s -> z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (y, s)
next))

{-# INLINE generate #-}
generate :: (acc -> Maybe (y, acc)) -> acc -> T y
generate :: forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate acc -> Maybe (y, acc)
f = StateT acc Maybe y -> acc -> T y
forall a s. StateT s Maybe a -> s -> T a
Cons ((acc -> Maybe (y, acc)) -> StateT acc Maybe y
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT acc -> Maybe (y, acc)
f)

{-# INLINE unfoldR #-}
unfoldR :: (acc -> Maybe (y, acc)) -> acc -> T y
unfoldR :: forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
unfoldR = (acc -> Maybe (y, acc)) -> acc -> T y
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate

{-# INLINE generateInfinite #-}
generateInfinite :: (acc -> (y, acc)) -> acc -> T y
generateInfinite :: forall acc y. (acc -> (y, acc)) -> acc -> T y
generateInfinite acc -> (y, acc)
f = (acc -> Maybe (y, acc)) -> acc -> T y
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate ((y, acc) -> Maybe (y, acc)
forall a. a -> Maybe a
Just ((y, acc) -> Maybe (y, acc))
-> (acc -> (y, acc)) -> acc -> Maybe (y, acc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. acc -> (y, acc)
f)

{-# INLINE fromList #-}
fromList :: [y] -> T y
fromList :: forall y. [y] -> T y
fromList = ([y] -> Maybe (y, [y])) -> [y] -> T y
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate [y] -> Maybe (y, [y])
forall a. [a] -> Maybe (a, [a])
ListHT.viewL

{-# INLINE toList #-}
toList :: T y -> [y]
toList :: forall y. T y -> [y]
toList (Cons StateT s Maybe y
f s
x0) =
   (s -> Maybe (y, s)) -> s -> [y]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (StateT s Maybe y -> s -> Maybe (y, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe y
f) s
x0


{-# INLINE fromStorableSignal #-}
fromStorableSignal ::
   (Storable a) =>
   SigSt.T a -> T a
fromStorableSignal :: forall a. Storable a => T a -> T a
fromStorableSignal =
   (Pointer a -> Maybe (a, Pointer a)) -> Pointer a -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate Pointer a -> Maybe (a, Pointer a)
forall a. Storable a => Pointer a -> Maybe (a, Pointer a)
PtrSt.viewL (Pointer a -> T a) -> (T a -> Pointer a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T a -> Pointer a
forall a. Storable a => Vector a -> Pointer a
PtrSt.cons

{-# INLINE fromStrictStorableSignal #-}
fromStrictStorableSignal ::
   (Storable a) =>
   V.Vector a -> T a
fromStrictStorableSignal :: forall a. Storable a => Vector a -> T a
fromStrictStorableSignal Vector a
xs =
   (Int -> a) -> T Int -> T a
forall a b. (a -> b) -> T a -> T b
map (Vector a -> Int -> a
forall a. Storable a => Vector a -> Int -> a
V.index Vector a
xs) (T Int -> T a) -> T Int -> T a
forall a b. (a -> b) -> a -> b
$ Int -> T Int -> T Int
forall a. Int -> T a -> T a
take (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
xs) (T Int -> T Int) -> T Int -> T Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> T Int
forall a. (a -> a) -> a -> T a
iterate Int -> Int
forall a. Enum a => a -> a
succ Int
forall a. C a => a
zero

{-# INLINE toStorableSignal #-}
toStorableSignal ::
   (Storable a) =>
   SigSt.ChunkSize -> T a -> SigSt.T a
toStorableSignal :: forall a. Storable a => ChunkSize -> T a -> T a
toStorableSignal ChunkSize
size (Cons StateT s Maybe a
f s
a) =
   ChunkSize -> (s -> Maybe (a, s)) -> s -> Vector a
forall b a.
Storable b =>
ChunkSize -> (a -> Maybe (b, a)) -> a -> Vector b
SigSt.unfoldr ChunkSize
size (StateT s Maybe a -> s -> Maybe (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe a
f) s
a

{-# INLINE toStrictStorableSignal #-}
toStrictStorableSignal ::
   (Storable a) =>
   Int -> T a -> V.Vector a
toStrictStorableSignal :: forall a. Storable a => Int -> T a -> Vector a
toStrictStorableSignal Int
size (Cons StateT s Maybe a
f s
a) =
   (Vector a, Maybe s) -> Vector a
forall a b. (a, b) -> a
fst ((Vector a, Maybe s) -> Vector a)
-> (Vector a, Maybe s) -> Vector a
forall a b. (a -> b) -> a -> b
$ Int -> (s -> Maybe (a, s)) -> s -> (Vector a, Maybe s)
forall b a.
Storable b =>
Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
V.unfoldrN Int
size (StateT s Maybe a -> s -> Maybe (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe a
f) s
a

-- needed in synthesizer-alsa
{-# INLINE toStorableSignalVary #-}
toStorableSignalVary ::
   (Storable a) =>
   SVL.LazySize -> T a -> SigSt.T a
toStorableSignalVary :: forall a. Storable a => LazySize -> T a -> T a
toStorableSignalVary LazySize
size (Cons StateT s Maybe a
f s
a) =
   (T a, Maybe s) -> T a
forall a b. (a, b) -> a
fst ((T a, Maybe s) -> T a) -> (T a, Maybe s) -> T a
forall a b. (a -> b) -> a -> b
$ LazySize -> (s -> Maybe (a, s)) -> s -> (T a, Maybe s)
forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
SVL.unfoldrN LazySize
size (StateT s Maybe a -> s -> Maybe (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe a
f) s
a

fromPiecewiseConstant ::
   (NonNeg98.C time, P.Integral time) =>
   EventList.T time a -> T a
fromPiecewiseConstant :: forall time a. (C time, Integral time) => T time a -> T a
fromPiecewiseConstant T time a
xs0 =
   (((a, time), T time a) -> Maybe (a, ((a, time), T time a)))
-> ((a, time), T time a) -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate
      (let go :: ((body, time), T time body)
-> Maybe (body, ((body, time), T time body))
go ((body
x,time
n),T time body
xs) =
             Bool
-> Maybe (body, ((body, time), T time body))
-> Maybe (body, ((body, time), T time body))
-> Maybe (body, ((body, time), T time body))
forall a. Bool -> a -> a -> a
if' (time
n time -> time -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> time
forall a. Num a => Integer -> a
P.fromInteger Integer
0)
               (((body, time), T time body)
-> Maybe (body, ((body, time), T time body))
go (((body, time), T time body)
 -> Maybe (body, ((body, time), T time body)))
-> Maybe ((body, time), T time body)
-> Maybe (body, ((body, time), T time body))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< T time body -> Maybe ((body, time), T time body)
forall time body. T time body -> Maybe ((body, time), T time body)
EventList.viewL T time body
xs)
               ((body, ((body, time), T time body))
-> Maybe (body, ((body, time), T time body))
forall a. a -> Maybe a
Just (body
x, ((body
x, time
n time -> time -> time
forall a. C a => a -> a -> a
-| Integer -> time
forall a. Num a => Integer -> a
P.fromInteger Integer
1), T time body
xs)))
       in  ((a, time), T time a) -> Maybe (a, ((a, time), T time a))
forall {time} {body}.
(Num time, C time) =>
((body, time), T time body)
-> Maybe (body, ((body, time), T time body))
go)
      ((String -> a
forall a. HasCallStack => String -> a
error String
"if counter is zero, the sample value is invalid", Integer -> time
forall a. Num a => Integer -> a
P.fromInteger Integer
0), T time a
xs0)


{-# INLINE iterate #-}
iterate :: (a -> a) -> a -> T a
iterate :: forall a. (a -> a) -> a -> T a
iterate a -> a
f = (a -> (a, a)) -> a -> T a
forall acc y. (acc -> (y, acc)) -> acc -> T y
generateInfinite (\a
x -> (a
x, a -> a
f a
x))

{-# INLINE iterateAssociative #-}
iterateAssociative :: (a -> a -> a) -> a -> T a
iterateAssociative :: forall a. (a -> a -> a) -> a -> T a
iterateAssociative a -> a -> a
op a
x = (a -> a) -> a -> T a
forall a. (a -> a) -> a -> T a
iterate (a -> a -> a
op a
x) a
x -- should be optimized

{-# INLINE repeat #-}
repeat :: a -> T a
repeat :: forall a. a -> T a
repeat = (a -> a) -> a -> T a
forall a. (a -> a) -> a -> T a
iterate a -> a
forall a. a -> a
id




{-# INLINE crochetL #-}
crochetL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL :: forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL x -> acc -> Maybe (y, acc)
g acc
b (Cons StateT s Maybe x
f s
a) =
   StateT (s, acc) Maybe y -> (s, acc) -> T y
forall a s. StateT s Maybe a -> s -> T a
Cons
      (((s, acc) -> Maybe (y, (s, acc))) -> StateT (s, acc) Maybe y
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\(s
a0,acc
b0) ->
          do (x
x0,s
a1) <- StateT s Maybe x -> s -> Maybe (x, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe x
f s
a0
             (y
y0,acc
b1) <- x -> acc -> Maybe (y, acc)
g x
x0 acc
b0
             (y, (s, acc)) -> Maybe (y, (s, acc))
forall a. a -> Maybe a
Just (y
y0, (s
a1,acc
b1))))
      (s
a,acc
b)


{-# INLINE scanL #-}
scanL :: (acc -> x -> acc) -> acc -> T x -> T acc
scanL :: forall acc x. (acc -> x -> acc) -> acc -> T x -> T acc
scanL acc -> x -> acc
f acc
start =
   acc -> T acc -> T acc
forall a. a -> T a -> T a
cons acc
start (T acc -> T acc) -> (T x -> T acc) -> T x -> T acc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (x -> acc -> Maybe (acc, acc)) -> acc -> T x -> T acc
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL (\x
x acc
acc -> let y :: acc
y = acc -> x -> acc
f acc
acc x
x in (acc, acc) -> Maybe (acc, acc)
forall a. a -> Maybe a
Just (acc
y, acc
y)) acc
start


{-# INLINE scanLClip #-}
-- | input and output have equal length, that's better for fusion
scanLClip :: (acc -> x -> acc) -> acc -> T x -> T acc
scanLClip :: forall acc x. (acc -> x -> acc) -> acc -> T x -> T acc
scanLClip acc -> x -> acc
f acc
start =
   (x -> acc -> Maybe (acc, acc)) -> acc -> T x -> T acc
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL (\x
x acc
acc -> (acc, acc) -> Maybe (acc, acc)
forall a. a -> Maybe a
Just (acc
acc, acc -> x -> acc
f acc
acc x
x)) acc
start

{-# INLINE map #-}
map :: (a -> b) -> (T a -> T b)
map :: forall a b. (a -> b) -> T a -> T b
map = (a -> b) -> T a -> T b
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
-- map f = crochetL (\x _ -> Just (f x, ())) ()


{- |
This function will recompute the input lists
and is thus probably not what you want.
If you want to avoid recomputation please consider Causal.Process.
-}
{-# INLINE unzip #-}
unzip :: T (a,b) -> (T a, T b)
unzip :: forall a b. T (a, b) -> (T a, T b)
unzip T (a, b)
x = (((a, b) -> a) -> T (a, b) -> T a
forall a b. (a -> b) -> T a -> T b
map (a, b) -> a
forall a b. (a, b) -> a
fst T (a, b)
x, ((a, b) -> b) -> T (a, b) -> T b
forall a b. (a -> b) -> T a -> T b
map (a, b) -> b
forall a b. (a, b) -> b
snd T (a, b)
x)

{-# INLINE unzip3 #-}
unzip3 :: T (a,b,c) -> (T a, T b, T c)
unzip3 :: forall a b c. T (a, b, c) -> (T a, T b, T c)
unzip3 T (a, b, c)
xs = (((a, b, c) -> a) -> T (a, b, c) -> T a
forall a b. (a -> b) -> T a -> T b
map (a, b, c) -> a
forall a b c. (a, b, c) -> a
fst3 T (a, b, c)
xs, ((a, b, c) -> b) -> T (a, b, c) -> T b
forall a b. (a -> b) -> T a -> T b
map (a, b, c) -> b
forall a b c. (a, b, c) -> b
snd3 T (a, b, c)
xs, ((a, b, c) -> c) -> T (a, b, c) -> T c
forall a b. (a -> b) -> T a -> T b
map (a, b, c) -> c
forall a b c. (a, b, c) -> c
thd3 T (a, b, c)
xs)


{-# INLINE delay1 #-}
{- |
This is a fusion friendly implementation of delay.
However, in order to be a 'crochetL'
the output has the same length as the input,
that is, the last element is removed - at least for finite input.
-}
delay1 :: a -> T a -> T a
delay1 :: forall a. a -> T a -> T a
delay1 = (a -> a -> Maybe (a, a)) -> a -> T a -> T a
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL ((a -> a -> Maybe (a, a)) -> a -> a -> Maybe (a, a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a, a) -> Maybe (a, a)) -> a -> a -> Maybe (a, a)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just))

{-# INLINE delay #-}
delay :: y -> Int -> T y -> T y
delay :: forall y. y -> Int -> T y -> T y
delay y
z Int
n = T y -> T y -> T y
forall a. T a -> T a -> T a
append (Int -> y -> T y
forall a. Int -> a -> T a
replicate Int
n y
z)

{-# INLINE take #-}
take :: Int -> T a -> T a
take :: forall a. Int -> T a -> T a
take Int
n =
   ((Int, a) -> a) -> T (Int, a) -> T a
forall a b. (a -> b) -> T a -> T b
map (Int, a) -> a
forall a b. (a, b) -> b
snd (T (Int, a) -> T a) -> (T a -> T (Int, a)) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a) -> Bool) -> T (Int, a) -> T (Int, a)
forall a. (a -> Bool) -> T a -> T a
takeWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (Int -> Bool) -> ((Int, a) -> Int) -> (Int, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, a) -> Int
forall a b. (a, b) -> a
fst) (T (Int, a) -> T (Int, a))
-> (T a -> T (Int, a)) -> T a -> T (Int, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Int -> T a -> T (Int, a)
forall a b. T a -> T b -> T (a, b)
zip ((Int -> Int) -> Int -> T Int
forall a. (a -> a) -> a -> T a
iterate Int -> Int
forall a. Enum a => a -> a
pred Int
n)
   -- crochetL (\x n -> toMaybe (n>zero) (x, pred n))

{-# INLINE takeWhile #-}
takeWhile :: (a -> Bool) -> T a -> T a
takeWhile :: forall a. (a -> Bool) -> T a -> T a
takeWhile a -> Bool
p = (a -> () -> Maybe (a, ())) -> () -> T a -> T a
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL (\a
x ()
_ -> Bool -> (a, ()) -> Maybe (a, ())
forall a. Bool -> a -> Maybe a
toMaybe (a -> Bool
p a
x) (a
x, ())) ()

{-# INLINE replicate #-}
replicate :: Int -> a -> T a
replicate :: forall a. Int -> a -> T a
replicate Int
n = Int -> T a -> T a
forall a. Int -> T a -> T a
take Int
n (T a -> T a) -> (a -> T a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T a
forall a. a -> T a
repeat


{- * functions consuming multiple lists -}

{-# INLINE zipWith #-}
zipWith :: (a -> b -> c) -> (T a -> T b -> T c)
zipWith :: forall a b c. (a -> b -> c) -> T a -> T b -> T c
zipWith a -> b -> c
h (Cons StateT s Maybe a
f s
a) =
   (b -> s -> Maybe (c, s)) -> s -> T b -> T c
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL
      (\b
x0 s
a0 ->
          do (a
y0,s
a1) <- StateT s Maybe a -> s -> Maybe (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe a
f s
a0
             (c, s) -> Maybe (c, s)
forall a. a -> Maybe a
Just (a -> b -> c
h a
y0 b
x0, s
a1))
      s
a

{-# INLINE zipWithStorable #-}
zipWithStorable :: (Storable b, Storable c) =>
   (a -> b -> c) -> (T a -> SigSt.T b -> SigSt.T c)
zipWithStorable :: forall b c a.
(Storable b, Storable c) =>
(a -> b -> c) -> T a -> T b -> T c
zipWithStorable a -> b -> c
h (Cons StateT s Maybe a
f s
a) =
   (b -> s -> Maybe (c, s)) -> s -> Vector b -> Vector c
forall x y acc.
(Storable x, Storable y) =>
(x -> acc -> Maybe (y, acc)) -> acc -> Vector x -> Vector y
SigSt.crochetL
      (\b
x0 s
a0 ->
          do (a
y0,s
a1) <- StateT s Maybe a -> s -> Maybe (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe a
f s
a0
             (c, s) -> Maybe (c, s)
forall a. a -> Maybe a
Just (a -> b -> c
h a
y0 b
x0, s
a1))
      s
a

{-# INLINE zipWith3 #-}
zipWith3 :: (a -> b -> c -> d) -> (T a -> T b -> T c -> T d)
zipWith3 :: forall a b c d. (a -> b -> c -> d) -> T a -> T b -> T c -> T d
zipWith3 a -> b -> c -> d
f T a
s0 T b
s1 =
   ((a, b) -> c -> d) -> T (a, b) -> T c -> T d
forall a b c. (a -> b -> c) -> T a -> T b -> T c
zipWith ((a -> b -> c -> d) -> (a, b) -> c -> d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d
f) (T a -> T b -> T (a, b)
forall a b. T a -> T b -> T (a, b)
zip T a
s0 T b
s1)

{-# INLINE zipWith4 #-}
zipWith4 :: (a -> b -> c -> d -> e) -> (T a -> T b -> T c -> T d -> T e)
zipWith4 :: forall a b c d e.
(a -> b -> c -> d -> e) -> T a -> T b -> T c -> T d -> T e
zipWith4 a -> b -> c -> d -> e
f T a
s0 T b
s1 =
   ((a, b) -> c -> d -> e) -> T (a, b) -> T c -> T d -> T e
forall a b c d. (a -> b -> c -> d) -> T a -> T b -> T c -> T d
zipWith3 ((a -> b -> c -> d -> e) -> (a, b) -> c -> d -> e
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> e
f) (T a -> T b -> T (a, b)
forall a b. T a -> T b -> T (a, b)
zip T a
s0 T b
s1)


{-# INLINE zip #-}
zip :: T a -> T b -> T (a,b)
zip :: forall a b. T a -> T b -> T (a, b)
zip = (a -> b -> (a, b)) -> T a -> T b -> T (a, b)
forall a b c. (a -> b -> c) -> T a -> T b -> T c
zipWith (,)

{-# INLINE zip3 #-}
zip3 :: T a -> T b -> T c -> T (a,b,c)
zip3 :: forall a b c. T a -> T b -> T c -> T (a, b, c)
zip3 = (a -> b -> c -> (a, b, c)) -> T a -> T b -> T c -> T (a, b, c)
forall a b c d. (a -> b -> c -> d) -> T a -> T b -> T c -> T d
zipWith3 (,,)

{-# INLINE zip4 #-}
zip4 :: T a -> T b -> T c -> T d -> T (a,b,c,d)
zip4 :: forall a b c d. T a -> T b -> T c -> T d -> T (a, b, c, d)
zip4 = (a -> b -> c -> d -> (a, b, c, d))
-> T a -> T b -> T c -> T d -> T (a, b, c, d)
forall a b c d e.
(a -> b -> c -> d -> e) -> T a -> T b -> T c -> T d -> T e
zipWith4 (,,,)


{- * functions based on 'foldL' -}

{-# INLINE foldL' #-}
foldL' :: (x -> acc -> acc) -> acc -> T x -> acc
foldL' :: forall a b. (a -> b -> b) -> b -> T a -> b
foldL' x -> acc -> acc
g acc
b0 T x
sig =
   T x
-> (forall s. (forall z. z -> (x -> s -> z) -> s -> z) -> s -> acc)
-> acc
forall y x.
T y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
runSwitchL T x
sig (\forall z. z -> (x -> s -> z) -> s -> z
next s
s0 ->
      let recurse :: acc -> s -> acc
recurse acc
b s
s =
             acc -> acc -> acc
forall a b. a -> b -> b
seq acc
b (acc -> (x -> s -> acc) -> s -> acc
forall z. z -> (x -> s -> z) -> s -> z
next acc
b (\x
x -> acc -> s -> acc
recurse (x -> acc -> acc
g x
x acc
b)) s
s)
      in  acc -> s -> acc
recurse acc
b0 s
s0)
{-
foldL' g b =
   seq b . switchL b (\ x xs -> foldL' g (g x b) xs)
-}

{-# INLINE foldL #-}
foldL :: (acc -> x -> acc) -> acc -> T x -> acc
foldL :: forall b a. (b -> a -> b) -> b -> T a -> b
foldL acc -> x -> acc
f = (x -> acc -> acc) -> acc -> T x -> acc
forall a b. (a -> b -> b) -> b -> T a -> b
foldL' ((acc -> x -> acc) -> x -> acc -> acc
forall a b c. (a -> b -> c) -> b -> a -> c
flip acc -> x -> acc
f)

{-# INLINE foldL1 #-}
foldL1 :: (x -> x -> x) -> T x -> x
foldL1 :: forall a. (a -> a -> a) -> T a -> a
foldL1 x -> x -> x
f =
   x -> (x -> T x -> x) -> T x -> x
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL
      (String -> x
forall a. HasCallStack => String -> a
error String
"State.Signal.foldL1: empty signal")
      ((x -> x -> x) -> x -> T x -> x
forall b a. (b -> a -> b) -> b -> T a -> b
foldL x -> x -> x
f)

{-# INLINE length #-}
length :: T a -> Int
length :: forall a. T a -> Int
length = (a -> Int -> Int) -> Int -> T a -> Int
forall a b. (a -> b -> b) -> b -> T a -> b
foldL' ((Int -> Int) -> a -> Int -> Int
forall a b. a -> b -> a
const Int -> Int
forall a. Enum a => a -> a
succ) Int
forall a. C a => a
zero

{-# INLINE equal #-}
equal :: (Eq a) => T a -> T a -> Bool
equal :: forall y. Eq y => T y -> T y -> Bool
equal T a
xs T a
ys =
   T a -> (forall s. (s -> Maybe (a, s)) -> s -> Bool) -> Bool
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T a
xs (\s -> Maybe (a, s)
nextX s
sx ->
   T a -> (forall s. (s -> Maybe (a, s)) -> s -> Bool) -> Bool
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T a
ys (\s -> Maybe (a, s)
nextY s
sy ->
      let go :: s -> s -> Bool
go s
px s
py =
             case (s -> Maybe (a, s)
nextX s
px, s -> Maybe (a, s)
nextY s
py) of
                (Maybe (a, s)
Nothing, Maybe (a, s)
Nothing) -> Bool
True
                (Just (a
x,s
xr), Just (a
y,s
yr)) ->
                   a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y Bool -> Bool -> Bool
&& s -> s -> Bool
go s
xr s
yr
                (Maybe (a, s), Maybe (a, s))
_ -> Bool
False
      in  s -> s -> Bool
go s
sx s
sy
   ))


{- * functions based on 'foldR' -}

foldR :: (x -> acc -> acc) -> acc -> T x -> acc
foldR :: forall a b. (a -> b -> b) -> b -> T a -> b
foldR x -> acc -> acc
g acc
b T x
sig =
   T x
-> (forall s. (forall z. z -> (x -> s -> z) -> s -> z) -> s -> acc)
-> acc
forall y x.
T y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
runSwitchL T x
sig (\forall z. z -> (x -> s -> z) -> s -> z
next s
s0 ->
      let recurse :: s -> acc
recurse =
             acc -> (x -> s -> acc) -> s -> acc
forall z. z -> (x -> s -> z) -> s -> z
next acc
b (\ x
x s
xs -> x -> acc -> acc
g x
x (s -> acc
recurse s
xs))
      in  s -> acc
recurse s
s0)
{-
foldR g b =
   switchL b (\ x xs -> g x (foldR g b xs))
-}


{- * Other functions -}

{-# INLINE null #-}
null :: T a -> Bool
null :: forall a. T a -> Bool
null =
   Bool -> (a -> T a -> Bool) -> T a -> Bool
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL Bool
True ((T a -> Bool) -> a -> T a -> Bool
forall a b. a -> b -> a
const (Bool -> T a -> Bool
forall a b. a -> b -> a
const Bool
False))
   -- foldR (const (const False)) True

{-# INLINE empty #-}
empty :: T a
empty :: forall a. T a
empty = (() -> Maybe (a, ())) -> () -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate (Maybe (a, ()) -> () -> Maybe (a, ())
forall a b. a -> b -> a
const Maybe (a, ())
forall a. Maybe a
Nothing) ()

{-# INLINE singleton #-}
singleton :: a -> T a
singleton :: forall a. a -> T a
singleton =
   (Maybe a -> Maybe (a, Maybe a)) -> Maybe a -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate ((a -> (a, Maybe a)) -> Maybe a -> Maybe (a, Maybe a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, Maybe a
forall a. Maybe a
Nothing))) (Maybe a -> T a) -> (a -> Maybe a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just

{-# INLINE cons #-}
{- |
This is expensive and should not be used to construct lists iteratively!
-}
cons :: a -> T a -> T a
cons :: forall a. a -> T a -> T a
cons a
x T a
xs =
   ((Maybe a, T a) -> Maybe (a, (Maybe a, T a)))
-> (Maybe a, T a) -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate
      (\(Maybe a
mx0,T a
xs0) ->
          ((a, T a) -> (a, (Maybe a, T a)))
-> Maybe (a, T a) -> Maybe (a, (Maybe a, T a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a -> (Maybe a, T a)) -> (a, T a) -> (a, (Maybe a, T a))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((,) Maybe a
forall a. Maybe a
Nothing)) (Maybe (a, T a) -> Maybe (a, (Maybe a, T a)))
-> Maybe (a, T a) -> Maybe (a, (Maybe a, T a))
forall a b. (a -> b) -> a -> b
$
          Maybe (a, T a)
-> (a -> Maybe (a, T a)) -> Maybe a -> Maybe (a, T a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
             (T a -> Maybe (a, T a)
forall a. T a -> Maybe (a, T a)
viewL T a
xs0)
             (\a
x0 -> (a, T a) -> Maybe (a, T a)
forall a. a -> Maybe a
Just (a
x0, T a
xs0))
             Maybe a
mx0) ((Maybe a, T a) -> T a) -> (Maybe a, T a) -> T a
forall a b. (a -> b) -> a -> b
$
   (a -> Maybe a
forall a. a -> Maybe a
Just a
x, T a
xs)

{-# INLINE viewL #-}
viewL :: T a -> Maybe (a, T a)
viewL :: forall a. T a -> Maybe (a, T a)
viewL (Cons StateT s Maybe a
f s
a0) =
   ((a, s) -> (a, T a)) -> Maybe (a, s) -> Maybe (a, T a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ((s -> T a) -> (a, s) -> (a, T a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (StateT s Maybe a -> s -> T a
forall a s. StateT s Maybe a -> s -> T a
Cons StateT s Maybe a
f))
      (StateT s Maybe a -> s -> Maybe (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe a
f s
a0)

{- iterated 'cons' is very inefficient
viewR :: T a -> Maybe (T a, a)
viewR =
   foldR (\x mxs -> Just (maybe (empty,x) (mapFst (cons x)) mxs)) Nothing
-}

{-# INLINE viewR #-}
viewR :: Storable a => T a -> Maybe (T a, a)
viewR :: forall a. Storable a => T a -> Maybe (T a, a)
viewR = ChunkSize -> T a -> Maybe (T a, a)
forall a. Storable a => ChunkSize -> T a -> Maybe (T a, a)
viewRSize ChunkSize
SigSt.defaultChunkSize

{-# INLINE viewRSize #-}
viewRSize :: Storable a => SigSt.ChunkSize -> T a -> Maybe (T a, a)
viewRSize :: forall a. Storable a => ChunkSize -> T a -> Maybe (T a, a)
viewRSize ChunkSize
size =
   ((T a, a) -> (T a, a)) -> Maybe (T a, a) -> Maybe (T a, a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a -> T a) -> (T a, a) -> (T a, a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst T a -> T a
forall a. Storable a => T a -> T a
fromStorableSignal) (Maybe (T a, a) -> Maybe (T a, a))
-> (T a -> Maybe (T a, a)) -> T a -> Maybe (T a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T a -> Maybe (T a, a)
forall a. Storable a => Vector a -> Maybe (Vector a, a)
SigSt.viewR (T a -> Maybe (T a, a)) -> (T a -> T a) -> T a -> Maybe (T a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ChunkSize -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a
toStorableSignal ChunkSize
size


{-# INLINE switchL #-}
switchL :: b -> (a -> T a -> b) -> T a -> b
switchL :: forall b a. b -> (a -> T a -> b) -> T a -> b
switchL b
n a -> T a -> b
j =
   b -> ((a, T a) -> b) -> Maybe (a, T a) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
n ((a -> T a -> b) -> (a, T a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> T a -> b
j) (Maybe (a, T a) -> b) -> (T a -> Maybe (a, T a)) -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> Maybe (a, T a)
forall a. T a -> Maybe (a, T a)
viewL

{-# INLINE switchR #-}
switchR :: Storable a => b -> (T a -> a -> b) -> T a -> b
switchR :: forall a b. Storable a => b -> (T a -> a -> b) -> T a -> b
switchR b
n T a -> a -> b
j =
   b -> ((T a, a) -> b) -> Maybe (T a, a) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
n ((T a -> a -> b) -> (T a, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T a -> a -> b
j) (Maybe (T a, a) -> b) -> (T a -> Maybe (T a, a)) -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> Maybe (T a, a)
forall a. Storable a => T a -> Maybe (T a, a)
viewR


{- |
This implementation requires
that the input generator has to check repeatedly whether it is finished.
-}
{-# INLINE extendConstant #-}
extendConstant :: T a -> T a
extendConstant :: forall a. T a -> T a
extendConstant T a
sig =
   T a
-> (forall s. (forall z. z -> (a -> s -> z) -> s -> z) -> s -> T a)
-> T a
forall y x.
T y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
runSwitchL T a
sig (\forall z. z -> (a -> s -> z) -> s -> z
switch s
s0 ->
   T a -> (a -> s -> T a) -> s -> T a
forall z. z -> (a -> s -> z) -> s -> z
switch
      T a
forall a. T a
empty
      (\ a
x0 s
_ ->
          ((a, s) -> Maybe (a, (a, s))) -> (a, s) -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate
             (\xt1 :: (a, s)
xt1@(a
x1,s
s1) ->
                 (a, (a, s)) -> Maybe (a, (a, s))
forall a. a -> Maybe a
Just ((a, (a, s)) -> Maybe (a, (a, s)))
-> (a, (a, s)) -> Maybe (a, (a, s))
forall a b. (a -> b) -> a -> b
$ (a, (a, s)) -> (a -> s -> (a, (a, s))) -> s -> (a, (a, s))
forall z. z -> (a -> s -> z) -> s -> z
switch
                    (a
x1,(a, s)
xt1)
                    (\a
x s
s2 -> (a
x, (a
x,s
s2)))
                    s
s1)
             (a
x0,s
s0)) (s -> T a) -> s -> T a
forall a b. (a -> b) -> a -> b
$
      s
s0)


{-
{-# INLINE tail #-}
tail :: T a -> T a
tail = Cons . List.tail . decons

{-# INLINE head #-}
head :: T a -> a
head = List.head . decons
-}

{-# INLINE drop #-}
drop :: Int -> T a -> T a
drop :: forall a. Int -> T a -> T a
drop Int
n =
   T a -> Maybe (T a) -> T a
forall a. a -> Maybe a -> a
fromMaybe T a
forall a. T a
empty (Maybe (T a) -> T a) -> (T a -> Maybe (T a)) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Int -> (Maybe (T a) -> Maybe (T a)) -> Maybe (T a) -> Maybe (T a)
forall a. Int -> (a -> a) -> a -> a
nest Int
n (((a, T a) -> T a) -> Maybe (a, T a) -> Maybe (T a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, T a) -> T a
forall a b. (a, b) -> b
snd (Maybe (a, T a) -> Maybe (T a))
-> (T a -> Maybe (a, T a)) -> T a -> Maybe (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> Maybe (a, T a)
forall a. T a -> Maybe (a, T a)
viewL (T a -> Maybe (T a)) -> Maybe (T a) -> Maybe (T a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe (T a) -> Maybe (T a))
-> (T a -> Maybe (T a)) -> T a -> Maybe (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T a -> Maybe (T a)
forall a. a -> Maybe a
Just

{-# INLINE dropMarginRem #-}
{- |
This implementation expects that looking ahead is cheap.
-}
dropMarginRem :: Int -> Int -> T a -> (Int, T a)
dropMarginRem :: forall a. Int -> Int -> T a -> (Int, T a)
dropMarginRem Int
n Int
m =
   (Int, T a)
-> ((Int, T a) -> T (Int, T a) -> (Int, T a))
-> T (Int, T a)
-> (Int, T a)
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL (String -> (Int, T a)
forall a. HasCallStack => String -> a
error (String -> (Int, T a)) -> String -> (Int, T a)
forall a b. (a -> b) -> a -> b
$ String
"StateSignal.dropMaringRem: length xs < " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) (Int, T a) -> T (Int, T a) -> (Int, T a)
forall a b. a -> b -> a
const (T (Int, T a) -> (Int, T a))
-> (T a -> T (Int, T a)) -> T a -> (Int, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Int -> Int -> T (Int, T a) -> T (Int, T a)
forall a. Int -> Int -> T a -> T a
dropMargin (Int -> Int
forall a. Enum a => a -> a
succ Int
n) Int
m (T (Int, T a) -> T (Int, T a))
-> (T a -> T (Int, T a)) -> T a -> T (Int, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (Int -> T a -> (Int, T a)) -> T Int -> T a -> T (Int, T a)
forall y0 y1 y2. (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails1 (,) ((Int -> Int) -> Int -> T Int
forall a. (a -> a) -> a -> T a
iterate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred) Int
m)

{-# INLINE dropMargin #-}
dropMargin :: Int -> Int -> T a -> T a
dropMargin :: forall a. Int -> Int -> T a -> T a
dropMargin Int
n Int
m T a
xs =
   T a -> T a -> T a
forall a b. T a -> T b -> T b
dropMatch (Int -> T a -> T a
forall a. Int -> T a -> T a
take Int
m (Int -> T a -> T a
forall a. Int -> T a -> T a
drop Int
n T a
xs)) T a
xs


dropMatch :: T b -> T a -> T a
dropMatch :: forall a b. T a -> T b -> T b
dropMatch T b
xs T a
ys =
   T a -> Maybe (T a) -> T a
forall a. a -> Maybe a -> a
fromMaybe T a
ys (Maybe (T a) -> T a) -> Maybe (T a) -> T a
forall a b. (a -> b) -> a -> b
$
   (T b -> T a -> T a) -> Maybe (T b) -> Maybe (T a) -> Maybe (T a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 T b -> T a -> T a
forall a b. T a -> T b -> T b
dropMatch
      (((b, T b) -> T b) -> Maybe (b, T b) -> Maybe (T b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, T b) -> T b
forall a b. (a, b) -> b
snd (Maybe (b, T b) -> Maybe (T b)) -> Maybe (b, T b) -> Maybe (T b)
forall a b. (a -> b) -> a -> b
$ T b -> Maybe (b, T b)
forall a. T a -> Maybe (a, T a)
viewL T b
xs)
      (((a, T a) -> T a) -> Maybe (a, T a) -> Maybe (T a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, T a) -> T a
forall a b. (a, b) -> b
snd (Maybe (a, T a) -> Maybe (T a)) -> Maybe (a, T a) -> Maybe (T a)
forall a b. (a -> b) -> a -> b
$ T a -> Maybe (a, T a)
forall a. T a -> Maybe (a, T a)
viewL T a
ys)


index :: Int -> T a -> a
index :: forall a. Int -> T a -> a
index Int
n =
   a -> (a -> T a -> a) -> T a -> a
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"State.Signal: index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" too large") a -> T a -> a
forall a b. a -> b -> a
const (T a -> a) -> (T a -> T a) -> T a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> T a -> T a
forall a. Int -> T a -> T a
drop Int
n


{-
splitAt :: Int -> T a -> (T a, T a)
splitAt n = mapPair (Cons, Cons) . List.splitAt n . decons
-}

{-# INLINE splitAt #-}
splitAt :: Storable a =>
   Int -> T a -> (T a, T a)
splitAt :: forall a. Storable a => Int -> T a -> (T a, T a)
splitAt = ChunkSize -> Int -> T a -> (T a, T a)
forall a. Storable a => ChunkSize -> Int -> T a -> (T a, T a)
splitAtSize ChunkSize
SigSt.defaultChunkSize

{-# INLINE splitAtSize #-}
splitAtSize :: Storable a =>
   SigSt.ChunkSize -> Int -> T a -> (T a, T a)
splitAtSize :: forall a. Storable a => ChunkSize -> Int -> T a -> (T a, T a)
splitAtSize ChunkSize
size Int
n =
   (T a -> T a, T a -> T a) -> (T a, T a) -> (T a, T a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T a -> T a
forall a. Storable a => T a -> T a
fromStorableSignal, T a -> T a
forall a. Storable a => T a -> T a
fromStorableSignal) ((T a, T a) -> (T a, T a))
-> (T a -> (T a, T a)) -> T a -> (T a, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Int -> T a -> (T a, T a)
forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
SigSt.splitAt Int
n (T a -> (T a, T a)) -> (T a -> T a) -> T a -> (T a, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ChunkSize -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a
toStorableSignal ChunkSize
size


{-# INLINE dropWhile #-}
dropWhile :: (a -> Bool) -> T a -> T a
dropWhile :: forall a. (a -> Bool) -> T a -> T a
dropWhile a -> Bool
p (Cons StateT s Maybe a
f s
s0) =
   let recurse :: s -> T a
recurse s
s =
          T a -> ((a, s) -> T a) -> Maybe (a, s) -> T a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T a
forall a. T a
empty (\(a
x,s
s1) -> Bool -> T a -> T a -> T a
forall a. Bool -> a -> a -> a
if' (a -> Bool
p a
x) (s -> T a
recurse s
s1) (StateT s Maybe a -> s -> T a
forall a s. StateT s Maybe a -> s -> T a
Cons StateT s Maybe a
f s
s)) (Maybe (a, s) -> T a) -> Maybe (a, s) -> T a
forall a b. (a -> b) -> a -> b
$
          StateT s Maybe a -> s -> Maybe (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s Maybe a
f s
s
   in  s -> T a
recurse s
s0
{-
dropWhile p xt =
   switchL empty (\ x xs -> if p x then dropWhile p xs else xt) xt
-}

{-
span :: (a -> Bool) -> T a -> (T a, T a)
span p = mapPair (Cons, Cons) . List.span p . decons
-}

{-# INLINE span #-}
span :: Storable a =>
   (a -> Bool) -> T a -> (T a, T a)
span :: forall a. Storable a => (a -> Bool) -> T a -> (T a, T a)
span = ChunkSize -> (a -> Bool) -> T a -> (T a, T a)
forall a.
Storable a =>
ChunkSize -> (a -> Bool) -> T a -> (T a, T a)
spanSize ChunkSize
SigSt.defaultChunkSize

{-# INLINE spanSize #-}
spanSize :: Storable a =>
   SigSt.ChunkSize -> (a -> Bool) -> T a -> (T a, T a)
spanSize :: forall a.
Storable a =>
ChunkSize -> (a -> Bool) -> T a -> (T a, T a)
spanSize ChunkSize
size a -> Bool
p =
   (T a -> T a, T a -> T a) -> (T a, T a) -> (T a, T a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T a -> T a
forall a. Storable a => T a -> T a
fromStorableSignal, T a -> T a
forall a. Storable a => T a -> T a
fromStorableSignal) ((T a, T a) -> (T a, T a))
-> (T a -> (T a, T a)) -> T a -> (T a, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> Bool) -> T a -> (T a, T a)
forall a.
Storable a =>
(a -> Bool) -> Vector a -> (Vector a, Vector a)
SigSt.span a -> Bool
p (T a -> (T a, T a)) -> (T a -> T a) -> T a -> (T a, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ChunkSize -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a
toStorableSignal ChunkSize
size


{-# INLINE cycle #-}
cycle :: T a -> T a
cycle :: forall a. T a -> T a
cycle T a
sig =
   T a -> (forall s. (s -> Maybe (a, s)) -> s -> T a) -> T a
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T a
sig
      (\s -> Maybe (a, s)
next s
s ->
          T a -> ((a, s) -> T a) -> Maybe (a, s) -> T a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
             (String -> T a
forall a. HasCallStack => String -> a
error String
"StateSignal.cycle: empty input")
             (\(a, s)
yt -> (s -> Maybe (a, s)) -> s -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate ((a, s) -> Maybe (a, s)
forall a. a -> Maybe a
Just ((a, s) -> Maybe (a, s)) -> (s -> (a, s)) -> s -> Maybe (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, s) -> Maybe (a, s) -> (a, s)
forall a. a -> Maybe a -> a
fromMaybe (a, s)
yt (Maybe (a, s) -> (a, s)) -> (s -> Maybe (a, s)) -> s -> (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (a, s)
next) s
s) (Maybe (a, s) -> T a) -> Maybe (a, s) -> T a
forall a b. (a -> b) -> a -> b
$
             s -> Maybe (a, s)
next s
s)
{-
cycle xs =
   maybe
      (error "StateSignal.cycle: empty input")
      (\yt -> generate (Just . fromMaybe yt . viewL) xs) $
      viewL xs
-}


{-# SPECIALISE INLINE mix :: T Float -> T Float -> T Float #-}
{-# SPECIALISE INLINE mix :: T Double -> T Double -> T Double #-}
{-# INLINE mix #-}
mix :: Additive.C a => T a -> T a -> T a
mix :: forall a. C a => T a -> T a -> T a
mix = (a -> a -> a) -> T a -> T a -> T a
forall y. (y -> y -> y) -> T y -> T y -> T y
zipWithAppend a -> a -> a
forall a. C a => a -> a -> a
(Additive.+)


{-# INLINE sub #-}
sub :: Additive.C a => T a -> T a -> T a
sub :: forall a. C a => T a -> T a -> T a
sub T a
xs T a
ys =  T a -> T a -> T a
forall a. C a => T a -> T a -> T a
mix T a
xs (T a -> T a
forall a. C a => T a -> T a
neg T a
ys)

{-# INLINE neg #-}
neg :: Additive.C a => T a -> T a
neg :: forall a. C a => T a -> T a
neg = (a -> a) -> T a -> T a
forall a b. (a -> b) -> T a -> T b
map a -> a
forall a. C a => a -> a
Additive.negate

instance Additive.C y => Additive.C (T y) where
   zero :: T y
zero = T y
forall a. T a
empty
   + :: T y -> T y -> T y
(+) = T y -> T y -> T y
forall a. C a => T a -> T a -> T a
mix
   (-) = T y -> T y -> T y
forall a. C a => T a -> T a -> T a
sub
   negate :: T y -> T y
negate = T y -> T y
forall a. C a => T a -> T a
neg

instance Module.C y yv => Module.C y (T yv) where
   *> :: y -> T yv -> T yv
(*>) y
x T yv
y = (yv -> yv) -> T yv -> T yv
forall a b. (a -> b) -> T a -> T b
map (y
xy -> yv -> yv
forall a v. C a v => a -> v -> v
*>) T yv
y


infixr 5 `append`

{-# INLINE append #-}
append :: T a -> T a -> T a
append :: forall a. T a -> T a -> T a
append T a
xs T a
ys =
   ((Bool, T a) -> Maybe (a, (Bool, T a))) -> (Bool, T a) -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate
      (\(Bool
b,T a
xys) ->
          Maybe (a, (Bool, T a))
-> Maybe (a, (Bool, T a)) -> Maybe (a, (Bool, T a))
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
             (((a, T a) -> (a, (Bool, T a)))
-> Maybe (a, T a) -> Maybe (a, (Bool, T a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a -> (Bool, T a)) -> (a, T a) -> (a, (Bool, T a))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((,) Bool
b)) (Maybe (a, T a) -> Maybe (a, (Bool, T a)))
-> Maybe (a, T a) -> Maybe (a, (Bool, T a))
forall a b. (a -> b) -> a -> b
$ T a -> Maybe (a, T a)
forall a. T a -> Maybe (a, T a)
viewL T a
xys)
             (Bool
-> Maybe (a, (Bool, T a))
-> Maybe (a, (Bool, T a))
-> Maybe (a, (Bool, T a))
forall a. Bool -> a -> a -> a
if' Bool
b Maybe (a, (Bool, T a))
forall a. Maybe a
Nothing
                (((a, T a) -> (a, (Bool, T a)))
-> Maybe (a, T a) -> Maybe (a, (Bool, T a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T a -> (Bool, T a)) -> (a, T a) -> (a, (Bool, T a))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((,) Bool
True)) (Maybe (a, T a) -> Maybe (a, (Bool, T a)))
-> Maybe (a, T a) -> Maybe (a, (Bool, T a))
forall a b. (a -> b) -> a -> b
$ T a -> Maybe (a, T a)
forall a. T a -> Maybe (a, T a)
viewL T a
ys)))
      (Bool
False,T a
xs)

{-# INLINE appendStored #-}
appendStored :: Storable a =>
   T a -> T a -> T a
appendStored :: forall a. Storable a => T a -> T a -> T a
appendStored = ChunkSize -> T a -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a -> T a
appendStoredSize ChunkSize
SigSt.defaultChunkSize

{-# INLINE appendStoredSize #-}
appendStoredSize :: Storable a =>
   SigSt.ChunkSize -> T a -> T a -> T a
appendStoredSize :: forall a. Storable a => ChunkSize -> T a -> T a -> T a
appendStoredSize ChunkSize
size T a
xs T a
ys =
   T a -> T a
forall a. Storable a => T a -> T a
fromStorableSignal (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$
   T a -> T a -> T a
forall a. Storable a => Vector a -> Vector a -> Vector a
SigSt.append
      (ChunkSize -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a
toStorableSignal ChunkSize
size T a
xs)
      (ChunkSize -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a
toStorableSignal ChunkSize
size T a
ys)

{-# INLINE concat #-}
-- | certainly inefficient because of frequent list deconstruction
concat :: [T a] -> T a
concat :: forall a. [T a] -> T a
concat =
   ([T a] -> Maybe (a, [T a])) -> [T a] -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate
      ([Maybe (a, [T a])] -> Maybe (a, [T a])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe (a, [T a])] -> Maybe (a, [T a]))
-> ([T a] -> [Maybe (a, [T a])]) -> [T a] -> Maybe (a, [T a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       ([T a] -> Maybe (a, [T a])) -> [[T a]] -> [Maybe (a, [T a])]
forall a b. (a -> b) -> [a] -> [b]
List.map
          (\ [T a]
x -> [T a] -> Maybe (T a, [T a])
forall a. [a] -> Maybe (a, [a])
ListHT.viewL [T a]
x Maybe (T a, [T a])
-> ((T a, [T a]) -> Maybe (a, [T a])) -> Maybe (a, [T a])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
           \(T a
y,[T a]
ys) -> T a -> Maybe (a, T a)
forall a. T a -> Maybe (a, T a)
viewL T a
y Maybe (a, T a)
-> ((a, T a) -> Maybe (a, [T a])) -> Maybe (a, [T a])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
           \(a
z,T a
zs) -> (a, [T a]) -> Maybe (a, [T a])
forall a. a -> Maybe a
Just (a
z,T a
zsT a -> [T a] -> [T a]
forall a. a -> [a] -> [a]
:[T a]
ys)) ([[T a]] -> [Maybe (a, [T a])])
-> ([T a] -> [[T a]]) -> [T a] -> [Maybe (a, [T a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [[T a]] -> [[T a]]
forall a. HasCallStack => [a] -> [a]
List.init ([[T a]] -> [[T a]]) -> ([T a] -> [[T a]]) -> [T a] -> [[T a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [T a] -> [[T a]]
forall a. [a] -> [[a]]
List.tails)


{-# INLINE concatStored #-}
concatStored :: Storable a =>
   [T a] -> T a
concatStored :: forall a. Storable a => [T a] -> T a
concatStored = ChunkSize -> [T a] -> T a
forall a. Storable a => ChunkSize -> [T a] -> T a
concatStoredSize ChunkSize
SigSt.defaultChunkSize

{-# INLINE concatStoredSize #-}
concatStoredSize :: Storable a =>
   SigSt.ChunkSize -> [T a] -> T a
concatStoredSize :: forall a. Storable a => ChunkSize -> [T a] -> T a
concatStoredSize ChunkSize
size =
   T a -> T a
forall a. Storable a => T a -> T a
fromStorableSignal (T a -> T a) -> ([T a] -> T a) -> [T a] -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [T a] -> T a
forall a. Storable a => [Vector a] -> Vector a
SigSt.concat ([T a] -> T a) -> ([T a] -> [T a]) -> [T a] -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (T a -> T a) -> [T a] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
List.map (ChunkSize -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a
toStorableSignal ChunkSize
size)

{-
This should be faster than Monad.ap
if an empty signal as second operand is detected.
In this case an empty signal is returned without running a loop.
-}
liftA2 :: (a -> b -> c) -> (T a -> T b -> T c)
liftA2 :: forall a b c. (a -> b -> c) -> T a -> T b -> T c
liftA2 a -> b -> c
p T a
x T b
y =
   T a -> (forall {s}. (s -> Maybe (a, s)) -> s -> T c) -> T c
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T a
x ((forall {s}. (s -> Maybe (a, s)) -> s -> T c) -> T c)
-> (forall {s}. (s -> Maybe (a, s)) -> s -> T c) -> T c
forall a b. (a -> b) -> a -> b
$ \s -> Maybe (a, s)
f s
s0 ->
   T b -> (forall {s}. (s -> Maybe (b, s)) -> s -> T c) -> T c
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T b
y ((forall {s}. (s -> Maybe (b, s)) -> s -> T c) -> T c)
-> (forall {s}. (s -> Maybe (b, s)) -> s -> T c) -> T c
forall a b. (a -> b) -> a -> b
$ \s -> Maybe (b, s)
g s
t0 ->
   ((Maybe ((a, s), (b, s)) -> Maybe (c, Maybe ((a, s), (b, s))))
 -> Maybe ((a, s), (b, s)) -> T c)
-> Maybe ((a, s), (b, s))
-> (Maybe ((a, s), (b, s)) -> Maybe (c, Maybe ((a, s), (b, s))))
-> T c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe ((a, s), (b, s)) -> Maybe (c, Maybe ((a, s), (b, s))))
-> Maybe ((a, s), (b, s)) -> T c
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate (((a, s) -> (b, s) -> ((a, s), (b, s)))
-> Maybe (a, s) -> Maybe (b, s) -> Maybe ((a, s), (b, s))
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
App.liftA2 (,) (s -> Maybe (a, s)
f s
s0) (s -> Maybe (b, s)
g s
t0)) ((Maybe ((a, s), (b, s)) -> Maybe (c, Maybe ((a, s), (b, s))))
 -> T c)
-> (Maybe ((a, s), (b, s)) -> Maybe (c, Maybe ((a, s), (b, s))))
-> T c
forall a b. (a -> b) -> a -> b
$ \Maybe ((a, s), (b, s))
m ->
   ((((a, s), (b, s)) -> (c, Maybe ((a, s), (b, s))))
 -> Maybe ((a, s), (b, s)) -> Maybe (c, Maybe ((a, s), (b, s))))
-> Maybe ((a, s), (b, s))
-> (((a, s), (b, s)) -> (c, Maybe ((a, s), (b, s))))
-> Maybe (c, Maybe ((a, s), (b, s)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a, s), (b, s)) -> (c, Maybe ((a, s), (b, s))))
-> Maybe ((a, s), (b, s)) -> Maybe (c, Maybe ((a, s), (b, s)))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ((a, s), (b, s))
m ((((a, s), (b, s)) -> (c, Maybe ((a, s), (b, s))))
 -> Maybe (c, Maybe ((a, s), (b, s))))
-> (((a, s), (b, s)) -> (c, Maybe ((a, s), (b, s))))
-> Maybe (c, Maybe ((a, s), (b, s)))
forall a b. (a -> b) -> a -> b
$ \(as :: (a, s)
as@(a
a,s
s), (b
b,s
t)) ->
   (a -> b -> c
p a
a b
b,
    ((b, s) -> ((a, s), (b, s)))
-> Maybe (b, s) -> Maybe ((a, s), (b, s))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) (a, s)
as) (s -> Maybe (b, s)
g s
t) Maybe ((a, s), (b, s))
-> Maybe ((a, s), (b, s)) -> Maybe ((a, s), (b, s))
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    ((a, s) -> (b, s) -> ((a, s), (b, s)))
-> Maybe (a, s) -> Maybe (b, s) -> Maybe ((a, s), (b, s))
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
App.liftA2 (,) (s -> Maybe (a, s)
f s
s) (s -> Maybe (b, s)
g s
t0))

{-# INLINE reverse #-}
reverse ::
   T a -> T a
reverse :: forall a. T a -> T a
reverse =
   [a] -> T a
forall y. [y] -> T y
fromList ([a] -> T a) -> (T a -> [a]) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
List.reverse ([a] -> [a]) -> (T a -> [a]) -> T a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall y. T y -> [y]
toList

{-# INLINE reverseStored #-}
reverseStored :: Storable a =>
   T a -> T a
reverseStored :: forall a. Storable a => T a -> T a
reverseStored = ChunkSize -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a
reverseStoredSize ChunkSize
SigSt.defaultChunkSize

{-# INLINE reverseStoredSize #-}
reverseStoredSize :: Storable a =>
   SigSt.ChunkSize -> T a -> T a
reverseStoredSize :: forall a. Storable a => ChunkSize -> T a -> T a
reverseStoredSize ChunkSize
size =
   T a -> T a
forall a. Storable a => T a -> T a
fromStorableSignal (T a -> T a) -> (T a -> T a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T a -> T a
forall a. Storable a => Vector a -> Vector a
SigSt.reverse (T a -> T a) -> (T a -> T a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ChunkSize -> T a -> T a
forall a. Storable a => ChunkSize -> T a -> T a
toStorableSignal ChunkSize
size


{-# INLINE sum #-}
sum :: (Additive.C a) => T a -> a
sum :: forall a. C a => T a -> a
sum = (a -> a -> a) -> a -> T a -> a
forall a b. (a -> b -> b) -> b -> T a -> b
foldL' a -> a -> a
forall a. C a => a -> a -> a
(Additive.+) a
forall a. C a => a
Additive.zero

{-# INLINE maximum #-}
maximum :: (Ord a) => T a -> a
maximum :: forall a. Ord a => T a -> a
maximum =
   a -> (a -> T a -> a) -> T a -> a
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL
      (String -> a
forall a. HasCallStack => String -> a
error String
"StateSignal.maximum: empty list")
      ((a -> a -> a) -> a -> T a -> a
forall a b. (a -> b -> b) -> b -> T a -> b
foldL' a -> a -> a
forall a. Ord a => a -> a -> a
max)

{-
{-# INLINE tails #-}
tails :: T y -> [T y]
tails = List.map Cons . List.tails . decons
-}

{-# INLINE init #-}
init :: T y -> T y
init :: forall a. T a -> T a
init =
   T y -> (y -> T y -> T y) -> T y -> T y
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL
      (String -> T y
forall a. HasCallStack => String -> a
error String
"StateSignal.init: empty list")
      ((y -> y -> Maybe (y, y)) -> y -> T y -> T y
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL (\y
x y
acc -> (y, y) -> Maybe (y, y)
forall a. a -> Maybe a
Just (y
acc,y
x)))

{-# INLINE sliceVert #-}
-- inefficient since it computes some things twice
sliceVert :: Int -> T y -> [T y]
sliceVert :: forall y. Int -> T y -> [T y]
sliceVert Int
n =
--   map fromList . Sig.sliceVert n . toList
   (T y -> T y) -> [T y] -> [T y]
forall a b. (a -> b) -> [a] -> [b]
List.map (Int -> T y -> T y
forall a. Int -> T a -> T a
take Int
n) ([T y] -> [T y]) -> (T y -> [T y]) -> T y -> [T y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T y -> Bool) -> [T y] -> [T y]
forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (T y -> Bool) -> T y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> Bool
forall a. T a -> Bool
null) ([T y] -> [T y]) -> (T y -> [T y]) -> T y -> [T y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T y -> T y) -> T y -> [T y]
forall a. (a -> a) -> a -> [a]
List.iterate (Int -> T y -> T y
forall a. Int -> T a -> T a
drop Int
n)

{-# DEPRECATED zapWith, zapWithAlt "use mapAdjacent" #-}
{-# INLINE zapWith #-}
zapWith :: (a -> a -> b) -> T a -> T b
zapWith :: forall a b. (a -> a -> b) -> T a -> T b
zapWith = (a -> a -> b) -> T a -> T b
forall a b. (a -> a -> b) -> T a -> T b
mapAdjacent

zapWithAlt :: (a -> a -> b) -> T a -> T b
zapWithAlt :: forall a b. (a -> a -> b) -> T a -> T b
zapWithAlt a -> a -> b
f T a
xs =
   (a -> a -> b) -> T a -> T a -> T b
forall a b c. (a -> b -> c) -> T a -> T b -> T c
zipWith a -> a -> b
f T a
xs (T a -> (a -> T a -> T a) -> T a -> T a
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL T a
forall a. T a
empty (((a, T a) -> T a) -> a -> T a -> T a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, T a) -> T a
forall a b. (a, b) -> b
snd) T a
xs)

{-# INLINE mapAdjacent #-}
mapAdjacent :: (a -> a -> b) -> T a -> T b
mapAdjacent :: forall a b. (a -> a -> b) -> T a -> T b
mapAdjacent a -> a -> b
f =
   T b -> (a -> T a -> T b) -> T a -> T b
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL T b
forall a. T a
empty
      ((a -> a -> Maybe (b, a)) -> a -> T a -> T b
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL (\a
y a
x -> (b, a) -> Maybe (b, a)
forall a. a -> Maybe a
Just (a -> a -> b
f a
x a
y, a
y)))

{-# INLINE modifyStatic #-}
modifyStatic :: Modifier.Simple s ctrl a b -> ctrl -> T a -> T b
modifyStatic :: forall s ctrl a b. Simple s ctrl a b -> ctrl -> T a -> T b
modifyStatic Simple s ctrl a b
modif ctrl
control T a
x =
   (a -> s -> Maybe (b, s)) -> s -> T a -> T b
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL
      (\a
a s
acc ->
         (b, s) -> Maybe (b, s)
forall a. a -> Maybe a
Just (State s b -> s -> (b, s)
forall s a. State s a -> s -> (a, s)
runState (Simple s ctrl a b -> ctrl -> a -> State s b
forall s ctrl a b. Simple s ctrl a b -> ctrl -> a -> State s b
Modifier.step Simple s ctrl a b
modif ctrl
control a
a) s
acc))
      (Simple s ctrl a b -> s
forall s ctrl a b. Simple s ctrl a b -> s
Modifier.init Simple s ctrl a b
modif) T a
x

{-| Here the control may vary over the time. -}
{-# INLINE modifyModulated #-}
modifyModulated :: Modifier.Simple s ctrl a b -> T ctrl -> T a -> T b
modifyModulated :: forall s ctrl a b. Simple s ctrl a b -> T ctrl -> T a -> T b
modifyModulated Simple s ctrl a b
modif T ctrl
control T a
x =
   ((ctrl, a) -> s -> Maybe (b, s)) -> s -> T (ctrl, a) -> T b
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL
      (\(ctrl, a)
ca s
acc ->
         (b, s) -> Maybe (b, s)
forall a. a -> Maybe a
Just (State s b -> s -> (b, s)
forall s a. State s a -> s -> (a, s)
runState ((ctrl -> a -> State s b) -> (ctrl, a) -> State s b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Simple s ctrl a b -> ctrl -> a -> State s b
forall s ctrl a b. Simple s ctrl a b -> ctrl -> a -> State s b
Modifier.step Simple s ctrl a b
modif) (ctrl, a)
ca) s
acc))
      (Simple s ctrl a b -> s
forall s ctrl a b. Simple s ctrl a b -> s
Modifier.init Simple s ctrl a b
modif)
      (T ctrl -> T a -> T (ctrl, a)
forall a b. T a -> T b -> T (a, b)
zip T ctrl
control T a
x)


-- cf. Module.linearComb
{-# INLINE linearComb #-}
linearComb ::
   (Module.C t y) =>
   T t -> T y -> y
linearComb :: forall t y. C t y => T t -> T y -> y
linearComb T t
ts T y
ys =
   T y -> y
forall a. C a => T a -> a
sum (T y -> y) -> T y -> y
forall a b. (a -> b) -> a -> b
$ (t -> y -> y) -> T t -> T y -> T y
forall a b c. (a -> b -> c) -> T a -> T b -> T c
zipWith t -> y -> y
forall a v. C a v => a -> v -> v
(*>) T t
ts T y
ys


-- comonadic 'bind'
-- only non-empty suffixes are processed
{-# INLINE mapTails #-}
mapTails ::
   (T y0 -> y1) -> T y0 -> T y1
mapTails :: forall y0 y1. (T y0 -> y1) -> T y0 -> T y1
mapTails T y0 -> y1
f =
   (T y0 -> Maybe (y1, T y0)) -> T y0 -> T y1
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate (\T y0
xs ->
      do (y0
_,T y0
ys) <- T y0 -> Maybe (y0, T y0)
forall a. T a -> Maybe (a, T a)
viewL T y0
xs
         (y1, T y0) -> Maybe (y1, T y0)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (T y0 -> y1
f T y0
xs, T y0
ys))
{-
mapTails f xs0 =
   runViewL xs0 (\next ->
      generate (\xs ->
         do (_,ys) <- next xs
            return (f xs, ys)))
-}

-- | only non-empty suffixes are processed
{-# INLINE zipWithTails #-}
zipWithTails ::
   (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails :: forall y0 y1 y2. (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails y0 -> T y1 -> y2
f =
   ((T y0, T y1) -> T y2) -> T y0 -> T y1 -> T y2
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((T y0, T y1) -> T y2) -> T y0 -> T y1 -> T y2)
-> ((T y0, T y1) -> T y2) -> T y0 -> T y1 -> T y2
forall a b. (a -> b) -> a -> b
$ ((T y0, T y1) -> Maybe (y2, (T y0, T y1))) -> (T y0, T y1) -> T y2
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate (\(T y0
xs0,T y1
ys0) ->
      do (y0
x,T y0
xs) <- T y0 -> Maybe (y0, T y0)
forall a. T a -> Maybe (a, T a)
viewL T y0
xs0
         (y1
_,T y1
ys) <- T y1 -> Maybe (y1, T y1)
forall a. T a -> Maybe (a, T a)
viewL T y1
ys0
         (y2, (T y0, T y1)) -> Maybe (y2, (T y0, T y1))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (y0 -> T y1 -> y2
f y0
x T y1
ys0, (T y0
xs,T y1
ys)))
{-
zipWithTails f xs1 ys1 =
   runViewL xs1 (\nextX xs2 ->
   runViewL ys1 (\nextY ys2 ->
      generate (\(xs0,ys0) ->
         do (x,xs) <- nextX xs0
            (_,ys) <- nextY ys0
            return (f x ys0, (xs,ys)))
         (xs2,ys2)))
-}

-- | in contrast to 'zipWithTails' it also generates the empty suffix (once)
{-# INLINE zipWithTails1 #-}
zipWithTails1 ::
   (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails1 :: forall y0 y1 y2. (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails1 y0 -> T y1 -> y2
f T y0
xs T y1
ys =
   ((T y0, Maybe (T y1)) -> Maybe (y2, (T y0, Maybe (T y1))))
-> (T y0, Maybe (T y1)) -> T y2
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate (\(T y0
xs0,Maybe (T y1)
ys0) ->
      do (y0
x,T y0
xs1) <- T y0 -> Maybe (y0, T y0)
forall a. T a -> Maybe (a, T a)
viewL T y0
xs0
         T y1
ys1 <- Maybe (T y1)
ys0
         (y2, (T y0, Maybe (T y1))) -> Maybe (y2, (T y0, Maybe (T y1)))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (y0 -> T y1 -> y2
f y0
x T y1
ys1, (T y0
xs1, ((y1, T y1) -> T y1) -> Maybe (y1, T y1) -> Maybe (T y1)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (y1, T y1) -> T y1
forall a b. (a, b) -> b
snd (Maybe (y1, T y1) -> Maybe (T y1))
-> Maybe (y1, T y1) -> Maybe (T y1)
forall a b. (a -> b) -> a -> b
$ T y1 -> Maybe (y1, T y1)
forall a. T a -> Maybe (a, T a)
viewL T y1
ys1)))
      (T y0
xs, T y1 -> Maybe (T y1)
forall a. a -> Maybe a
Just T y1
ys)

-- | in contrast to 'zipWithTails' it appends infinitely many empty suffixes
{-# INLINE zipWithTailsInf #-}
zipWithTailsInf ::
   (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTailsInf :: forall y0 y1 y2. (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTailsInf y0 -> T y1 -> y2
f =
   ((T y0, T y1) -> T y2) -> T y0 -> T y1 -> T y2
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((T y0, T y1) -> T y2) -> T y0 -> T y1 -> T y2)
-> ((T y0, T y1) -> T y2) -> T y0 -> T y1 -> T y2
forall a b. (a -> b) -> a -> b
$ ((T y0, T y1) -> Maybe (y2, (T y0, T y1))) -> (T y0, T y1) -> T y2
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate (\(T y0
xs0,T y1
ys0) ->
      do (y0
x,T y0
xs) <- T y0 -> Maybe (y0, T y0)
forall a. T a -> Maybe (a, T a)
viewL T y0
xs0
         (y2, (T y0, T y1)) -> Maybe (y2, (T y0, T y1))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (y0 -> T y1 -> y2
f y0
x T y1
ys0, (T y0
xs, T y1 -> (y1 -> T y1 -> T y1) -> T y1 -> T y1
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL T y1
forall a. T a
empty ((T y1 -> y1 -> T y1) -> y1 -> T y1 -> T y1
forall a b c. (a -> b -> c) -> b -> a -> c
flip T y1 -> y1 -> T y1
forall a b. a -> b -> a
const) T y1
ys0)))

{-
This can hardly be implemented in an efficient way.
But this means, we cannot implement the Generic.Transform class.

zipWithRest ::
   (y0 -> y0 -> y1) ->
   T y0 -> T y0 ->
   (T y1, (Bool, T y0))
zipWithRest f =
   curry $ generate (\(xs0,ys0) ->
      do (x,xs) <- viewL xs0
         (y,ys) <- viewL ys0
         return (f x y, (xs,ys)))
-}


{-# INLINE zipWithAppend #-}
zipWithAppend ::
   (y -> y -> y) ->
   T y -> T y -> T y
zipWithAppend :: forall y. (y -> y -> y) -> T y -> T y -> T y
zipWithAppend y -> y -> y
f T y
xs T y
ys =
   T y -> (forall s. (s -> Maybe (y, s)) -> s -> T y) -> T y
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T y
xs (\s -> Maybe (y, s)
nextX s
sx ->
   T y -> (forall s. (s -> Maybe (y, s)) -> s -> T y) -> T y
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T y
ys (\s -> Maybe (y, s)
nextY s
sy ->
      ((s, s) -> Maybe (y, (s, s))) -> (s, s) -> T y
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
unfoldR ((s -> Maybe (y, s))
-> (s -> Maybe (y, s))
-> (y -> y -> y)
-> (s, s)
-> Maybe (y, (s, s))
forall s a t.
(s -> Maybe (a, s))
-> (t -> Maybe (a, t))
-> (a -> a -> a)
-> (s, t)
-> Maybe (a, (s, t))
zipStep s -> Maybe (y, s)
nextX s -> Maybe (y, s)
nextY y -> y -> y
f) (s
sx,s
sy)
   ))

{-# INLINE zipStep #-}
zipStep ::
   (s -> Maybe (a,s)) ->
   (t -> Maybe (a,t)) ->
   (a -> a -> a) -> (s, t) -> Maybe (a, (s, t))
zipStep :: forall s a t.
(s -> Maybe (a, s))
-> (t -> Maybe (a, t))
-> (a -> a -> a)
-> (s, t)
-> Maybe (a, (s, t))
zipStep s -> Maybe (a, s)
nextX t -> Maybe (a, t)
nextY a -> a -> a
f (s
xt,t
yt) =
   case (s -> Maybe (a, s)
nextX s
xt, t -> Maybe (a, t)
nextY t
yt) of
      (Just (a
x,s
xs), Just (a
y,t
ys)) -> (a, (s, t)) -> Maybe (a, (s, t))
forall a. a -> Maybe a
Just (a -> a -> a
f a
x a
y, (s
xs,t
ys))
      (Maybe (a, s)
Nothing,     Just (a
y,t
ys)) -> (a, (s, t)) -> Maybe (a, (s, t))
forall a. a -> Maybe a
Just (a
y,     (s
xt,t
ys))
      (Just (a
x,s
xs), Maybe (a, t)
Nothing)     -> (a, (s, t)) -> Maybe (a, (s, t))
forall a. a -> Maybe a
Just (a
x,     (s
xs,t
yt))
      (Maybe (a, s)
Nothing,     Maybe (a, t)
Nothing)     -> Maybe (a, (s, t))
forall a. Maybe a
Nothing



delayLoop ::
      (T y -> T y)
            -- ^ processor that shall be run in a feedback loop
   -> T y   -- ^ prefix of the output, its length determines the delay
   -> T y
delayLoop :: forall y. (T y -> T y) -> T y -> T y
delayLoop T y -> T y
proc T y
prefix =
   -- the temporary list is need for sharing the output
   let ys :: T y
ys = [y] -> T y
forall y. [y] -> T y
fromList (T y -> [y]
forall y. T y -> [y]
toList T y
prefix [y] -> [y] -> [y]
forall a. [a] -> [a] -> [a]
List.++ T y -> [y]
forall y. T y -> [y]
toList (T y -> T y
proc T y
ys))
   in  T y
ys

delayLoopOverlap ::
   (Additive.C y) =>
      Int
   -> (T y -> T y)
            -- ^ processor that shall be run in a feedback loop
   -> T y   -- ^ input
   -> T y   -- ^ output has the same length as the input
delayLoopOverlap :: forall y. C y => Int -> (T y -> T y) -> T y -> T y
delayLoopOverlap Int
time T y -> T y
proc T y
xs =
   -- the temporary list is need for sharing the output
   let ys :: T y
ys = (y -> y -> y) -> T y -> T y -> T y
forall a b c. (a -> b -> c) -> T a -> T b -> T c
zipWith y -> y -> y
forall a. C a => a -> a -> a
(Additive.+) T y
xs (y -> Int -> T y -> T y
forall y. y -> Int -> T y -> T y
delay y
forall a. C a => a
zero Int
time (T y -> T y
proc ([y] -> T y
forall y. [y] -> T y
fromList (T y -> [y]
forall y. T y -> [y]
toList T y
ys))))
   in  T y
ys


{-
A traversable instance is hardly useful,
because 'cons' is so expensive.

instance Traversable T where
-}
{-# INLINE sequence_ #-}
sequence_ :: Monad m => T (m a) -> m ()
sequence_ :: forall (m :: * -> *) a. Monad m => T (m a) -> m ()
sequence_ =
   m () -> (m a -> T (m a) -> m ()) -> T (m a) -> m ()
forall b a. b -> (a -> T a -> b) -> T a -> b
switchL (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\m a
x T (m a)
xs -> m a
x m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> T (m a) -> m ()
forall (m :: * -> *) a. Monad m => T (m a) -> m ()
sequence_ T (m a)
xs)

{-# INLINE mapM_ #-}
mapM_ :: Monad m => (a -> m ()) -> T a -> m ()
mapM_ :: forall (m :: * -> *) a. Monad m => (a -> m ()) -> T a -> m ()
mapM_ a -> m ()
f = T (m ()) -> m ()
forall (m :: * -> *) a. Monad m => T (m a) -> m ()
sequence_ (T (m ()) -> m ()) -> (T a -> T (m ())) -> T a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m ()) -> T a -> T (m ())
forall a b. (a -> b) -> T a -> T b
map a -> m ()
f


{- |
Counterpart to 'Data.Monoid.mconcat'.
-}
fold :: Monoid m => T m -> m
fold :: forall m. Monoid m => T m -> m
fold = (m -> m -> m) -> m -> T m -> m
forall a b. (a -> b -> b) -> b -> T a -> b
foldR m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
forall a. Monoid a => a
mempty

{-# DEPRECATED monoidConcat "Use foldMap instead." #-}
monoidConcat :: Monoid m => T m -> m
monoidConcat :: forall m. Monoid m => T m -> m
monoidConcat = T m -> m
forall m. Monoid m => T m -> m
fold


foldMap :: Monoid m => (a -> m) -> T a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> T a -> m
foldMap a -> m
f = T m -> m
forall m. Monoid m => T m -> m
monoidConcat (T m -> m) -> (T a -> T m) -> T a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m) -> T a -> T m
forall a b. (a -> b) -> T a -> T b
map a -> m
f

{-# DEPRECATED monoidConcatMap "Use foldMap instead." #-}
monoidConcatMap :: Monoid m => (a -> m) -> T a -> m
monoidConcatMap :: forall m a. Monoid m => (a -> m) -> T a -> m
monoidConcatMap = (a -> m) -> T a -> m
forall m a. Monoid m => (a -> m) -> T a -> m
foldMap


instance Semigroup (T y) where
   <> :: T y -> T y -> T y
(<>) = T y -> T y -> T y
forall a. T a -> T a -> T a
append

instance Monoid (T y) where
   mempty :: T y
mempty = T y
forall a. T a
empty
   mappend :: T y -> T y -> T y
mappend = T y -> T y -> T y
forall a. Semigroup a => a -> a -> a
(<>)


catMaybes :: T (Maybe a) -> T a
catMaybes :: forall a. T (Maybe a) -> T a
catMaybes T (Maybe a)
sig =
   T (Maybe a)
-> (forall s. (s -> Maybe (Maybe a, s)) -> s -> T a) -> T a
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T (Maybe a)
sig (\s -> Maybe (Maybe a, s)
next ->
   (s -> Maybe (a, s)) -> s -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate (
      let go :: s -> Maybe (a, s)
go s
s0 =
             s -> Maybe (Maybe a, s)
next s
s0 Maybe (Maybe a, s)
-> ((Maybe a, s) -> Maybe (a, s)) -> Maybe (a, s)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Maybe a
ma,s
s1) ->
             (a -> (a, s)) -> Maybe a -> Maybe (a, s)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> s -> (a, s)) -> s -> a -> (a, s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) s
s1) Maybe a
ma Maybe (a, s) -> Maybe (a, s) -> Maybe (a, s)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
             s -> Maybe (a, s)
go s
s1
      in  s -> Maybe (a, s)
go))

flattenPairs :: T (a,a) -> T a
flattenPairs :: forall a. T (a, a) -> T a
flattenPairs T (a, a)
sig =
   T (a, a) -> (forall s. (s -> Maybe ((a, a), s)) -> s -> T a) -> T a
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T (a, a)
sig (\s -> Maybe ((a, a), s)
next s
t ->
   ((Maybe a, s) -> Maybe (a, (Maybe a, s))) -> (Maybe a, s) -> T a
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
generate
      (\(Maybe a
carry,s
s0) ->
         (a -> (a, (Maybe a, s))) -> Maybe a -> Maybe (a, (Maybe a, s))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
b -> (a
b, (Maybe a
forall a. Maybe a
Nothing, s
s0))) Maybe a
carry Maybe (a, (Maybe a, s))
-> Maybe (a, (Maybe a, s)) -> Maybe (a, (Maybe a, s))
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
         (((a, a), s) -> (a, (Maybe a, s)))
-> Maybe ((a, a), s) -> Maybe (a, (Maybe a, s))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((a
a,a
b),s
s1) -> (a
a, (a -> Maybe a
forall a. a -> Maybe a
Just a
b, s
s1))) (s -> Maybe ((a, a), s)
next s
s0))
      (Maybe a
forall a. Maybe a
Nothing,s
t))

interleave, interleaveAlt ::
   T y -> T y -> T y
interleave :: forall a. T a -> T a -> T a
interleave T y
xs T y
ys =
   T y -> (forall s. (s -> Maybe (y, s)) -> s -> T y) -> T y
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T y
xs (\s -> Maybe (y, s)
nextX s
sx ->
   T y -> (forall s. (s -> Maybe (y, s)) -> s -> T y) -> T y
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
runViewL T y
ys (\s -> Maybe (y, s)
nextY s
sy ->
   ((Bool, (s, s)) -> Maybe (y, (Bool, (s, s))))
-> (Bool, (s, s)) -> T y
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
unfoldR
      (\(Bool
select,(s
sx0,s
sy0)) ->
         case Bool
select of
            Bool
False -> ((y, s) -> (y, (Bool, (s, s))))
-> Maybe (y, s) -> Maybe (y, (Bool, (s, s)))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> (Bool, (s, s))) -> (y, s) -> (y, (Bool, (s, s)))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\s
sx1 -> (Bool
True,  (s
sx1,s
sy0)))) (Maybe (y, s) -> Maybe (y, (Bool, (s, s))))
-> Maybe (y, s) -> Maybe (y, (Bool, (s, s)))
forall a b. (a -> b) -> a -> b
$ s -> Maybe (y, s)
nextX s
sx0
            Bool
True  -> ((y, s) -> (y, (Bool, (s, s))))
-> Maybe (y, s) -> Maybe (y, (Bool, (s, s)))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> (Bool, (s, s))) -> (y, s) -> (y, (Bool, (s, s)))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\s
sy1 -> (Bool
False, (s
sx0,s
sy1)))) (Maybe (y, s) -> Maybe (y, (Bool, (s, s))))
-> Maybe (y, s) -> Maybe (y, (Bool, (s, s)))
forall a b. (a -> b) -> a -> b
$ s -> Maybe (y, s)
nextY s
sy0)
      (Bool
False, (s
sx,s
sy))))

interleaveAlt :: forall a. T a -> T a -> T a
interleaveAlt T y
xs T y
ys = T (y, y) -> T y
forall a. T (a, a) -> T a
flattenPairs (T (y, y) -> T y) -> T (y, y) -> T y
forall a b. (a -> b) -> a -> b
$ T y -> T y -> T (y, y)
forall a b. T a -> T b -> T (a, b)
zip T y
xs T y
ys