----------------------------------------------------------------------------- -- | -- 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)