{-# LANGUAGE TypeFamilies, FlexibleInstances, PostfixOperators, GADTs, StandaloneDeriving #-}
{-# OPTIONS_HADDOCK hide #-}
module ForSyDe.Atom.MoC.DE.React.Core where

import ForSyDe.Atom.MoC
import ForSyDe.Atom.MoC.TimeStamp
import ForSyDe.Atom.Utility.Tuple
import Prelude hiding (until)

import Control.Concurrent
import Data.Time.Clock

-- | Type synonym for a base DE signal as a stream of 'DE' events, where the type of
-- tags has not been determined yet. In designs, it is advised to define a type alias
-- for signals, using an appropriate numerical type for tags, e.g.
--
-- > import ForSyDe.Atom.MoC.DE.React hiding (Signal) -- hide provided alias, to use your own
-- >
-- > type Signal a = SignalBase Int a
type SignalBase t a = Stream (RE t a)

-- | Convenience alias for a DE signal, where tags are represented using our exported
-- 'TimeStamp' type.
type Signal a = SignalBase TimeStamp a

-- | The reactor-like DE event, defined exactly like its 'ForSyDe.Atom.MoC.DE.DE'
-- predecessor, and identifying a discrete event signal. The type of the tag system
-- needs to satisfy all of the three properties, as suggested by the type constraints
-- imposed on it:
--
-- * it needs to be a numerical type and every representable number needs to have an
--   additive inverse.
--
-- * it needs to be unambiguously comparable (defines a total order).
--
-- * it needs to unambiguously define an equality operation.
--
-- Due to these properties not all numerical types can represent DE tags. A typical
-- example of inappropriate representation is 'Float'.
data RE t a  where
  RE :: (Num t, Ord t, Eq t)
     => { RE t a -> t
tag :: t,  -- ^ timestamp
          RE t a -> a
val :: a   -- ^ the value
        } -> RE t a
deriving instance (Num t, Ord t, Eq t, Eq t, Eq a) => Eq (RE t a)

instance (Num t, Ord t, Eq t) => MoC (RE t) where
  type Fun (RE t) a b = (Bool, [a] -> b)
  type Ret (RE t) b   = ((), [b]) 
  ---------------------
  -.- :: Fun (RE t) a b -> Stream (RE t a) -> Stream (RE t b)
(-.-) = Fun (RE t) a b -> Stream (RE t a) -> Stream (RE t b)
forall a. HasCallStack => a
undefined
  ---------------------
  (RE t :: t
t (_,f):-fs :: Stream (RE t (Fun (RE t) a b))
fs) -*- :: Stream (RE t (Fun (RE t) a b))
-> Stream (RE t a) -> Stream (RE t b)
-*- NullS   = t -> b -> RE t b
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t ([a] -> b
f [] ) RE t b -> Stream (RE t b) -> Stream (RE t b)
forall e. e -> Stream e -> Stream e
:- Stream (RE t (Fun (RE t) a b))
fs Stream (RE t (Fun (RE t) a b))
-> Stream (RE t a) -> Stream (RE t b)
forall (e :: * -> *) a b.
MoC e =>
Stream (e (Fun e a b)) -> Stream (e a) -> Stream (e b)
-*- Stream (RE t a)
forall e. Stream e
NullS
  NullS   -*- _       = Stream (RE t b)
forall e. Stream e
NullS
  (RE t :: t
t (trigger,f):-fs :: Stream (RE t (Fun (RE t) a b))
fs) -*- px :: Stream (RE t a)
px@(RE _ x :: a
x:-xs :: Stream (RE t a)
xs) 
    | Bool
trigger   = t -> b -> RE t b
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t ([a] -> b
f [a
x]) RE t b -> Stream (RE t b) -> Stream (RE t b)
forall e. e -> Stream e -> Stream e
:- Stream (RE t (Fun (RE t) a b))
fs Stream (RE t (Fun (RE t) a b))
-> Stream (RE t a) -> Stream (RE t b)
forall (e :: * -> *) a b.
MoC e =>
Stream (e (Fun e a b)) -> Stream (e a) -> Stream (e b)
-*- Stream (RE t a)
xs
    | Bool
otherwise = t -> b -> RE t b
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t ([a] -> b
f [] ) RE t b -> Stream (RE t b) -> Stream (RE t b)
forall e. e -> Stream e -> Stream e
:- Stream (RE t (Fun (RE t) a b))
fs Stream (RE t (Fun (RE t) a b))
-> Stream (RE t a) -> Stream (RE t b)
forall (e :: * -> *) a b.
MoC e =>
Stream (e (Fun e a b)) -> Stream (e a) -> Stream (e b)
-*- Stream (RE t a)
px
  ---------------------
  -* :: Stream (RE t (Ret (RE t) b)) -> Stream (RE t b)
(-*) NullS = Stream (RE t b)
forall e. Stream e
NullS
  (-*) (RE t :: t
t (_,x):-xs :: Stream (RE t (Ret (RE t) b))
xs) = [RE t b] -> Stream (RE t b)
forall a. [a] -> Stream a
stream ((b -> RE t b) -> [b] -> [RE t b]
forall a b. (a -> b) -> [a] -> [b]
map (t -> b -> RE t b
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t) [b]
x) Stream (RE t b) -> Stream (RE t b) -> Stream (RE t b)
forall e. Stream e -> Stream e -> Stream e
+-+ (Stream (RE t (Ret (RE t) b))
xs Stream (RE t (Ret (RE t) b)) -> Stream (RE t b)
forall (e :: * -> *) b.
MoC e =>
Stream (e (Ret e b)) -> Stream (e b)
-*)
  ---------------------
  (RE t :: t
t v :: a
v :- _) -<- :: Stream (RE t a) -> Stream (RE t a) -> Stream (RE t a)
-<- xs :: Stream (RE t a)
xs = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t a
v RE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:- Stream (RE t a)
xs
  ---------------------
  (RE d1 :: t
d1 _ :- RE d2 :: t
d2 _ :- _) -&- :: Stream (RE t a) -> Stream (RE t a) -> Stream (RE t a)
-&- xs :: Stream (RE t a)
xs = (\(RE t :: t
t v :: a
v) -> t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE (t
t t -> t -> t
forall a. Num a => a -> a -> a
+ t
d2 t -> t -> t
forall a. Num a => a -> a -> a
- t
d1) a
v) (RE t a -> RE t a) -> Stream (RE t a) -> Stream (RE t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream (RE t a)
xs
  (_ :- NullS) -&- _  = [Char] -> Stream (RE t a)
forall a. HasCallStack => [Char] -> a
error "[MoC.DE.RE] signal delayed to infinity"
  ---------------------
  
-- | Shows the event with tag @t@ and value @v@ as @v\@t@.
instance (Show t, Show a) => Show (RE t a) where
  showsPrec :: Int -> RE t a -> ShowS
showsPrec _ (RE t :: t
t x :: a
x) = [Char] -> ShowS
forall a. [a] -> [a] -> [a]
(++) ( a -> [Char]
forall a. Show a => a -> [Char]
show a
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ "@" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> [Char]
forall a. Show a => a -> [Char]
show t
t )

-- | Reads the string of type @v\@t@ as an event @RE t v@.
instance (Read a,Read t, Num t, Ord t, Eq t, Eq t) => Read (RE t a) where
  readsPrec :: Int -> ReadS (RE t a)
readsPrec _ x :: [Char]
x = [ (t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
tg a
val, [Char]
r2)
                  | (val :: a
val,r1 :: [Char]
r1) <- ReadS a
forall a. Read a => ReadS a
reads ReadS a -> ReadS a
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='@') [Char]
x
                  , (tg :: t
tg, r2 :: [Char]
r2) <- ReadS t
forall a. Read a => ReadS a
reads ReadS t -> ReadS t
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='@') [Char]
x ]

-- | Allows for mapping of functions on a RE event.
instance (Num t, Ord t, Eq t) => Functor (RE t) where
  fmap :: (a -> b) -> RE t a -> RE t b
fmap f :: a -> b
f (RE t :: t
t a :: a
a) = t -> b -> RE t b
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t (a -> b
f a
a)

-- | Allows for lifting functions on a pair of RE events.
instance (Num t, Ord t, Eq t) => Applicative (RE t) where
  pure :: a -> RE t a
pure = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE 0
  (RE tf :: t
tf f :: a -> b
f) <*> :: RE t (a -> b) -> RE t a -> RE t b
<*> (RE _ x :: a
x) = t -> b -> RE t b
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
tf (a -> b
f a
x)

----------------------------------------------------------------------------- 
-- These functions are not exported and are used internally.

infixl 5 -?-
infixl 5 -?

detect :: (Ord t, Num t) => SignalBase t a -> SignalBase t [Bool]
detect :: SignalBase t a -> SignalBase t [Bool]
detect = ((RE t a -> RE t [Bool]) -> SignalBase t a -> SignalBase t [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RE t a -> RE t [Bool]) -> SignalBase t a -> SignalBase t [Bool])
-> ((a -> [Bool]) -> RE t a -> RE t [Bool])
-> (a -> [Bool])
-> SignalBase t a
-> SignalBase t [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Bool]) -> RE t a -> RE t [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ([Bool] -> a -> [Bool]
forall a b. a -> b -> a
const [Bool
True])

(-?-) :: (Ord t, Num t)
      => SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
pg :: SignalBase t [Bool]
pg@(RE tg :: t
tg g :: [Bool]
g :- gs :: SignalBase t [Bool]
gs) -?- :: SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
-?- px :: SignalBase t a
px@(RE tx :: t
tx x :: a
x :- xs :: SignalBase t a
xs) 
  | t
tg t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
tx = t -> [Bool] -> RE t [Bool]
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
tg (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
g)  RE t [Bool] -> SignalBase t [Bool] -> SignalBase t [Bool]
forall e. e -> Stream e -> Stream e
:- SignalBase t [Bool]
gs SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
forall t a.
(Ord t, Num t) =>
SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
-?- SignalBase t a
xs
  | t
tg t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<  t
tx = t -> [Bool] -> RE t [Bool]
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
tg (Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
g) RE t [Bool] -> SignalBase t [Bool] -> SignalBase t [Bool]
forall e. e -> Stream e -> Stream e
:- SignalBase t [Bool]
gs SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
forall t a.
(Ord t, Num t) =>
SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
-?- SignalBase t a
px
  | t
tg t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>  t
tx = t -> [Bool] -> RE t [Bool]
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
tx (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool] -> [Bool]
forall a. [a] -> [Bool]
falsify [Bool]
g) RE t [Bool] -> SignalBase t [Bool] -> SignalBase t [Bool]
forall e. e -> Stream e -> Stream e
:- SignalBase t [Bool]
pg SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
forall t a.
(Ord t, Num t) =>
SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
-?- SignalBase t a
xs
pg :: SignalBase t [Bool]
pg@(RE tg :: t
tg g :: [Bool]
g :- gs :: SignalBase t [Bool]
gs) -?- NullS = t -> [Bool] -> RE t [Bool]
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
tg (Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
g) RE t [Bool] -> SignalBase t [Bool] -> SignalBase t [Bool]
forall e. e -> Stream e -> Stream e
:- SignalBase t [Bool]
gs SignalBase t [Bool] -> SignalBase t Any -> SignalBase t [Bool]
forall t a.
(Ord t, Num t) =>
SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
-?- SignalBase t Any
forall e. Stream e
NullS
NullS -?- px :: SignalBase t a
px@(RE tx :: t
tx x :: a
x :- xs :: SignalBase t a
xs) = t -> [Bool] -> RE t [Bool]
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
tx (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) RE t [Bool] -> SignalBase t [Bool] -> SignalBase t [Bool]
forall e. e -> Stream e -> Stream e
:- SignalBase t [Bool]
forall e. Stream e
NullS SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
forall t a.
(Ord t, Num t) =>
SignalBase t [Bool] -> SignalBase t a -> SignalBase t [Bool]
-?- SignalBase t a
xs
NullS -?- NullS = SignalBase t [Bool]
forall e. Stream e
NullS


falsify :: [a] -> [Bool]
falsify (_:xs :: [a]
xs) = Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [a] -> [Bool]
falsify [a]
xs
falsify []     = []

-? :: f (f a) -> (a -> b) -> f (f b)
(-?) s :: f (f a)
s wrap :: a -> b
wrap = ((f a -> f b) -> f (f a) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> f b) -> f (f a) -> f (f b))
-> ((a -> b) -> f a -> f b) -> (a -> b) -> f (f a) -> f (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
wrap f (f a)
s
  
-----------------------------------------------------------------------------


unit  :: (Num t, Ord t) => (t, a) -> SignalBase t a 
-- | Wraps a (tuple of) pair(s) @(tag, value)@ into the equivalent unit signal(s). A
-- unit signal is a signal with one event with the period @tag@ carrying @value@,
-- starting at tag 0.
--
-- Helpers: @unit@ and @unit[2-4]@.
unit2 :: (Num t, Ord t)
      => ((t,a1),(t, a2))
      -> (SignalBase t a1, SignalBase t a2)
unit3 :: (Num t, Ord t)
      => ((t,a1),(t, a2),(t, a3))
      -> (SignalBase t a1, SignalBase t a2, SignalBase t a3)
unit4 :: (Num t, Ord t)
      => ((t,a1),(t, a2),(t, a3),(t, a4))
      -> (SignalBase t a1, SignalBase t a2, SignalBase t a3, SignalBase t a4)

unit :: (t, a) -> SignalBase t a
unit (t :: t
t,v :: a
v) = (t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE 0 a
v RE t a -> SignalBase t a -> SignalBase t a
forall e. e -> Stream e -> Stream e
:- t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t a
v RE t a -> SignalBase t a -> SignalBase t a
forall e. e -> Stream e -> Stream e
:- SignalBase t a
forall e. Stream e
NullS)
unit2 :: ((t, a1), (t, a2)) -> (SignalBase t a1, SignalBase t a2)
unit2 = ((t, a1) -> SignalBase t a1, (t, a2) -> SignalBase t a2)
-> ((t, a1), (t, a2)) -> (SignalBase t a1, SignalBase t a2)
forall a1 b1 a2 b2. (a1 -> b1, a2 -> b2) -> (a1, a2) -> (b1, b2)
($$) ((t, a1) -> SignalBase t a1
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit,(t, a2) -> SignalBase t a2
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit)
unit3 :: ((t, a1), (t, a2), (t, a3))
-> (SignalBase t a1, SignalBase t a2, SignalBase t a3)
unit3 = ((t, a1) -> SignalBase t a1, (t, a2) -> SignalBase t a2,
 (t, a3) -> SignalBase t a3)
-> ((t, a1), (t, a2), (t, a3))
-> (SignalBase t a1, SignalBase t a2, SignalBase t a3)
forall t1 a t2 b t3 c.
(t1 -> a, t2 -> b, t3 -> c) -> (t1, t2, t3) -> (a, b, c)
($$$) ((t, a1) -> SignalBase t a1
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit,(t, a2) -> SignalBase t a2
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit,(t, a3) -> SignalBase t a3
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit)
unit4 :: ((t, a1), (t, a2), (t, a3), (t, a4))
-> (SignalBase t a1, SignalBase t a2, SignalBase t a3,
    SignalBase t a4)
unit4 = ((t, a1) -> SignalBase t a1, (t, a2) -> SignalBase t a2,
 (t, a3) -> SignalBase t a3, (t, a4) -> SignalBase t a4)
-> ((t, a1), (t, a2), (t, a3), (t, a4))
-> (SignalBase t a1, SignalBase t a2, SignalBase t a3,
    SignalBase t a4)
forall t1 a t2 b t3 c t4 d.
(t1 -> a, t2 -> b, t3 -> c, t4 -> d)
-> (t1, t2, t3, t4) -> (a, b, c, d)
($$$$) ((t, a1) -> SignalBase t a1
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit,(t, a2) -> SignalBase t a2
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit,(t, a3) -> SignalBase t a3
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit,(t, a4) -> SignalBase t a4
forall t a. (Num t, Ord t) => (t, a) -> SignalBase t a
unit)

-- | Creates a signal with an instant event at time 0.
instant :: (Num t, Ord t) => a -> SignalBase t a
instant :: a -> SignalBase t a
instant v :: a
v = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE 0 a
v RE t a -> SignalBase t a -> SignalBase t a
forall e. e -> Stream e -> Stream e
:- SignalBase t a
forall e. Stream e
NullS

-- | Transforms a list of tuples @(tag, value)@ into a RE signal. Checks if it is
-- well-formed.
signal :: (Num t, Ord t) => [(t, a)] -> SignalBase t a
signal :: [(t, a)] -> SignalBase t a
signal = SignalBase t a -> SignalBase t a
forall t a. Ord t => Stream (RE t a) -> Stream (RE t a)
checkSignal (SignalBase t a -> SignalBase t a)
-> ([(t, a)] -> SignalBase t a) -> [(t, a)] -> SignalBase t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RE t a] -> SignalBase t a
forall a. [a] -> Stream a
stream ([RE t a] -> SignalBase t a)
-> ([(t, a)] -> [RE t a]) -> [(t, a)] -> SignalBase t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((t, a) -> RE t a) -> [(t, a)] -> [RE t a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(t :: t
t, v :: a
v) -> t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t a
v)

-- | Takes the first part of the signal util a given timestamp. The last event of the
-- resulting signal is at the given timestamp and carries the previous value. This
-- utility is useful when plotting a signal, to specify the interval of plotting.
until :: (Num t, Ord t) => t -> SignalBase t a -> SignalBase t a
until :: t -> SignalBase t a -> SignalBase t a
until _ NullS = SignalBase t a
forall e. Stream e
NullS
until u :: t
u (RE t :: t
t v :: a
v:-NullS)
  | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
u     = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t a
v RE t a -> SignalBase t a -> SignalBase t a
forall e. e -> Stream e -> Stream e
:- t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
u a
v RE t a -> SignalBase t a -> SignalBase t a
forall e. e -> Stream e -> Stream e
:- SignalBase t a
forall e. Stream e
NullS
  | Bool
otherwise = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
u a
v RE t a -> SignalBase t a -> SignalBase t a
forall e. e -> Stream e -> Stream e
:- SignalBase t a
forall e. Stream e
NullS
until u :: t
u (RE t :: t
t v :: a
v:-xs :: SignalBase t a
xs)
  | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
u     = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
t a
v RE t a -> SignalBase t a -> SignalBase t a
forall e. e -> Stream e -> Stream e
:- t -> SignalBase t a -> SignalBase t a
forall t a. (Num t, Ord t) => t -> SignalBase t a -> SignalBase t a
until t
u SignalBase t a
xs
  | Bool
otherwise = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE t
u a
v RE t a -> SignalBase t a -> SignalBase t a
forall e. e -> Stream e -> Stream e
:- SignalBase t a
forall e. Stream e
NullS

-- | Reads a signal from a string and checks if it is well-formed.  Like with the
-- @read@ function from @Prelude@, you must specify the type of the signal.
--
-- >>> readSignal "{ 1@0, 2@2, 3@5, 4@7, 5@10 }" :: Signal Int
-- {1@0s,2@2s,3@5s,4@7s,5@10s}
-- >>> readSignal "{ 1@1, 2@2, 3@5, 4@7, 5@10 }" :: Signal Int
-- {1@1s,2@2s,3@5s,4@7s,5@10s}
--
-- Incorrect usage (not covered by @doctest@):
--
-- > λ> readSignal "{ 1@0, 2@2, 3@5, 4@10, 5@7 }" :: Signal Int
-- > {1@0s,2@2s,3@5s*** Exception: [MoC.RE] malformed signal
readSignal :: (Num t, Ord t, Read t, Read a) => String -> SignalBase t a
readSignal :: [Char] -> SignalBase t a
readSignal s :: [Char]
s = SignalBase t a -> SignalBase t a
forall t a. Ord t => Stream (RE t a) -> Stream (RE t a)
checkSignal (SignalBase t a -> SignalBase t a)
-> SignalBase t a -> SignalBase t a
forall a b. (a -> b) -> a -> b
$ [Char] -> SignalBase t a
forall a. Read a => [Char] -> a
read [Char]
s

-- | Checks if a signal is well-formed or not, according to the RE MoC
-- interpretation in ForSyDe-Atom.
checkSignal :: Stream (RE t a) -> Stream (RE t a)
checkSignal NullS      = Stream (RE t a)
forall e. Stream e
NullS
checkSignal (x :: RE t a
x:-NullS) = (RE t a
xRE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:-Stream (RE t a)
forall e. Stream e
NullS)
checkSignal (x :: RE t a
x:-y :: RE t a
y:-xs :: Stream (RE t a)
xs) | RE t a -> t
forall t a. RE t a -> t
tag RE t a
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< RE t a -> t
forall t a. RE t a -> t
tag RE t a
y = RE t a
x RE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:-Stream (RE t a) -> Stream (RE t a)
checkSignal (RE t a
yRE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:-Stream (RE t a)
xs)
                       | Bool
otherwise = [Char] -> Stream (RE t a)
forall a. HasCallStack => [Char] -> a
error "[MoC.DE.RE] malformed signal"

-----------------------------------------------------------------------------

fromList1 :: [a] -> a
fromList1 (a1 :: a
a1:_)                      = a
a1
fromList2 :: [b] -> (b, b)
fromList2 (a1 :: b
a1:a2 :: b
a2:_)                   = (b
a2,b
a1)
fromList3 :: [c] -> (c, c, c)
fromList3 (a1 :: c
a1:a2 :: c
a2:a3 :: c
a3:_)                = (c
a3,c
a2,c
a1)
fromList4 :: [d] -> (d, d, d, d)
fromList4 (a1 :: d
a1:a2 :: d
a2:a3 :: d
a3:a4 :: d
a4:_)             = (d
a4,d
a3,d
a2,d
a1)
fromList5 :: [e] -> (e, e, e, e, e)
fromList5 (a1 :: e
a1:a2 :: e
a2:a3 :: e
a3:a4 :: e
a4:a5 :: e
a5:_)          = (e
a5,e
a4,e
a3,e
a2,e
a1)
fromList6 :: [f] -> (f, f, f, f, f, f)
fromList6 (a1 :: f
a1:a2 :: f
a2:a3 :: f
a3:a4 :: f
a4:a5 :: f
a5:a6 :: f
a6:_)       = (f
a6,f
a5,f
a4,f
a3,f
a2,f
a1)
fromList7 :: [g] -> (g, g, g, g, g, g, g)
fromList7 (a1 :: g
a1:a2 :: g
a2:a3 :: g
a3:a4 :: g
a4:a5 :: g
a5:a6 :: g
a6:a7 :: g
a7:_)    = (g
a7,g
a6,g
a5,g
a4,g
a3,g
a2,g
a1)
fromList8 :: [h] -> (h, h, h, h, h, h, h, h)
fromList8 (a1 :: h
a1:a2 :: h
a2:a3 :: h
a3:a4 :: h
a4:a5 :: h
a5:a6 :: h
a6:a7 :: h
a7:a8 :: h
a8:_) = (h
a8,h
a7,h
a6,h
a5,h
a4,h
a3,h
a2,h
a1)
li1 :: (t -> t) -> [t] -> t
li1 f :: t -> t
f [x :: t
x] = t -> t
f t
x

-----------------------------------------------------------------------------


-- | Simulates a signal, calling delays according to the timestamps.
simulate :: (Num t, Ord t, Eq t, Show t, Real t, Show a)
         => t -> SignalBase t a -> IO ()
simulate :: t -> SignalBase t a -> IO ()
simulate t :: t
t = SignalBase t a -> IO ()
forall a a. (Show a, Show a, Real a) => Stream (RE a a) -> IO ()
execute (SignalBase t a -> IO ())
-> (SignalBase t a -> SignalBase t a) -> SignalBase t a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> SignalBase t a -> SignalBase t a
forall t a. (Num t, Ord t) => t -> SignalBase t a -> SignalBase t a
until t
t
  where
    execute :: Stream (RE a a) -> IO ()
execute NullS = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    execute (x :: RE a a
x:-NullS) = do
      [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show (RE a a -> a
forall t a. RE t a -> t
tag RE a a
x) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ "\t" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show (RE a a -> a
forall t a. RE t a -> a
val RE a a
x)
      Int -> IO ()
threadDelay 1000000
    execute (x :: RE a a
x:-y :: RE a a
y:-xs :: Stream (RE a a)
xs) = do
      [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show (RE a a -> a
forall t a. RE t a -> t
tag RE a a
x) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ "\t" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show (RE a a -> a
forall t a. RE t a -> a
val RE a a
x)
      let tsx :: Integer
tsx = DiffTime -> Integer
diffTimeToPicoseconds (DiffTime -> Integer) -> DiffTime -> Integer
forall a b. (a -> b) -> a -> b
$ a -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RE a a -> a
forall t a. RE t a -> t
tag RE a a
x)
          tsy :: Integer
tsy = DiffTime -> Integer
diffTimeToPicoseconds (DiffTime -> Integer) -> DiffTime -> Integer
forall a b. (a -> b) -> a -> b
$ a -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RE a a -> a
forall t a. RE t a -> t
tag RE a a
y)
          dly :: Int
dly = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ (Integer
tsy Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
tsx) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 1000000
      Int -> IO ()
threadDelay Int
dly
      Stream (RE a a) -> IO ()
execute (RE a a
yRE a a -> Stream (RE a a) -> Stream (RE a a)
forall e. e -> Stream e -> Stream e
:-Stream (RE a a)
xs)