ForSyDe-3.0: src/ForSyDe/Shallow/UntimedLib.hs
-----------------------------------------------------------------------------
-- |
-- Module : ForSyDe.Shallow.UntimedLib
-- Copyright : (c) SAM Group, KTH/ICT/ECS 2007-2008
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : forsyde-dev@ict.kth.se
-- Stability : experimental
-- Portability : portable
--
-- The untimed library defines process constructors and processes for
-- the untimed computational model. A process constructor is a higher
-- order function which together with combinational function(s) and
-- values as arguments constructs a process.
-----------------------------------------------------------------------------
module ForSyDe.Shallow.UntimedLib(
-- * Combinational process constructors
-- | Combinational process constructors are used for processes that do not have a state.
combU, comb2U, comb2UC,
mapU,
-- * Sequential process constructors
-- | Sequential process constructors are used for processes that have a state. One of the input parameters is the initial state.
scanU, mealyU, mooreU, sourceU, sinkU, initU,
-- * Zipping and unzipping signals
zipU, zipUs,
zipWithU, zipWith3U, zipWith4U,
unzipU
)
where
import ForSyDe.Shallow.CoreLib
----------------------------------------
-- --
-- COMBINATIONAL PROCESS CONSTRUCTORS --
-- --
----------------------------------------
combU :: Int -> ([a] -> [b]) -> Signal a -> Signal b
combU = mapU
comb2U :: Int -> Int -> ([a]->[b]->[c]) -> Signal a -> Signal b -> Signal c
comb2U = zipWithU
comb2UC :: Int -> (a->[b]->[c]) -> Signal a -> Signal b -> Signal c
comb2UC = zipWithUC
-- | The first parameter of 'mapU' is a constant integer defining the number of tokens consumed in every evaluation cycle. The second argument is a function on lists of the input type and returning a list of the output type. For instance,
--
-- > r2 = mapU 1 f
-- > where f :: [Int] -> [Int]
-- > f [x] = [2*x]
--
-- defines a process r2 which consumes one token in each evaluation cycle and multiplies it by two.
mapU :: Int -> ([a] -> [b]) -> Signal a -> Signal b
mapU _ _ NullS = NullS
mapU c f xs | lengthS (takeS c xs) < c = NullS
| otherwise
= signal (f (takeL c xs)) +-+ (mapU c f (dropS c xs))
--mapUC :: Int -> ([a] -> b) -> Signal a -> Signal b
--mapUC _ _ NullS = NullS
--mapUC c f xs | lengthS (takeS c xs) < c = NullS
-- | otherwise
-- = signal [(f (takeL c xs))] +-+ (mapUC c f (dropS c xs))
---------------------------
-- --
-- SYNCHRONOUS PROCESSES --
-- --
---------------------------
-- | 'scanU' has an internal state which is visible at the output. The first argument is a function \'gamma\' which, given the state returns the number of tokens consumed next. The second argument is the next state function and the third is the initial state.
scanU :: (b->Int) -> (b->[a]->b) -> b -> Signal a -> Signal b
scanU _ _ _ NullS = NullS
scanU gamma g state xs
| length as == c = newstate :- scanU gamma g newstate (dropS c xs)
| otherwise = NullS
where c = gamma state
as = takeL c xs
newstate = g state as
-- | The process constructor 'mooreU' creates a state machine of Moore type. In addition to the next state function they also have an output encoding function. The output depends directly on the internal state.
mooreU :: (b->Int) -> (b->[a]->b) -> (b -> [c]) -> b -> Signal a -> Signal c
mooreU _ _ _ _ NullS = NullS
mooreU gamma g f state xs
| length as == c = (signal bs) +-+ mooreU gamma g f newstate (dropS c xs)
| otherwise = NullS
where c = gamma state
as = takeL c xs
newstate = g state as
bs = f state
-- | The process constructor 'mealyU' creates a state machine of Moore type. In addition to the next state function they also have an output encoding function. The output depends directly on the internal state.
mealyU :: (b->Int) -> (b->[a]->b) -> (b -> [a] -> [c]) -> b
-> Signal a -> Signal c
mealyU _ _ _ _ NullS = NullS
mealyU gamma g f state xs
| length as == c = (signal bs)
+-+ mealyU gamma g f newstate (dropS c xs)
| otherwise = NullS
where c = gamma state
as = takeL c xs
newstate = g state as
bs = f state as
zipU :: Signal (Int,Int) -> Signal a -> Signal b -> Signal ([a],[b])
zipU NullS _ _ = NullS
zipU _ NullS _ = NullS
zipU _ _ NullS = NullS
zipU ((c1,c2):-cs) xs ys
| lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2
= (takeL c1 xs,takeL c2 ys) :- zipU cs (dropS c1 xs) (dropS c2 ys)
| otherwise = NullS
zipUs :: Int -> Int -> Signal a -> Signal b -> Signal ([a],[b])
zipUs _ _ NullS _ = NullS
zipUs _ _ _ NullS = NullS
zipUs c1 c2 xs ys
| lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2
= (takeL c1 xs,takeL c2 ys)
:- zipUs c1 c2 (dropS c1 xs) (dropS c2 ys)
| otherwise = NullS
zipWithU :: Int -> Int -> ([a]->[b]->[c]) -> Signal a -> Signal b -> Signal c
zipWithU _ _ _ NullS _ = NullS
zipWithU _ _ _ _ NullS = NullS
zipWithU c1 c2 f xs ys
| lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2
= signal (f (takeL c1 xs) (takeL c2 ys))
+-+ zipWithU c1 c2 f (dropS c1 xs) (dropS c2 ys)
| otherwise = NullS
zipWithUC :: Int -> (a->[b]->[c]) -> Signal a -> Signal b -> Signal c
zipWithUC _ _ NullS _ = NullS
zipWithUC _ _ _ NullS = NullS
zipWithUC c1 f xs ys
| lengthS (takeS 1 xs) == 1 && lengthS (takeS c1 ys) == c1
= signal (f (headS xs) (takeL c1 ys))
+-+ zipWithUC c1 f (tailS xs) (dropS c1 ys)
| otherwise = NullS
zipWith3U :: Int -> Int -> Int -> ([a]->[b]->[c]->[d]) -> Signal a -> Signal b -> Signal c -> Signal d
zipWith3U _ _ _ _ NullS _ _ = NullS
zipWith3U _ _ _ _ _ NullS _ = NullS
zipWith3U _ _ _ _ _ _ NullS = NullS
zipWith3U c1 c2 c3 f xs ys zs
| lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2 && lengthS (takeS c3 zs) == c3
= signal (f (takeL c1 xs) (takeL c2 ys) (takeL c3 zs))
+-+ zipWith3U c1 c2 c3 f (dropS c1 xs) (dropS c2 ys) (dropS c3 zs)
| otherwise = NullS
zipWith4U :: Int -> Int -> Int -> Int -> ([a]->[b]->[c]->[d]->[e]) ->
Signal a -> Signal b -> Signal c -> Signal d -> Signal e
zipWith4U _ _ _ _ _ NullS _ _ _= NullS
zipWith4U _ _ _ _ _ _ NullS _ _ = NullS
zipWith4U _ _ _ _ _ _ _ NullS _ = NullS
zipWith4U _ _ _ _ _ _ _ _ NullS = NullS
zipWith4U c1 c2 c3 c4 f xs ys zs as
| lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2
&& lengthS (takeS c3 zs) == c3 && lengthS (takeS c4 as) == c4
= signal (f (takeL c1 xs) (takeL c2 ys) (takeL c3 zs) (takeL c4 as))
+-+ zipWith4U c1 c2 c3 c4 f (dropS c1 xs) (dropS c2 ys) (dropS c3 zs) (dropS c4 as)
| otherwise = NullS
unzipU :: Signal ([a],[b]) -> (Signal a,Signal b)
unzipU NullS = (NullS,NullS)
unzipU ((as,bs):-xs) = (signal as +-+ ass,
signal bs +-+ bss)
where (ass,bss) = unzipU xs
sourceU :: (a->a) -> a -> Signal a
sourceU g state = newstate :- sourceU g newstate
where newstate = g state
sinkU :: (a->Int) -> (a->a) -> a -> Signal b -> Signal b
sinkU _ _ _ NullS = NullS
sinkU gamma g state xs
| length as == c = sinkU gamma g newstate (dropS c xs)
| otherwise = NullS
where as = takeL c xs
c = gamma state
newstate = g state
-- | 'initU' is used to initialise a signal. Its first argument is prepended to its second argument, a signal.
initU :: [a] -> Signal a -> Signal a
initU initial s = (signal initial) +-+ s
takeL :: Int -> Signal a -> [a]
takeL c = fromSignal . (takeS c)