{-# 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
(LazySize -> LazySize -> Bool)
-> (LazySize -> LazySize -> Bool) -> Eq LazySize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LazySize -> LazySize -> Bool
== :: LazySize -> LazySize -> Bool
$c/= :: LazySize -> LazySize -> Bool
/= :: LazySize -> LazySize -> Bool
Eq, Eq LazySize
Eq LazySize =>
(LazySize -> LazySize -> Ordering)
-> (LazySize -> LazySize -> Bool)
-> (LazySize -> LazySize -> Bool)
-> (LazySize -> LazySize -> Bool)
-> (LazySize -> LazySize -> Bool)
-> (LazySize -> LazySize -> LazySize)
-> (LazySize -> LazySize -> LazySize)
-> Ord 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
$ccompare :: LazySize -> LazySize -> Ordering
compare :: LazySize -> LazySize -> Ordering
$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
>= :: LazySize -> LazySize -> Bool
$cmax :: LazySize -> LazySize -> LazySize
max :: LazySize -> LazySize -> LazySize
$cmin :: LazySize -> LazySize -> LazySize
min :: LazySize -> LazySize -> LazySize
Ord, Int -> LazySize -> ShowS
[LazySize] -> ShowS
LazySize -> String
(Int -> LazySize -> ShowS)
-> (LazySize -> String) -> ([LazySize] -> ShowS) -> Show LazySize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LazySize -> ShowS
showsPrec :: Int -> LazySize -> ShowS
$cshow :: LazySize -> String
show :: LazySize -> String
$cshowList :: [LazySize] -> ShowS
showList :: [LazySize] -> ShowS
Show,
             LazySize
LazySize -> LazySize
LazySize -> LazySize -> LazySize
LazySize
-> (LazySize -> LazySize -> LazySize)
-> (LazySize -> LazySize -> LazySize)
-> (LazySize -> LazySize)
-> C LazySize
forall a. a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> C a
$czero :: LazySize
zero :: LazySize
$c+ :: LazySize -> LazySize -> LazySize
+ :: LazySize -> LazySize -> LazySize
$c- :: LazySize -> LazySize -> LazySize
- :: LazySize -> LazySize -> LazySize
$cnegate :: LazySize -> LazySize
negate :: LazySize -> LazySize
Additive.C, C LazySize
LazySize
Integer -> LazySize
C LazySize =>
(LazySize -> LazySize -> LazySize)
-> LazySize
-> (Integer -> LazySize)
-> (LazySize -> Integer -> LazySize)
-> C LazySize
LazySize -> Integer -> LazySize
LazySize -> LazySize -> LazySize
forall a.
C a =>
(a -> a -> a) -> a -> (Integer -> a) -> (a -> Integer -> a) -> C a
$c* :: LazySize -> LazySize -> LazySize
* :: LazySize -> LazySize -> LazySize
$cone :: LazySize
one :: LazySize
$cfromInteger :: Integer -> LazySize
fromInteger :: Integer -> LazySize
$c^ :: LazySize -> Integer -> LazySize
^ :: LazySize -> Integer -> LazySize
Ring.C, LazySize -> Bool
(LazySize -> Bool) -> C LazySize
forall a. (a -> Bool) -> C a
$cisZero :: LazySize -> Bool
isZero :: LazySize -> Bool
ZeroTestable.C,
             C LazySize
C LazySize
(C LazySize, C LazySize) => (LazySize -> Integer) -> C LazySize
LazySize -> Integer
forall a. (C a, C a) => (a -> Integer) -> C a
$ctoInteger :: LazySize -> Integer
toInteger :: LazySize -> Integer
ToInteger.C, Ord LazySize
C LazySize
C LazySize
(C LazySize, C LazySize, Ord LazySize) =>
(LazySize -> Rational) -> C LazySize
LazySize -> Rational
forall a. (C a, C a, Ord a) => (a -> Rational) -> C a
$ctoRational :: LazySize -> Rational
toRational :: LazySize -> Rational
ToRational.C, C LazySize
C LazySize =>
(LazySize -> LazySize) -> (LazySize -> LazySize) -> C LazySize
LazySize -> LazySize
forall a. C a => (a -> a) -> (a -> a) -> C a
$cabs :: LazySize -> LazySize
abs :: LazySize -> LazySize
$csignum :: LazySize -> LazySize
signum :: LazySize -> LazySize
Absolute.C,
             Ord LazySize
C LazySize
C LazySize
C LazySize
(C LazySize, C LazySize, Ord LazySize, C LazySize) =>
(LazySize -> LazySize -> LazySize)
-> (LazySize -> LazySize -> LazySize)
-> (LazySize -> LazySize -> (LazySize, 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
$cquot :: LazySize -> LazySize -> LazySize
quot :: LazySize -> LazySize -> LazySize
$crem :: LazySize -> LazySize -> LazySize
rem :: LazySize -> LazySize -> LazySize
$cquotRem :: LazySize -> LazySize -> (LazySize, LazySize)
quotRem :: LazySize -> LazySize -> (LazySize, LazySize)
RealIntegral.C, C LazySize
C LazySize =>
(LazySize -> LazySize -> LazySize)
-> (LazySize -> LazySize -> LazySize)
-> (LazySize -> LazySize -> (LazySize, LazySize))
-> 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
$cdiv :: LazySize -> LazySize -> LazySize
div :: LazySize -> LazySize -> LazySize
$cmod :: LazySize -> LazySize -> LazySize
mod :: LazySize -> LazySize -> LazySize
$cdivMod :: LazySize -> LazySize -> (LazySize, LazySize)
divMod :: LazySize -> LazySize -> (LazySize, LazySize)
Integral.C)

instance Semigroup LazySize where
   LazySize Int
a <> :: LazySize -> LazySize -> LazySize
<> LazySize Int
b = Int -> LazySize
LazySize (Int
a Int -> Int -> Int
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 = LazySize -> LazySize -> LazySize
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 Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
b)

instance NonNeg.C LazySize where
   split :: LazySize -> LazySize -> (LazySize, (Bool, LazySize))
split = (LazySize -> Int)
-> (Int -> LazySize)
-> LazySize
-> LazySize
-> (LazySize, (Bool, LazySize))
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 -> (Int -> LazySize) -> Gen Int -> Gen LazySize
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> LazySize
LazySize ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
1, Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* Int
n))

instance Cut.Read LazySize where
   null :: LazySize -> Bool
null (LazySize Int
n) = Int
nInt -> Int -> Bool
forall 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 (Int -> LazySize) -> Int -> LazySize
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
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 (Int -> LazySize) -> Int -> LazySize
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Int -> Int -> Int
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 = Int -> LazySize -> LazySize
forall sig. Transform sig => Int -> sig -> sig
Cut.take Int
m LazySize
x
      in  (LazySize
y, LazySize
xLazySize -> LazySize -> LazySize
forall 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 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
m (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
xs Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
n
      in  (Int
mInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
d, Int -> LazySize -> LazySize
forall sig. Transform sig => Int -> sig -> sig
Cut.drop Int
d LazySize
x)
   {-# INLINE reverse #-}
   reverse :: LazySize -> LazySize
reverse = LazySize -> LazySize
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
_ = 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 Vector a -> Constraints (Vector a)
forall signal. Storage signal => signal -> Constraints signal
constraints Vector a
x of Constraints (Vector a)
R:ConstraintsVector1 a
StorableLazyConstraints -> Storable a => Vector a -> b
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 Vector a -> Constraints (Vector a)
forall signal. Storage signal => signal -> Constraints signal
constraints Vector a
z of Constraints (Vector a)
R:ConstraintsVector1 a
StorableLazyConstraints -> Vector a
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 = (Storable y => Vector y -> [y])
-> Storage (Vector y) => Vector y -> [y]
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL Storable y => Vector y -> [y]
Vector y -> [y]
forall a. Storable a => Vector a -> [a]
SVL.unpack
   {-# INLINE toState #-}
   toState :: forall y. Storage (Vector y) => Vector y -> T y
toState = (Storable y => Vector y -> T y)
-> Storage (Vector y) => Vector y -> T y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL Storable y => Vector y -> T y
Vector y -> T y
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 = (Storable y => Vector y -> s)
-> Storage (Vector y) => Vector y -> s
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((s -> y -> s) -> s -> Vector y -> s
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 = (Storable y => Vector y -> s)
-> Storage (Vector y) => Vector y -> s
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((y -> s -> s) -> s -> Vector y -> s
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 = (Storable y => Vector y -> Int -> y)
-> Storage (Vector y) => Vector y -> Int -> y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL Storable y => Vector y -> Int -> y
Vector y -> Int -> y
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 = (Storable y => Vector y -> Vector y)
-> Storage (Vector y) => Vector y -> Vector y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL (y -> Vector y -> Vector y
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 = (Storable y => Vector y -> Vector y)
-> Storage (Vector y) => Vector y -> Vector y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((y -> Bool) -> Vector y -> Vector y
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 = (Storable y => Vector y -> Vector y)
-> Storage (Vector y) => Vector y -> Vector y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((y -> Bool) -> Vector y -> Vector y
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 = (Storable y => Vector y -> (Vector y, Vector y))
-> Storage (Vector y) => Vector y -> (Vector y, Vector y)
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((y -> Bool) -> Vector y -> (Vector y, Vector y)
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 = (Storable y => Vector y -> Maybe (y, Vector y))
-> Storage (Vector y) => Vector y -> Maybe (y, Vector y)
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL Storable y => Vector y -> Maybe (y, Vector y)
Vector y -> Maybe (y, Vector y)
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 = (Storable y => Vector y -> Maybe (Vector y, y))
-> Storage (Vector y) => Vector y -> Maybe (Vector y, y)
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL Storable y => Vector y -> Maybe (Vector y, y)
Vector y -> Maybe (Vector y, y)
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 = (Storable y1 => Vector y1) -> Storage (Vector y1) => Vector y1
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL ((Storable y0 => Vector y0 -> Vector y1)
-> Storage (Vector y0) => Vector y0 -> Vector y1
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((y0 -> y1) -> Vector y0 -> Vector y1
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 = (Storable y1 => Vector y1) -> Storage (Vector y1) => Vector y1
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL ((Storable y0 => Vector y0 -> Vector y1)
-> Storage (Vector y0) => Vector y0 -> Vector y1
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((y1 -> y0 -> y1) -> y1 -> Vector y0 -> Vector y1
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 = (Storable y1 => Vector y1) -> Storage (Vector y1) => Vector y1
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL ((Storable y0 => Vector y0 -> Vector y1)
-> Storage (Vector y0) => Vector y0 -> Vector y1
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((y0 -> s -> Maybe (y1, s)) -> s -> Vector y0 -> Vector y1
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 = (Storable y => Vector y -> Vector y -> Vector y)
-> Storage (Vector y) => Vector y -> Vector y -> Vector y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSVL ((y -> y -> y) -> Vector y -> Vector y -> Vector y
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 = (ChunkSize -> [y] -> Vector y) -> LazySize -> [y] -> Vector y
forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext ((ChunkSize -> [y] -> Vector y) -> LazySize -> [y] -> Vector y)
-> (ChunkSize -> [y] -> Vector y) -> LazySize -> [y] -> Vector y
forall a b. (a -> b) -> a -> b
$ \ChunkSize
size [y]
x -> (Storable y => Vector y) -> Storage (Vector y) => Vector y
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (ChunkSize -> [y] -> Vector y
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 = (ChunkSize -> y -> Vector y) -> LazySize -> y -> Vector y
forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext ((ChunkSize -> y -> Vector y) -> LazySize -> y -> Vector y)
-> (ChunkSize -> y -> Vector y) -> LazySize -> y -> Vector y
forall a b. (a -> b) -> a -> b
$ \ChunkSize
size y
x -> (Storable y => Vector y) -> Storage (Vector y) => Vector y
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (ChunkSize -> y -> Vector y
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 = (ChunkSize -> Int -> y -> Vector y)
-> LazySize -> Int -> y -> Vector y
forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext ((ChunkSize -> Int -> y -> Vector y)
 -> LazySize -> Int -> y -> Vector y)
-> (ChunkSize -> Int -> y -> Vector y)
-> LazySize
-> Int
-> y
-> Vector y
forall a b. (a -> b) -> a -> b
$ \ChunkSize
size Int
n y
x -> (Storable y => Vector y) -> Storage (Vector y) => Vector y
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (ChunkSize -> Int -> y -> Vector y
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 = (ChunkSize -> (y -> y) -> y -> Vector y)
-> LazySize -> (y -> y) -> y -> Vector y
forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext ((ChunkSize -> (y -> y) -> y -> Vector y)
 -> LazySize -> (y -> y) -> y -> Vector y)
-> (ChunkSize -> (y -> y) -> y -> Vector y)
-> LazySize
-> (y -> y)
-> y
-> Vector y
forall a b. (a -> b) -> a -> b
$ \ChunkSize
size y -> y
f y
x -> (Storable y => Vector y) -> Storage (Vector y) => Vector y
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (ChunkSize -> (y -> y) -> y -> Vector y
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 = (ChunkSize -> (s -> Maybe (y, s)) -> s -> Vector y)
-> LazySize -> (s -> Maybe (y, s)) -> s -> Vector y
forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext ((ChunkSize -> (s -> Maybe (y, s)) -> s -> Vector y)
 -> LazySize -> (s -> Maybe (y, s)) -> s -> Vector y)
-> (ChunkSize -> (s -> Maybe (y, s)) -> s -> Vector y)
-> LazySize
-> (s -> Maybe (y, s))
-> s
-> Vector y
forall a b. (a -> b) -> a -> b
$ \ChunkSize
size s -> Maybe (y, s)
f s
x -> (Storable y => Vector y) -> Storage (Vector y) => Vector y
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (ChunkSize -> (s -> Maybe (y, s)) -> s -> Vector y
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 = (ChunkSize -> (y -> y -> y) -> y -> Vector y)
-> LazySize -> (y -> y -> y) -> y -> Vector y
forall a. (ChunkSize -> a) -> LazySize -> a
withStorableContext ((ChunkSize -> (y -> y -> y) -> y -> Vector y)
 -> LazySize -> (y -> y -> y) -> y -> Vector y)
-> (ChunkSize -> (y -> y -> y) -> y -> Vector y)
-> LazySize
-> (y -> y -> y)
-> y
-> Vector y
forall a b. (a -> b) -> a -> b
$ \ChunkSize
size y -> y -> y
op y
x -> (Storable y => Vector y) -> Storage (Vector y) => Vector y
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSVL (ChunkSize -> (y -> y) -> y -> Vector y
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
_ = 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 Vector a -> Constraints (Vector a)
forall signal. Storage signal => signal -> Constraints signal
constraints Vector a
x of Constraints (Vector a)
R:ConstraintsVector a
StorableConstraints -> Storable a => Vector a -> b
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 Vector a -> Constraints (Vector a)
forall signal. Storage signal => signal -> Constraints signal
constraints Vector a
z of Constraints (Vector a)
R:ConstraintsVector a
StorableConstraints -> Vector a
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 = (Storable y => Vector y -> [y])
-> Storage (Vector y) => Vector y -> [y]
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV Storable y => Vector y -> [y]
Vector y -> [y]
forall a. Storable a => Vector a -> [a]
SV.unpack
   {-# INLINE toState #-}
   toState :: forall y. Storage (Vector y) => Vector y -> T y
toState = (Storable y => Vector y -> T y)
-> Storage (Vector y) => Vector y -> T y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV Storable y => Vector y -> T y
Vector y -> T y
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 = (Storable y => Vector y -> s)
-> Storage (Vector y) => Vector y -> s
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV ((s -> y -> s) -> s -> Vector y -> s
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 = (Storable y => Vector y -> s)
-> Storage (Vector y) => Vector y -> s
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV ((y -> s -> s) -> s -> Vector y -> s
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 = (Storable y => Vector y -> Int -> y)
-> Storage (Vector y) => Vector y -> Int -> y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV Storable y => Vector y -> Int -> y
Vector y -> Int -> y
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 = (Storable y => Vector y -> Vector y)
-> Storage (Vector y) => Vector y -> Vector y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (y -> Vector y -> Vector y
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 = (Storable y => Vector y -> Vector y)
-> Storage (Vector y) => Vector y -> Vector y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV ((y -> Bool) -> Vector y -> Vector y
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 = (Storable y => Vector y -> Vector y)
-> Storage (Vector y) => Vector y -> Vector y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV ((y -> Bool) -> Vector y -> Vector y
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 = (Storable y => Vector y -> (Vector y, Vector y))
-> Storage (Vector y) => Vector y -> (Vector y, Vector y)
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV ((y -> Bool) -> Vector y -> (Vector y, Vector y)
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 = (Storable y => Vector y -> Maybe (y, Vector y))
-> Storage (Vector y) => Vector y -> Maybe (y, Vector y)
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV Storable y => Vector y -> Maybe (y, Vector y)
Vector y -> Maybe (y, Vector y)
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 = (Storable y => Vector y -> Maybe (Vector y, y))
-> Storage (Vector y) => Vector y -> Maybe (Vector y, y)
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV Storable y => Vector y -> Maybe (Vector y, y)
Vector y -> Maybe (Vector y, y)
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 = (Storable y1 => Vector y1) -> Storage (Vector y1) => Vector y1
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSV ((Storable y0 => Vector y0 -> Vector y1)
-> Storage (Vector y0) => Vector y0 -> Vector y1
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV ((y0 -> y1) -> Vector y0 -> Vector y1
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 = (Storable y1 => Vector y1) -> Storage (Vector y1) => Vector y1
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSV ((Storable y0 => Vector y0 -> Vector y1)
-> Storage (Vector y0) => Vector y0 -> Vector y1
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV ((y1 -> y0 -> y1) -> y1 -> Vector y0 -> Vector y1
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 =
      (Storable y1 => Vector y1) -> Storage (Vector y1) => Vector y1
forall a.
(Storable a => Vector a) -> Storage (Vector a) => Vector a
writeSV ((Vector y1, Maybe s) -> Vector y1
forall a b. (a, b) -> a
fst ((Storable y0 => Vector y0 -> (Vector y1, Maybe s))
-> Storage (Vector y0) => Vector y0 -> (Vector y1, Maybe s)
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV ((y0 -> s -> Maybe (y1, s))
-> s -> Vector y0 -> (Vector y1, Maybe s)
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 =
      (Storable y => Vector y -> Vector y -> Vector y)
-> Storage (Vector y) => Vector y -> Vector y -> Vector y
forall a b.
(Storable a => Vector a -> b)
-> Storage (Vector a) => Vector a -> b
readSV (\Vector y
xs Vector y
ys ->
         case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector y -> Int
forall a. Vector a -> Int
SV.length Vector y
xs) (Vector y -> Int
forall a. Vector a -> Int
SV.length Vector y
ys) of
            Ordering
EQ -> (y -> y -> y) -> Vector y -> Vector y -> Vector y
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 -> Vector y -> Vector y -> Vector y
forall a. Storable a => Vector a -> Vector a -> Vector a
SV.append ((y -> y -> y) -> Vector y -> Vector y -> Vector y
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) (Int -> Vector y -> Vector y
forall a. Storable a => Int -> Vector a -> Vector a
SV.drop (Vector y -> Int
forall a. Vector a -> Int
SV.length Vector y
xs) Vector y
ys)
            Ordering
GT -> Vector y -> Vector y -> Vector y
forall a. Storable a => Vector a -> Vector a -> Vector a
SV.append ((y -> y -> y) -> Vector y -> Vector y -> Vector y
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) (Int -> Vector y -> Vector y
forall a. Storable a => Int -> Vector a -> Vector a
SV.drop (Vector y -> Int
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]
_ = Constraints [y]
forall y. Constraints [y]
ListConstraints

instance Read [] y where

instance Read0 [] where
   {-# INLINE toList #-}
   toList :: forall y. Storage [y] => [y] -> [y]
toList = [y] -> [y]
forall a. a -> a
id
   {-# INLINE toState #-}
   toState :: forall y. Storage [y] => [y] -> T y
toState = [y] -> T y
forall y. [y] -> T y
SigS.fromList
   {-# INLINE foldL #-}
   foldL :: forall y s. Storage [y] => (s -> y -> s) -> s -> [y] -> s
foldL = (s -> y -> s) -> s -> [y] -> s
forall b a. (b -> a -> b) -> b -> [a] -> b
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 = (y -> s -> s) -> s -> [y] -> s
forall a b. (a -> b -> b) -> b -> [a] -> b
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 = [y] -> Int -> y
forall a. HasCallStack => [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 = (y -> Bool) -> [y] -> [y]
forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile
   {-# INLINE dropWhile #-}
   dropWhile :: forall y. Storage [y] => (y -> Bool) -> [y] -> [y]
dropWhile = (y -> Bool) -> [y] -> [y]
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhile
   {-# INLINE span #-}
   span :: forall y. Storage [y] => (y -> Bool) -> [y] -> ([y], [y])
span = (y -> Bool) -> [y] -> ([y], [y])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span

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

   {-# INLINE map #-}
   map :: forall y0 y1.
(Storage [y0], Storage [y1]) =>
(y0 -> y1) -> [y0] -> [y1]
map = (y0 -> y1) -> [y0] -> [y1]
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 = (y1 -> y0 -> y1) -> y1 -> [y0] -> [y1]
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 = (y0 -> s -> Maybe (y1, s)) -> s -> [y0] -> [y1]
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 = (y -> y -> y) -> [y] -> [y] -> [y]
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
_ = [y] -> [y]
forall a. a -> a
id
   {-# INLINE repeat #-}
   repeat :: forall y. Storage [y] => LazySize -> y -> [y]
repeat LazySize
_ = y -> [y]
forall a. a -> [a]
List.repeat
   {-# INLINE replicate #-}
   replicate :: forall y. Storage [y] => LazySize -> Int -> y -> [y]
replicate LazySize
_ = Int -> y -> [y]
forall a. Int -> a -> [a]
List.replicate
   {-# INLINE iterate #-}
   iterate :: forall y. Storage [y] => LazySize -> (y -> y) -> y -> [y]
iterate LazySize
_ = (y -> y) -> y -> [y]
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
_ = (s -> Maybe (y, s)) -> s -> [y]
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
_ = (y -> y -> y) -> y -> [y]
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
_ = 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 = T y -> [y]
forall y. T y -> [y]
SigS.toList
   {-# INLINE toState #-}
   toState :: forall y. Storage (T y) => T y -> T y
toState = T y -> T y
forall a. a -> a
id
   {-# INLINE foldL #-}
   foldL :: forall y s. Storage (T y) => (s -> y -> s) -> s -> T y -> s
foldL = (s -> y -> s) -> s -> T y -> s
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 = (y -> s -> s) -> s -> T y -> s
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 = T y -> Int -> y
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 = y -> T y -> T y
forall a. a -> T a -> T a
SigS.cons
   {-# INLINE takeWhile #-}
   takeWhile :: forall y. Storage (T y) => (y -> Bool) -> T y -> T y
takeWhile = (y -> Bool) -> T y -> T y
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 = (y -> Bool) -> T y -> T y
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?
      ([y] -> T y, [y] -> T y) -> ([y], [y]) -> (T y, T y)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ([y] -> T y
forall y. [y] -> T y
SigS.fromList, [y] -> T y
forall y. [y] -> T y
SigS.fromList) (([y], [y]) -> (T y, T y))
-> (T y -> ([y], [y])) -> T y -> (T y, T y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (y -> Bool) -> [y] -> ([y], [y])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span y -> Bool
p ([y] -> ([y], [y])) -> (T y -> [y]) -> T y -> ([y], [y])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> [y]
forall y. T y -> [y]
SigS.toList

   {-# INLINE viewL #-}
   viewL :: forall y. Storage (T y) => T y -> Maybe (y, T y)
viewL = T y -> Maybe (y, T y)
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?
      (([y], y) -> (T y, y)) -> Maybe ([y], y) -> Maybe (T y, y)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([y] -> T y) -> ([y], y) -> (T y, y)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst [y] -> T y
forall y. [y] -> T y
SigS.fromList) (Maybe ([y], y) -> Maybe (T y, y))
-> (T y -> Maybe ([y], y)) -> T y -> Maybe (T y, y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [y] -> Maybe ([y], y)
forall a. [a] -> Maybe ([a], a)
ListHT.viewR ([y] -> Maybe ([y], y)) -> (T y -> [y]) -> T y -> Maybe ([y], y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> [y]
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 = (y0 -> y1) -> T y0 -> T y1
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 = (y1 -> y0 -> y1) -> y1 -> T y0 -> T y1
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 = (y0 -> s -> Maybe (y1, s)) -> s -> T y0 -> T y1
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 = (y -> y -> y) -> T y -> T y -> T y
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
_ = [y] -> T y
forall y. [y] -> T y
SigS.fromList
   {-# INLINE repeat #-}
   repeat :: forall y. Storage (T y) => LazySize -> y -> T y
repeat LazySize
_ = y -> T y
forall a. a -> T a
SigS.repeat
   {-# INLINE replicate #-}
   replicate :: forall y. Storage (T y) => LazySize -> Int -> y -> T y
replicate LazySize
_ = Int -> y -> T y
forall a. Int -> a -> T a
SigS.replicate
   {-# INLINE iterate #-}
   iterate :: forall y. Storage (T y) => LazySize -> (y -> y) -> y -> T y
iterate LazySize
_ = (y -> y) -> y -> T y
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
_ = (s -> Maybe (y, s)) -> s -> T y
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
_ = (y -> y -> y) -> y -> T y
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
_ = 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 =
      ((y, time) -> [y]) -> [(y, time)] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap ((y -> time -> [y]) -> (y, time) -> [y]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((time -> y -> [y]) -> y -> time -> [y]
forall a b c. (a -> b -> c) -> b -> a -> c
flip time -> y -> [y]
forall i a. Integral i => i -> a -> [a]
List.genericReplicate)) ([(y, time)] -> [y])
-> (T time y -> [(y, time)]) -> T time y -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      T time y -> [(y, time)]
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 = T time y -> T y
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 = (s -> y -> s) -> s -> T y -> s
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
SigS.foldL s -> y -> s
f s
x (T y -> s) -> (T time y -> T y) -> T time y -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time y -> T y
forall y. Storage (T time y) => T time y -> T y
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 = (y -> s -> s) -> s -> T y -> s
forall x acc. (x -> acc -> acc) -> acc -> T x -> acc
SigS.foldR y -> s -> s
f s
x (T y -> s) -> (T time y -> T y) -> T time y -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time y -> T y
forall y. Storage (T time y) => T time y -> T y
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 =
      (y -> time -> (time -> y) -> time -> y)
-> (time -> y) -> T time y -> time -> y
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 time -> time -> Bool
forall a. Ord a => a -> a -> Bool
< time
t
              then y
b
              else time -> y
go (time
t time -> time -> time
forall a. C a => a -> a -> a
NonNeg98.-| time
k))
         (String -> time -> y
forall a. HasCallStack => String -> a
error (String -> time -> y) -> String -> time -> y
forall a b. (a -> b) -> a -> b
$ String
"EventList.index: positions " 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
" out of range")
         T time y
sig
         (Int -> time
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 = y -> time -> T time y -> T time y
forall body time. body -> time -> T time body -> T time body
EventList.cons y
b (Integer -> time
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 =
      (y -> time -> T time y -> T time y)
-> T time y -> T time y -> T time y
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 y -> time -> T time y -> T time y
forall body time. body -> time -> T time body -> T time body
EventList.cons y
b time
t T time y
rest
              else T time y
forall time body. T time body
EventList.empty)
         T time y
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 =
             ((y -> time -> T time y -> T time y) -> T time y -> T time y)
-> T time y -> (y -> time -> T time y -> T time y) -> T time y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T time y
-> (y -> time -> T time y -> T time y) -> T time y -> T time y
forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL T time y
forall time body. T time body
EventList.empty) T time y
xs ((y -> time -> T time y -> T time y) -> T time y)
-> (y -> time -> T time y -> T time y) -> T time y
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 =
             ((y -> time -> T time y -> (T time y, T time y))
 -> T time y -> (T time y, T time y))
-> T time y
-> (y -> time -> T time y -> (T time y, T time y))
-> (T time y, T time y)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((T time y, T time y)
-> (y -> time -> T time y -> (T time y, T time y))
-> T time y
-> (T time y, T time y)
forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL (T time y
forall time body. T time body
EventList.empty,T time y
forall time body. T time body
EventList.empty)) T time y
xs ((y -> time -> T time y -> (T time y, T time y))
 -> (T time y, T time y))
-> (y -> time -> T time y -> (T time y, T time y))
-> (T time y, T time y)
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)
-> (T time y, T time y) -> (T time y, T time y)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (y -> time -> T time y -> T time y
forall body time. body -> time -> T time body -> T time body
EventList.cons y
b time
t) ((T time y, T time y) -> (T time y, T time y))
-> (T time y, T time y) -> (T time y, T time y)
forall a b. (a -> b) -> a -> b
$ T time y -> (T time y, T time y)
recourse T time y
rest
               else (T time y
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) <- T time y -> Maybe ((y, time), T time y)
forall time body. T time body -> Maybe ((body, time), T time body)
EventList.viewL T time y
xs
      if time
ttime -> time -> Bool
forall a. Ord a => a -> a -> Bool
>time
0
        then (y, T time y) -> Maybe (y, T time y)
forall a. a -> Maybe a
Just (y
b, if time
ttime -> time -> Bool
forall a. Eq a => a -> a -> Bool
==time
1 then T time y
ys else y -> time -> T time y -> T time y
forall body time. body -> time -> T time body -> T time body
EventList.cons y
b (time
t time -> time -> time
forall a. C a => a -> a -> a
NonNeg98.-|time
1) T time y
ys)
        else T time y -> Maybe (y, T time y)
forall y. Storage (T time y) => T time y -> Maybe (y, T time y)
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 =
             (body -> time -> T time body -> T time body)
-> T time body -> T time body -> T time body
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
ttime -> time -> Bool
forall a. Eq a => a -> a -> Bool
==time
0 Bool -> Bool -> Bool
&& T time body -> Bool
forall time body. T time body -> Bool
EventList.null T time body
rest
                     then T time body
forall time body. T time body
EventList.empty
                     else body -> time -> T time body -> T time body
forall body time. body -> time -> T time body -> T time body
EventList.cons body
b time
t T time body
rest)
                T time body
forall time body. T time body
EventList.empty
          recourse :: (a, b) -> T b a -> (T b a, a)
recourse (a
b,b
t) =
             (T b a, a)
-> (a -> b -> T b a -> (T b a, a)) -> T b a -> (T b a, a)
forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL
                (if b
tb -> b -> Bool
forall a. Ord a => a -> a -> Bool
<=b
1
                   then T b a
forall time body. T time body
EventList.empty
                   else a -> b -> T b a
forall body time. body -> time -> T time body
EventList.singleton a
b (b
t b -> b -> b
forall a. C a => a -> a -> a
NonNeg98.-| b
1),
                 a
b)
                (\a
b0 b
t0 T b a
xs0 ->
                   (T b a -> T b a) -> (T b a, a) -> (T b a, a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a -> b -> T b a -> T b a
forall body time. body -> time -> T time body -> T time body
EventList.cons a
b b
t) ((T b a, a) -> (T b a, a)) -> (T b a, a) -> (T b a, a)
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  (((y, time), T time y) -> (T time y, y))
-> Maybe ((y, time), T time y) -> Maybe (T time y, y)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((y, time) -> T time y -> (T time y, y))
-> ((y, time), T time y) -> (T time y, y)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (y, time) -> T time y -> (T time y, y)
forall {b} {a}. (Num b, C b) => (a, b) -> T b a -> (T b a, a)
recourse) (Maybe ((y, time), T time y) -> Maybe (T time y, y))
-> (T time y -> Maybe ((y, time), T time y))
-> T time y
-> Maybe (T time y, y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time y -> Maybe ((y, time), T time y)
forall time body. T time body -> Maybe ((body, time), T time body)
EventList.viewL (T time y -> Maybe ((y, time), T time y))
-> (T time y -> T time y)
-> T time y
-> Maybe ((y, time), T time y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time y -> T time y
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 = (y0 -> y1) -> T time y0 -> T time y1
forall a b. (a -> b) -> T time a -> T time b
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 =
      LazySize -> T y1 -> T time y1
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
fromState (Int -> LazySize
LazySize Int
1) (T y1 -> T time y1)
-> (T time y0 -> T y1) -> T time y0 -> T time y1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y1 -> y0 -> y1) -> y1 -> T y0 -> T y1
forall acc x. (acc -> x -> acc) -> acc -> T x -> T acc
SigS.scanL y1 -> y0 -> y1
f y1
x (T y0 -> T y1) -> (T time y0 -> T y0) -> T time y0 -> T y1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time y0 -> T y0
forall y. Storage (T time y) => T time y -> T y
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 =
      LazySize -> T y1 -> T time y1
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
fromState (Int -> LazySize
LazySize Int
1) (T y1 -> T time y1)
-> (T time y0 -> T y1) -> T time y0 -> T time y1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y0 -> s -> Maybe (y1, s)) -> s -> T y0 -> T y1
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
SigS.crochetL y0 -> s -> Maybe (y1, s)
f s
x (T y0 -> T y1) -> (T time y0 -> T y0) -> T time y0 -> T y1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time y0 -> T y0
forall y. Storage (T time y) => T time y -> T y
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 =
             ((y -> time -> T time y -> T time y) -> T time y -> T time y)
-> T time y -> (y -> time -> T time y -> T time y) -> T time y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T time y
-> (y -> time -> T time y -> T time y) -> T time y -> T time y
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 ((y -> time -> T time y -> T time y) -> T time y)
-> (y -> time -> T time y -> T time y) -> T time y
forall a b. (a -> b) -> a -> b
$ \y
x time
xn T time y
xs0 ->
             ((y -> time -> T time y -> T time y) -> T time y -> T time y)
-> T time y -> (y -> time -> T time y -> T time y) -> T time y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T time y
-> (y -> time -> T time y -> T time y) -> T time y -> T time y
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 ((y -> time -> T time y -> T time y) -> T time y)
-> (y -> time -> T time y -> T time y) -> T time y
forall a b. (a -> b) -> a -> b
$ \y
y time
yn T time y
ys0 ->
             let n :: time
n = time -> time -> time
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
ntime -> time -> Bool
forall a. Ord a => a -> a -> Bool
>=time
an
                      then T time y
as0
                      else y -> time -> T time y -> T time y
forall body time. body -> time -> T time body -> T time body
EventList.cons y
a (time
an time -> time -> time
forall a. C a => a -> a -> a
NonNeg98.-| time
n) T time y
as0
             in  y -> time -> T time y -> T time y
forall body time. body -> time -> T time body -> T time body
EventList.cons (y -> y -> y
f y
x y
y) time
n (T time y -> T time y) -> T time y -> T time y
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
_ =
      [(y, time)] -> T time y
forall body time. [(body, time)] -> T time body
EventList.fromPairList ([(y, time)] -> T time y)
-> ([y] -> [(y, time)]) -> [y] -> T time y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (y -> (y, time)) -> [y] -> [(y, time)]
forall a b. (a -> b) -> [a] -> [b]
List.map ((y -> time -> (y, time)) -> time -> y -> (y, time)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (Integer -> time
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 = y -> time -> T time y -> T time y
forall body time. body -> time -> T time body -> T time body
EventList.cons y
a (Int -> time
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 =
      Int -> T time y -> T time y
forall sig. Transform sig => Int -> sig -> sig
Cut.take Int
m (LazySize -> y -> T time y
forall y. Storage (T time y) => LazySize -> y -> T time y
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 =
      LazySize -> T y -> T time y
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
fromState LazySize
size (T y -> T time y) -> (y -> T y) -> y -> T time y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> y) -> y -> T y
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 =
             T time y -> ((y, s) -> T time y) -> Maybe (y, s) -> T time y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T time y
forall time body. T time body
EventList.empty
                (\(y
x,s
s) -> y -> time -> T time y -> T time y
forall body time. body -> time -> T time body -> T time body
EventList.cons y
x
                   (Integer -> time
forall a. Num a => Integer -> a
P.fromInteger Integer
1) (s -> T time y
recourse s
s)) (Maybe (y, s) -> T time y) -> (s -> Maybe (y, s)) -> s -> T time y
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 = LazySize -> (y -> y) -> y -> T time y
forall y.
Storage (T time y) =>
LazySize -> (y -> y) -> y -> T time y
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 =
   a -> ((y, sig y) -> a) -> Maybe (y, sig y) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
nothing ((y -> sig y -> a) -> (y, sig y) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry y -> sig y -> a
just) (Maybe (y, sig y) -> a)
-> (sig y -> Maybe (y, sig y)) -> sig y -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig y -> Maybe (y, sig y)
forall y. Storage (sig y) => sig y -> Maybe (y, sig y)
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 =
   a -> ((sig y, y) -> a) -> Maybe (sig y, y) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
nothing ((sig y -> y -> a) -> (sig y, y) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry sig y -> y -> a
just) (Maybe (sig y, y) -> a)
-> (sig y -> Maybe (sig y, y)) -> sig y -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig y -> Maybe (sig y, y)
forall y. Storage (sig y) => sig y -> Maybe (sig y, y)
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 =
   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
SigS.runViewL (sig y -> T y
forall y. Storage (sig y) => sig y -> T y
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 =
   T y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
forall y x.
T y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
SigS.runSwitchL (sig y -> T y
forall y. Storage (sig y) => sig y -> T y
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 = y -> sig y -> sig y
forall y. Storage (sig y) => y -> sig y -> sig y
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
y -> sig y -> sig y
cons y
x sig y
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 = (y -> y -> y) -> sig y -> sig y -> sig y
forall y.
Storage (sig y) =>
(y -> y -> y) -> sig y -> sig y -> sig y
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
(y -> y -> y) -> sig y -> sig y -> sig y
zipWithAppend y -> y -> y
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 = (a -> b -> (a, b)) -> sig a -> sig b -> sig (a, b)
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 = (a -> b -> c) -> T a -> sig b -> sig c
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 (T a -> sig b -> sig c)
-> (sig a -> T a) -> sig a -> sig b -> sig c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig a -> T a
forall y. Storage (sig y) => sig y -> T y
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 = (a -> b -> c -> c) -> T a -> T b -> sig c -> sig c
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 (sig a -> T a
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState sig a
as) (sig b -> T b
forall y. Storage (sig y) => sig y -> T y
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 =
   T a
-> (forall s. (s -> Maybe (a, s)) -> s -> sig b -> sig c)
-> sig b
-> sig c
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
SigS.runViewL T a
sig (\s -> Maybe (a, s)
next ->
   (b -> s -> Maybe (c, s)) -> s -> sig b -> sig c
forall y0 y1 s.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
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
         (c, s) -> Maybe (c, s)
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 =
   ((c -> d) -> c -> d) -> T (c -> d) -> sig c -> sig d
forall (sig :: * -> *) b c a.
(Transform sig b, Transform sig c) =>
(a -> b -> c) -> T a -> sig b -> sig c
zipWithState (c -> d) -> c -> d
forall a b. (a -> b) -> a -> b
($) ((a -> b -> c -> d) -> T a -> T b -> T (c -> d)
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 =
   (((a, b) -> a) -> sig (a, b) -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map (a, b) -> a
forall a b. (a, b) -> a
fst sig (a, b)
xs, ((a, b) -> b) -> sig (a, b) -> sig b
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map (a, b) -> b
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 =
   (((a, b, c) -> a) -> sig (a, b, c) -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map (a, b, c) -> a
forall a b c. (a, b, c) -> a
fst3 sig (a, b, c)
xs, ((a, b, c) -> b) -> sig (a, b, c) -> sig b
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map (a, b, c) -> b
forall a b c. (a, b, c) -> b
snd3 sig (a, b, c)
xs, ((a, b, c) -> c) -> sig (a, b, c) -> sig c
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
map (a, b, c) -> c
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 =
   (b -> a -> b) -> T b -> sig a -> sig b
forall (sig :: * -> *) b c a.
(Transform sig b, Transform sig c) =>
(a -> b -> c) -> T a -> sig b -> sig c
zipWithState b -> a -> b
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 =
   sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
append (LazySize -> Int -> y -> sig y
forall y. Storage (sig y) => LazySize -> Int -> y -> sig y
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 =
   (sig y -> sig y) -> sig y
forall a. (a -> a) -> a
fix (sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
append sig y
prefix (sig y -> sig y) -> (sig y -> sig y) -> sig y -> sig y
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 =
   (sig y -> sig y) -> sig y
forall a. (a -> a) -> a
fix ((y -> y -> y) -> sig y -> sig y -> sig y
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
zipWith y -> y -> y
forall a. C a => a -> a -> a
(Additive.+) sig y
xs (sig y -> sig y) -> (sig y -> sig y) -> sig y -> sig y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        LazySize -> y -> Int -> sig y -> sig y
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> y -> Int -> sig y -> sig y
delay LazySize
defaultLazySize y
forall a. C a => a
Additive.zero Int
time (sig y -> sig y) -> (sig y -> sig y) -> sig y -> sig y
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 = (a -> a -> a) -> a -> sig a -> a
forall y s. Storage (sig y) => (s -> y -> s) -> s -> sig y -> s
forall (sig :: * -> *) y s.
(Read0 sig, Storage (sig y)) =>
(s -> y -> s) -> s -> sig y -> s
foldL a -> a -> a
forall a. C a => a -> a -> a
(Additive.+) a
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 = (a -> a -> a) -> T a -> a
forall x. (x -> x -> x) -> T x -> x
SigS.foldL1 a -> a -> a
forall a. C a => a -> a -> a
(Additive.+) (T a -> a) -> (sig a -> T a) -> sig a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig a -> T a
forall y. Storage (sig y) => sig y -> T y
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 = (a -> m -> m) -> m -> sig a -> m
forall y s. Storage (sig y) => (y -> s -> s) -> s -> sig y -> s
forall (sig :: * -> *) y s.
(Read0 sig, Storage (sig y)) =>
(y -> s -> s) -> s -> sig y -> s
foldR (m -> m -> m
forall sig. Monoid sig => sig -> sig -> sig
mappend (m -> m -> m) -> (a -> m) -> a -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) m
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 = (a -> m) -> sig a -> m
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 =
   (Maybe (sig y) -> Maybe (sig y, Maybe (sig y)))
-> Maybe (sig y) -> T (sig y)
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
SigS.unfoldR ((sig y -> (sig y, Maybe (sig y)))
-> Maybe (sig y) -> Maybe (sig y, Maybe (sig y))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\sig y
x -> (sig y
x, ((y, sig y) -> sig y) -> Maybe (y, sig y) -> Maybe (sig y)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (y, sig y) -> sig y
forall a b. (a, b) -> b
snd (sig y -> Maybe (y, sig y)
forall y. Storage (sig y) => sig y -> Maybe (y, sig y)
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig y
x)))) (Maybe (sig y) -> T (sig y))
-> (sig y -> Maybe (sig y)) -> sig y -> T (sig y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig y -> Maybe (sig y)
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 =
   sig y -> (y -> sig y -> sig y) -> sig y -> sig y
forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
switchL sig y
xs ((sig y -> y -> sig y) -> y -> sig y -> sig y
forall a b c. (a -> b -> c) -> b -> a -> c
flip sig y -> y -> sig y
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 = sig a -> ((a, sig a) -> sig a) -> Maybe (a, sig a) -> sig a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe sig a
xs0 (a, sig a) -> sig a
forall a b. (a, b) -> b
snd (sig a -> Maybe (a, sig a)
forall y. Storage (sig y) => sig y -> Maybe (y, sig y)
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig a
xs0)
   in  (a -> a -> a) -> sig a -> sig a -> sig a
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 =
   (a -> s -> Maybe (a, s)) -> s -> sig a -> sig a
forall y0 y1 s.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
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 -> (a, s) -> Maybe (a, s)
forall a. a -> Maybe a
Just (State s a -> s -> (a, s)
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 =
   sig ctrl
-> (forall s. (s -> Maybe (ctrl, s)) -> s -> sig a -> sig b)
-> sig a
-> sig b
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 ->
   (a -> (s, s) -> Maybe (b, (s, s))) -> (s, s) -> sig a -> sig b
forall y0 y1 s.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
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) = State s b -> s -> (b, s)
forall s a. State s a -> s -> (a, s)
runState (ctrl -> a -> State s b
proc ctrl
c a
x) s
acc0
            (b, (s, s)) -> Maybe (b, (s, s))
forall a. a -> Maybe a
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 =
   T y -> y
forall a. C a => T a -> a
SigS.sum ((t -> y -> y) -> T t -> T y -> T y
forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith t -> y -> y
forall a v. C a v => a -> v -> v
(Module.*>) (sig t -> T t
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
toState sig t
ts) (sig y -> T y
forall y. Storage (sig y) => sig y -> T y
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) =
   LazySize -> (s -> Maybe (y, s)) -> s -> sig y
forall y s.
Storage (sig y) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
forall (sig :: * -> *) y s.
(Write0 sig, Storage (sig y)) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
unfoldR LazySize
size (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
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 =
   sig y -> ((sig y, y) -> sig y) -> Maybe (sig y, y) -> sig y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      sig y
xt
      (sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
append sig y
xt (sig y -> sig y) -> ((sig y, y) -> sig y) -> (sig y, y) -> sig y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazySize -> y -> sig y
forall y. Storage (sig y) => LazySize -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> y -> sig y
repeat LazySize
size (y -> sig y) -> ((sig y, y) -> y) -> (sig y, y) -> sig y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (sig y, y) -> y
forall a b. (a, b) -> b
snd)
      (sig y -> Maybe (sig y, y)
forall y. Storage (sig y) => sig y -> Maybe (sig y, y)
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 = sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
append sig y
xs (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ y -> sig y
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 =
   (a -> sig a -> Maybe (a, sig a)) -> sig a -> sig a -> sig a
forall y0 y1 s.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
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) <- sig a -> Maybe (a, sig a)
forall y. Storage (sig y) => sig y -> Maybe (y, sig y)
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig a
xs0
         (a, sig a) -> Maybe (a, sig a)
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 =
   LazySize -> (sig a -> Maybe (b, sig a)) -> sig a -> sig b
forall y s.
Storage (sig y) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
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) <- sig a -> Maybe (a, sig a)
forall y. Storage (sig y) => sig y -> Maybe (y, sig y)
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig a
xs
         (b, sig a) -> Maybe (b, sig a)
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 =
   (sig b -> sig a -> sig c) -> sig a -> sig b -> sig c
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> sig b -> Maybe (c, sig b)) -> sig b -> sig a -> sig c
forall y0 y1 s.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
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) <- sig b -> Maybe (b, sig b)
forall y. Storage (sig y) => sig y -> Maybe (y, sig y)
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
viewL sig b
ys0
         (c, sig b) -> Maybe (c, sig b)
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
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0
     then String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Generic.index: negative index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
     else a -> (a -> sig a -> a) -> sig a -> a
forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
switchL
             (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Generic.index: index too large " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
             a -> sig a -> a
forall a b. a -> b -> a
const
             (Int -> sig a -> sig a
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)
-}