ForSyDe-3.0: ForSyDe's Haskell-embedded Domain Specific Language.Source codeContentsIndex
ForSyDe.Process.SynchProc
Portabilitynon-portable (Template Haskell)
Stabilityexperimental
Maintainerforsyde-dev@ict.kth.se
Contents
Combinational process constructors
Sequential process constructors
Synchronous Processes
Description
This module provides the synchronous process constructors of ForSyDe and some useful synchronous processes.
Synopsis
constSY :: ProcType a => ProcId -> a -> Signal a
mapSY :: forall a b. (ProcType a, ProcType b) => ProcId -> ProcFun (a -> b) -> Signal a -> Signal b
zipWithSY :: forall a b c. (ProcType a, ProcType b, ProcType c) => ProcId -> ProcFun (a -> b -> c) -> Signal a -> Signal b -> Signal c
zipWith3SY :: forall a b c d. (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> ProcFun (a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d
zipWith4SY :: forall a b c d e. (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e) => ProcId -> ProcFun (a -> b -> c -> d -> e) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e
zipWith5SY :: forall a b c d e f. (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e, ProcType f) => ProcId -> ProcFun (a -> b -> c -> d -> e -> f) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f
zipWith6SY :: forall a b c d e f g. (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e, ProcType f, ProcType g) => ProcId -> ProcFun (a -> b -> c -> d -> e -> f -> g) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal g
zipWithxSY :: forall s a b. (Nat s, Typeable s, ProcType a, ProcType b) => ProcId -> ProcFun (FSVec s a -> b) -> FSVec s (Signal a) -> Signal b
delaySY :: ProcType a => ProcId -> a -> Signal a -> Signal a
delaynSY :: ProcType a => ProcId -> a -> Int -> Signal a -> Signal a
scanlSY :: (ProcType a, ProcType b) => ProcId -> ProcFun (a -> b -> a) -> a -> Signal b -> Signal a
scanl2SY :: (ProcType a, ProcType b, ProcType c) => ProcId -> ProcFun (a -> b -> c -> a) -> a -> Signal b -> Signal c -> Signal a
scanl3SY :: (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> ProcFun (a -> b -> c -> d -> a) -> a -> Signal b -> Signal c -> Signal d -> Signal a
scanldSY :: (ProcType a, ProcType b) => ProcId -> ProcFun (a -> b -> a) -> a -> Signal b -> Signal a
scanld2SY :: (ProcType a, ProcType b, ProcType c) => ProcId -> ProcFun (a -> b -> c -> a) -> a -> Signal b -> Signal c -> Signal a
scanld3SY :: (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> ProcFun (a -> b -> c -> d -> a) -> a -> Signal b -> Signal c -> Signal d -> Signal a
mooreSY :: (ProcType a, ProcType b, ProcType c) => ProcId -> ProcFun (a -> b -> a) -> ProcFun (a -> c) -> a -> Signal b -> Signal c
moore2SY :: (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> ProcFun (a -> b -> c -> a) -> ProcFun (a -> d) -> a -> Signal b -> Signal c -> Signal d
moore3SY :: (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e) => ProcId -> ProcFun (a -> b -> c -> d -> a) -> ProcFun (a -> e) -> a -> Signal b -> Signal c -> Signal d -> Signal e
mealySY :: (ProcType a, ProcType b, ProcType c) => ProcId -> ProcFun (a -> b -> a) -> ProcFun (a -> b -> c) -> a -> Signal b -> Signal c
mealy2SY :: (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> ProcFun (a -> b -> c -> a) -> ProcFun (a -> b -> c -> d) -> a -> Signal b -> Signal c -> Signal d
mealy3SY :: (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e) => ProcId -> ProcFun (a -> b -> c -> d -> a) -> ProcFun (a -> b -> c -> d -> e) -> a -> Signal b -> Signal c -> Signal d -> Signal e
sourceSY :: ProcType a => ProcId -> ProcFun (a -> a) -> a -> Signal a
filterSY :: ProcType a => ProcId -> ProcFun (a -> Bool) -> Signal a -> Signal (AbstExt a)
fillSY :: ProcType a => ProcId -> a -> Signal (AbstExt a) -> Signal a
holdSY :: ProcType a => ProcId -> a -> Signal (AbstExt a) -> Signal a
whenSY :: (ProcType a, ProcType b) => ProcId -> Signal (AbstExt a) -> Signal (AbstExt b) -> Signal (AbstExt a)
zipSY :: (ProcType a, ProcType b) => ProcId -> Signal a -> Signal b -> Signal (a, b)
zip3SY :: (ProcType a, ProcType b, ProcType c) => ProcId -> Signal a -> Signal b -> Signal c -> Signal (a, b, c)
zip4SY :: (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> Signal a -> Signal b -> Signal c -> Signal d -> Signal (a, b, c, d)
zip5SY :: (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e) => ProcId -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal (a, b, c, d, e)
zip6SY :: (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e, ProcType f) => ProcId -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal (a, b, c, d, e, f)
unzipSY :: forall a b. (ProcType a, ProcType b) => ProcId -> Signal (a, b) -> (Signal a, Signal b)
unzip3SY :: forall a b c. (ProcType a, ProcType b, ProcType c) => ProcId -> Signal (a, b, c) -> (Signal a, Signal b, Signal c)
unzip4SY :: forall a b c d. (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> Signal (a, b, c, d) -> (Signal a, Signal b, Signal c, Signal d)
unzip5SY :: forall a b c d e. (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e) => ProcId -> Signal (a, b, c, d, e) -> (Signal a, Signal b, Signal c, Signal d, Signal e)
unzip6SY :: forall a b c d e f. (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e, ProcType f) => ProcId -> Signal (a, b, c, d, e, f) -> (Signal a, Signal b, Signal c, Signal d, Signal e, Signal f)
zipxSY :: (Nat s, Typeable s, ProcType a) => ProcId -> FSVec s (Signal a) -> Signal (FSVec s a)
unzipxSY :: forall s a. (Typeable s, Nat s, ProcType a) => ProcId -> Signal (FSVec s a) -> FSVec s (Signal a)
mapxSY :: (Nat s, ProcType a, ProcType b) => ProcId -> ProcFun (a -> b) -> FSVec s (Signal a) -> FSVec s (Signal b)
fstSY :: (ProcType a, ProcType b) => ProcId -> Signal (a, b) -> Signal a
sndSY :: (ProcType a, ProcType b) => ProcId -> Signal (a, b) -> Signal b
groupSY :: forall k a. (Nat k, Typeable k, ProcType a) => ProcId -> k -> Signal a -> Signal (AbstExt (FSVec k a))
Combinational process constructors
Combinational process constructors are used for processes that do not have a state.
constSYSource
:: ProcType a
=> ProcIdIdentifier of the process
-> aValue to output
-> Signal aResulting output signal
Creates a constant process. A process which outputs the same signal value in every clock cycle.
mapSYSource
:: forall a b . (ProcType a, ProcType b)
=> ProcIdIdentifier of the process
-> ProcFun (a -> b)Function applied to the input signal in every cycle
-> Signal aInput Signal
-> Signal bOutput Signal
The process constructor mapSY takes an identifier and a combinational function as arguments and returns a process with one input signal and one output signal.
zipWithSYSource
:: forall a b c . (ProcType a, ProcType b, ProcType c)
=> ProcIdIdentifier of the process
-> ProcFun (a -> b -> c)Function applied to the input signals in every cycle
-> Signal aFirst input Signal
-> Signal bSecond input Signal
-> Signal cOutput Signal
The process constructor zipWithSY takes an identifier and a combinational function as arguments and returns a process with two input signals and one output signal.
zipWith3SYSource
:: forall a b c d . (ProcType a, ProcType b, ProcType c, ProcType d)
=> ProcIdIdentifier of the process
-> ProcFun (a -> b -> c -> d)Function applied to the input signals in every cycle
-> Signal aFirst input Signal
-> Signal bSecond input Signal
-> Signal cThird input Signal
-> Signal dOutput Signal
The process constructor zipWith3SY takes an identifier and a combinational function as arguments and returns a process with three input signals and one output signal.
zipWith4SYSource
:: forall a b c d e . (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e)
=> ProcIdIdentifier of the process
-> ProcFun (a -> b -> c -> d -> e)Function applied to the input signals in every cycle
-> Signal aFirst input Signal
-> Signal bSecond input Signal
-> Signal cThird input Signal
-> Signal dFourth input Signal
-> Signal eOutput Signal
The process constructor zipWith4SY takes an identifier and a combinational function as arguments and returns a process with four input signals and one output signal.
zipWith5SYSource
:: forall a b c d e f . (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e, ProcType f)
=> ProcIdIdentifier of the process
-> ProcFun (a -> b -> c -> d -> e -> f)Function applied to the input signals in every cycle
-> Signal aFirst input Signal
-> Signal bSecond input Signal
-> Signal cThird input Signal
-> Signal dFourth input Signal
-> Signal eFifth input Signal
-> Signal fOutput Signal
The process constructor zipWith5SY takes an identifier and a combinational function as arguments and returns a process with five input signals and one output signal.
zipWith6SYSource
:: forall a b c d e f g . (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e, ProcType f, ProcType g)
=> ProcIdIdentifier of the process
-> ProcFun (a -> b -> c -> d -> e -> f -> g)Function applied to the input signals in every cycle
-> Signal aFirst input Signal
-> Signal bSecond input Signal
-> Signal cThird input Signal
-> Signal dFourth input Signal
-> Signal eFifth input Signal
-> Signal fSixth input Signal
-> Signal gOutput Signal
The process constructor zipWith6SY takes an identifier and a combinational function as arguments and returns a process with five input signals and one output signal.
zipWithxSY :: forall s a b. (Nat s, Typeable s, ProcType a, ProcType b) => ProcId -> ProcFun (FSVec s a -> b) -> FSVec s (Signal a) -> Signal bSource
The process constructor zipWithxSY works as zipWithSY, but takes a vector of signals as input.
Sequential process constructors
Sequential process constructors are used for processes that have a state. One of the input parameters is the initial state.
delaySYSource
:: ProcType a
=> ProcIdIdentifier of the process
-> aInitial value
-> Signal aSignal to be delayed
-> Signal aResulting delayed Signal
The process constructor delaySY delays the signal one event cycle by introducing an initial value at the beginning of the output signal. Note, that this implies that there is one event (the first) at the output signal that has no corresponding event at the input signal. One could argue that input and output signals are not fully synchronized, even though all input events are synchronous with a corresponding output event. However, this is necessary to initialize feed-back loops.
delaynSYSource
:: ProcType a
=> ProcIdIdentifier
-> aInitial state
-> IntNumber of Delay cycles
-> Signal aInput signal
-> Signal aOutput signal
The process constructor delaynSY delays the signal n events by introducing n identical default values. It creates a chain of delaySY processes.
scanlSYSource
:: (ProcType a, ProcType b)
=> ProcIdProcess Identifier
-> ProcFun (a -> b -> a)Combinational function for next state decoder
-> aInitial state
-> Signal bInput signal
-> Signal aOutput signal

The process constructor scanlSY is used to construct a finite state machine process without output decoder. It takes an initial value and a function for the next state decoder. The process constructor behaves similar to the Haskell prelude function scanlSY and has the value of the new state as its output value as illustrated by the following example.

This is in contrast to the function scanldSY, which has its current state as its output value.

scanl2SYSource
:: (ProcType a, ProcType b, ProcType c)
=> ProcIdProcess Identifier
-> ProcFun (a -> b -> c -> a)Combinational function for next state decoder
-> aInitial state
-> Signal bFirst Input signal
-> Signal cSecond Input signal
-> Signal aOutput signal
The process constructor scanl2SY behaves like scanlSY, but has two input signals.
scanl3SYSource
:: (ProcType a, ProcType b, ProcType c, ProcType d)
=> ProcIdProcess Identifier
-> ProcFun (a -> b -> c -> d -> a)Combinational function for next state decoder
-> aInitial state
-> Signal bFirst Input signal
-> Signal cSecond Input signal
-> Signal dThird Input signal
-> Signal aOutput signal
The process constructor scanl2SY behaves like scanlSY, but has two input signals.
scanldSYSource
:: (ProcType a, ProcType b)
=> ProcId
-> ProcFun (a -> b -> a)Combinational function for next state decoder
-> aInitial state
-> Signal bInput signal
-> Signal aOutput signal
The process constructor scanldSY is used to construct a finite state machine process without output decoder. It takes an initial value and a function for the next state decoder. The process constructor behaves similarly to the Haskell prelude function scanlSY. In contrast to the process constructor scanlSY here the output value is the current state and not the one of the next state.
scanld2SYSource
:: (ProcType a, ProcType b, ProcType c)
=> ProcId
-> ProcFun (a -> b -> c -> a)Combinational function for next state decoder
-> aInitial state
-> Signal bFirst Input signal
-> Signal cSecond Input signal
-> Signal aOutput signal
The process constructor scanld2SY behaves like scanldSY, but has two input signals.
scanld3SYSource
:: (ProcType a, ProcType b, ProcType c, ProcType d)
=> ProcId
-> ProcFun (a -> b -> c -> d -> a)Combinational function for next state decoder
-> aInitial state
-> Signal bFirst Input signal
-> Signal cSecond Input signal
-> Signal dSecond Input signal
-> Signal aOutput signal
The process constructor scanld2SY behaves like scanldSY, but has two input signals.
mooreSYSource
:: (ProcType a, ProcType b, ProcType c)
=> ProcId
-> ProcFun (a -> b -> a)Combinational function for next state decoder
-> ProcFun (a -> c)Combinational function for output decoder
-> aInitial state
-> Signal bInput signal
-> Signal cOutput signal

The process constructor mooreSY is used to model state machines of "Moore" type, where the output only depends on the current state. The process constructor is based on the process constructor scanldSY, since it is natural for state machines in hardware, that the output operates on the current state and not on the next state. The process constructors takes a function to calculate the next state, another function to calculate the output and a value for the initial state.

In contrast the output of a process created by the process constructor mealySY depends not only on the state, but also on the input values.

moore2SYSource
:: (ProcType a, ProcType b, ProcType c, ProcType d)
=> ProcId
-> ProcFun (a -> b -> c -> a)Combinational function for next state decoder
-> ProcFun (a -> d)Combinational function for output decoder
-> aInitial state
-> Signal bFirst Input signal
-> Signal cSecond Input signal
-> Signal dOutput signal
The process constructor moore2SY behaves like mooreSY, but has two input signals.
moore3SYSource
:: (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e)
=> ProcId
-> ProcFun (a -> b -> c -> d -> a)Combinational function for next state decoder
-> ProcFun (a -> e)Combinational function for output decoder
-> aInitial state
-> Signal bFirst Input signal
-> Signal cSecond Input signal
-> Signal dThird Input signal
-> Signal eOutput signal
The process constructor moore2SY behaves like mooreSY, but has two input signals.
mealySYSource
:: (ProcType a, ProcType b, ProcType c)
=> ProcId
-> ProcFun (a -> b -> a)Combinational function for next state decoder
-> ProcFun (a -> b -> c)Combinational function for output decoder
-> aInitial state
-> Signal bInput signal
-> Signal cOutput signal

The process constructor melaySY is used to model state machines of "Mealy" type, where the output only depends on the current state and the input values. The process constructor is based on the process constructor scanldSY, since it is natural for state machines in hardware, that the output operates on the current state and not on the next state. The process constructors takes a function to calculate the next state, another function to calculate the output and a value for the initial state.

In contrast the output of a process created by the process constructor mooreSY depends only on the state, but not on the input values.

mealy2SYSource
:: (ProcType a, ProcType b, ProcType c, ProcType d)
=> ProcId
-> ProcFun (a -> b -> c -> a)Combinational function for next state decoder
-> ProcFun (a -> b -> c -> d)Combinational function for output decoder
-> aInitial state
-> Signal bFirst Input signal
-> Signal cSecond Input signal
-> Signal dOutput signal
The process constructor mealy2SY behaves like mealySY, but has two input signals.
mealy3SYSource
:: (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e)
=> ProcId
-> ProcFun (a -> b -> c -> d -> a)Combinational function for next state decoder
-> ProcFun (a -> b -> c -> d -> e)Combinational function for output decoder
-> aInitial state
-> Signal bFirst Input signal
-> Signal cSecond Input signal
-> Signal dThird Input signal
-> Signal eOutput signal
The process constructor mealy2SY behaves like mealySY, but has two input signals.
sourceSY :: ProcType a => ProcId -> ProcFun (a -> a) -> a -> Signal aSource

The process sourceSY takes a function and an initial state and generates an infinite signal starting with the initial state as first output followed by the recursive application of the function on the current state. The state also serves as output value.

The process that has the infinite signal of natural numbers as output is con structed by

sourceSY "naturals" (+1) 0

filterSYSource
:: ProcType a
=> ProcId
-> ProcFun (a -> Bool)Predicate function
-> Signal aInput signal
-> Signal (AbstExt a)Output signal
The process constructor filterSY discards the values who do not fulfill a predicate given by a predicate function and replaces them with absent events.
fillSYSource
:: ProcType a
=> ProcId
-> aDefault value
-> Signal (AbstExt a)Absent extended input signal
-> Signal aOutput signal
The process constructor fillSY creates a process that fills a signal with present values by replacing absent values with a given value. The output signal is not any more of the type AbstExt.
holdSYSource
:: ProcType a
=> ProcIdDefault value
-> a
-> Signal (AbstExt a)Absent extended input signal
-> Signal aOutput signal
The process constructor holdSY creates a process that fills a signal with values by replacing absent values by the preceding present value. Only in cases, where no preceding value exists, the absent value is replaced by a default value. The output signal is not any more of the type AbstExt.
Synchronous Processes
The library contains a few simple processes that are applicable to many cases.
whenSY :: (ProcType a, ProcType b) => ProcId -> Signal (AbstExt a) -> Signal (AbstExt b) -> Signal (AbstExt a)Source
The process constructor whenSY creates a process that synchronizes a signal of absent extended values with another signal of absent extended values. The output signal has the value of the first signal whenever an event has a present value and Abst when the event has an absent value.
zipSY :: (ProcType a, ProcType b) => ProcId -> Signal a -> Signal b -> Signal (a, b)Source
The process zipSY "zips" two incoming signals into one signal of tuples.
zip3SY :: (ProcType a, ProcType b, ProcType c) => ProcId -> Signal a -> Signal b -> Signal c -> Signal (a, b, c)Source
The process zip3SY works as zipSY, but takes three input signals.
zip4SY :: (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> Signal a -> Signal b -> Signal c -> Signal d -> Signal (a, b, c, d)Source
The process zip4SY works as zipSY, but takes four input signals.
zip5SY :: (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e) => ProcId -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal (a, b, c, d, e)Source
The process zip5SY works as zipSY, but takes five input signals.
zip6SY :: (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e, ProcType f) => ProcId -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal (a, b, c, d, e, f)Source
The process zip6SY works as zipSY, but takes six input signals.
unzipSY :: forall a b. (ProcType a, ProcType b) => ProcId -> Signal (a, b) -> (Signal a, Signal b)Source
The process unzipSY "unzips" a signal of tuples into two signals.
unzip3SY :: forall a b c. (ProcType a, ProcType b, ProcType c) => ProcId -> Signal (a, b, c) -> (Signal a, Signal b, Signal c)Source
The process unzip3SY "unzips" a signal of tuples into three signals.
unzip4SY :: forall a b c d. (ProcType a, ProcType b, ProcType c, ProcType d) => ProcId -> Signal (a, b, c, d) -> (Signal a, Signal b, Signal c, Signal d)Source
The process unzip4SY "unzips" a signal of tuples into four signals.
unzip5SY :: forall a b c d e. (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e) => ProcId -> Signal (a, b, c, d, e) -> (Signal a, Signal b, Signal c, Signal d, Signal e)Source
The process unzip5SY "unzips" a signal of tuples into five signals.
unzip6SY :: forall a b c d e f. (ProcType a, ProcType b, ProcType c, ProcType d, ProcType e, ProcType f) => ProcId -> Signal (a, b, c, d, e, f) -> (Signal a, Signal b, Signal c, Signal d, Signal e, Signal f)Source
The process unzip6SY "unzips" a signal of tuples into six signals.
zipxSY :: (Nat s, Typeable s, ProcType a) => ProcId -> FSVec s (Signal a) -> Signal (FSVec s a)Source
The process zipxSY "zips" a signal of vectors into a vector of signals.
unzipxSY :: forall s a. (Typeable s, Nat s, ProcType a) => ProcId -> Signal (FSVec s a) -> FSVec s (Signal a)Source
The process unzipxSY "unzips" a vector of n signals into a signal of vectors.
mapxSY :: (Nat s, ProcType a, ProcType b) => ProcId -> ProcFun (a -> b) -> FSVec s (Signal a) -> FSVec s (Signal b)Source
The process constructor mapxSY creates a process network that maps a function onto all signals in a vector of signals. The identifier is used as the identifier prefix of the processes created (a number starting with 1 will be appended to each identifier)
fstSY :: (ProcType a, ProcType b) => ProcId -> Signal (a, b) -> Signal aSource
The process fstSY selects always the first value from a signal of pairs
sndSY :: (ProcType a, ProcType b) => ProcId -> Signal (a, b) -> Signal bSource
The process sndSY selects always the second value from a signal of pairs
groupSY :: forall k a. (Nat k, Typeable k, ProcType a) => ProcId -> k -> Signal a -> Signal (AbstExt (FSVec k a))Source
The function groupSY groups values into a vector of size n, which takes n cycles. While the grouping takes place the output from this process consists of absent values.
Produced by Haddock version 2.1.0