{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS -fplugin=WidgetRattus.Plugin #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}


-- | Programming with signals.

module WidgetRattus.Signal
  ( map
  , mapAwait
  , switch
  , switchS
  , switchR
  , trigger
  , triggerAwait
  , triggerM
  , triggerAwaitM
  , buffer
  , bufferAwait
  , switchAwait
  , interleave
  , mapInterleave
  , interleaveAll
  , mkSig
  , mkSig'
  , current
  , future
  , const
  , jump
  , jumping
  , stop
  , scan
  , scanC
  , scanAwait
  , scanAwaitC
  , scanMap
  , Sig(..)
  , zipWith
  , zipWith3
  , zip
  , cond
  , update
  , integral
  , derivative
  )

where

import WidgetRattus
import Prelude hiding (map, const, zipWith, zipWith3, zip, filter)
import Data.VectorSpace
import Data.Ratio ((%))
-- TODO: InternalPrimitives is only used to implment instance of
-- Continuous. Replace this manual instance declaration with Template
-- Haskell.
import WidgetRattus.InternalPrimitives

infixr 5 :::

-- | @Sig a@ is a stream of values of type @a@.
data Sig a = !a ::: !(O (Sig a))

-- | Get the current value of a signal.
current :: Sig a -> a
current :: forall a. Sig a -> a
current (a
x ::: O (Sig a)
_) = a
x


-- | Get the future the signal.
future :: Sig a -> O (Sig a)
future :: forall a. Sig a -> O (Sig a)
future (a
_ ::: O (Sig a)
xs) = O (Sig a)
xs

-- | Apply a function to the value of a signal.
map :: Box (a -> b) -> Sig a -> Sig b
map :: forall a b. Box (a -> b) -> Sig a -> Sig b
map Box (a -> b)
f (a
x ::: O (Sig a)
xs) = Box (a -> b) -> a -> b
forall a. Box a -> a
unbox Box (a -> b)
f a
x b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: Sig b -> O (Sig b)
forall a. a -> O a
delay (Box (a -> b) -> Sig a -> Sig b
forall a b. Box (a -> b) -> Sig a -> Sig b
map Box (a -> b)
f (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
xs))

-- | A version of @map@ for delayed signals.
mapAwait :: Box (a -> b) -> O (Sig a) -> O (Sig b)
mapAwait :: forall a b. Box (a -> b) -> O (Sig a) -> O (Sig b)
mapAwait Box (a -> b)
f O (Sig a)
d = Sig b -> O (Sig b)
forall a. a -> O a
delay (Box (a -> b) -> Sig a -> Sig b
forall a b. Box (a -> b) -> Sig a -> Sig b
map Box (a -> b)
f (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
d))

-- | Turns a boxed delayed computation into a delayed signal.
mkSig :: Box (O a) -> O (Sig a)
mkSig :: forall a. Box (O a) -> O (Sig a)
mkSig Box (O a)
b = Sig a -> O (Sig a)
forall a. a -> O a
delay (O a -> a
forall a. O a -> a
adv (Box (O a) -> O a
forall a. Box a -> a
unbox Box (O a)
b) a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Box (O a) -> O (Sig a)
forall a. Box (O a) -> O (Sig a)
mkSig Box (O a)
b)


-- | Turns a boxed delayed computation into a delayed signal.
mkSig' :: Box (O (C a)) -> O (Sig a)
mkSig' :: forall a. Box (O (C a)) -> O (Sig a)
mkSig' Box (O (C a))
b = O (C (Sig a)) -> O (Sig a)
forall a. O (C a) -> O a
delayC (O (C (Sig a)) -> O (Sig a)) -> O (C (Sig a)) -> O (Sig a)
forall a b. (a -> b) -> a -> b
$ C (Sig a) -> O (C (Sig a))
forall a. a -> O a
delay (do a
a <- O (C a) -> C a
forall a. O a -> a
adv (Box (O (C a)) -> O (C a)
forall a. Box a -> a
unbox Box (O (C a))
b)
                              Sig a -> C (Sig a)
forall a. a -> C a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Box (O (C a)) -> O (Sig a)
forall a. Box (O (C a)) -> O (Sig a)
mkSig' Box (O (C a))
b))



-- | Construct a constant signal that never updates.
const :: a -> Sig a
const :: forall a. a -> Sig a
const a
x = a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: O (Sig a)
forall a. O a
never

-- | Similar to Haskell's 'scanl'.
--
-- > scan (box f) x (v1 ::: v2 ::: v3 ::: ... ) == (x `f` v1) ::: ((x `f` v1) `f` v2) ::: ...
--
-- Note: Unlike 'scanl', 'scan' starts with @x `f` v1@, not @x@.

scan :: (Stable b) => Box(b -> a -> b) -> b -> Sig a -> Sig b
scan :: forall b a. Stable b => Box (b -> a -> b) -> b -> Sig a -> Sig b
scan Box (b -> a -> b)
f b
acc (a
a ::: O (Sig a)
as) = b
acc' b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: Sig b -> O (Sig b)
forall a. a -> O a
delay (Box (b -> a -> b) -> b -> Sig a -> Sig b
forall b a. Stable b => Box (b -> a -> b) -> b -> Sig a -> Sig b
scan Box (b -> a -> b)
f b
acc' (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
as))
  where acc' :: b
acc' = Box (b -> a -> b) -> b -> a -> b
forall a. Box a -> a
unbox Box (b -> a -> b)
f b
acc a
a

-- | A variant of 'scan' that works with the 'C' monad.

scanC :: (Stable b) => Box(b -> a -> C b) -> b -> Sig a -> C (Sig b)
scanC :: forall b a.
Stable b =>
Box (b -> a -> C b) -> b -> Sig a -> C (Sig b)
scanC Box (b -> a -> C b)
f b
acc (a
a ::: O (Sig a)
as) = do
    b
acc' <- Box (b -> a -> C b) -> b -> a -> C b
forall a. Box a -> a
unbox Box (b -> a -> C b)
f b
acc a
a
    Sig b -> C (Sig b)
forall a. a -> C a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
acc' b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: O (C (Sig b)) -> O (Sig b)
forall a. O (C a) -> O a
delayC (C (Sig b) -> O (C (Sig b))
forall a. a -> O a
delay (Box (b -> a -> C b) -> b -> Sig a -> C (Sig b)
forall b a.
Stable b =>
Box (b -> a -> C b) -> b -> Sig a -> C (Sig b)
scanC Box (b -> a -> C b)
f b
acc' (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
as))))
        
-- | Like 'scan', but uses a delayed signal.
scanAwait :: (Stable b) => Box (b -> a -> b) -> b -> O (Sig a) -> Sig b
scanAwait :: forall b a.
Stable b =>
Box (b -> a -> b) -> b -> O (Sig a) -> Sig b
scanAwait Box (b -> a -> b)
f b
acc O (Sig a)
as = b
acc b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: Sig b -> O (Sig b)
forall a. a -> O a
delay (Box (b -> a -> b) -> b -> Sig a -> Sig b
forall b a. Stable b => Box (b -> a -> b) -> b -> Sig a -> Sig b
scan Box (b -> a -> b)
f b
acc (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
as))

-- | A variant of 'scanAwait' that works with the 'C' monad.

scanAwaitC :: (Stable b) => Box (b -> a -> C b) -> b -> O (Sig a) -> Sig b
scanAwaitC :: forall b a.
Stable b =>
Box (b -> a -> C b) -> b -> O (Sig a) -> Sig b
scanAwaitC Box (b -> a -> C b)
f b
acc O (Sig a)
as = b
acc b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: O (C (Sig b)) -> O (Sig b)
forall a. O (C a) -> O a
delayC (C (Sig b) -> O (C (Sig b))
forall a. a -> O a
delay (Box (b -> a -> C b) -> b -> Sig a -> C (Sig b)
forall b a.
Stable b =>
Box (b -> a -> C b) -> b -> Sig a -> C (Sig b)
scanC Box (b -> a -> C b)
f b
acc (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
as)))

-- | 'scanMap' is a composition of 'map' and 'scan':
--
-- > scanMap f g x === map g . scan f x
scanMap :: (Stable b) => Box (b -> a -> b) -> Box (b -> c) -> b -> Sig a -> Sig c
scanMap :: forall b a c.
Stable b =>
Box (b -> a -> b) -> Box (b -> c) -> b -> Sig a -> Sig c
scanMap Box (b -> a -> b)
f Box (b -> c)
p b
acc (a
a ::: O (Sig a)
as) =  Box (b -> c) -> b -> c
forall a. Box a -> a
unbox Box (b -> c)
p b
acc' c -> O (Sig c) -> Sig c
forall a. a -> O (Sig a) -> Sig a
::: Sig c -> O (Sig c)
forall a. a -> O a
delay (Box (b -> a -> b) -> Box (b -> c) -> b -> Sig a -> Sig c
forall b a c.
Stable b =>
Box (b -> a -> b) -> Box (b -> c) -> b -> Sig a -> Sig c
scanMap Box (b -> a -> b)
f Box (b -> c)
p b
acc' (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
as))
  where acc' :: b
acc' = Box (b -> a -> b) -> b -> a -> b
forall a. Box a -> a
unbox Box (b -> a -> b)
f b
acc a
a

-- | @jump (box f) xs@ first behaves like @xs@, but as soon as @f x =
-- Just xs'@ for a (current or future) value @x@ of @xs@, it behaves
-- like @xs'@.

jump :: Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
jump :: forall a. Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
jump Box (a -> Maybe' (Sig a))
f (a
x ::: O (Sig a)
xs) = case Box (a -> Maybe' (Sig a)) -> a -> Maybe' (Sig a)
forall a. Box a -> a
unbox Box (a -> Maybe' (Sig a))
f a
x of
                        Just' Sig a
xs' -> Sig a
xs'
                        Maybe' (Sig a)
Nothing' -> a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Sig a -> O (Sig a)
forall a. a -> O a
delay (Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
forall a. Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
jump Box (a -> Maybe' (Sig a))
f (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
xs))


-- | Similar to 'jump', but it can jump repeatedly. That is, @jumping
-- (box f) xs@ first behaves like @xs@, but every time @f x = Just
-- xs'@ for a (current or future) value @x@ of @jumping (box f) xs@,
-- it behaves like @xs'@.

jumping :: Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
jumping :: forall a. Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
jumping Box (a -> Maybe' (Sig a))
f (a
x ::: O (Sig a)
xs) = case Box (a -> Maybe' (Sig a)) -> a -> Maybe' (Sig a)
forall a. Box a -> a
unbox Box (a -> Maybe' (Sig a))
f a
x of
                         Just' (a
x' ::: O (Sig a)
xs') -> a
x' a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Sig a -> O (Sig a)
forall a. a -> O a
delay (Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
forall a. Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
jumping Box (a -> Maybe' (Sig a))
f (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
xs'))
                         Maybe' (Sig a)
Nothing'           -> a
x  a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Sig a -> O (Sig a)
forall a. a -> O a
delay (Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
forall a. Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
jumping Box (a -> Maybe' (Sig a))
f (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
xs))

-- | Stops as soon as the the predicate becomes true for the current
-- value. That is, @stop (box p) xs@ first behaves as @xs@, but as
-- soon as @f x = True@ for some (current or future) value @x@ of
-- @xs@, then it behaves as @const x@.
stop :: Box (a -> Bool) -> Sig a ->  Sig a
stop :: forall a. Box (a -> Bool) -> Sig a -> Sig a
stop Box (a -> Bool)
p = Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
forall a. Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a
jump ((a -> Maybe' (Sig a)) -> Box (a -> Maybe' (Sig a))
forall a. a -> Box a
box (\ a
x -> if Box (a -> Bool) -> a -> Bool
forall a. Box a -> a
unbox Box (a -> Bool)
p a
x then Sig a -> Maybe' (Sig a)
forall a. a -> Maybe' a
Just' (a -> Sig a
forall a. a -> Sig a
const a
x) else Maybe' (Sig a)
forall a. Maybe' a
Nothing'))

-- | This function allows to switch from one signal to another one
-- dynamically. The signal defined by @switch xs ys@ first behaves
-- like @xs@, but as soon as @ys@ produces a new value, @switch xs ys@
-- behaves like @ys@.
--
-- Example:
--
-- >           xs: 1 2 3 4 5   6 7 8   9
-- >           ys:         1 2   3 4 5 6
-- >
-- > switch xs ys: 1 2 3 1 2 4   3 4 5 6
switch :: Sig a -> O (Sig a) -> Sig a
switch :: forall a. Sig a -> O (Sig a) -> Sig a
switch (a
x ::: O (Sig a)
xs) O (Sig a)
d = a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Sig a -> O (Sig a)
forall a. a -> O a
delay (case O (Sig a) -> O (Sig a) -> Select (Sig a) (Sig a)
forall a b. O a -> O b -> Select a b
select O (Sig a)
xs O (Sig a)
d of
                                     Fst   Sig a
xs'  O (Sig a)
d'  -> Sig a -> O (Sig a) -> Sig a
forall a. Sig a -> O (Sig a) -> Sig a
switch Sig a
xs' O (Sig a)
d'
                                     Snd   O (Sig a)
_    Sig a
d'  -> Sig a
d'
                                     Both  Sig a
_    Sig a
d'  -> Sig a
d')

-- | This function is similar to 'switch', but the (future) second
-- signal may depend on the last value of the first signal.
switchS :: Stable a => Sig a -> O (a -> Sig a) -> Sig a
switchS :: forall a. Stable a => Sig a -> O (a -> Sig a) -> Sig a
switchS (a
x ::: O (Sig a)
xs) O (a -> Sig a)
d = a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Sig a -> O (Sig a)
forall a. a -> O a
delay (case O (Sig a) -> O (a -> Sig a) -> Select (Sig a) (a -> Sig a)
forall a b. O a -> O b -> Select a b
select O (Sig a)
xs O (a -> Sig a)
d of
                                     Fst   Sig a
xs'  O (a -> Sig a)
d'  -> Sig a -> O (a -> Sig a) -> Sig a
forall a. Stable a => Sig a -> O (a -> Sig a) -> Sig a
switchS Sig a
xs' O (a -> Sig a)
d'
                                     Snd   O (Sig a)
_    a -> Sig a
f  -> a -> Sig a
f a
x
                                     Both  Sig a
_    a -> Sig a
f  -> a -> Sig a
f a
x)

-- | This function is similar to 'switch' but works on delayed signals
-- instead of signals.
switchAwait :: O (Sig a) -> O (Sig a) -> O (Sig a)
switchAwait :: forall a. O (Sig a) -> O (Sig a) -> O (Sig a)
switchAwait O (Sig a)
xs O (Sig a)
ys = Sig a -> O (Sig a)
forall a. a -> O a
delay (case O (Sig a) -> O (Sig a) -> Select (Sig a) (Sig a)
forall a b. O a -> O b -> Select a b
select O (Sig a)
xs O (Sig a)
ys of
                                  Fst  Sig a
xs'  O (Sig a)
d'  -> Sig a -> O (Sig a) -> Sig a
forall a. Sig a -> O (Sig a) -> Sig a
switch Sig a
xs' O (Sig a)
d'
                                  Snd  O (Sig a)
_    Sig a
d'  -> Sig a
d'
                                  Both Sig a
_    Sig a
d'  -> Sig a
d')

-- | Variant of 'switchS' that repeatedly switches. The output signal
-- @switch xs ys@ first behaves like @xs@, but whenever @ys@ produces
-- a value @f@, the signal switches to @f v@ where @v@ is the previous
-- value of the output signal. 
--
-- 'switchS' can be considered a special case of 'switchR' that only
-- makes a single switch. That is we have the following:
--
-- > switchS xs ys = switchR (delay (const (adv xs))) ys
switchR :: Stable a => Sig a -> O (Sig (a -> Sig a)) -> Sig a
switchR :: forall a. Stable a => Sig a -> O (Sig (a -> Sig a)) -> Sig a
switchR Sig a
sig O (Sig (a -> Sig a))
steps = Sig a -> O (a -> Sig a) -> Sig a
forall a. Stable a => Sig a -> O (a -> Sig a) -> Sig a
switchS Sig a
sig
      ((a -> Sig a) -> O (a -> Sig a)
forall a. a -> O a
delay (let a -> Sig a
step ::: O (Sig (a -> Sig a))
steps' = O (Sig (a -> Sig a)) -> Sig (a -> Sig a)
forall a. O a -> a
adv O (Sig (a -> Sig a))
steps in \ a
x -> Sig a -> O (Sig (a -> Sig a)) -> Sig a
forall a. Stable a => Sig a -> O (Sig (a -> Sig a)) -> Sig a
switchR (a -> Sig a
step a
x) O (Sig (a -> Sig a))
steps'))

-- | This function interleaves two signals producing a new value @v@
-- whenever either input stream produces a new value @v@. In case the
-- input signals produce a new value simultaneously, the function
-- argument is used break ties, i.e. to compute the new output value based
-- on the two new input values
--
-- Example:
--
-- >                         xs: 1 3   5 3 1 3
-- >                         ys:   0 2   4
-- >
-- > interleave (box (+)) xs ys: 1 3 2 5 7 1 3
interleave :: Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
interleave :: forall a. Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
interleave Box (a -> a -> a)
f O (Sig a)
xs O (Sig a)
ys = Sig a -> O (Sig a)
forall a. a -> O a
delay (case O (Sig a) -> O (Sig a) -> Select (Sig a) (Sig a)
forall a b. O a -> O b -> Select a b
select O (Sig a)
xs O (Sig a)
ys of
                              Fst (a
x ::: O (Sig a)
xs') O (Sig a)
ys' -> a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
forall a. Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
interleave Box (a -> a -> a)
f O (Sig a)
xs' O (Sig a)
ys'
                              Snd O (Sig a)
xs' (a
y ::: O (Sig a)
ys') -> a
y a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
forall a. Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
interleave Box (a -> a -> a)
f O (Sig a)
xs' O (Sig a)
ys'
                              Both (a
x ::: O (Sig a)
xs') (a
y ::: O (Sig a)
ys') -> Box (a -> a -> a) -> a -> a -> a
forall a. Box a -> a
unbox Box (a -> a -> a)
f a
x a
y a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
forall a. Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
interleave Box (a -> a -> a)
f O (Sig a)
xs' O (Sig a)
ys')


-- | This is the composition of 'mapAwait' and 'interleave'. That is,
-- 
-- > mapInterleave f g xs ys = mapAwait f (interleave xs ys)
mapInterleave :: Box (a -> a) -> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
mapInterleave :: forall a.
Box (a -> a)
-> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
mapInterleave Box (a -> a)
g Box (a -> a -> a)
f O (Sig a)
xs O (Sig a)
ys = Sig a -> O (Sig a)
forall a. a -> O a
delay (case O (Sig a) -> O (Sig a) -> Select (Sig a) (Sig a)
forall a b. O a -> O b -> Select a b
select O (Sig a)
xs O (Sig a)
ys of
                              Fst (a
x ::: O (Sig a)
xs') O (Sig a)
ys' -> Box (a -> a) -> a -> a
forall a. Box a -> a
unbox Box (a -> a)
g a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> a)
-> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
forall a.
Box (a -> a)
-> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
mapInterleave Box (a -> a)
g Box (a -> a -> a)
f O (Sig a)
xs' O (Sig a)
ys'
                              Snd O (Sig a)
xs' (a
y ::: O (Sig a)
ys') -> Box (a -> a) -> a -> a
forall a. Box a -> a
unbox Box (a -> a)
g a
y a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> a)
-> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
forall a.
Box (a -> a)
-> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
mapInterleave Box (a -> a)
g Box (a -> a -> a)
f O (Sig a)
xs' O (Sig a)
ys'
                              Both (a
x ::: O (Sig a)
xs') (a
y ::: O (Sig a)
ys') -> Box (a -> a) -> a -> a
forall a. Box a -> a
unbox Box (a -> a)
g (Box (a -> a -> a) -> a -> a -> a
forall a. Box a -> a
unbox Box (a -> a -> a)
f a
x a
y) a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> a)
-> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
forall a.
Box (a -> a)
-> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
mapInterleave Box (a -> a)
g Box (a -> a -> a)
f O (Sig a)
xs' O (Sig a)
ys')


{-# ANN interleaveAll AllowRecursion #-}
interleaveAll :: Box (a -> a -> a) -> List (O (Sig a)) -> O (Sig a)
interleaveAll :: forall a. Box (a -> a -> a) -> List (O (Sig a)) -> O (Sig a)
interleaveAll Box (a -> a -> a)
_ List (O (Sig a))
Nil = [Char] -> O (Sig a)
forall a. HasCallStack => [Char] -> a
error [Char]
"interleaveAll: List must be nonempty"
interleaveAll Box (a -> a -> a)
_ [Item (List (O (Sig a)))
s] = Item (List (O (Sig a)))
O (Sig a)
s
interleaveAll Box (a -> a -> a)
f (O (Sig a)
x :! List (O (Sig a))
xs) = Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
forall a. Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)
interleave Box (a -> a -> a)
f O (Sig a)
x (Box (a -> a -> a) -> List (O (Sig a)) -> O (Sig a)
forall a. Box (a -> a -> a) -> List (O (Sig a)) -> O (Sig a)
interleaveAll Box (a -> a -> a)
f List (O (Sig a))
xs)


-- | Takes two signals and updates the first signal using the
-- functions produced by the second signal:
--
-- Law:
--
-- > (xs `update` fs) `update` gs = (xs `update` (interleave (box (.)) gs fs))
update :: (Stable a) => Sig a -> O (Sig (a -> a)) -> Sig a
update :: forall a. Stable a => Sig a -> O (Sig (a -> a)) -> Sig a
update (a
x ::: O (Sig a)
xs) O (Sig (a -> a))
fs = a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Sig a -> O (Sig a)
forall a. a -> O a
delay 
    (case O (Sig a) -> O (Sig (a -> a)) -> Select (Sig a) (Sig (a -> a))
forall a b. O a -> O b -> Select a b
select O (Sig a)
xs O (Sig (a -> a))
fs of
      Fst Sig a
xs' O (Sig (a -> a))
ys' -> Sig a -> O (Sig (a -> a)) -> Sig a
forall a. Stable a => Sig a -> O (Sig (a -> a)) -> Sig a
update Sig a
xs' O (Sig (a -> a))
ys'
      Snd O (Sig a)
xs' (a -> a
f ::: O (Sig (a -> a))
fs') -> Sig a -> O (Sig (a -> a)) -> Sig a
forall a. Stable a => Sig a -> O (Sig (a -> a)) -> Sig a
update (a -> a
f a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: O (Sig a)
xs') O (Sig (a -> a))
fs'
      Both (a
x' ::: O (Sig a)
xs') (a -> a
f ::: O (Sig (a -> a))
fs') -> Sig a -> O (Sig (a -> a)) -> Sig a
forall a. Stable a => Sig a -> O (Sig (a -> a)) -> Sig a
update (a -> a
f a
x' a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: O (Sig a)
xs') O (Sig (a -> a))
fs')


-- | This function is a variant of combines the values of two signals
-- using the function argument. @zipWith f xs ys@ produces a new value
-- @unbox f x y@ whenever @xs@ or @ys@ produce a new value, where @x@
-- and @y@ are the current values of @xs@ and @ys@, respectively.
--
-- Example:
--
-- >                      xs:  1 2 3     2
-- >                      ys:  1     0 5 2
-- >
-- > zipWith (box (+)) xs ys:  2 3 4 3 8 4

zipWith :: (Stable a, Stable b) => Box(a -> b -> c) -> Sig a -> Sig b -> Sig c
zipWith :: forall a b c.
(Stable a, Stable b) =>
Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
zipWith Box (a -> b -> c)
f (a
a ::: O (Sig a)
as) (b
b ::: O (Sig b)
bs) = Box (a -> b -> c) -> a -> b -> c
forall a. Box a -> a
unbox Box (a -> b -> c)
f a
a b
b c -> O (Sig c) -> Sig c
forall a. a -> O (Sig a) -> Sig a
::: Sig c -> O (Sig c)
forall a. a -> O a
delay (
    case O (Sig a) -> O (Sig b) -> Select (Sig a) (Sig b)
forall a b. O a -> O b -> Select a b
select O (Sig a)
as O (Sig b)
bs of
      Fst Sig a
as' O (Sig b)
lbs -> Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
forall a b c.
(Stable a, Stable b) =>
Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
zipWith Box (a -> b -> c)
f Sig a
as' (b
b b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: O (Sig b)
lbs)
      Snd O (Sig a)
las Sig b
bs' -> Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
forall a b c.
(Stable a, Stable b) =>
Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
zipWith Box (a -> b -> c)
f (a
a a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: O (Sig a)
las) Sig b
bs'
      Both Sig a
as' Sig b
bs' -> Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
forall a b c.
(Stable a, Stable b) =>
Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
zipWith Box (a -> b -> c)
f Sig a
as' Sig b
bs'
  )

-- | Variant of 'zipWith' with three signals.
zipWith3 :: forall a b c d. (Stable a, Stable b, Stable c) => Box(a -> b -> c -> d) -> Sig a -> Sig b -> Sig c -> Sig d
zipWith3 :: forall a b c d.
(Stable a, Stable b, Stable c) =>
Box (a -> b -> c -> d) -> Sig a -> Sig b -> Sig c -> Sig d
zipWith3 Box (a -> b -> c -> d)
f Sig a
as Sig b
bs Sig c
cs = Box (Box (c -> d) -> c -> d)
-> Sig (Box (c -> d)) -> Sig c -> Sig d
forall a b c.
(Stable a, Stable b) =>
Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
zipWith ((Box (c -> d) -> c -> d) -> Box (Box (c -> d) -> c -> d)
forall a. a -> Box a
box (\Box (c -> d)
f c
x -> Box (c -> d) -> c -> d
forall a. Box a -> a
unbox Box (c -> d)
f c
x)) Sig (Box (c -> d))
cds Sig c
cs
  where cds :: Sig (Box (c -> d))
        cds :: Sig (Box (c -> d))
cds = Box (a -> b -> Box (c -> d))
-> Sig a -> Sig b -> Sig (Box (c -> d))
forall a b c.
(Stable a, Stable b) =>
Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
zipWith ((a -> b -> Box (c -> d)) -> Box (a -> b -> Box (c -> d))
forall a. a -> Box a
box (\a
a b
b -> (c -> d) -> Box (c -> d)
forall a. a -> Box a
box (\ c
c -> Box (a -> b -> c -> d) -> a -> b -> c -> d
forall a. Box a -> a
unbox Box (a -> b -> c -> d)
f a
a b
b c
c))) Sig a
as Sig b
bs

-- | If-then-else lifted to signals. @cond bs xs ys@ produces a stream
-- whose value is taken from @xs@ whenever @bs@ is true and from @ys@
-- otherwise.
cond :: Stable a => Sig Bool -> Sig a -> Sig a -> Sig a
cond :: forall a. Stable a => Sig Bool -> Sig a -> Sig a -> Sig a
cond = Box (Bool -> a -> a -> a) -> Sig Bool -> Sig a -> Sig a -> Sig a
forall a b c d.
(Stable a, Stable b, Stable c) =>
Box (a -> b -> c -> d) -> Sig a -> Sig b -> Sig c -> Sig d
zipWith3 ((Bool -> a -> a -> a) -> Box (Bool -> a -> a -> a)
forall a. a -> Box a
box (\Bool
b a
x a
y -> if Bool
b then a
x else a
y))


-- | This is a special case of 'zipWith' using the tupling
-- function. That is,
--
-- > zip = zipWith (box (:*))
zip :: (Stable a, Stable b) => Sig a -> Sig b -> Sig (a:*b)
zip :: forall a b. (Stable a, Stable b) => Sig a -> Sig b -> Sig (a :* b)
zip = Box (a -> b -> a :* b) -> Sig a -> Sig b -> Sig (a :* b)
forall a b c.
(Stable a, Stable b) =>
Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
zipWith ((a -> b -> a :* b) -> Box (a -> b -> a :* b)
forall a. a -> Box a
box a -> b -> a :* b
forall a b. a -> b -> a :* b
(:*))

-- | This function is a variant of 'trigger' that works on a delayed
-- input signal. To this end, 'triggerAwait' takes an additional
-- argument that is the initial value of output signal.
--
-- Example:
--
-- >                             xs:    1     0 5 2
-- >                             ys:  5 1 2 3     2
-- >
-- > triggerAwait (box (+)) 0 xy ys:  0 2 2 2 3 8 4

triggerAwait :: (Stable b, Stable c) => Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
triggerAwait :: forall b c a.
(Stable b, Stable c) =>
Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
triggerAwait Box (a -> b -> c)
f c
c O (Sig a)
as (b
b ::: O (Sig b)
bs) = c
c c -> O (Sig c) -> Sig c
forall a. a -> O (Sig a) -> Sig a
:::
    Sig c -> O (Sig c)
forall a. a -> O a
delay (case O (Sig a) -> O (Sig b) -> Select (Sig a) (Sig b)
forall a b. O a -> O b -> Select a b
select O (Sig a)
as O (Sig b)
bs of
            Fst (a
a' ::: O (Sig a)
as') O (Sig b)
bs' -> Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
forall b c a.
(Stable b, Stable c) =>
Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
triggerAwait Box (a -> b -> c)
f (Box (a -> b -> c) -> a -> b -> c
forall a. Box a -> a
unbox Box (a -> b -> c)
f a
a' b
b) O (Sig a)
as' (b
b b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: O (Sig b)
bs')
            Snd O (Sig a)
as' Sig b
bs' -> Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
forall b c a.
(Stable b, Stable c) =>
Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
triggerAwait Box (a -> b -> c)
f c
c O (Sig a)
as' Sig b
bs'
            Both (a
a' ::: O (Sig a)
as') (b
b' ::: O (Sig b)
bs') -> Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
forall b c a.
(Stable b, Stable c) =>
Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
triggerAwait Box (a -> b -> c)
f (Box (a -> b -> c) -> a -> b -> c
forall a. Box a -> a
unbox Box (a -> b -> c)
f a
a' b
b') O (Sig a)
as' (b
b' b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: O (Sig b)
bs'))


-- | This function is a variant of 'triggerAwait' that only produces a
-- value when the first signal ticks; otherwise it produces
-- @Nothing'@.
--
-- Example:
--
-- >                             xs:    1     0 5 2
-- >                             ys:  5 1 2 3     2
-- >
-- > triggerAwaitM (box plus) xy ys:    2 N N 3 8 4 where plus x y =
-- Just' (x+y)

triggerAwaitM :: Stable b => Box (a -> b -> Maybe' c) -> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
triggerAwaitM :: forall b a c.
Stable b =>
Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
triggerAwaitM Box (a -> b -> Maybe' c)
f O (Sig a)
as (b
b ::: O (Sig b)
bs) = 
    Sig (Maybe' c) -> O (Sig (Maybe' c))
forall a. a -> O a
delay (case O (Sig a) -> O (Sig b) -> Select (Sig a) (Sig b)
forall a b. O a -> O b -> Select a b
select O (Sig a)
as O (Sig b)
bs of
            Fst (a
a' ::: O (Sig a)
as') O (Sig b)
bs' -> Box (a -> b -> Maybe' c) -> a -> b -> Maybe' c
forall a. Box a -> a
unbox Box (a -> b -> Maybe' c)
f a
a' b
b Maybe' c -> O (Sig (Maybe' c)) -> Sig (Maybe' c)
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
forall b a c.
Stable b =>
Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
triggerAwaitM Box (a -> b -> Maybe' c)
f O (Sig a)
as' (b
b b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: O (Sig b)
bs')
            Snd O (Sig a)
as' Sig b
bs' -> Maybe' c
forall a. Maybe' a
Nothing' Maybe' c -> O (Sig (Maybe' c)) -> Sig (Maybe' c)
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
forall b a c.
Stable b =>
Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
triggerAwaitM Box (a -> b -> Maybe' c)
f O (Sig a)
as' Sig b
bs'
            Both (a
a' ::: O (Sig a)
as') (b
b' ::: O (Sig b)
bs') -> Box (a -> b -> Maybe' c) -> a -> b -> Maybe' c
forall a. Box a -> a
unbox Box (a -> b -> Maybe' c)
f a
a' b
b' Maybe' c -> O (Sig (Maybe' c)) -> Sig (Maybe' c)
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
forall b a c.
Stable b =>
Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
triggerAwaitM Box (a -> b -> Maybe' c)
f O (Sig a)
as' (b
b' b -> O (Sig b) -> Sig b
forall a. a -> O (Sig a) -> Sig a
::: O (Sig b)
bs'))

-- | This function is a variant of 'zipWith'. Whereas @zipWith f xs
-- ys@ produces a new value whenever @xs@ or @ys@ produce a new value,
-- @trigger f xs ys@ only produces a new value when xs produces a new
-- value, otherwise it just repeats the previous value.
--
-- Example:
--
-- >                      xs:  1     0 5 2
-- >                      ys:  1 2 3     2
-- >
-- > zipWith (box (+)) xs ys:  2 3 4 3 8 4
-- > trigger (box (+)) xy ys:  2 2 2 3 8 4

trigger :: (Stable b, Stable c) => Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
trigger :: forall b c a.
(Stable b, Stable c) =>
Box (a -> b -> c) -> Sig a -> Sig b -> Sig c
trigger Box (a -> b -> c)
f (a
a:::O (Sig a)
as) bs :: Sig b
bs@(b
b ::: O (Sig b)
_) = Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
forall b c a.
(Stable b, Stable c) =>
Box (a -> b -> c) -> c -> O (Sig a) -> Sig b -> Sig c
triggerAwait Box (a -> b -> c)
f (Box (a -> b -> c) -> a -> b -> c
forall a. Box a -> a
unbox Box (a -> b -> c)
f a
a b
b) O (Sig a)
as Sig b
bs

-- | This function is a variant of 'trigger' that only produces a
-- value when the first signal ticks; otherwise it produces
-- @Nothing'@.
--
-- Example:
--
-- >                      xs:  1     0 5 2
-- >                      ys:  1 2 3     2
-- >
-- > zipWith (box plus) xs ys:  2 3 4 3 8 4
-- > trigger (box plus) xy ys:  2 N N 3 8 4
-- where
-- > plus x y = Just' (x+y)

triggerM :: Stable b => Box (a -> b -> Maybe' c) -> Sig a -> Sig b -> Sig (Maybe' c)
triggerM :: forall b a c.
Stable b =>
Box (a -> b -> Maybe' c) -> Sig a -> Sig b -> Sig (Maybe' c)
triggerM Box (a -> b -> Maybe' c)
f (a
a:::O (Sig a)
as) bs :: Sig b
bs@(b
b ::: O (Sig b)
_) = Box (a -> b -> Maybe' c) -> a -> b -> Maybe' c
forall a. Box a -> a
unbox Box (a -> b -> Maybe' c)
f a
a b
b Maybe' c -> O (Sig (Maybe' c)) -> Sig (Maybe' c)
forall a. a -> O (Sig a) -> Sig a
::: Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
forall b a c.
Stable b =>
Box (a -> b -> Maybe' c)
-> O (Sig a) -> Sig b -> O (Sig (Maybe' c))
triggerAwaitM Box (a -> b -> Maybe' c)
f O (Sig a)
as Sig b
bs


-- Buffer takes an initial value and a signal as input and returns a signal that
-- is always one tick behind the input signal.
buffer :: Stable a => a -> Sig a -> Sig a
buffer :: forall a. Stable a => a -> Sig a -> Sig a
buffer a
x (a
y ::: O (Sig a)
ys) = a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: Sig a -> O (Sig a)
forall a. a -> O a
delay (a -> Sig a -> Sig a
forall a. Stable a => a -> Sig a -> Sig a
buffer a
y (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
ys))

-- Like buffer but works for delayed signals
bufferAwait :: Stable a => a -> O (Sig a) -> O (Sig a)
bufferAwait :: forall a. Stable a => a -> O (Sig a) -> O (Sig a)
bufferAwait a
x O (Sig a)
xs = Sig a -> O (Sig a)
forall a. a -> O a
delay (a -> Sig a -> Sig a
forall a. Stable a => a -> Sig a -> Sig a
buffer a
x (O (Sig a) -> Sig a
forall a. O a -> a
adv O (Sig a)
xs))

-- | Sampling interval (in microseconds) for the 'integral' and
-- 'derivative' functions.

dt :: Int
dt :: Int
dt = Int
20000

-- | @integral x xs@ computes the integral of the signal @xs@ with the
-- constant @x@. For example, if @xs@ is the velocity of an object,
-- the signal @integral 0 xs@ describes the distance travelled by that
-- object.
integral :: forall a v . (VectorSpace v a, Eq v, Fractional a, Stable v, Stable a)
  => v -> Sig v -> Sig v
integral :: forall a v.
(VectorSpace v a, Eq v, Fractional a, Stable v, Stable a) =>
v -> Sig v -> Sig v
integral = v -> Sig v -> Sig v
int 
  where int :: v -> Sig v -> Sig v
int v
cur (v
x ::: O (Sig v)
xs)
          | v
x v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
forall v a. VectorSpace v a => v
zeroVector = v
cur v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: Sig v -> O (Sig v)
forall a. a -> O a
delay (v -> Sig v -> Sig v
int v
cur (O (Sig v) -> Sig v
forall a. O a -> a
adv O (Sig v)
xs))
          | Bool
otherwise = v
cur v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: Sig v -> O (Sig v)
forall a. a -> O a
delay (
              case O (Sig v) -> O () -> Select (Sig v) ()
forall a b. O a -> O b -> Select a b
select O (Sig v)
xs (Int -> O ()
timer Int
dt) of
                Fst Sig v
xs' O ()
_ -> v -> Sig v -> Sig v
int v
cur Sig v
xs'
                Snd O (Sig v)
xs' ()
_ -> v -> Sig v -> Sig v
int (a
dtf a -> v -> v
forall v a. VectorSpace v a => a -> v -> v
*^ (v
cur v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^+^ v
x)) (v
x v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: O (Sig v)
xs')
                Both (v
x' ::: O (Sig v)
xs') ()
_ ->  v -> Sig v -> Sig v
int (a
dtf a -> v -> v
forall v a. VectorSpace v a => a -> v -> v
*^ (v
cur v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^+^ v
x')) (v
x'v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: O (Sig v)
xs'))
         -- sampling interval in seconds
        dtf :: a
        dtf :: a
dtf = Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dt Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000)
                
-- | Compute the derivative of a signal. For example, if @xs@ is the
-- velocity of an object, the signal @derivative xs@ describes the
-- acceleration travelled by that object.
derivative :: forall a v . (VectorSpace v a, Eq v, Fractional a, Stable v, Stable a)
  => Sig v -> Sig v
derivative :: forall a v.
(VectorSpace v a, Eq v, Fractional a, Stable v, Stable a) =>
Sig v -> Sig v
derivative Sig v
xs = v -> v -> Sig v -> Sig v
der v
forall v a. VectorSpace v a => v
zeroVector (Sig v -> v
forall a. Sig a -> a
current Sig v
xs) Sig v
xs where
  -- inverse sampling interval in seconds
  dtf :: a
  dtf :: a
dtf = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dt a -> a -> a
forall a. Num a => a -> a -> a
* a
0.000001

  der :: v -> v -> Sig v -> Sig v
  der :: v -> v -> Sig v -> Sig v
der v
d v
last (v
x:::O (Sig v)
xs)
    | v
d v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
forall v a. VectorSpace v a => v
zeroVector = v
forall v a. VectorSpace v a => v
zeroVector v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: Sig v -> O (Sig v)
forall a. a -> O a
delay
                        (let v
x' ::: O (Sig v)
xs' = O (Sig v) -> Sig v
forall a. O a -> a
adv O (Sig v)
xs
                         in v -> v -> Sig v -> Sig v
der ((v
x' v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^-^ v
x) v -> a -> v
forall v a. VectorSpace v a => v -> a -> v
^/ a
dtf) v
x (v
x' v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: O (Sig v)
xs'))
    | Bool
otherwise = v
d v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: Sig v -> O (Sig v)
forall a. a -> O a
delay (
        case O (Sig v) -> O () -> Select (Sig v) ()
forall a b. O a -> O b -> Select a b
select O (Sig v)
xs (Int -> O ()
timer Int
dt) of
          Fst Sig v
xs' O ()
_ -> v -> v -> Sig v -> Sig v
der v
d v
last Sig v
xs'
          Snd O (Sig v)
xs' ()
_ -> v -> v -> Sig v -> Sig v
der ((v
x v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^-^ v
last) v -> a -> v
forall v a. VectorSpace v a => v -> a -> v
^/ a
dtf) v
x (v
x v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: O (Sig v)
xs')
          Both (v
x' ::: O (Sig v)
xs') ()
_ ->  v -> v -> Sig v -> Sig v
der ((v
x' v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^-^ v
last) v -> a -> v
forall v a. VectorSpace v a => v -> a -> v
^/ a
dtf) v
x' (v
x' v -> O (Sig v) -> Sig v
forall a. a -> O (Sig a) -> Sig a
::: O (Sig v)
xs'))


instance Continuous a => Continuous (Sig a) where
    progressInternal :: InputValue -> Sig a -> Sig a
progressInternal InputValue
inp (a
x ::: xs :: O (Sig a)
xs@(Delay Clock
cl InputValue -> Sig a
_)) = 
        if InputValue -> Clock -> Bool
inputInClock InputValue
inp Clock
cl then (O (Sig a) -> InputValue -> Sig a
forall a. O a -> InputValue -> a
adv' O (Sig a)
xs InputValue
inp)
        else InputValue -> a -> a
forall p. Continuous p => InputValue -> p -> p
progressInternal InputValue
inp a
x a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: O (Sig a)
xs
    progressAndNext :: InputValue -> Sig a -> (Sig a, Clock)
progressAndNext InputValue
inp (a
x ::: xs :: O (Sig a)
xs@(Delay Clock
cl InputValue -> Sig a
_)) = 
        if InputValue -> Clock -> Bool
inputInClock InputValue
inp Clock
cl then let n :: Sig a
n = O (Sig a) -> InputValue -> Sig a
forall a. O a -> InputValue -> a
adv' O (Sig a)
xs InputValue
inp in (Sig a
n, Sig a -> Clock
forall p. Continuous p => p -> Clock
nextProgress Sig a
n)
        else let (a
n , Clock
cl') = InputValue -> a -> (a, Clock)
forall p. Continuous p => InputValue -> p -> (p, Clock)
progressAndNext InputValue
inp a
x in (a
n a -> O (Sig a) -> Sig a
forall a. a -> O (Sig a) -> Sig a
::: O (Sig a)
xs , Clock
cl Clock -> Clock -> Clock
`clockUnion` Clock
cl')
    nextProgress :: Sig a -> Clock
nextProgress (a
x ::: (Delay Clock
cl InputValue -> Sig a
_)) = a -> Clock
forall p. Continuous p => p -> Clock
nextProgress a
x Clock -> Clock -> Clock
`clockUnion` Clock
cl

-- Prevent functions from being inlined too early for the rewrite
-- rules to fire.

{-# NOINLINE [1] map #-}
{-# NOINLINE [1] const #-}
{-# NOINLINE [1] scan #-}
{-# NOINLINE [1] scanMap #-}
{-# NOINLINE [1] zip #-}
{-# NOINLINE [1] update #-}
{-# NOINLINE [1] switch #-}
{-# NOINLINE [1] interleave #-}
{-# NOINLINE [1] mapAwait #-}


{-# RULES

  "const/switch" forall x xs.
  switch (const x) xs = x ::: xs;

  "update/update" forall xs fs gs.
    update (update xs fs) gs = update xs (interleave (box (.)) gs fs) ;

  "const/map" forall (f :: Stable b => Box (a -> b))  x.
    map f (const x) = let x' = unbox f x in const x' ;

  "map/map" forall f g xs.
    map f (map g xs) = map (box (unbox f . unbox g)) xs ;

  "map/scan" forall f p acc as.
    map p (scan f acc as) = scanMap f p acc as ;

  "mapAwait/interleave" forall f g xs ys.
    mapAwait f (interleave g xs ys) = mapInterleave f g xs ys ;

  "zip/map" forall xs ys f.
    map f (zip xs ys) = let f' = unbox f in zipWith (box (\ x y -> f' (x :* y))) xs ys;

  "scan/scan" forall f g b c as.
    scan g c (scan f b as) =
      let f' = unbox f; g' = unbox g in
      scanMap (box (\ (b:*c) a -> let b' = f' b a in (b':* g' c b'))) (box snd') (b:*c) as ;

  "scan/scanMap" forall f g p b c as.
    scan g c (scanMap f p b as) =
      let f' = unbox f; g' = unbox g; p' = unbox p in
      scanMap (box (\ (b:*c) a -> let b' = f' (p' b) a in (b':* g' c b'))) (box snd') (b:*c) as ;

#-}