Copyright | (c) ForSyDe Group KTH 2007-2008 |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | forsyde-dev@ict.kth.se |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell98 |
The dataflow library defines data types, process constructors and functions to model dataflow process networks, as described by Lee and Parks in Dataflow process networks, IEEE Proceedings, 1995 ([LeeParks95]).
Each process is defined by a set of firing rules and corresponding actions. A process fires, if the incoming signals match a firing rule. Then the process consumes the matched tokens and executes the action corresponding to the firing rule.
Synopsis
- data FiringToken a
- mapDF :: Eq a => [[FiringToken a]] -> (Signal a -> [[b]]) -> Signal a -> Signal b
- zipWithDF :: (Eq a, Eq b) => [([FiringToken b], [FiringToken a])] -> (Signal b -> Signal a -> [[c]]) -> Signal b -> Signal a -> Signal c
- zipWith3DF :: (Eq a, Eq b, Eq c) => [([FiringToken a], [FiringToken b], [FiringToken c])] -> (Signal a -> Signal b -> Signal c -> [[d]]) -> Signal a -> Signal b -> Signal c -> Signal d
- scanlDF :: (Eq a, Eq b) => [(FiringToken b, [FiringToken a])] -> (b -> Signal a -> [b]) -> b -> Signal a -> Signal b
- mooreDF :: (Eq a, Eq b) => [(FiringToken b, [FiringToken a])] -> (b -> Signal a -> [b]) -> (b -> [c]) -> b -> Signal a -> Signal c
- mealyDF :: (Eq a, Eq b) => [(FiringToken b, [FiringToken a])] -> (b -> Signal a -> [b]) -> (b -> Signal a -> [[c]]) -> b -> Signal a -> Signal c
Data Types
The data type FiringToken
defines the data type for tokens. The
constructor Wild
constructs a token wildcard, the constructor
Value a
constructs a token with value a
.
A sequence (pattern) matches a signal, if the sequence is a prefix of the signal. The following list illustrates the firing rules:
- [⊥] matches always (NullS in ForSyDe)
- [*] matches signal with at least one token ([Wild] in ForSyDe)
- [v] matches signal with v as its first value ([Value v] in ForSyDe)
- [*,*] matches signals with at least two tokens ([Wild,Wild] in ForSyDe)
data FiringToken a Source #
Instances
Eq a => Eq (FiringToken a) Source # | |
Defined in ForSyDe.Shallow.MoC.Dataflow (==) :: FiringToken a -> FiringToken a -> Bool # (/=) :: FiringToken a -> FiringToken a -> Bool # | |
Show a => Show (FiringToken a) Source # | |
Defined in ForSyDe.Shallow.MoC.Dataflow showsPrec :: Int -> FiringToken a -> ShowS # show :: FiringToken a -> String # showList :: [FiringToken a] -> ShowS # |
Combinational Process Constructors
Combinatorial processes do not have an internal state. This means, that the output signal only depends on the input signals.
To illustrate the concept of data flow processes, we create a process that selects tokens from two inputs according to a control signal.
The process has the following firing rules [LeeParks95]:
- R1 = {[*], ⊥, [T]}
- R2 = {⊥, [*], [F]}
The corresponding ForSyDe formulation of the firing rules is:
selectRules = [ ([Wild], [], [Value True]), ([], [Wild], [Value False]) ]
For the output we formulate the following set of output functions:
selectOutput xs ys _ = [ [headS xs], [headS ys] ]
The select process selectDF is then defined by:
selectDF :: Eq a => Signal a -> Signal a -> Signal Bool -> Signal a selectDF = zipWith3DF selectRules selectOutput
Given the signals s1, s2 and s3
s1 = signal [1,2,3,4,5,6] s2 = signal [7,8,9,10,11,12] s3 = signal [True, True, False, False, True, True]
the executed process gives the following results:
DataflowLib> selectDF s1 s2 s3 {1,2,7,8,3,4} :: Signal Integer
The library contains the following combinational process constructors:
mapDF :: Eq a => [[FiringToken a]] -> (Signal a -> [[b]]) -> Signal a -> Signal b Source #
The process constructor mapDF
takes a list of firing rules, a
list of corresponding output functions and generates a data flow
process with one input and one output signal.
zipWithDF :: (Eq a, Eq b) => [([FiringToken b], [FiringToken a])] -> (Signal b -> Signal a -> [[c]]) -> Signal b -> Signal a -> Signal c Source #
The process constructors zipWithDF
takes a list of firing rules,
a list of corresponding output functions to generate a data flow
process with two input signals and one output signal.
zipWith3DF :: (Eq a, Eq b, Eq c) => [([FiringToken a], [FiringToken b], [FiringToken c])] -> (Signal a -> Signal b -> Signal c -> [[d]]) -> Signal a -> Signal b -> Signal c -> Signal d Source #
The process constructors zipWith3DF
takes a list of firing
rules, a list of corresponding output functions to generate a data
flow process with three input signals and one output signal.
Sequential Process Constructors
Sequential processes have an internal state. This means, that the output signal may depend internal state and on the input signal.
As an example we can view a process calculating the running sum of the input tokens. It has only one firing rule, which is illustrated below.
Firing Rule Next State Output ------------------------------------ (*,[*]) state + x {state}
A dataflow process using these firing rules and the initial state 0 can be formulated in ForSyDe as
rs xs = mealyDF firingRule nextState output initState xs where firingRule = [(Wild, [Wild])] nextState state xs = [(state + headS xs)] output state _ = [[state]] initState = 0
Execution of the process gives
DataflowLib> rs (signal[1,2,3,4,5,6]) {0,1,3,6,10,15} :: Signal Integer
Another 'running sum' process rs2 takes two tokens, pushes them into a queue of five elements and calculates the sum as output.
rs2 = mealyDF fs ns o init where init = [0,0,0,0,0] fs = [(Wild, ([Wild, Wild]))] ns state xs = [drop 2 state ++ fromSignal (takeS 2 xs)] o state _ = [[(sum state)]]
Execution of the process gives
DataflowLib>rs2 (signal [1,2,3,4,5,6,7,8,9,10]) {0,3,10,20,30} :: Signal Integer
scanlDF :: (Eq a, Eq b) => [(FiringToken b, [FiringToken a])] -> (b -> Signal a -> [b]) -> b -> Signal a -> Signal b Source #
The process constructor scanlDF
implements a finite state
machine without output decoder in the ForSyDe methodology. It takes
a set of firing rules and a set of corresponding next state
functions as arguments. A firing rule is a tuple. The first value
is a pattern for the state, the second value corresponds to an
input pattern. When a pattern matches, the process fires, the
corresponding next state is executed, and the tokens matching the
pattern are consumed.
mooreDF :: (Eq a, Eq b) => [(FiringToken b, [FiringToken a])] -> (b -> Signal a -> [b]) -> (b -> [c]) -> b -> Signal a -> Signal c Source #
The process constructor mooreDF
implements a Moore finite state
machine in the ForSyDe methodology. It takes a set of firing rules,
a set of corresponding next state functions and a set of output
functions as argument. A firing rule is a tuple. The first value is
a pattern for the state, the second value corresponds to an input
pattern. When a pattern matches, the process fires, the
corresponding next state and output functions are executed, and the
tokens matching the pattern are consumed.
mealyDF :: (Eq a, Eq b) => [(FiringToken b, [FiringToken a])] -> (b -> Signal a -> [b]) -> (b -> Signal a -> [[c]]) -> b -> Signal a -> Signal c Source #
The process constructor mealyDF
implements the most general
state machine in the ForSyDe methodology. It takes a set of firing
rules, a set of corresponding next state functions and a set of
output functions as argument. A firing rule is a tuple. The first
value is a pattern for the state, the second value corresponds to
an input pattern. When a pattern matches, the process fires, the
corresponding next state and output functions are executed, and the
tokens matching the pattern are consumed.