forsyde-shallow-3.4.0.0: ForSyDe's Haskell-embedded Domain Specific Language.

Copyright(c) ForSyDe Group KTH 2007-2008
LicenseBSD-style (see the file LICENSE)
Maintainerforsyde-dev@ict.kth.se
Stabilityexperimental
Portabilityportable
Safe HaskellSafe
LanguageHaskell98

ForSyDe.Shallow.MoC.Dataflow

Contents

Description

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

Constructors

Wild 
Value a 
Instances
Eq a => Eq (FiringToken a) Source # 
Instance details

Defined in ForSyDe.Shallow.MoC.Dataflow

Show a => Show (FiringToken a) Source # 
Instance details

Defined in ForSyDe.Shallow.MoC.Dataflow

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.