forsyde-shallow 3.3.1.0 → 3.3.2.0

raw patch · 70 files changed

+5190/−5631 lines, 70 filesdep +forsyde-shallowdep +hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: forsyde-shallow, hspec

API changes (from Hackage documentation)

Files

• INSTALL +0/−25
• README +0/−20
• README.md +71/−0
• examples/Equalizer_Shallow/AudioAnalyzer.lhs +0/−55
• examples/Equalizer_Shallow/AudioFilter.lhs +0/−34
• examples/Equalizer_Shallow/ButtonControl.lhs +0/−139
• examples/Equalizer_Shallow/DistortionControl.lhs +0/−61
• examples/Equalizer_Shallow/Equalizer.lhs +0/−55
• examples/Equalizer_Shallow/EqualizerTypes.lhs +0/−21
• examples/Equalizer_Shallow/README +0/−6
• examples/Equalizer_Shallow/Test/AudioIn.mat +0/−1
• examples/Equalizer_Shallow/TestAnalyzer.lhs +0/−30
• examples/Equalizer_Shallow/TestButtonControl.lhs +0/−38
• examples/Equalizer_Shallow/TestDFT.lhs +0/−17
• examples/Equalizer_Shallow/TestDistortionControl.lhs +0/−30
• examples/Equalizer_Shallow/TestEqualizer.lhs +0/−94
• examples/Equalizer_Shallow/TestFIR.lhs +0/−10
• examples/Equalizer_Shallow/TestFilter.lhs +0/−82
• forsyde-shallow.cabal +42/−50
• src/ForSyDe/Shallow.hs +28/−30
• src/ForSyDe/Shallow/AbsentExt.hs +0/−88
• src/ForSyDe/Shallow/AdaptivityLib.hs +0/−34
• src/ForSyDe/Shallow/BitVector.hs +0/−122
• src/ForSyDe/Shallow/CTLib.hs +0/−1078
• src/ForSyDe/Shallow/Core.hs +37/−0
• src/ForSyDe/Shallow/Core/AbsentExt.hs +81/−0
• src/ForSyDe/Shallow/Core/BitVector.hs +122/−0
• src/ForSyDe/Shallow/Core/Signal.hs +222/−0
• src/ForSyDe/Shallow/Core/Vector.hs +422/−0
• src/ForSyDe/Shallow/CoreLib.hs +0/−37
• src/ForSyDe/Shallow/DFT.hs +0/−71
• src/ForSyDe/Shallow/DataflowLib.hs +0/−443
• src/ForSyDe/Shallow/DomainInterfaces.hs +0/−130
• src/ForSyDe/Shallow/FIR.hs +0/−36
• src/ForSyDe/Shallow/FilterLib.hs +0/−313
• src/ForSyDe/Shallow/Gaussian.hs +0/−68
• src/ForSyDe/Shallow/Memory.hs +0/−64
• src/ForSyDe/Shallow/MoC.hs +44/−0
• src/ForSyDe/Shallow/MoC/Adaptivity.hs +36/−0
• src/ForSyDe/Shallow/MoC/CT.hs +1074/−0
• src/ForSyDe/Shallow/MoC/Dataflow.hs +466/−0
• src/ForSyDe/Shallow/MoC/DomainInterface.hs +130/−0
• src/ForSyDe/Shallow/MoC/MoCInterface.hs +38/−0
• src/ForSyDe/Shallow/MoC/SDF.hs +455/−0
• src/ForSyDe/Shallow/MoC/Synchronous.hs +34/−0
• src/ForSyDe/Shallow/MoC/Synchronous/Lib.hs +435/−0
• src/ForSyDe/Shallow/MoC/Synchronous/Process.hs +114/−0
• src/ForSyDe/Shallow/MoC/Synchronous/Stochastic.hs +267/−0
• src/ForSyDe/Shallow/MoC/Untimed.hs +214/−0
• src/ForSyDe/Shallow/MoCInterfaces.hs +0/−34
• src/ForSyDe/Shallow/MoCLib.hs +0/−46
• src/ForSyDe/Shallow/PolyArith.hs +0/−106
• src/ForSyDe/Shallow/Queue.hs +0/−98
• src/ForSyDe/Shallow/SDFLib.hs +0/−452
• src/ForSyDe/Shallow/Signal.hs +0/−224
• src/ForSyDe/Shallow/StochasticLib.hs +0/−255
• src/ForSyDe/Shallow/SynchronousLib.hs +0/−367
• src/ForSyDe/Shallow/SynchronousProcessLib.hs +0/−115
• src/ForSyDe/Shallow/UntimedLib.hs +0/−200
• src/ForSyDe/Shallow/Utility.hs +34/−0
• src/ForSyDe/Shallow/Utility/DFT.hs +71/−0
• src/ForSyDe/Shallow/Utility/FIR.hs +36/−0
• src/ForSyDe/Shallow/Utility/FilterLib.hs +313/−0
• src/ForSyDe/Shallow/Utility/Gaussian.hs +68/−0
• src/ForSyDe/Shallow/Utility/Memory.hs +69/−0
• src/ForSyDe/Shallow/Utility/PolyArith.hs +106/−0
• src/ForSyDe/Shallow/Utility/Queue.hs +99/−0
• src/ForSyDe/Shallow/UtilityLib.hs +0/−54
• src/ForSyDe/Shallow/Vector.hs +0/−398
• test/Spec.hs +62/−0

@@ -1,25 +0,0 @@-DEPENDENCIES- - The Shallow version of ForSyDe can be built using standard Haskell.--INSTALLATION--See http://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package--Here is a summary on how to install ForSyDe manually:--To install globally, for the whole system (requires admin permissions):--$ ./Setup.hs configure-$ ./Setup.hs build-$ ./Setup.hs haddock # generate documentation, optional, -                     # requires Haddock > 2.0 due to the use of TH-$ sudo ./Setup.hs install--To install locally and just for your own user:--$ ./Setup.hs configure --user --prefix=The/selected/local/directory-$ ./Setup.hs build-$ ./Setup.hs haddock  # generate documentation, optional, -                      # requires Haddock > 2.0 due to the use of TH-$ ./Setup.hs install

@@ -1,20 +0,0 @@- ForSyDe's Haskell-embedded Domain Specific Language.- ====================================================--DESCRIPTION-- The ForSyDe (Formal System Design) methodology has been developed- with the objective to move system design to a higher level of- abstraction and to bridge the abstraction gap by transformational- design refinement.- - This library provides ForSyDe's implementation as a Haskell-embedded- Domain Specific Language (DSL). -- For more information, please see ForSyDe's website:- <http://forsyde.ict.kth.se/>.---INSTALLATION-- For information on how to install ForSyDe see the INSTALL file.

@@ -0,0 +1,71 @@+[![Build Status](https://travis-ci.org/forsyde/forsyde-shallow.svg?branch=master)](https://travis-ci.org/forsyde/forsyde-shallow)++ForSyDe's Haskell-embedded Domain Specific Language+===================================================++Description+-----------++The ForSyDe (Formal System Design) methodology has been developed with+the objective to move system design to a higher level of abstraction+and to bridge the abstraction gap by transformational design+refinement.+ +This library provides a shallow implementation of ForSyDe as a+Haskell-embedded Domain Specific Language (DSL)++For more information, please see+[ForSyDe's website](http://forsyde.ict.kth.se/).+++Installation+------------++The [`forsyde-shallow`](https://hackage.haskell.org/package/forsyde-shallow)+package is available through [HackageDB](https://hackage.haskell.org/)+and the latest stable release can be installed via your favorite+Haskell package manager, e.g.:++    cabal update+    cabal install forsyde-shallow+	+To install the latest updates and nightly builds you need clone+[this repository](https://github.com/forsyde/forsyde-shallow). To+install and use the contents of this repository globally, some useful+commands are:++    cabal install -j4 --enable-tests+	cabal configure --enable tests+	cabal test                        # runs the test suites+	cabal haddock                     # generates the API documentation+	ghci                              # starts an interpreter session++To install and use the contents of this repository in a sandbox+environment (recommended), the equivalent commands are:++    cabal sandbox init+    cabal install -j4 --enable-tests+	cabal configure --enable tests+	cabal test                        # runs the test suites+	cabal haddock                     # generates the API documentation+	cabal repl                        # starts an interpreter session with the sandbox loaded+++Getting started+---------------++To get started with using `ForSyDe.Shallow`, once succesfully+installed open an interpreter session and load the library:++    > :m +ForSyDe.Shallow+	> let s = signal [1..4] :: Signal Int+    > mooreSY (+) (*2) 0 s+	{0,2,6,12,20}++The example above implements a Moore finite state machine that+calculates the running sum and multiplies the output with 2. For more+examples and tutorials please check the+[forsyde-shallow-examples](https://github.com/forsyde/forsyde-shallow-examples)+repository, and the online +[API documentation](https://hackage.haskell.org/package/forsyde-shallow)+

@@ -1,55 +0,0 @@-\subsection{Overview}--The \process{Audio Analyzer} analyzes the current bass level and raises a flag when the bass level exceeds a limit. --\begin{figure}-\centering-\scalebox{0.8}{\mbox{\input{Figures/AudioAnalyzer.pstex_t}}}-\caption{The \textit{Audio Analyzer} subsystem}-\label{fig:AudioAnalyzerSubsystem}-\end{figure}--As illutsrated in Figure \ref{fig:AudioAnalyzerSubsystem} the \process{Audio Analyzer} is divided into four blocks. The input signal is first grouped into samples of size $N$ in the process \process{Group Samples} and then processed with a \process{DFT} in order to get the frequency spectrum of the signal. Then the power spectrum is calculated in \process{Spectrum}. In \process{CheckBass} the lowest frequencies are compared with a threshold value. If they exceed this value, the output \process{Distortion Flag} will have the value \constant{Fail}.--Since \process{Group Samples} needs $N$ cycles for the grouping, it produces $N-1$ absent values $\perp$ for each grouped sample. Thus the following processes \process{DFT}, \process{Spectrum} and \process{Check Bass} are all $\Psi$-extended in order to be able to process the absent value $\Abst$.-\begin{code}-module AudioAnalyzer (audioAnalyzer) where--import ForSyDe.Shallow-import Data.Complex-import EqualizerTypes--input = 0.1 :- 0.2 :- input--limit :: Double-limit = 1.0--nLow :: Int-nLow = 3--audioAnalyzer :: Int -> Signal Double -> Signal (AbstExt AnalyzerMsg)-audioAnalyzer pts =  mapSY (psi checkBass) -- Check Bass -		   . mapSY (psi spectrum)  -- Spectrum-		   . mapSY (psi (dft pts)) -- DFT-		   . groupSY pts	   -- Group Samples -		   . mapSY toComplex--spectrum :: (RealFloat a) => Vector (Complex a) -> Vector a-spectrum =  mapV log10 . selectLow nLow . mapV power . selectHalf . dropV 1-  where-    log10 x        = log x / log 10-    selectLow n xs = takeV n xs-    selectHalf xs  = takeV half xs-	       where half = floor (fromIntegral (lengthV xs) / 2)  -    power x = (magnitude x) ^ 2--checkBass :: Vector Double -> AnalyzerMsg-checkBass = checkLimit limit . sumV-  where-    checkLimit limit x | x > limit  = Fail-	               | otherwise  = Pass-    sumV vs = foldlV (+) 0.0 vs---toComplex x = x :+ 0-\end{code}

@@ -1,34 +0,0 @@-\subsection{Overview}-Figure \ref{fig:AudioFilter} shows the structure of the \process{AudioFilter}. The task of this subsystem is to amplify different frequencies of the audio signal independently according to the assigned levels. The audio signal is splitted into three identical signals, one for each frequency region. The signals are filtered and then amplified according to the assigned amplification level. As the equalizer in this design only has a bass and treble control, the middle frequencies are not amplified. The output signal from the \process{Audio Filter} is the addition of the three filtered and amplified signals.--\begin{figure}[h]-\centering-\input{Figures/AudioFilter.pstex_t}-\caption{Subsystems of the \emph{Audio Filter}}-\label{fig:AudioFilter}-\end{figure}--We model this structure as a network of blocks directly from Figure \ref{fig:AudioFilter}. It consists of three filters, two amplifiers and an adder. These blocks are modeled in the process layer. The \process{Audio Filter} has the filter coefficients for the low pass, band pass and high pass filter as parameters.-%-\begin{code}-module AudioFilter where--import ForSyDe.Shallow-import ForSyDe.Shallow.FIR--audioFilter :: Floating a => Vector a -> Vector a -> Vector a -	    -> Signal a -> Signal a -> Signal a -> Signal a-audioFilter lpCoeff bpCoeff hpCoeff bass treble audioIn = audioOut-   where audioOut      = zipWith3SY add3 bassPath middlePath treblePath-	 bassPath      = ((amplify bass) . lowPass) audioIn-	 middlePath    = bandPass audioIn-	 treblePath    = ((amplify treble) . highPass) audioIn-	 lowPass       = firSY lpCoeff-	 bandPass      = firSY bpCoeff-	 highPass      = firSY hpCoeff-	 amplify       = zipWithSY scale-	 add3 x y z    = x + y + z-	 scale x y     = y * (base ** x)  -	 base	       = 1.1-\end{code}-

@@ -1,139 +0,0 @@-\subsection{Overview}--The subsystem \process{Button Control} works as a user interface in the equalizer system. It receives the four input signals \signal{BassDn}, \signal{BassUp}, \signal{TrebleDn}, \signal{TrebleUp} and the override signal \process{Override} from the \process{Distortion Control} and calculates the new bass and treble values for the output signals \signal{Bass} and \signal{Treble}. The subsytem contains the main processes \process{Button Interface} and \process{Level Control}. The process \process{Level Control} outputs a new value, if either the signal \signal{Button} or the signal \signal{Overr} is present, otherwise the output value is absent. The process \process{Hold Level} is modeled by means of \process{holdSY (0.0, 0.0)} that outputs the last present value, if the input value is absent. The process \process{unzipSY} transforms a signal of tuples (the current bass and treble level) into a tuple of signals (a bass and a treble signal).--\begin{figure}-\centering-\scalebox{0.8}{\mbox{\input{Figures/ButtonControl.pstex_t}}}-\caption{The Subsystem \process{Button Control}}-\end{figure}--\begin{code}-module ButtonControl (buttonControl) where --import ForSyDe.Shallow-import EqualizerTypes---import Combinators--data State   = Operating -	     | Locked deriving(Eq, Show)-type Level   = Double-type Bass    = Level-type Treble  = Level--buttonControl :: Signal (AbstExt OverrideMsg) -> Signal (AbstExt Sensor) - 	      -> Signal (AbstExt Sensor) -> Signal (AbstExt Sensor) - 	      -> Signal (AbstExt Sensor) -> (Signal Bass,Signal Treble)-buttonControl overrides bassDn bassUp trebleDn trebleUp -    = (bass, treble) -      where (bass, treble) = unzipSY levels-            levels = holdSY (0.0, 0.0) $ levelControl button overrides - 	    button = buttonInterface bassDn bassUp trebleDn trebleUp-\end{code}--\subsection{The Process \process{Button Interface}}--The \process{Button Interface} monitors the four input buttons \signal{BassDn}, \signal{BassUp}, \signal{TrebleDn}, \signal{TrebleUp} and indicates if a button is pressed. If two or more buttons are pressed the conflict is resolved by the priority order of the buttons. --\begin{code}-buttonInterface :: Signal (AbstExt Sensor) -> Signal (AbstExt Sensor) -		-> Signal (AbstExt Sensor) -> Signal (AbstExt Sensor) -		-> Signal (AbstExt Button)-buttonInterface bassUp bassDn trebleUp trebleDn -   = zipWith4SY f bassUp bassDn trebleUp trebleDn-     where f (Prst Active) _ _ _ = Prst BassUp-	   f _ (Prst Active) _ _ = Prst BassDn-	   f _ _ (Prst Active) _ = Prst TrebleUp-	   f _ _ _ (Prst Active) = Prst TrebleDn-	   f _ _ _ _		 = Abst-\end{code}--\subsection{The Process \process{Level Control}}--The process has a local state that consists of a mode and the current values for the bass and treble levels (Figure \ref{fig:FSM_LevelControl}). The \process{Level Control} has two modes, in the mode \constant{Operating} the bass and treble values are stepwise changed in 0.2 steps. However, there exists maximum and minimum values which are -5.0 and +5.0. The process enters the mode \constant{Locked} when the \constant{Override} input has the value \constant{Lock}. In this mode an additional increase of the bass level is prohibitet and even decreased by 1.0 in case the \constant{Override} signal has the value \constant{CutBass}. The subsystem returns to the \constant{Operating} mode on the override value \constant{Release}. The output of the process is an absent extended signal of tuples with the current bass and treble levels.   --\begin{figure}-\resizebox{\columnwidth}{!}{\mbox{\input{Figures/FSM_LevelControl.pstex_t}}}-\caption{The State Diagram of the Process \process{Level Control}}-\label{fig:FSM_LevelControl}-\end{figure}-\begin{code}-levelControl :: Signal (AbstExt Button) -> Signal (AbstExt OverrideMsg) - 	     -> Signal (AbstExt (Bass,Treble))-levelControl button overrides -  = mealy2SY nextState output (initState, initLevel) button overrides--nextState :: (State,(Double,Double)) -> AbstExt Button -	  -> AbstExt OverrideMsg -> (State,(Double,Double))-nextState (state, (bass, treble)) button override-  = (newState, (newBass, newTreble)) where-     newState = if state == Operating then-		   if override == Prst Lock then-		      Locked-		   else-		      Operating-	        else-		   if override == Prst Release then-		      Operating-		   else -		      Locked--     newBass = if state == Locked then-		  if override == Prst CutBass then-		     decreaseLevel bass cutStep-		  else-	             if button == Prst BassDn then-			decreaseLevel bass step-		     else-			bass-	       else -- state = Operating-		  if button == Prst BassDn then-		     decreaseLevel bass step-		  else -		     if button == Prst BassUp then-			increaseLevel bass step-		     else-			bass-		    -     newTreble = if button == Prst TrebleDn then-		    decreaseLevel treble step-		 else -		    if button == Prst TrebleUp then-		       increaseLevel treble step-		    else -		       treble--output :: (a, (Bass, Treble)) -> AbstExt Button -> AbstExt OverrideMsg - 	  -> AbstExt (Bass,Treble)-output _           Abst Abst = Abst-output (_, levels) _    _    = Prst levels	          -\end{code}--The process uses the following initial values.--\begin{code}-initState =  Operating-initLevel =  (0.0, 0.0)-maxLevel  =  5.0-minLevel  = -5.0-step      =  0.2-cutStep   =  1.0-\end{code}--The process uses the following auxiliary functions.--\begin{code}-decreaseLevel :: Level -> Level -> Level-decreaseLevel level step = if reducedLevel >= minLevel then-			      reducedLevel-		           else-			      minLevel-			   where reducedLevel = level - step--increaseLevel :: Level -> Level -> Level-increaseLevel level step = if increasedLevel <= maxLevel then-			      increasedLevel-		           else-			      maxLevel-			   where increasedLevel = level + step-\end{code}

@@ -1,61 +0,0 @@-The block \process{Distortion Control} is directly developed from the SDL-specification, that has been used for the MASCOT-model \cite{BjJa2000}. The specification is shown in Figure \ref{fig:SDL-Distortion Control}.--\begin{figure}[h]-\centering-\includegraphics[scale=0.5]{Figures/DistortionControl.eps}-\caption{SDL-description of \emph{Distortion Control}}-\label{fig:SDL-Distortion Control}-\end{figure}--The \process{Distortion Control} is a single FSM, which is modeled by means of the skeleton \process{mealySY}. The global state is not only expressed by the explicit states - \constant{Passed}, \constant{Failed} and \constant{Locked} -, but also by means of the variable \variable{cnt}. The state machine has two possible input values, \constant{Pass} and \constant{Fail}, and three output values, \constant{Lock}, \constant{Release} and \constant{CutBass}. --The \process{mealySY} creates a process that can be interpreted as a Mealy-machine. It takes two functions, \function{nxtSt} to calculate the next state and \function{out} to calculate the output. The state is represented by a pair of the explicit state and the variable \variable{cnt}. The initial state is the same as in the SDL-model, given by the tuple \constant{(Passed, 0)}. The \function{nxtSt} function uses pattern matching. Whenever an input value matches a pattern of the \function{nxtSt} function the corresponding right hand side is evaluated, giving the next state. An event with an absent value leaves the state unchanged. The output function is modeled in a similar way. The output is absent, when no output message is indicated in the SDL-model.-%-\begin{code}-module DistortionControl (distortionControl) where--import ForSyDe.Shallow-import EqualizerTypes--data State =  Passed-            | Failed-            | Locked--distortionControl ::  Signal (AbstExt AnalyzerMsg) -		     -> Signal (AbstExt OverrideMsg)--distortionControl distortion -   = mealySY nxtSt out (Passed, 0) distortion--lim = 3----     State       Input       NextState       -nxtSt (state, cnt) (Abst)      = (state,cnt)-nxtSt (Passed,cnt) (Prst Pass) = (Passed,cnt)-nxtSt (Passed,_  ) (Prst Fail) = (Failed,lim)-nxtSt (Failed,cnt) (Prst Pass) = (Locked,cnt)-nxtSt (Failed,cnt) (Prst Fail) = (Failed,cnt)-nxtSt (Locked,_  ) (Prst Fail) = (Failed,lim)-nxtSt (Locked,cnt) (Prst Pass) = (newSt,newCnt)-   where newSt = if (newCnt == 0) then Passed-	                          else Locked-         newCnt = cnt - 1----   State         Input       Output-out (Passed,_)   (Prst Pass) = Abst-out (Passed,_)   (Prst Fail) = Prst Lock-out (Failed,_)   (Prst Pass) = Abst-out (Failed,_)   (Prst Fail) = Prst CutBass-out (Locked,_)   (Prst Fail) = Abst -out (Locked,cnt) (Prst Pass) = -   if (cnt == 1) then Prst Release-		  else Abst-out _             Abst        = Abst-\end{code}-------

@@ -1,55 +0,0 @@-\subsection{Overview}--The main task of the equalizer system is to adjust the audio signal according to the \process{Button Control}, that works as a user interface. In addition, the bass level must not-exceed a predefined threshold to avoid damage to the speakers.--This specification can be naturally decomposed into four functions shown in-Figure \ref{fig:Equalizer-Level1}. The subsystems \process{Button Control} and \process{Distortion Control}, are control dominated (grey shaded), while the \process{Audio Filter} and the \process{Audio Analyzer} are data flow dominated subsystems.  --\begin{figure}[h]-\centering-\input{Figures/Equalizer-Level1.pstex_t}-\caption{Subsystems of the \process{Equalizer}}-\label{fig:Equalizer-Level1}-\end{figure}--The \process{Button Control} subsystem monitors the button inputs and the override-signal from the subsystem \process{Distortion Control} and adjusts the current-bass and treble levels. This information is passed to the subsystem-\process{Audio Filter}, which receives the audio input, and filters and-amplifies the audio signal according to the current bass and treble-levels. This signal, the output signal of the equalizer, is analyzed by the -\process{Audio Analyzer} subsystem, which determines, whether the bass exceeds a-predefined threshold. The result of this analysis is passed to the subsystem \process{Distortion Control}, which decides, if a minor or major violation is encountered and issues the-necessary commands to the \process{Button Control} subsystem.  --The frequency characteristics of the \process{Equalizer} is adjusted by the coefficients for the three FIR-filters in the \process{AudioFilter}. -%-\begin{code}-module Equalizer(equalizer) where--import ForSyDe.Shallow--import ButtonControl-import DistortionControl-import AudioAnalyzer-import AudioFilter-\end{code}-%-The structure of the equalizer is expressed as a network of blocks:-%-\begin{code}-equalizer lpCoeff bpCoeff hpCoeff dftPts -	  bassUp bassDn trebleUp trebleDn input = (bass, treble) --output -  where-    (bass, treble)  = buttonControl overrides bassUp bassDn -	                            trebleUp trebleDn-    output          = audioFilter lpCoeff bpCoeff hpCoeff bass -				  treble input-    distFlag        = audioAnalyzer dftPts output-    overrides       = distortionControl delayedDistFlag-    delayedDistFlag = delaySY Abst distFlag-\end{code}--Since the equalizer contains a feedback loop, the signal \process{DistFlag} is delayed one event cycle using the initial value \Abst.-

@@ -1,21 +0,0 @@-\subsection{Overview}--This module is a collection of data types that are used in the equalizer model.--\begin{code}-module EqualizerTypes where--data AnalyzerMsg = Pass- 		 | Fail deriving(Show, Read, Eq)--data OverrideMsg = Lock-                 | CutBass-	         | Release deriving(Show, Read, Eq)--data Sensor = Active deriving(Show, Read, Eq)--data Button = BassDn-	    | BassUp-	    | TrebleDn-	    | TrebleUp deriving (Show, Read, Eq)-\end{code}

@@ -1,6 +0,0 @@-This directory contains the Equalizer example, used in Sander's PhD Thesis,-and modelled using shallow-embedded signals.--[San03] Ingo Sander. System Modeling and Design Refinement in ForSyDe. -        PhD thesis, Royal Institute of Technology, Stockholm, Sweden,-        April 2003. [http://web.it.kth.se/~ingo/Papers/Thesis_Sander_2003.pdf]

@@ -1,1 +0,0 @@-   3.0000000e+00   1.1102230e-16   6.1803399e-01   0.0000000e+00   1.6180340e+00  -1.7460502e-15  -1.6180340e+00   6.6613381e-16  -6.1803399e-01   1.4432899e-15  -3.0000000e+00   1.2212453e-15  -6.1803399e-01  -8.8817842e-16  -1.6180340e+00  -2.7554553e-15   1.6180340e+00  -1.1102230e-15   6.1803399e-01   1.6653345e-15   3.0000000e+00  -2.2204460e-16   6.1803399e-01   7.6605389e-15   1.6180340e+00   1.0397118e-15  -1.6180340e+00   1.9984014e-15  -6.1803399e-01   2.7755576e-15  -3.0000000e+00   1.7763568e-15  -6.1803399e-01  -1.6653345e-15  -1.6180340e+00   6.0051022e-15   1.6180340e+00  -7.4384943e-15   6.1803399e-01   5.2180482e-15   3.0000000e+00  -1.0214052e-14   6.1803399e-01  -4.4408921e-15   1.6180340e+00  -2.3917751e-15  -1.6180340e+00   7.1054274e-15  -6.1803399e-01  -4.6629367e-15  -3.0000000e+00  -4.5519144e-15  -6.1803399e-01   4.7739590e-15  -1.6180340e+00   9.4365891e-15   1.6180340e+00   3.3306691e-15   6.1803399e-01  -1.0991208e-14   3.0000000e+00   6.4392935e-15   6.1803399e-01   7.7715612e-15   1.6180340e+00  -4.9419158e-16  -1.6180340e+00   9.2148511e-15  -6.1803399e-01  -1.2434498e-14  -3.0000000e+00  -7.2164497e-15  -6.1803399e-01  -2.3092639e-14  -1.6180340e+00   2.2099351e-15   1.6180340e+00   1.5321078e-14   6.1803399e-01   6.3282712e-15   3.0000000e+00  -1.0769163e-14   6.1803399e-01  -1.3211654e-14   1.6180340e+00   6.7324625e-15  -1.6180340e+00   1.4210855e-14  -6.1803399e-01  -5.5511151e-15  -3.0000000e+00  -1.2989609e-14  -6.1803399e-01  -2.2426505e-14  -1.6180340e+00  -1.2122146e-14   1.6180340e+00   1.5543122e-15   6.1803399e-01   3.6637360e-15   3.0000000e+00   4.9960036e-15   6.1803399e-01   1.4765966e-14   1.6180340e+00  -7.3571655e-15  -1.6180340e+00   1.0658141e-14  -6.1803399e-01  -1.2878587e-14  -3.0000000e+00   3.2751579e-14  -6.1803399e-01  -1.5543122e-15  -1.6180340e+00   5.8810900e-14   1.6180340e+00  -2.6201263e-14   6.1803399e-01  -2.6201263e-14   3.0000000e+00   6.4392935e-15   6.1803399e-01   1.1546319e-14   1.6180340e+00   1.0527630e-14  -1.6180340e+00   1.2989609e-14  -6.1803399e-01  -1.1435297e-14  -3.0000000e+00   5.5511151e-16  -6.1803399e-01  -2.6645353e-14  -1.6180340e+00   1.2504396e-14   1.6180340e+00  -2.7977620e-14   6.1803399e-01   2.0428104e-14   3.0000000e+00   3.8524739e-14   6.1803399e-01   3.6637360e-14   1.6180340e+00   5.6834134e-14  -1.6180340e+00   3.8080650e-14  -6.1803399e-01   1.8429702e-14  -3.0000000e+00   1.6764368e-14  -6.1803399e-01   2.2648550e-14  -1.6180340e+00   4.4357592e-14   1.6180340e+00   2.1205260e-14   6.1803399e-01   3.6637360e-14   3.0000000e+00  -2.5757174e-14   6.1803399e-01  -7.5495166e-15   1.6180340e+00  -6.7389618e-14  -1.6180340e+00   1.7208457e-14  -6.1803399e-01   2.3314684e-15  -3.0000000e+00  -1.3211654e-14  -6.1803399e-01   2.5979219e-14  -1.6180340e+00   2.6472797e-14   1.6180340e+00  -3.8857806e-15   6.1803399e-01   4.5519144e-15   3.0000000e+00   4.1078252e-15   6.1803399e-01   6.3504757e-14   1.6180340e+00   7.3385961e-15  -1.6180340e+00   3.6637360e-14  -6.1803399e-01   3.7747583e-15  -3.0000000e+00   4.4408921e-14  -6.1803399e-01  -4.8849813e-15  -1.6180340e+00  -4.8255417e-14   1.6180340e+00  -2.8976821e-14   6.1803399e-01   3.1086245e-15   3.0000000e+00  -8.8595797e-14   6.1803399e-01  -4.9404925e-14   1.6180340e+00   1.4601566e-13  -1.6180340e+00   5.6621374e-14  -6.1803399e-01   4.4519943e-14  -3.0000000e+00  -6.6613381e-16  -6.1803399e-01   1.5987212e-14  -1.6180340e+00  -9.2967930e-15   1.6180340e+00   4.8738791e-14   6.1803399e-01   2.1427304e-14   3.0000000e+00  -8.3266727e-15   6.1803399e-01  -2.9309888e-14   1.6180340e+00  -1.3735233e-14  -1.6180340e+00  -5.1070259e-15  -6.1803399e-01  -2.6201263e-14  -3.0000000e+00   1.7541524e-14  -6.1803399e-01   4.2743586e-14  -1.6180340e+00   9.3610677e-14   1.6180340e+00   1.8540725e-14   6.1803399e-01   3.5305092e-14   3.0000000e+00  -2.6645353e-14   6.1803399e-01   8.8817842e-16   1.6180340e+00  -1.1664270e-13  -1.6180340e+00  -3.1752379e-14  -6.1803399e-01  -4.4519943e-14  -3.0000000e+00   3.5860204e-14  -6.1803399e-01   1.2434498e-14  -1.6180340e+00   1.3967473e-13   1.6180340e+00   4.5186077e-14   6.1803399e-01   5.3512750e-14   3.0000000e+00  -1.0169643e-13   6.1803399e-01  -2.5757174e-14   1.6180340e+00  -1.6270675e-13  -1.6180340e+00  -4.6851412e-14  -6.1803399e-01  -1.1968204e-13  -3.0000000e+00   1.1102230e-13  -6.1803399e-01   3.9079850e-14  -1.6180340e+00   1.8573878e-13   1.6180340e+00   3.4416914e-15   6.1803399e-01   1.2867485e-13   3.0000000e+00  -2.3758773e-14   6.1803399e-01  -5.7731597e-15   1.6180340e+00  -2.4029693e-14  -1.6180340e+00   2.9976022e-14  -6.1803399e-01  -4.1522341e-14  -3.0000000e+00   3.2973624e-14  -6.1803399e-01   1.9206858e-14  -1.6180340e+00   1.0390514e-13   1.6180340e+00  -1.6653345e-14   6.1803399e-01   5.0737192e-14   3.0000000e+00  -4.2077453e-14   6.1803399e-01  -3.2418512e-14   1.6180340e+00  -1.1272631e-13  -1.6180340e+00   3.3306691e-15  -6.1803399e-01  -5.9952043e-14  -3.0000000e+00   5.1181281e-14  -6.1803399e-01  -1.1102230e-14  -1.6180340e+00   1.3575833e-13   1.6180340e+00   9.9920072e-15   6.1803399e-01   6.8944850e-14   3.0000000e+00   3.5971226e-14   6.1803399e-01  -2.2204460e-15   1.6180340e+00   2.5950752e-14  -1.6180340e+00   3.3639758e-14  -6.1803399e-01   1.8207658e-14  -3.0000000e+00   1.2634338e-13  -6.1803399e-01   2.5757174e-14  -1.6180340e+00   1.8182239e-13   1.6180340e+00  -6.6724404e-14   6.1803399e-01   8.7263530e-14   3.0000000e+00  -3.9190873e-14   6.1803399e-01   3.9523940e-14   1.6180340e+00  -2.0113300e-14  -1.6180340e+00  -3.3306691e-15  -6.1803399e-01  -1.1102230e-16  -3.0000000e+00  -8.6597396e-15  -6.1803399e-01  -7.2719608e-14  -1.6180340e+00   9.9988744e-14   1.6180340e+00  -4.0190073e-14   6.1803399e-01   6.6058270e-14   3.0000000e+00  -5.7398530e-14   6.1803399e-01   2.7755576e-15   1.6180340e+00  -6.6177351e-14  -1.6180340e+00  -2.9976022e-14  -6.1803399e-01  -1.3200552e-13  -3.0000000e+00   5.3290705e-15  -6.1803399e-01  -4.6185278e-14  -1.6180340e+00   1.8155103e-14   1.6180340e+00  -1.3544721e-14   6.1803399e-01   7.9936058e-14   3.0000000e+00  -7.1276318e-14   6.1803399e-01  -1.2434498e-14   1.6180340e+00  -2.2592824e-13  -1.6180340e+00  -4.5075055e-14  -6.1803399e-01  -1.5021318e-13  -3.0000000e+00   1.9095836e-14  -6.1803399e-01  -1.9539925e-14  -1.6180340e+00   1.7790599e-13   1.6180340e+00   1.5543122e-15   6.1803399e-01   9.8254738e-14   3.0000000e+00   1.0313972e-13   6.1803399e-01  -3.9079850e-14   1.6180340e+00  -2.7199229e-13  -1.6180340e+00  -7.1609385e-14  -6.1803399e-01   2.4202862e-14  -3.0000000e+00   3.7414516e-14  -6.1803399e-01   1.8540725e-14  -1.6180340e+00   2.2397004e-13   1.6180340e+00  -6.5059069e-14   6.1803399e-01   1.1668444e-13   3.0000000e+00   8.4821039e-14   6.1803399e-01  -7.7049478e-14   1.6180340e+00   5.1425881e-14  -1.6180340e+00  -8.6930463e-14  -6.1803399e-01   5.8841820e-15  -3.0000000e+00   1.6953106e-13  -6.1803399e-01  -4.8072657e-14  -1.6180340e+00   2.7003409e-13   1.6180340e+00  -3.8413717e-14   6.1803399e-01   1.3489210e-13   3.0000000e+00  -4.7184479e-14   6.1803399e-01  -8.0713214e-14   1.6180340e+00   5.3618297e-15  -1.6180340e+00   1.1102230e-16  -6.1803399e-01  -1.2545520e-14  -3.0000000e+00   1.8784974e-13  -6.1803399e-01  -4.4408921e-14  -1.6180340e+00   3.1609814e-13   1.6180340e+00  -1.2545520e-13   6.1803399e-01  -3.9523940e-14   3.0000000e+00  -6.5503158e-14   6.1803399e-01   6.3282712e-15   1.6180340e+00  -4.0702221e-14  -1.6180340e+00   6.6724404e-14  -6.1803399e-01  -3.0864200e-14  -3.0000000e+00   1.3433699e-14  -6.1803399e-01  -1.3145041e-13  -1.6180340e+00  -7.3200267e-15   1.6180340e+00  -9.8920871e-14   6.1803399e-01  -2.1205260e-14   3.0000000e+00  -1.5409896e-13   6.1803399e-01   7.2941653e-14   1.6180340e+00  -3.1413995e-13  -1.6180340e+00   4.0079051e-14  -6.1803399e-01  -2.3303581e-13  -3.0000000e+00   3.1641356e-14  -6.1803399e-01   7.9047879e-14  -1.6180340e+00   3.8744024e-14   1.6180340e+00   1.1168844e-13   6.1803399e-01  -2.8865799e-15   3.0000000e+00  -1.7241764e-13   6.1803399e-01   4.6296300e-14   1.6180340e+00  -3.6020400e-13  -1.6180340e+00   1.3433699e-14  -6.1803399e-01  -2.5135449e-13  -3.0000000e+00   4.9960036e-14

@@ -1,30 +0,0 @@-\begin{code}-module Main(main) where--import IO-import ForSyDe.Shallow-import AudioFilter-import AudioAnalyzer--input = 0.1 :- 0.2 :- input-zeros = (0.0, 0.0) :- zeros---k = 8-n = 2 ^ k -sig = takeS (2*(2^k)) input-pts = 4----testFilter = audioFilter zeros input--main = do fftInfile <- openFile "Test/audioOut.dat" ReadMode-	  fftOutfile <- openFile "Test/fftOut.dat" WriteMode-	  contents <- hGetContents fftInfile---	  hPutStr fftOutfile (writeS (audioAnalyzer 6 ((readS contents2) :: Signal Double)))-	  putStr (show (audioAnalyzer pts ((readS contents) :: Signal Double)))-	  hPutStr fftOutfile (writeS (audioAnalyzer pts ((readS contents) :: Signal Double)))---	  hClose fftOutfile-	  putStr "\nDone.\n"-\end{code}--

@@ -1,38 +0,0 @@-\begin{code}-module TestButtonControl where--import ButtonControl-import EqualizerTypes-import ForSyDe.Shallow-----bassUp = signal [Prst Active, Prst Active, Abst, Abst,-		 Prst Active, Prst Active, Abst, Abst,-		 Prst Active, Prst Active, Abst, Abst,-		 Prst Active, Prst Active, Abst, Abst]--bassDn = signal [Abst, Abst, Prst Active, Abst,-		 Abst, Abst, Prst Active, Abst,-		 Abst, Abst, Prst Active, Abst,-		 Abst, Abst, Prst Active, Abst]--trebleUp = signal [Abst, Abst, Abst, Abst,-		 Abst, Abst, Abst, Prst Active,-		 Abst, Abst, Abst, Abst,-		 Abst, Abst, Abst, Prst Active]--trebleDn = signal [Abst, Abst, Abst, Prst Active,-		 Abst, Abst, Abst, Prst Active,-		 Abst, Abst, Abst,  Prst Active,-		 Abst, Abst, Abst, Prst Active]--overrides = signal [Abst, Abst, Abst, Abst,-		    Prst Lock, Abst, Abst, Abst,-		    Abst, Prst CutBass, Abst, Abst,-		    Prst Release,  Abst, Abst, Abst]--testButtonControl = buttonControl overrides bassUp bassDn trebleUp trebleDn---testButtonInterface = buttonInterface  bassUp bassDn trebleUp trebleDn -\end{code}

@@ -1,17 +0,0 @@-\begin{code}-module TestFFT where--import ForSyDe.Shallow-import Data.Complex--toComplex a = a:+0--testDFT = dft 8 v3-testFFT = fft 8 v3--testBoth = zipWithV (-) testDFT testFFT--v1 = mapV toComplex (vector [1, 2])-v2 = mapV toComplex (vector [1, 2,3,4])-v3 = mapV toComplex (vector [1, 2, 3, 4, 5, 6, 7, 8])-\end{code}

@@ -1,30 +0,0 @@-\begin{code}-module TestDistortionControl where--import DistortionControl-import EqualizerTypes-import ForSyDe.Shallow--flag = signal-       [Abst, Abst, Abst, Prst Fail,-        Abst, Abst, Abst, Prst Fail,-	Abst, Abst, Abst, Prst Fail,-	Abst, Abst, Abst, Prst Fail,-        Abst, Abst, Abst, Prst Pass,-        Abst, Abst, Abst, Prst Pass,-        Abst, Abst, Abst, Prst Pass,-        Abst, Abst, Abst, Prst Pass,-	Abst, Abst, Abst, Prst Fail,-        Abst, Abst, Abst, Prst Fail,-        Abst, Abst, Abst, Prst Pass,-        Abst, Abst, Abst, Prst Pass,-        Abst, Abst, Abst, Prst Pass,-        Abst, Abst, Abst, Prst Pass,-	Abst, Abst, Abst, Prst Fail,-        Abst, Abst, Abst, Prst Pass,-	Abst, Abst, Abst, Prst Fail,-        Abst, Abst, Abst, Prst Pass,-        Abst, Abst, Abst, Prst Pass]        --testDistortionControl = distortionControl flag-\end{code}

@@ -1,94 +0,0 @@-\begin{code}-module TestEqualizer where--import System.IO-import Equalizer-import EqualizerTypes-import ForSyDe.Shallow-import AudioFilter-import AudioAnalyzer--audioIn = takeS (pts * 4) $ infiniteS (id) 1.0--bassUp = signal [Prst Active, Prst Active, Abst, Abst,-		 Prst Active, Prst Active, Abst, Abst,-		 Prst Active, Prst Active, Abst, Abst,-		 Prst Active, Prst Active, Abst, Abst]--bassDn = signal [Abst, Abst, Prst Active, Abst,-		 Abst, Abst, Prst Active, Abst,-		 Abst, Abst, Prst Active, Abst,-		 Abst, Abst, Prst Active, Abst]--trebleUp = signal [Abst, Abst, Abst, Abst,-		 Abst, Abst, Abst, Prst Active,-		 Abst, Abst, Abst, Abst,-		 Abst, Abst, Abst, Prst Active]--trebleDn = signal [Abst, Abst, Abst, Prst Active,-		 Abst, Abst, Abst, Prst Active,-		 Abst, Abst, Abst,  Prst Active,-		 Abst, Abst, Abst, Prst Active]--overrides = signal [Abst, Abst, Abst, Abst,-		    Prst Lock, Abst, Abst, Abst,-		    Abst, Prst CutBass, Abst, Abst,-		    Prst Release,  Abst, Abst, Abst]-bass = infiniteS id 0.0-treble = infiniteS id 0.0-dataflow = audioAnalyzer 2 (audioFilter lpCoeff bpCoeff hpCoeff bass treble audioIn)--testEqualizer = equalizer lpCoeff bpCoeff hpCoeff 2 bassUp bassDn trebleUp trebleDn audioIn---testButtonInterface = buttonInterface  bassUp bassDn trebleUp trebleDn -\end{code}--\begin{code}-lpCoeff = vector-     [ 0.01392741661548, 0.01396895728902,-       0.01399870011280, 0.01401657422649,-       0.01402253700635, 0.01401657422649,-       0.01399870011280, 0.01396895728902,-       0.01392741661548 ]--bpCoeff = vector-     [ 0.06318761339784, 0.08131651217682,-       0.09562326700432, 0.10478344432968,-       0.10793629404886, 0.10478344432968,-       0.09562326700432, 0.08131651217682,-       0.06318761339784 ]--hpCoeff = vector-     [ -0.07883878579454, -0.09820015927379,-       -0.11354603917221, -0.12339860164118,-        0.87320570334018, -0.12339860164118,-       -0.11354603917221, -0.09820015927379,-       -0.07883878579454 ]--zeros = infiniteS id 0.0--audioFilterD = audioFilter lpCoeff bpCoeff hpCoeff zeros zeros-pts = 4--main = do -          -- Test AudioFilter-          putStr "\n-->Test AudioFilter \n"-          filterInfile <- openFile "Test/AudioIn.mat" ReadMode-          filterContents <- hGetContents filterInfile -          putStr (show (audioFilterD (readS filterContents)))-          writeFile "Test/audioOut.dat" (writeS (audioFilterD (readS filterContents)))        -          -- Test AudioAnalyzer-          putStr "\n--> Test AudioAnalyzer \n"-          analyzerInfile <- openFile "Test/audioOut.dat" ReadMode-	  analyzerOutfile <- openFile "Test/analyzerOut.dat" WriteMode-	  analyzerContents <- hGetContents analyzerInfile-          putStr (show (audioAnalyzer pts ((readS analyzerContents) :: Signal Double)))-	  hPutStr analyzerOutfile (writeS (audioAnalyzer pts ((readS analyzerContents) :: Signal Double)))-          -	  --fftInfile <- openFile "audioOut.txt" ReadMode-	  --fftOutfile <- openFile "fftOut.txt" WriteMode-	  --contents <- hGetContents fftInfile-	  --putStr (writeS (((readS contents) :: Signal Double)))-	  --hPutStr fftOutfile (writeS (((readS contents) :: Signal Double)))-	  putStr "\nDone.\n"-\end{code}-

@@ -1,10 +0,0 @@-\begin{code}-module TestFIR(main) where--import ForSyDe.Shallow-import ForSyDe.Shallow.FIR-coeff = vector [0.1, -0.2, 0.5, 0.2]-s = signal [1.0, 0, 0, 0, 0]-main = do putStr (show (firSY coeff s))-          putStr "\nDone\n."-\end{code}

@@ -1,82 +0,0 @@-\begin{code}-module Main where--import IO-import ForSyDe.Shallow---import FixedPoint-import AudioFilter--zeros = infiniteS id 0.0--s = signal [0.1,0.05,0.3,0.2,-0.5,0.2,0.1,0.3,0.1,-0.1,0.0,0.2]--fs = 200-t = takeS 400 (infiniteS (+1/200) 0.0)- -cos10 x = cos (2*pi*10*x)-cos50 x = cos (2*pi*50*x)-cos90 x = cos (2*pi*90*x)--modCos x = cos10 x + cos50 x + cos90 x--audioIn = mapSY modCos t--lpCoeffD = vector [-   0.03898579822345,-   0.09739504968381,-   0.15360490491115,-   0.19416166962179,-   0.20893350067585,-   0.19416166962179,-   0.15360490491115,   -   0.09739504968381,-   0.03898579822345-   ]--bpCoeffD = vector [-  -0.07845593083988,-   0.00000000000000,-  -0.30707118658796,-   0.00000000000000,-   0.58268794919522,-   0.00000000000000,-  -0.30707118658796,-   0.00000000000000,-  -0.07845593083988-   ]--hpCoeffD = vector [-   0.03898579822345,  -  -0.09739504968381,   -   0.15360490491115,-  -0.19416166962179,-   0.20893350067585,-  -0.19416166962179,-   0.15360490491115,-  -0.09739504968381,-   0.03898579822345-  ]----lpCoeffF8 = mapV real2Fixed8 lpCoeffD---bpCoeffF8 = mapV real2Fixed8 bpCoeffD---hpCoeffF8 = mapV real2Fixed8 hpCoeffD---sF8	  = mapSY real2Fixed8 s----lpCoeffF16 = mapV real2Fixed16 lpCoeffD---bpCoeffF16 = mapV real2Fixed16 bpCoeffD---hpCoeffF16 = mapV real2Fixed16 hpCoeffD---sF16	  = mapSY real2Fixed16 s--audioFilterD = audioFilter lpCoeffD bpCoeffD hpCoeffD zeros zeros-outDouble = audioFilter lpCoeffD bpCoeffD hpCoeffD zeros zeros s---outF16	  = audioFilter lpCoeffF16 bpCoeffF16 hpCoeffF16 (mapSY real2Fixed16 zeros) (mapSY real2Fixed16 zeros) sF16---outF8	  = audioFilter lpCoeffF8 bpCoeffF8 hpCoeffF8 (mapSY real2Fixed8 zeros)(mapSY real2Fixed8 zeros) sF8----writeAudioOut = writeFile "Test/AudioOut.for") . writeS -readAudioIn = readFile "Test/AudioIn.mat"--testSeries = do contents <- readAudioIn-		writeFile "Test/AudioOutFSD.ext" (writeS (audioFilterD (readS contents)))---		writeAudioIn--\end{code}

@@ -1,11 +1,11 @@ name:           forsyde-shallow-version:        3.3.1.0-cabal-version:  >= 1.6+version:        3.3.2.0+cabal-version:  >= 1.8 build-type:     Simple license:        BSD3 license-file:   LICENSE-author:         ForSyDe Group, KTH/EECS/ES-copyright:      Copyright (c) 2003-2018 ForSyDe Group, KTH/EECS/ES+author:         ForSyDe Group, KTH/EECS/ELE+copyright:      Copyright (c) 2003-2018 ForSyDe Group, KTH/EECS/ELE maintainer:     ForSyDe Group <forsyde-dev@eecs.kth.se> homepage:       http://forsyde.ict.kth.se/ stability:      alpha@@ -14,7 +14,7 @@ description:   The ForSyDe (Formal System Design) methodology has been developed with the objective to move system design to a higher level of abstraction and to bridge the abstraction gap by transformational design refinement.   .- This library provides a shallow implementation of ForSyDe as a Haskell-embedded Domain Specific Language (DSL). For more information, please see ForSyDe's website: <http://forsyde.ict.kth.se/>.+ This library provides a shallow implementation of ForSyDe as a Haskell-embedded Domain Specific Language (DSL). For more information, please see ForSyDe's website: <http://forsyde.ict.kth.se/>. For examples and tutorials using @ForSyDe.Shallow@, check the <https://github.com/forsyde/forsyde-shallow-examples forsyde-shallow-examples> repository.  .  This package is a spin-off of the <https://hackage.haskell.org/package/ForSyDe ForSyDe> project and it follows its versioning.  category:       Language@@ -24,23 +24,7 @@  -- In order to include all this files with sdist extra-source-files: LICENSE,-                    README,-                    INSTALL,-                    examples/Equalizer_Shallow/README,-                    examples/Equalizer_Shallow/AudioAnalyzer.lhs,-                    examples/Equalizer_Shallow/AudioFilter.lhs,-                    examples/Equalizer_Shallow/ButtonControl.lhs,-                    examples/Equalizer_Shallow/DistortionControl.lhs,-                    examples/Equalizer_Shallow/Equalizer.lhs,-                    examples/Equalizer_Shallow/EqualizerTypes.lhs,-                    examples/Equalizer_Shallow/Test/AudioIn.mat,-                    examples/Equalizer_Shallow/TestAnalyzer.lhs,-                    examples/Equalizer_Shallow/TestButtonControl.lhs,-                    examples/Equalizer_Shallow/TestDFT.lhs,-                    examples/Equalizer_Shallow/TestDistortionControl.lhs,-                    examples/Equalizer_Shallow/TestEqualizer.lhs,-                    examples/Equalizer_Shallow/TestFilter.lhs,-                    examples/Equalizer_Shallow/TestFIR.lhs+                    README.md   source-repository head@@ -53,33 +37,41 @@                    old-time,                    process,                    random--   hs-source-dirs:  src-  exposed-modules: ForSyDe.Shallow,-                   ForSyDe.Shallow.AbsentExt,-                   ForSyDe.Shallow.MoCLib,-                   ForSyDe.Shallow.AdaptivityLib,-                   ForSyDe.Shallow.PolyArith,-                   ForSyDe.Shallow.BitVector,-                   ForSyDe.Shallow.Queue,-                   ForSyDe.Shallow.CTLib,-                   ForSyDe.Shallow.Signal,-                   ForSyDe.Shallow.CoreLib,-                   ForSyDe.Shallow.StochasticLib,-                   ForSyDe.Shallow.DFT,-                   ForSyDe.Shallow.SynchronousLib,-                   ForSyDe.Shallow.DomainInterfaces,-                   ForSyDe.Shallow.SynchronousProcessLib,-                   ForSyDe.Shallow.FIR,-                   ForSyDe.Shallow.UntimedLib,-                   ForSyDe.Shallow.FilterLib,-                   ForSyDe.Shallow.UtilityLib,-                   ForSyDe.Shallow.Gaussian,-                   ForSyDe.Shallow.Vector,-                   ForSyDe.Shallow.Memory,-                   ForSyDe.Shallow.DataflowLib,-                   ForSyDe.Shallow.SDFLib,-                   ForSyDe.Shallow.MoCInterfaces-+  exposed-modules: ForSyDe.Shallow+                 , ForSyDe.Shallow.Core+                 , ForSyDe.Shallow.Core.Signal+                 , ForSyDe.Shallow.Core.Vector+                 , ForSyDe.Shallow.Core.AbsentExt+                 , ForSyDe.Shallow.Core.BitVector+                 , ForSyDe.Shallow.MoC+                 , ForSyDe.Shallow.MoC.CT+                 , ForSyDe.Shallow.MoC.Synchronous+                 , ForSyDe.Shallow.MoC.Synchronous.Lib+                 , ForSyDe.Shallow.MoC.Synchronous.Process+                 , ForSyDe.Shallow.MoC.Synchronous.Stochastic+                 , ForSyDe.Shallow.MoC.Adaptivity+                 , ForSyDe.Shallow.MoC.Untimed+                 , ForSyDe.Shallow.MoC.Dataflow+                 , ForSyDe.Shallow.MoC.SDF+                 , ForSyDe.Shallow.MoC.DomainInterface+                 , ForSyDe.Shallow.MoC.MoCInterface+                 , ForSyDe.Shallow.Utility+                 , ForSyDe.Shallow.Utility.PolyArith+                 , ForSyDe.Shallow.Utility.Queue+                 , ForSyDe.Shallow.Utility.DFT+                 , ForSyDe.Shallow.Utility.FIR+                 , ForSyDe.Shallow.Utility.FilterLib+                 , ForSyDe.Shallow.Utility.Gaussian+                 , ForSyDe.Shallow.Utility.Memory   ghc-options:	-Wall -fno-warn-name-shadowing+++Test-Suite unit+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Spec.hs+  build-depends:  base>=4 && <6+                , forsyde-shallow+                , hspec >= 2.2.4+  ghc-options:  -threaded -rtsopts -with-rtsopts=-N

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- |--- Module  :  ForSyDe.Shallow--- Copyright   :  (c) SAM Group, KTH/ICT/ECS 2007-2008+-- Module      :  ForSyDe.Shallow+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008 -- License     :  BSD-style (see the file LICENSE) --  -- Maintainer  :  forsyde-dev@ict.kth.se@@ -9,35 +9,33 @@ -- Portability :  portable -- ----- Shallow-embedded implementation of ForSyDe (see "ForSyDe.Shallow.Signal"). +-- Shallow-embedded implementation of ForSyDe (see "ForSyDe.Shallow.Core.Signal").  -- -- Unlike systems built using the deep-embedded Signal type of ForSyDe--- (see 'ForSyDe.Signal'), systems built with 'ForSyDe.Shallow.Signal'--- can make use of new and experimental features such as multiple,--- heterogeneous MoCs (Models of Computation) other than the Synchronous--- MoC (the only Model of Computation currently supported by deep-embdded--- ForSyDe). However, as an important tradeoff, 'ForSyDe.Shallow.Signal'--- is unaware of the resulting system structure, only allowing simulation --- (i.e. a VHDL or GraphML backend is impossible to implement).--- --- The shallow implementation of ForSyDe consists of three main libraries:--- --- * "ForSyDe.Shallow.CoreLib" contains the basic definitions and---   functions such as events and signals.------ * "ForSyDe.Shallow.MoCLib" defines the models of computations---   included in ForSyDe.------ * "ForSyDe.Shallow.UtilityLib" provides several additional modules---   that are useful and convenient in practice. Their status is---   experimental.---+-- (see @forsyde-deep@), systems built with+-- 'ForSyDe.Shallow.Core.Signal' can make use of new and experimental+-- features such as multiple, heterogeneous MoCs (Models of+-- Computation) other than the Synchronous MoC (the only Model of+-- Computation currently supported by deep-embdded ForSyDe). However,+-- as an important tradeoff, 'ForSyDe.Shallow.Core.Signal' is unaware+-- of the resulting system structure, only allowing simulation (i.e. a+-- VHDL or GraphML backend is impossible to implement). ------------------------------------------------------------------------------module ForSyDe.Shallow(module ForSyDe.Shallow.CoreLib-      , module ForSyDe.Shallow.MoCLib-      , module ForSyDe.Shallow.UtilityLib-      ) where+module ForSyDe.Shallow(+  -- | The "ForSyDe.Shallow.Core" module contains the basic+  --   definitions and functions such as events and signals.+  module ForSyDe.Shallow.Core, -import ForSyDe.Shallow.CoreLib-import ForSyDe.Shallow.MoCLib-import ForSyDe.Shallow.UtilityLib+  -- | The "ForSyDe.Shallow.MoC" module defines the models of+  --   computations included in ForSyDe.+  module ForSyDe.Shallow.MoC,++  -- | The "ForSyDe.Shallow.Utility" module provides several+  --   additional modules that are useful and convenient in+  --   practice.+  module ForSyDe.Shallow.Utility+  ) where++import ForSyDe.Shallow.Core+import ForSyDe.Shallow.MoC+import ForSyDe.Shallow.Utility

@@ -1,88 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.AbsentExt--- 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 'AbstExt' is used to extend existing data types with the value---  \'absent\', which models the absence of a value.--- -------------------------------------------------------------------------------module ForSyDe.Shallow.AbsentExt( -    AbstExt (Abst, Prst), fromAbstExt, abstExt, psi, -      isAbsent, isPresent, abstExtFunc)-    where------- |The data type 'AbstExt' has two constructors. The constructor 'Abst' is used to model the absence of a value, while the constructor 'Prst' is used to model present values.-data AbstExt a     =  Abst   -       |  Prst a deriving (Eq)------ |The function 'fromAbstExt' converts a value from a extended value.-fromAbstExt   :: a -> AbstExt a -> a--- |The functions 'isPresent' checks for the presence of a value.-isPresent   :: AbstExt a -> Bool--- |The functions 'isAbsent' checks for the absence of a value.-isAbsent   :: AbstExt a -> Bool--- |The function 'abstExtFunc' extends a function in order to process absent extended values. If the input is (\"bottom\"), the output will also be  (\"bottom\").-abstExtFunc   :: (a -> b) -> AbstExt a -> AbstExt b--- | The function 'psi' is identical to 'abstExtFunc' and should be used in future.-psi :: (a -> b) -> AbstExt a -> AbstExt b--- | The function 'abstExt' converts a usual value to a present value. -abstExt :: a -> AbstExt a--------- Implementation of Library Functions---- | The data type 'AbstExt' is defined as an instance of 'Show' and 'Read'. \'_\' represents the value 'Abst' while a present value is represented with its value, e.g.  'Prst' 1 is represented as \'1\'.-instance Show a => Show (AbstExt a) where-   showsPrec _   = showsAbstExt--showsAbstExt :: Show a => AbstExt a -> String -> String-showsAbstExt Abst   = (++) "_"   -showsAbstExt (Prst x)   = (++) (show x)--instance Read a => Read (AbstExt a) where-    readsPrec _   =  readsAbstExt --readsAbstExt     :: (Read a) => ReadS (AbstExt a)-readsAbstExt s     =     [(Abst, r1)    | ("_", r1) <- lex s]-              ++ [(Prst x, r2)  | (x, r2) <- reads s]--abstExt       =  Prst--fromAbstExt x Abst   =  x   -fromAbstExt _ (Prst y)   =  y   --isPresent Abst     =  False-isPresent (Prst _)   =  True--isAbsent     =  not . isPresent--abstExtFunc f     = f' -  where f' Abst     = Abst-        f' (Prst x)   = Prst (f x)---psi       = abstExtFunc---------

@@ -1,34 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.AdaptivityLib--- 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------ Adaptivity Library, yet to be completed.--- -------------------------------------------------------------------------------module ForSyDe.Shallow.AdaptivityLib (applyfSY, applyf2SY, applyf3SY, -              applyfU) where--import ForSyDe.Shallow.Signal-import ForSyDe.Shallow.SynchronousLib-import ForSyDe.Shallow.UntimedLib--applyfSY :: Signal (a -> b) -> Signal a -> Signal b-applyfSY = zipWithSY ($)--applyf2SY :: Signal (a -> c -> d) -      -> Signal a -> Signal c -> Signal d-applyf2SY = zipWith3SY ($)--applyf3SY :: Signal (a -> c -> d -> e) -      -> Signal a -> Signal c -> Signal d -> Signal e-applyf3SY = zipWith4SY ($)--applyfU :: Int -> Signal ([a] -> [b]) -> Signal a -> Signal b-applyfU tokenNum = comb2UC tokenNum apply-  where apply f = f

@@ -1,122 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.BitVector--- 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------ It defines the bit vector operations from\/to integer.-------------------------------------------------------------------------------module ForSyDe.Shallow.BitVector(-    -- *Polynomial data type-    BitVector, Parity(..),-    -- *Bit-vector and integer transformations-    intToBitVector, bitVectorToInt,-    -- *Add even\/odd parity bit-    addEvenParityBit, addOddParityBit, addParityBit,-    -- *Remove parity bit-    removeParityBit,-    -- *Check the even\/odd parity of the bit-vector-    isEvenParity, isOddParity,-    -- *Judge the form sanity of the bit-vector-    isBitVector-  )-  where--import ForSyDe.Shallow.Vector--type BitVector = Vector Integer---- |To judge whether the input bit-vector is in a proper form.-isBitVector :: (Num t, Eq t) =>-      Vector t  -- ^Input bit-vector-   -> Bool  -- ^Output boolean value-isBitVector NullV = True-isBitVector (x:>xs) = (x `elem` [0, 1]) && isBitVector xs---- |To transform the input integer to a bit-vector with specified number of--- bits.-intToBitVector :: Int  -- ^Num of the bits-       -> Integer  -- ^The input integer-       -> BitVector -- ^The output bit-vector-intToBitVector bits n | n >= 0 && n < 2^(bits-1) -       = intToBitVector' bits n-intToBitVector bits n | n < 0 && abs n <= 2^(bits-1) -       = intToBitVector' bits (n + 2^bits)-intToBitVector _    _ | otherwise = -      error "intToBitvector : Number out of range!" ---- |Helper function of 'intToBitVector'.-intToBitVector' :: (Num a, Ord a1, Num a1, Integral t) => -       t -> a1 -> Vector a-intToBitVector' 0    _ = NullV-intToBitVector' bits n = if n >= 2^(bits-1) then-         1 :> intToBitVector' (bits-1) (n - 2^(bits-1))-       else  -         0 :> intToBitVector' (bits-1) n---- |To transform the input bit-vecotr to an integer.-bitVectorToInt :: BitVector -> Integer-bitVectorToInt (1:>xv) | isBitVector xv -       = bitVectorToInt' xv (lengthV xv) - 2 ^ lengthV xv -bitVectorToInt (0:>xv) | isBitVector xv -       = bitVectorToInt' xv (lengthV xv)-bitVectorToInt _ = error "bitVectorToInt: Vector is not a BitVector!"----- |Helper function of 'bitVectorToInt'.-bitVectorToInt' :: (Integral a, Num t) => Vector t -> a -> t-bitVectorToInt' NullV   _   = 0-bitVectorToInt' (x:>xv) bit = x * 2^(bit-1) + bitVectorToInt' xv (bit-1)--data Parity = Even | Odd deriving (Show, Eq)---- |To add even parity bit on the bit-vector in the tail.-addEvenParityBit :: (Num a, Eq a) => Vector a -> Vector a-addEvenParityBit = addParityBit Even--- |To add odd parity bit on the bit-vector in the tail.-addOddParityBit :: (Num a, Eq a) => Vector a -> Vector a-addOddParityBit  = addParityBit Odd--addParityBit :: (Num a, Eq a) => Parity -> Vector a -> Vector a-addParityBit p v -  | isBitVector v = case p of-    Even -> resZero even-    Odd -> resZero (not even)-  | otherwise =  error "addParity: Vector is not a BitVector"  - where even = evenNumber v -       resZero b = v <+> unitV (if b then 0 else 1)----- |To remove the parity bit in the tail.-removeParityBit :: (Num t, Eq t) => Vector t -> Vector t-removeParityBit v - | isBitVector v = takeV (lengthV v - 1) v- | otherwise = error "removeParityBit: Vector is not a BitVector "---- |To check the even parity of the bit-vector.-isEvenParity :: (Num t, Eq t) => Vector t -> Bool-isEvenParity = isParityCorrect Even---- |To check the odd parity of the bit-vector.-isOddParity :: (Num t, Eq t) => Vector t -> Bool-isOddParity = isParityCorrect Odd--isParityCorrect :: (Num t, Eq t) => Parity -> Vector t -> Bool -isParityCorrect Even xv = evenNumber xv-isParityCorrect Odd xv  = not $ evenNumber xv --evenNumber :: (Num t, Eq t) => Vector t -> Bool-evenNumber NullV   = True-evenNumber (0:>xv) = xor False (evenNumber xv)-evenNumber (1:>xv) = xor True (evenNumber xv)-evenNumber (_:>_) = error "evenNumber: Vector is not a BitVector "-         -xor :: Bool -> Bool -> Bool-xor True  False = True-xor False True  = True-xor _     _     = False -

@@ -1,1078 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.CTLib--- 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------ This is the ForSyDe library for continuous time MoC (CT-MoC).--- It is still experimental.--- Right now there are only constructors 'combCT', 'scaleCT', 'addCT',--- 'multCT' and 'absCT'.------ The main idea is to represent continuous time signals as functions--- @Real --> a@ with @a@ being a numerical type. This allows us to represent a --- continuous time signal without loss of information because no sampling or --- ADC is required. The sampling occurs only when a signal is evaluated, --- for instance when it is plotted. --- --- Thus, a /signal/ is represented as a sequence of functions and intervals. For--- instance a signal --- --- @s = \<(sin,[0,100])\>@ ------ represents a sinus signal in the interval between 0 and 100. The signal ------ @s2 = \<(f1(x)=2x, [0,2]), (f2(x)=3+x,[2,4])\>@------ defines a signal that is defined by function @f1@ in the interval @[0,2]@ --- and by function @f2@ in the interval @[2,4]@. ------ A /process/ transforms the incoming functions into outgoing functions. --- The approach is described in more detail in the ANDRES deliverable D1.1a.--- Here we only briefly comment the main functions and constructors.------------------------------------------------------------------------------module ForSyDe.Shallow.CTLib (---  module ForSyDe.Shallow.CoreLib,-  -- * The signal data type-  SubsigCT(..),-  ctSignal,-  liftCT,-  timeStep,-  -- * Primary process constructors-  mapCT, zipWithCT,-  combCT, comb2CT,-  -- mooreCT, mealyCT, delayCT, initCT,-  -- * Derived process constructors-  -- | These constructors instantiate very useful processes.-  -- They could be defined in terms of the basic constructors-  -- but are typically defined in a more direct way for -  -- the sake of efficieny.-  scaleCT, addCT, multCT, absCT,-  -- * Convenient functions and processes-  -- | Several helper functions are available to obtain parts-  -- of a signal, the duration, the start time of a signal, and-  -- to generate a sine wave and constant signals.-  takeCT, dropCT, duration, startTime, sineWave, -- constCT, zeroCT,-  -- * AD and DA converters-  DACMode(..), a2dConverter, d2aConverter,-  -- * Some helper functions-  applyF1, applyF2, applyG1, cutEq, -  -- * Sampling, printing and plotting-  -- $plotdoc-  plot, plotCT, plotCT' ,showParts, vcdGen-  ) where--import ForSyDe.Shallow.CoreLib-import System.Process-import System.Time---import System.IO-import System.Directory-import Control.Exception-import Data.Ratio---import Numeric()---- The revision number of this file:-revision :: String-revision=filter (\ c -> (not (c=='$'))) "$Revision: 1.7 $, $Date: 2007/07/11 08:38:34 $"---- |The type of a sub-signal of a continuous signal. It consisits of the ---  function and the interval on which the function is defined.--- The continuous time signal is then defined as a sequence of SubsigCT --- elements: Signal SubsigCT-data SubsigCT a = SubsigCT ((Rational -> a),     -- The function Time -> Value-            (Rational,Rational)) -- The interval on which the-                 --  function is defined--instance (Num a, Show a) => Show (SubsigCT a) where-    show ss = show (sampleSubsig timeStep ss)---- | The function 'liftCT' creates a CT-compliant function (using the--- Rationals as domain) from a normal mathematical function that uses a--- fractional (Double) as domain-liftCT :: Fractional a => (a -> b) -> Rational -> b-liftCT f = f . fromRational---- | The function 'ctSignal' creates a CT signal from a list of--- subsignals that are given by a function, an a time range.------ > *ForSyDe.Shallow.CTLib> ctsig1 = ctSignal [(liftCT sin, (0, 3.14)), (\t -> 1, (3.14, 6.28))]--- > *ForSyDe.Shallow.CTLib> :t ctsig1--- > ctsig1 :: Floating a => Signal (SubsigCT a)-- ctsig1 = ctSignal [(liftCT sin, (0, 3.14)), (\t -> 1, (3.14, 6.28))]-ctSignal :: [(Rational -> a, (Rational, Rational))] -> Signal (SubsigCT a)-ctSignal []           = NullS-ctSignal ((f, (start, end)) : xs) = SubsigCT (f, (start, end)) :- ctSignal xs----unit :: String -- all time numbers are in terms of this unit.---unit = "sec" ---- | This constant gives the default time step for sampling and plotting.--- Its value is 10ns.-timeStep :: Rational ---timeStep = 10.0e-9-timeStep = 10.0e-2--mapCT :: (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)-mapCT _ NullS = NullS-mapCT g (SubsigCT (f, (f_start, f_end)):-fs)-  = (SubsigCT (\x -> g (f x), (f_start, f_end)) :- mapCT g fs)--zipWithCT :: (a -> b -> c) -> Signal (SubsigCT a) -> Signal (SubsigCT b) -> Signal (SubsigCT c)-zipWithCT _ NullS _ = NullS-zipWithCT _ _ NullS = NullS-zipWithCT h (SubsigCT (f, (f_start, f_end)):-fs) (SubsigCT (g, (g_start, g_end)):-gs)-    | f_start /= g_start = error "Start times not aligned"-    | f_end == g_end     = (SubsigCT (\x -> h (f x) (g x), (f_start, f_end)) :- zipWithCT h fs gs)-    | f_end < g_end  = (SubsigCT (\x -> h (f x) (g x), (f_start, f_end))-          :- zipWithCT h fs (SubsigCT (g, (f_end, g_end)) :- gs))           -    | f_end > g_end  = (SubsigCT (\x -> h (f x) (g x), (f_start, g_end))-          :- zipWithCT h (SubsigCT (f, (g_end, f_end)) :- fs) gs)-    | otherwise = error "zipWithCT: pattern not covered"--combCT :: (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)-combCT = mapCT--comb2CT :: (a -> b -> c) -> Signal (SubsigCT a) -> Signal (SubsigCT b) -> Signal (SubsigCT c)-comb2CT = zipWithCT--delayCT :: Rational -> a -> Signal (SubsigCT a) -> Signal (SubsigCT a)    -delayCT period value fs    = (SubsigCT (\_ -> value, (0,period))) :- addTime period fs            --addTime :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)-addTime _     NullS          = NullS-addTime delay (SubsigCT (f, (start, end)) :- fs) = (SubsigCT (f, (start+delay, end+delay)) :- addTime delay fs)--{--------- | initCT takes an initial signal, outputs it and then copies its second --- input signal, which is delayed by the duration of the initial signal.--- The delay is realized by 'delayCT' -initCT :: (Num a, Show a) => -      Signal (SubsigCT a) -- ^ The initial signal output first.-   -> Signal (SubsigCT a) -- ^ Then this signal is output, but delayed.-   -> Signal (SubsigCT a) -- ^ The concatation of the two inputs.-initCT s0 s1 = s0 +-+ (delayCT (duration s0) s1)--}-    -{-   --------------------------------------------------------------------------------- |The state-full constructor 'mealyCT' resembles a Mealy machine.-mealyCT :: (Num b, Num c, Show b, Show c) =>-       (a -> Rational)      -- ^The gamma function which defines-               -- the partitioning of the input-               -- signal. -   -> (a -> (Rational -> b) -> a) -- ^The next state function g-   -> (a -> (Rational -> b) -> (Rational -> c))-               -- ^The output encoding function f -   -> a          -- ^The initial state-   -> Signal (SubsigCT b)        -- ^The input signal-   -> Signal (SubsigCT c)        -- ^The output signal-mealyCT _     _ _ _ NullS = NullS-mealyCT gamma g f w s-    | (duration (takeCT c s)) < c = NullS-    | otherwise = applyF1 (f w) (takeCT c s) -    +-+ mealyCT gamma g f w' (dropCT c s)-    where c = gamma w-  w' = applyG1 g w (takeCT c s)---- |The state-full constructor 'mooreCT' resembles a Moore machine.-mooreCT :: (Num b, Num c, Show b, Show c) =>-       (a -> Rational)      -- ^The gamma function which defines-               -- the partitioning of the input-               -- signal. -   -> (a -> (Rational -> b) -> a) -- ^The next state function g-   -> (a -> (Rational -> c))-               -- ^The output encoding function f -   -> a          -- ^The initial state-   -> Signal (SubsigCT b)        -- ^The input signal-   -> Signal (SubsigCT c)        -- ^The output signal-mooreCT _     _ _ _ NullS = NullS-mooreCT gamma g f w s-    | (duration (takeCT c s)) < c = NullS-    | otherwise = (SubsigCT ((f w),(a,b))) -      :- mooreCT gamma g f w' (dropCT c s)-    where c = gamma w-      a = startTime s-      b = a + c-  w' = applyG1 g w (takeCT c s)------------------------------------------------------------------------------ Some useful process constructors:--- --}--- |'scaleCT' amplifies an input by a constant factor:-scaleCT :: (Num a, Show a) =>-       a       -- ^The scaling factor-    -> Signal (SubsigCT a) -- ^The input signal-    -> Signal (SubsigCT a) -- ^The output signal of the process-scaleCT factor = mapCT (* factor)---- |'addCT' adds two input signals together.-addCT :: (Num a, Show a) =>-     Signal (SubsigCT a) -- ^The first input signal-  -> Signal (SubsigCT a) -- ^The second input signal-  -> Signal (SubsigCT a) -- ^The output signal-addCT = zipWithCT (+)---- |'multCT' multiplies two input signals together.-multCT :: (Num a, Show a) =>-      Signal (SubsigCT a) -- ^The first input signal-   -> Signal (SubsigCT a) -- ^The second input signal-   -> Signal (SubsigCT a) -- ^The output signal-multCT = zipWithCT (*)---- |'absCT' takes the absolute value of a signal.-absCT :: (Num a,Ord a, Show a) =>-     Signal (SubsigCT a) -- ^The input signal-  -> Signal (SubsigCT a) -- ^The output signal-absCT = mapCT abs----scaleCT k = applyF1 f'---    where f' f x = k * (f x)--{---- |'scaleCT' has the same functionality as scaleCT but operates with a--- given signal partitioning rather than on the --- SubsigCT elements.---scaleCT' :: (Num a) =>---    Rational -- The sampling period---     -> a    -- The scaling factor---     -> Signal (SubsigCT a) -> Signal (SubsigCT a)---scaleCT' step k = combCT step f---    where f g = f'---  where f' x = k * (g x)--}---addCT s1 s2 = applyF2 f s1' s2'---    where (s1',s2') = cutEq s1 s2---      f g1 g2 = f'---      where f' x = (g1 x) + (g2 x)-{-  --- addCT' has the same functionality as addCT but operates with a--- given signal partitioning rather than on the SubsigCT elements.--- addCT' :: (Num a) =>---       Rational      -- The sampling period---    -> Signal (SubsigCT a) -- The first input signal---    -> Signal (SubsigCT a) -- The second input signal---    -> Signal (SubsigCT a) -- The output signal--- addCT' step = combCT2 step f---     where f g1 g2 = f'---   where f' x = (g1 x) + (g2 x)--}-{--multCT s1 s2 = applyF2 f s1' s2'-    where (s1',s2') = cutEq s1 s2-      f g1 g2 = f'-      where f' x = (g1 x) * (g2 x)---- multCT' has the same functionality as multCT but operates with a--- given signal partitioning rather than on the SubsigCT elements.--- multCT' :: (Num a) =>---    Rational      -- The sampling period---     -> Signal (SubsigCT a) -- The first input signal---     -> Signal (SubsigCT a) -- The second input signal---     -> Signal (SubsigCT a) -- The output signal--- multCT' step = combCT2 step f---     where f g1 g2 = f'---       where f' x = (g1 x) * (g2 x)--}-{-  -absCT = applyF1 f-    where f g = f'-  where f' x | (g x) <= 0 = (-1) * (g x)-         | otherwise  = (g x)--}--- | 'sineWave' generates a sinus signal with the given frequency defined--- over  a given period. The function is defined as @f(x)=sin(2*pi*freq*x)@.-sineWave :: (Floating a, Show a) =>-    Rational      -- ^The frequency-     -> (Rational,Rational) -- ^The interval of the signal-     -> Signal (SubsigCT a) -- ^The generated signal-sineWave freq timeInterval -    = signal [SubsigCT (sineFunction, timeInterval)]-  where -    sineFunction :: (Floating a) => Rational -> a-    --sineFunction t = sin (2*pi * freq * t)-    sineFunction t = (sin (2*pi * (fromRational (freq * t))))--{---- | constCT generates a constant signal for a given time duration.-constCT :: (Num a, Show a) => -       Rational -- ^ The time duration of the generated signal.-    -> a    -- ^ The constant value of the signal.-    -> Signal (SubsigCT a) -- ^ The resulting signal.-constCT t c = signal [SubsigCT ((\_->c), (0,t))]---- | zeroCT generates a constant 0 signal for the given time duration.-zeroCT :: (Num a, Show a) => -      Rational    -- ^ The time duration-   -> Signal (SubsigCT a) -- ^ The generated signal.-zeroCT t = constCT t 0--}-    --------------------------------------------------------------------------------- DA and AD converter processes:------ |For the digital-analog conversion we have two different possibilities--- which is determined by this data type 'DACMode'.-data DACMode = DAlinear -- ^linear interpolation-     | DAhold   -- ^the last digital value is frozen-  deriving (Show, Eq)--{- |'d2aConverter' converts an untimes or synchronous signal into a - continuous time signal.- The process 'd2aConverter' converts a signal of the digital domain- into a continuous time signal. There are two modes, 'DAlinear',- which makes a smooth transition between adjacent digital values and- 'DAhold', where the analog value directly follows the digital- value. This means that in 'DAhold'-mode a staircase function- remains a staircase function, while in 'DAlinear' the staircase- function would resemble at least partially a /saw tooth/-curve. -- The resolution of the converter is given by the parameter- 'timeStep'.-- Note, that the process 'd2aConverter' is an ideal component, i.e. there- are no losses due to a limited resolution due to a fixed number of bits. --}-d2aConverter :: (Fractional a, Show a) =>-        DACMode       -- ^Mode of conversion-      -> Rational       -- ^Duration of input signal-      -> Signal a     -- ^Input signal (untimed MoC)-      -> Signal (SubsigCT a)  -- ^Output signal (continuous time MoC)-d2aConverter mode c xs-    | mode == DAlinear = d2aLinear c 0.0 xs-    | otherwise = d2aHolder c 0.0 xs-  where-    d2aHolder :: (Num a, Show a) => -         Rational -> Rational -> Signal a -> Signal (SubsigCT a)-    d2aHolder _ _ NullS = NullS-    d2aHolder c holdT (x:-xs) = (SubsigCT (constRationalF x,(holdT,holdT+c)) )-            :- d2aHolder c (holdT+c) xs--    d2aLinear :: (Fractional a, Show a) =>-         Rational -> Rational -> Signal a -> Signal (SubsigCT a)-    d2aLinear _ _ NullS = NullS-    d2aLinear _ _ (_:-NullS) = NullS-    d2aLinear c holdT (x:-y:-xs) = -          (SubsigCT (linearRationalF c holdT x y,(holdT,holdT+c)) )-              :- d2aLinear c (holdT+c) (y:-xs)--constRationalF :: (Num a) => a -> Rational -> a-constRationalF = (\x _->x)--linearRationalF :: (Fractional a) =>-       Rational -> Rational -> a -> a -> Rational -> a-linearRationalF c holdT m n x = (1-alpha)*m + alpha*n-  where alpha :: (Fractional a) => a-        alpha = fromRational ((x-holdT)/c)--{- | The process 'a2dConverter' converts a continuous time signal to-   an untimed or synchronous signal. The first parameter gives the-   sampling period of the converter.--   Note, that the process 'a2dConverter' is an ideal component,-   i.e. there are no losses due to a limited resolution due to a fixed-   number of bits.  --}-a2dConverter :: (Num a, Show a) =>-        Rational    -- ^Sampling Period-     -> Signal (SubsigCT a) -- ^Input signal (continuous time)-     -> Signal a    -- ^Output signal (untimed)-a2dConverter _ NullS = NullS-a2dConverter c s | (duration (takeCT c s)) < c = NullS-         | otherwise = f (takeCT c s)-           +-+ a2dConverter c (dropCT c s)-    where f :: (Num a, Show a) => Signal (SubsigCT a) -> Signal a-          f NullS = NullS-          f (SubsigCT (g,(a,_)) :- _) = signal [g a]---------------------------------------------------------------------------- Helpter functions for the CT MoC:--- | applyF1 applies a function on a sub-signal, which means the function of --- the subsignal is transformed to another function:-applyF1 :: (Num a, Num b, Show a, Show b) =>-       ((Rational -> a) -> (Rational -> b)) -- The transformer-    -> Signal (SubsigCT a)            -- The input signal-    -> Signal (SubsigCT b)            -- The output signal-applyF1 _ NullS = NullS-applyF1 f (ss :- s) = (applyF' f ss) :- (applyF1 f s)-  where applyF' :: (Num a, Num b, Show a, Show b)-                   => ((Rational -> a) -> (Rational -> b)) -                   -> (SubsigCT a) -> (SubsigCT b)-        applyF' f (SubsigCT (f',(a,b))) = SubsigCT ((f f'), (a,b))---- | applyF2 works just like applyF1 but operates on two incoming signals.-applyF2 :: (Num a, Num b, Num c, Show a, Show b, Show c) =>-       ((Rational -> a) -> (Rational->b) -> (Rational -> c))-    -> Signal (SubsigCT a) -    -> Signal (SubsigCT b) -    -> Signal (SubsigCT c) -applyF2 _ NullS _ = NullS-applyF2 _ _ NullS = NullS-applyF2 f (ss1 :- s1) (ss2 :- s2) = (applyF' f ss1 ss2) :- (applyF2 f s1 s2)-  where applyF' f (SubsigCT (f1,(a,b))) (SubsigCT (f2,(c,d))) -          | (a==c) && (b==d) -            || (abs (a-c)< 0)-            || (abs (b-d)< 0) = SubsigCT ((f f1 f2), (a,b))-          | otherwise    = error ("applyF2: The two subintervals are"-                                  ++ " not identical: (a,b) = ("-                                  ++ (show a) ++ ", "-                                  ++ (show b) ++ "); (c,d) = ("-                                  ++ (show c) ++ ", "-                                  ++ (show d) ++ ").")---- | applyG1 is used to apply a next-state function. A very interesting--- question is, what should be an argument to the next-state function: --- the incoming function, defining the value of the input signal?--- or the incoming function and the incoming interval?--- or the value of the incoming signal at a particular point, e.g. at the --- left most point of the interval?--- To give the next-state function the interval itself as argument, would mean--- that the process becomes time variant process, i.e. its behaviour is --- dependent on the absolute time values. This is not a good thing to have!--- Another possibility may be to give a sub-signal that is relative to the --- current evaluation, i.e. the left most point is always 0. Would that make--- sense?-applyG1 :: (Num b, Show b) =>-       (a -> (Rational -> b) -> a) -> a -> Signal (SubsigCT b) -> a-applyG1 _ w NullS = w-applyG1 g w (ss :- _) = applyG1' g w ss-    where -    applyG1' :: (Num b, Show b) =>-        (a -> (Rational -> b) -> a) -> a -> (SubsigCT b) -> a-    applyG1' g w (SubsigCT (f, (_,_))) = g w f---- | cutEq partitions the two signals such that the partitioning are identical--- in both result signals, but only up to the duration of the shorter of the --- two signals:-cutEq :: (Num a, Num b, Show a, Show b) =>-     Signal (SubsigCT a) -> Signal (SubsigCT b) -  -> (Signal (SubsigCT a), Signal (SubsigCT b))-cutEq NullS s2 = (NullS, s2) -cutEq s1 NullS = (s1, NullS) -cutEq s1 s2 = unzipCT (cutEq' s1 s2)-    where -    cutEq' :: (Num a, Num b, Show a, Show b) =>-      Signal (SubsigCT a) -> Signal  (SubsigCT b) -      -> Signal ((SubsigCT a), (SubsigCT b))-    cutEq' NullS _    = NullS-    cutEq' _ NullS    = NullS-    cutEq' (ss1:-s1) (ss2:-s2) -      | dur1 == dur2 = (ss1,ss2) :- (cutEq' s1 s2)-      | dur1 <  dur2 = (ss1, takeSubSig dur1 ss2) -                       :- (cutEq' s1 ((dropSubSig dur1 ss2) :- s2))-      | dur1 >  dur2 = (takeSubSig dur2 ss1, ss2)-                       :- (cutEq' ((dropSubSig dur2 ss1) :- s1) s2)-      | otherwise = error ("cutEq' pattern match error: dur1="++(show dur1)-                           ++ ", dur2="++ (show dur2)++";")-      where dur1 = durationSS ss1-            dur2 = durationSS ss2--unzipCT :: Num a => Signal ((SubsigCT a), (SubsigCT b)) -        -> (Signal (SubsigCT a), Signal (SubsigCT b))-unzipCT NullS = (NullS, NullS)-unzipCT ((ss1,ss2) :- s) = (ss1:-s1, ss2:-s2)-    where (s1,s2) = unzipCT s---- The take and drop functions on CT signals:-takeCT :: (Num a, Show a) => -      Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)-takeCT _ NullS = NullS-takeCT 0 _     = NullS-takeCT c (ss:-s) | (durationSS ss) >= c = (takeSubSig c ss) :- NullS-         | otherwise    = ss :- (takeCT (c - (durationSS ss)) s)--dropCT :: (Num a, Show a) =>-      Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)-dropCT _ NullS   = NullS-dropCT 0 s   = s-dropCT c (ss:-s) | (durationSS ss > c) = dropSubSig c ss :- s-         | otherwise       = dropCT (c - (durationSS ss)) s---- The interval length of a signal:-duration :: (Num a, Show a) => Signal (SubsigCT a) -> Rational-duration NullS = 0-duration (ss:- s) = (durationSS ss) + (duration s)  ---- The interval length of a sub-signal:-durationSS :: (Num a, Show a) => (SubsigCT a) -> Rational-durationSS (SubsigCT (_, (a,b))) = b-a---- The start time of a signal:-startTime :: (Num a, Show a) => Signal (SubsigCT a) -> Rational-startTime NullS = 0-startTime (SubsigCT (_,(a,_)) :- _) = a---- The take and drop functions for sub-signals:-takeSubSig :: (Num a, Show a) => Rational -> (SubsigCT a) -> (SubsigCT a)-takeSubSig c (SubsigCT (f,(a,b))) | c >= (b-a) = SubsigCT (f,(a,b))-              | otherwise  = SubsigCT (f,(a,a+c))---dropSubSig :: (Num a, Show a) => Rational -> (SubsigCT a) -> (SubsigCT a)-dropSubSig c (SubsigCT (f,(a,b))) | c > (b-a) = SubsigCT (f,(b,b))-              | otherwise = SubsigCT (f,(a+c,b))------------------------------------------------------------------------------ Functions to display and plot signals:--------------------------------------------------------------------------- The function 'sample' evaluates the signal and returns a list of --- (time,value) pairs, which can be displayed as text or used in any other way.-{- $plotdoc-   Several functions are available to display a signal in textual or -   graphics form. All displaying of signals is based on sampling and -   evaluation the signal at regular sampling points. -   -   'showParts' does not evaluate the signal; it only shows how it is -   partitioned. Hence, it returns a sequence of intervals.-  -   'plot', 'plotCT' and 'plotCT'' can plot a signal or a list of signals -   in a graph. They use @gnuplot@ for doing the actual work.-   They are in the IO monad because they write to the file system.-  -   'plot' is defined in terms of 'plotCT' but it uses the default sampling -   period 'timeStep' and it can plot only one signal in a plot.-  -   'plotCT' can plot a list of signals in the same plot.-   'plotCT' is defined in terms of 'plotCT'' but uses -   default label names for the plot.--   'vcdGen' writes the values of signals in Value Change Dump (VCD) format to -   a file. There are public domain wave viewers which understand this format -   and can display the signals.--}---- |'sample' computes the values of a signal with a given step size. --- It returns a list with (x, (f x)) pairs of type [(Rational,Rational)].-sample :: (Num a, Show a) =>-      Rational    -- ^ The sampling period-   -> Signal (SubsigCT a) -- ^The signal to be sampled-   -> [(Rational,a)]  -- ^The list of (time,value) pairs of the -          -- evaluated signal-sample _ NullS = []-sample step (ss :- s) = sampleSubsig step ss ++ (sample step s)---- sampleSubsig samples a Subsig signal:-sampleSubsig :: (Num a, Show a) => Rational -> (SubsigCT  a) -> [(Rational,a)]-sampleSubsig step (SubsigCT (f,(a,b)))-    | b>a = (a,(f a)) : (sampleSubsig step (SubsigCT (f,(a+step,b))))-    | otherwise = []---- |'showParts' allows to see how a signal is partitioned into sub-signals.--- It returns the sequence of intervals.-showParts :: (Num a, Show a) =>-     Signal (SubsigCT a)   -- ^The partitioned signal-      -> [(Double,Double)] -- ^The sequence of intervals-showParts NullS = []-showParts (SubsigCT (_,(a,b)):-s) = (fromRational a,fromRational b) -             : (showParts s)---------------------------------------------------------------------------------- |'plot' plots one signal in a graph with the default sampling period --- of 1\/200 of the duration of the signal.-plot :: (Num a, Show a) =>-    Signal (SubsigCT a) -- ^The signal to be plotted.-     -> IO String      -- ^A reporting message.-plot s = plotCT step [s]-    where step = (duration s) / 200.0---- |'plotCT' plots a list of signals in the same graph. The sampling period --- has to be given as argument. In the graph default label names are used--- to identify the signals.-plotCT :: (Num a, Show a) =>-      Rational      -- ^The sampling period-   -> [Signal (SubsigCT a)] -- ^The list of signals to be ploted -            -- in the same graph-   -> IO String     -- ^A messeage reporting what has been done.-plotCT step sigs = plotCT' step (map (\ s -> (s,"")) sigs)--{- |-   'plotCT'' is the work horse for plotting and the functions 'plot' and -   'plotCT' use it with specialising arguments.--   'plotCT'' plots all the signals in the list in one graph. If a label is-   given for a signal, this label appears in the graph. If the label string is -   \"\", a default label like \"sig-1\"  is used.--   In addition to displaying the graph on the screen, the following files-   are created in directory .\/fig:--   [ct-moc-graph.eps]      an eps file of the complete graph--   [ct-moc-graph.pdf]      A pdf file of the complete graph- -   [ct-moc-graph-latex.eps]    included by ct-moc-graph-latex.tex--   [ct-moc-graph-latex.tex]    This is the tex file that should be included-           by your latex document. It in turn includes-        the file ct-moc-graph-latex.eps.-       These two files have to be used together;-        the .eps file contains only the graphics,-       while the .tex file contains the labels and -           text.--}-plotCT' :: (Num a, Show a) =>-       Rational     -- ^Sampling period-    -> [(Signal (SubsigCT a), String)]-       -- ^A list of (signal,label) pairs. The signals are plotted and-       -- denoted by the corresponding labels in the plot.-    -> IO String     -- ^A simple message to report completion-plotCT' _ [] = return []-plotCT' 0 _    = error "plotCT: Cannot compute signal with step=0.\n"-plotCT' step sigs = plotSig (expandSig 1 sigs)-  where -    expandSig :: (Num a, Show a) => -                 Int -> [(Signal (SubsigCT a),String)] -              -> [(Int,String,[(Rational,a)])]-    expandSig _ [] = []-    expandSig i ((sig,label):sigs) -      = (i, label, (sample step sig)) : (expandSig (i+1) sigs)-    plotSig :: (Num a, Show a) => [(Int,String,[(Rational,a)])] -> IO String-    plotSig sigs -      = do mkDir "./fig"-           writeDatFiles sigs-           -- We write the gnuplot script to a file;-           -- But we try several times with a different name because -           -- with ghc on cygwin we cannot write to a script file while-           -- gnuplot is still running with the old script file:-           fname <- tryNTimes 10 -                    (\ file -> (writeFile file-                                (mkPlotScript (map mkDatFileName sigs))))-           -- We fire up gnuplot:-           _ <- system ("gnuplot -persist " ++ fname)-           -- We return some reporting string:-           return ("Signal(s) " ++(mkAllLabels sigs) ++ " plotted.")-    writeDatFiles [] = return ()-    writeDatFiles (s@(_, _, sig): sigs)-      = do writeFile (fst (mkDatFileName s)) (dumpSig sig)-           writeDatFiles sigs-    mkDatFileName :: (Int,String,a) -> (String,String)-    mkDatFileName (sigid,label,_) = ("./fig/ct-moc-" ++ (replChar ">" label) -                                     ++(show sigid)++".dat", -                                     (mkLabel label sigid))-    mkLabel :: String -> Int -> String-    mkLabel "" n = "sig-" ++ show n -    mkLabel l _  = l-    mkAllLabels :: (Num a) => [(Int,String,[(Rational,a)])] -> String-    mkAllLabels sigs = drop 2 (foldl f "" sigs)-      where f labelString (n,label,_) -              = labelString ++ ", " ++ (mkLabel label n)-    replChar :: String -- all characters given in this set are replaced by '_'-                -> String -- the string where characters are replaced-                -> String -- the result string with all characters replaced-    replChar [] s = s-    replChar _ [] = []-    replChar replSet (c:s) | elem c replSet = '_' : (replChar replSet s)-                           | otherwise  = c   : (replChar replSet s)--    dumpSig :: (Num a, Show a) => [(Rational,a)] -> String-    dumpSig points = concatMap f points-      where f (x,y) = show ((fromRational x) :: Float) ++ "    " -                      ++ show (y) ++ "\n"--    mkPlotScript :: [(String  -- the file name of the dat file-                     ,String  -- the label for the signal to be drawn-                     )] -> String  -- the gnuplot script-    mkPlotScript ns = "set xlabel \"seconds\" \n"-                      ++ "plot " ++ (f1 ns) ++ "\n"-                      ++ "set terminal postscript eps color\n"-                      ++ "set output \"" ++ plotFileName++".eps\"\n"-                      ++ "replot \n"-                      ++ "set terminal epslatex color\n"-                      ++ "set output \"" ++ plotFileName++"-latex.eps\"\n"-                      ++ "replot\n"-                      -- ++ "set terminal pdf\n"-                      -- ++ "set output \"fig/ct-moc-graph.pdf\"\n"-                      -- ++ "replot\n"-      where f1 :: [(String,String)] -> String-            f1 ((datfilename,label):(n:ns)) -              = "\t\"" ++ datfilename-                ++ "\" with linespoints title \""++label++"\",\\\n"-                ++ "    " ++ (f1 (n:ns))-            f1 ((datfilename,label):[]) -              = "\"" ++ datfilename -                ++ "\" with linespoints title \""++label++"\"\n"-            f1 [] = ""-            plotFileName = "fig/ct-moc-graph-" ++ (f2 ns)-            f2 :: [(String,String)] -> String -- f2 generates part of the -                  -- filename for the eps and -                  -- latex files, which is -                  -- determined by the signal-                  -- labels.-            f2 [] = ""-            f2 ((_,label):[]) = label-            f2 ((_,label):_) = label ++ "_"-    -- tryNTimes applies a given actions at most n times. Everytime-    -- the action is applied and an error occurrs, it tries again but -    -- with a decremented first argument. It also changes the file name-    -- because the file name uses the n as part of the name.-    -- The idea is that the action tries different files to operate on.-    -- The problem was that when gnuplot was called on a gnuplot script-    -- file, it was not possible to write a new script file with the same-    -- name and start a new gnuplot process (at least not with ghc or ghci on -    -- cygwin; it worked fine with hugs on cygwin). -    -- So we go around the problem here by trying different file names until-    -- we succeed or until the maximum number of attempts have been performed.-    tryNTimes :: Int -> (String -> IO ()) -> IO String-    tryNTimes n a | n <= 0 = error "tryNTimes: not succedded"-                  | n > 0 = -                      do catch (action fname a) (handler a)-                           where handler :: (String -> IO()) -> IOError -> IO String-                                 handler a _ = tryNTimes (n-1) a-                                 fname = "./fig/ct-moc-" ++ (show n) ++ ".gnuplot"-                                 action :: String -> (String -> IO ()) -> IO String-                                 action fname a = do (a fname)-                                                     return fname-    tryNTimes _ _ = error "tryNTimes: Unexpected pattern."-------------------------------------------------------------------------------{- |-vcdGen dumps the values of a list of signal in VCD (Value Change Dump) format -(IEEE Std 1364-2001), which is part of the Verilog standard -(<http://en.wikipedia.org/wiki/Value_change_dump>).-There are public domain tools to view VCD files. For instance, -GTKWave (<http://home.nc.rr.com/gtkwave/>) is a popular viewer available for-Windows and Linux.--The values are written to the file ./fig/ct-moc.vcd. If the file exists, it-is overwritten. If the directory does not exist, it is created.---}-vcdGen :: (Num a, Show a) -      => Rational     -- ^Sampling period; defines for what-              -- time stamps the values are written.-      -> [(Signal (SubsigCT a), String)]-      -- ^A list of (signal,label) pairs. The signal values written and-      -- denoted by the corresponding labels.-      -> IO String    -- ^A simple message to report completion-vcdGen _ [] = return []-vcdGen 0    _  = error "vcdgen: Cannot compute signals with step=0.\n"-vcdGen step sigs = -    do -  -- putStr (show (distLabels (expandSig 1 sigs)))-  plotSig (expandSig 1 sigs)-    where -  expandSig :: (Num a, Show a) => -       Int -> [(Signal (SubsigCT a),String)] -           -> [(Int,String,[(Rational,a)])]-  expandSig _ [] = []-  expandSig i ((sig,label):sigs) -      = (i, label, (sample step sig)) : (expandSig (i+1) sigs)-  plotSig :: (Num a, Show a) => [(Int,String,[(Rational,a)])] -> IO String-  plotSig sigs -      = do writeVCDFile sigs-           -- We return some reporting string:-           return ("Signal(s) " ++(mkAllLabels sigs) ++ " dumped.")-  mkLabel :: String -> Int -> String-  mkLabel "" n = "sig-" ++ show n -  mkLabel l _  = l-  mkAllLabels sigs = drop 2 (foldl f "" sigs)-      where f labelString (n,label,_) -              = labelString ++ ", " ++ (mkLabel label n)-  writeVCDFile :: (Show a) => [(Int,String,[(Rational,a)])] -> IO()-  writeVCDFile sigs-    = do mkDir "./fig"-         clocktime <- getClockTime-         let {date = calendarTimeToString (toUTCTime clocktime);-              labels = getLabels sigs;-              timescale = findTimescale sigs;}-           in writeFile mkVCDFileName ((vcdHeader timescale labels date)-                                       ++ (valueDump timescale (prepSigValues sigs)))-  mkVCDFileName :: String-  mkVCDFileName = ("./fig/ct-moc.vcd")--mkDir :: String -> IO()-mkDir dir = do dirExists <- doesDirectoryExist dir-               if (not dirExists) -                 then (createDirectory dir) -                 else return ()---- prepSigValues rearranges the [(label,[(time,value)])] lists such --- that we get a list of time time stamps and for each time stamp --- we have a list of (label,value) pairs to be dumped:-prepSigValues :: (Show a) => [(Int,String,[(Rational,a)])]-      -> [(Rational,[(String,a)])]-prepSigValues sigs = f2 (distLabels sigs)-    where -  -- f2 transforms a [[(label,time,value)]] -  -- into a [(time, [label,value])] structure:-  f2 :: (Show a) -    => [[(String,Rational,a)]] -> [(Rational,[(String,a)])]-  f2 [] = []-  f2 ([]:_) = []  -  f2 xs = f3 hdxs : f2 tailxs-      where -    -- here we take all first elements of the lists in xs-    -- and the tail of the lists in xs:-    (hdxs,tailxs) = (map g1 xs,-             map (\ (_:ys)-> ys) xs)-    g1 [] = error ("prepSig.f2.g1: first element of xs is empty:"-           ++ "xs="++show xs)-    g1 (y:_) = y-    f3 :: (Show a) -      => [(String,Rational,a)] -> (Rational,[(String,a)])-    f3 (valList@((_, time, _):_)) = (time, f4 time valList)-    f3 [] = error ("prepSigValues.f2.f3: "-           ++ "empty (label,time,value)-list")-    f4 :: (Show a) -      => Rational -> [(String,Rational,a)] -> [(String,a)]-    f4 _ [] = []-    f4 time ((label,time1,value):valList) -       | time == time1 = (label,value) : f4 time valList-       | otherwise -       = error ("prepSigValues: Time stamps in different"-            ++ " signals do not match: time="-            ++(show time)++", time1="++(show time1)-            ++", label="++label++", value="++(show value)-            ++"!")--- distLabels inserts the labels into its corresponding --- (time,value) pair list to get a (label,time,value) triple:-distLabels :: [(Int,String,[(Rational,a)])] -       -> [[(String,Rational,a)]]-distLabels [] = []-distLabels ((_,label,valList):sigs) -    = (map (\ (t,v) -> (label,t,v)) valList) : (distLabels sigs)-getLabels :: [(Int,String,[(Rational,a)])] -> [String]-getLabels = map (\(_,label,_)-> label)-vcdHeader :: Rational -> [String] -> String -> String-vcdHeader timescale labels date = "$date\n"-           ++ date ++ "\n"-           ++ "$end\n"-           ++ "$version\n"-           ++ "ForSyDe CTLib " ++ revision ++ "\n"-           ++ "$end\n"-           ++ "$timescale 1 " ++ (timeunit timescale) ++ " $end\n"-           ++ "$scope module top $end\n"-           ++ (concatMap (\ label -> ("$var real 64 "++label-                  ++ " " ++ label -                  ++ " $end\n")) labels)-           ++ "$upscope $end\n"-           ++ "$enddefinitions $end\n"-           ++ "#0\n"-           ++ "$dumpvars\n"-           ++ (concatMap (\ label -> "r0.0 "++label++ "\n") -             labels)-           ++ "\n"-valueDump :: (Show a) => Rational -> [(Rational,[(String,a)])] -> String-valueDump _ [] = ""-valueDump timescale ((t,values):valList) -    = "#"++(show (g (t/timescale)))++"\n" -  ++ (f values) ++ (valueDump timescale valList)-    where -  f :: (Show a) => [(String,a)] -> String-  f [] = ""-  f ((l,v):values) = "r"++(show v)++" "++l++"\n" ++ (f values)-  g :: Rational -> Integer-  -- Since the VCD format expects integers for the timestamp, we make-  -- sure that only an integer is printed in decimal format (no exponent):-  g t = round t---timeunit :: Rational -> String-timeunit timescale | timescale == 1 % 1    = "s"-       | timescale == 1 % 1000 = "ms"-       | timescale == 1 % 1000000 = "us"-       | timescale == 1 % 1000000000 = "ns"-       | timescale == 1 % 1000000000000 = "ps"-       | timescale == 1 % 1000000000000000 = "fs"-       | otherwise = error ("timeunit: unexpected timescale: "-                ++ (show timescale))--findTimescale :: [(Int,String,[(Rational,a)])] -> Rational-findTimescale sigs -    = f 1 (concatMap (\ (_,_,valList) -> (fst (unzip valList))) sigs)-  where -    f :: Rational -> [Rational] -> Rational-    f scale [] = scale-    f scale (x:xs) | r == 0    = f scale xs-           | otherwise = f (scale/1000) xs-           where (_,r) = (properFraction (abs (x / scale))) -                         :: (Int,Rational)------------------------------------------------------------------------------------------------------------------------------------------ Testing the CT signals and process constructors:--{---main = testAll-testAll = -    do -  testScaleCT -  testAddCT -  testMultCT -  testAbsCT -  testDelayCT-  testConverters-  testFeedback--- test scaleCT:-testScaleCT = plotCT' 1E-4 [(toneA, "Tone A"), -            ((scaleCT 1.5 toneA), "Tone A x 1.5"),-            ((scaleCT 2.0 toneA), "Tone A x 2.0")]---- test addCT:-testAddCT = plotCT' 1e-4 [(toneA, "Tone A"),-          (toneE, "Tone E"), -          ((addCT toneA toneE), "Tones A+E")]---- test multCT:-testMultCT = plotCT' 1e-4 [(toneA, "Tone A"),-          (toneE, "Tone E"), -          ((multCT toneA toneE), "Tones A x E")]---- test absCT:-testAbsCT = plotCT' 1E-4 [(toneA, "Tone A"), -          ((absCT toneA), "abs (Tone A)")]---- test delayCT:-testDelayCT = plotCT' 1E-4 -      [(toneA, "Tone A"), -       (takeCT 0.02 ((delayCT 0.0025 toneA)), -           "Tone A delayed by 2.5ms"),-       (takeCT 0.02 ((shiftCT 0.003 toneA)), "Tone A shifted by 3ms")]---- test a2dConverter:-testConverters = -    do (plotCT' 1e-4-    [(toneA, "Tone A"),-     (d2aConverter DAlinear 1e-3 (a2dConverter 1e-3 toneA),-      "Tone A (A->D->A) converted with linear mode, 1ms sampling period")])-   (plotCT' 1e-4-    [(toneA, "Tone A"),-     (d2aConverter DAhold 1e-3 (a2dConverter 1e-3 toneA),-      "Tone A (A->D->A) converted with hold mode, 1ms sampling period")])---- test a feed back loop:-block sin = [sin,s1,s2,sout]-    where sout = p2 s1-      s1 = p1 sin s2-      s2 = p3 sout-      -- The individual processes:-      p1 :: Signal (SubsigCT Double) -> Signal (SubsigCT Double)-     -> Signal (SubsigCT Double)-      p2,p3 :: Signal (SubsigCT Double) -> Signal (SubsigCT Double)-      p1 = addCT-      p2 = scaleCT 0.5-      p3 = initCT (zeroCT 0.0005)-testFeedback = plotCT' 0.0001 ss-    where ss = [(sin, "sin"), (s1, "s1"), (s2, "s2"), (sout, "sout")]-      [sin,s1,s2,sout] = block (takeCT 0.005 toneA)----toneA = sineWave (440.0) (0, 0.02)-toneE = sineWave 520.0 (0, 0.02)--}--{- Some performance tests on my laptop under cygwin:--***********************************************************************-With ghc:--with -toneA = sineWave (440.0) (0, 2.0)-toneE = sineWave 520.0 (0, 2.0)--****-we make testAll with Double data types on--ghc --make CTLib.hs -O3 -o ttt.exe-time ttt-   -real    0m33.749s-user    0m0.010s-sys     0m0.010s--****-we make testAll with Rational data types on--ghc --make CTLib.hs -O3 -o ttt.exe-time ttt-   -real    0m53.687s-user    0m0.010s-sys     0m0.010s--****-hence the performance penalty when using Rational instead of Double is-1.59 (60%) longer delay.---************************************************************************-On hugs: (when using 0.2 second long waves, hugs aborted with an out of memory -message both with Double and Rational; but with Double it aborted much faster;)--toneA = sineWave (440.0) (0, 0.02)-toneE = sineWave 520.0 (0, 0.02)--****************-**** with Double:-time runhugs.exe -h500k CTLib.hs--real    0m1.702s-user    0m0.020s-sys     0m0.010s--******************-**** with Rational:--time runhugs.exe -h500k CTLib.hs--real    0m21.501s-user    0m0.010s-sys     0m0.020s--****************-hence we have a factor of 12.5 longer delay with Rational compared to Double.----}----eulerCT :: Signal (SubsigCT a) -> Signal (SubsigCT a)---eulerCT = undefined--{--s1 = signal [SubsigCT (sine', (0,6.28)), SubsigCT (\x -> 1, (6.28, 10.0))]--sine' :: (Floating a) => Rational -> a-sine' t = sin (fromRational t)--s2 = mapCT (*2.0) s1-s3 = zipWithCT (+) s1 s2--s4 = delayCT 0.5 (-4.0) s1--integratorCT :: Signal (SubsigCT a) -> Signal (SubsigCT a)-integratorCT = undefined----eulerCT :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)---eulerCT step (SubsigCT (f, (t_start, t_end)) :- fs)---  =  undefined----eulerCT' :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)-eulerCT stepsize (SubsigCT (f, (t_start, t_end))) =-   signal (SubsigCT (\x -> stepsize * f t_start, (t_start, t_start + stepsize)) :-   eulerCT' stepsize (SubsigCT (f, (t_start + stepsize, t_end))) (stepsize * f t_start))--eulerCT' stepsize (SubsigCT (f, (t_start, t_end))) y_i-  | t_start <= t_end - stepsize-   = SubsigCT (\x -> y_i + stepsize * f t_start, (t_start, t_start + stepsize))-       : eulerCT' stepsize (SubsigCT (f, (t_start + stepsize, t_end))) (y_i + stepsize * f t_start)-  | otherwise-   = []--s6 = signal [SubsigCT (\x -> 1.0, (0.0, 5.0))]-s5 = eulerCT 0.5 (SubsigCT (\x -> 1.0, (0.0, 5.0)))--plotEuler = plotCT' 1e-1 [(s5, "s5")]--ctsig1 = ctSignal [(liftCT sin, (0, 3.14)), (\t -> 1, (3.14, 6.28))]-ctsig2 = ctSignal [(liftCT cos, (0, 6.28))]--}

@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde@kth.se+-- Stability   :  experimental+-- Portability :  portable +-- +-- The CoreLib is the base for all MoC libraries and is a container+-- that includes the following libraries:+-- +-- * "ForSyDe.Shallow.Core.Signal"+-- +-- * "ForSyDe.Shallow.Core.Vector"+-- +-- * "ForSyDe.Shallow.Core.AbsentExt" +-----------------------------------------------------------------------------++module ForSyDe.Shallow.Core(  +        module ForSyDe.Shallow.Core.Signal,+        module ForSyDe.Shallow.Core.Vector,+        module ForSyDe.Shallow.Core.AbsentExt+        ) where++import ForSyDe.Shallow.Core.Vector+import ForSyDe.Shallow.Core.Signal+import ForSyDe.Shallow.Core.AbsentExt++++++++

@@ -0,0 +1,81 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.Core.AbsentExt+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- The 'AbstExt' is used to extend existing data types with the value+--  \'absent\', which models the absence of a value.+-- +-----------------------------------------------------------------------------+module ForSyDe.Shallow.Core.AbsentExt ( +  AbstExt (Abst, Prst), fromAbstExt, abstExt, psi, +  isAbsent, isPresent, abstExtFunc+  ) where+++-- |The data type 'AbstExt' has two constructors. The constructor 'Abst' is used to model the absence of a value, while the constructor 'Prst' is used to model present values.+data AbstExt a =  Abst   +               |  Prst a deriving (Eq)++++-- |The function 'fromAbstExt' converts a value from a extended value.+fromAbstExt   :: a -> AbstExt a -> a+-- |The functions 'isPresent' checks for the presence of a value.+isPresent   :: AbstExt a -> Bool+-- |The functions 'isAbsent' checks for the absence of a value.+isAbsent   :: AbstExt a -> Bool+-- |The function 'abstExtFunc' extends a function in order to process absent extended values. If the input is (\"bottom\"), the output will also be  (\"bottom\").+abstExtFunc   :: (a -> b) -> AbstExt a -> AbstExt b+-- | The function 'psi' is identical to 'abstExtFunc' and should be used in future.+psi :: (a -> b) -> AbstExt a -> AbstExt b+-- | The function 'abstExt' converts a usual value to a present value. +abstExt :: a -> AbstExt a++-- Implementation of Library Functions++-- | The data type 'AbstExt' is defined as an instance of 'Show' and 'Read'. \'_\' represents the value 'Abst' while a present value is represented with its value, e.g.  'Prst' 1 is represented as \'1\'.+instance Show a => Show (AbstExt a) where+  showsPrec _   = showsAbstExt++showsAbstExt :: Show a => AbstExt a -> String -> String+showsAbstExt Abst      = (++) "_"   +showsAbstExt (Prst x)  = (++) (show x)++instance Read a => Read (AbstExt a) where+  readsPrec _ =  readsAbstExt ++readsAbstExt :: (Read a) => ReadS (AbstExt a)+readsAbstExt s = [(Abst, r1)    | ("_", r1) <- lex s]+                 ++ [(Prst x, r2)  | (x, r2) <- reads s]++abstExt =  Prst++fromAbstExt x Abst     =  x   +fromAbstExt _ (Prst y) =  y   ++isPresent Abst     = False+isPresent (Prst _) = True++isAbsent =  not . isPresent++abstExtFunc f       = f' +  where f' Abst     = Abst+        f' (Prst x) = Prst (f x)+++psi = abstExtFunc+++++++++

@@ -0,0 +1,122 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.Core.BitVector+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- It defines the bit vector operations from\/to integer.+-----------------------------------------------------------------------------+module ForSyDe.Shallow.Core.BitVector(+    -- *Polynomial data type+    BitVector, Parity(..),+    -- *Bit-vector and integer transformations+    intToBitVector, bitVectorToInt,+    -- *Add even\/odd parity bit+    addEvenParityBit, addOddParityBit, addParityBit,+    -- *Remove parity bit+    removeParityBit,+    -- *Check the even\/odd parity of the bit-vector+    isEvenParity, isOddParity,+    -- *Judge the form sanity of the bit-vector+    isBitVector+  )+  where++import ForSyDe.Shallow.Core.Vector++type BitVector = Vector Integer++-- |To judge whether the input bit-vector is in a proper form.+isBitVector :: (Num t, Eq t) =>+      Vector t  -- ^Input bit-vector+   -> Bool  -- ^Output boolean value+isBitVector NullV = True+isBitVector (x:>xs) = (x `elem` [0, 1]) && isBitVector xs++-- |To transform the input integer to a bit-vector with specified number of+-- bits.+intToBitVector :: Int  -- ^Num of the bits+       -> Integer  -- ^The input integer+       -> BitVector -- ^The output bit-vector+intToBitVector bits n | n >= 0 && n < 2^(bits-1) +       = intToBitVector' bits n+intToBitVector bits n | n < 0 && abs n <= 2^(bits-1) +       = intToBitVector' bits (n + 2^bits)+intToBitVector _    _ | otherwise = +      error "intToBitvector : Number out of range!" ++-- |Helper function of 'intToBitVector'.+intToBitVector' :: (Num a, Ord a1, Num a1, Integral t) => +       t -> a1 -> Vector a+intToBitVector' 0    _ = NullV+intToBitVector' bits n = if n >= 2^(bits-1) then+         1 :> intToBitVector' (bits-1) (n - 2^(bits-1))+       else  +         0 :> intToBitVector' (bits-1) n++-- |To transform the input bit-vecotr to an integer.+bitVectorToInt :: BitVector -> Integer+bitVectorToInt (1:>xv) | isBitVector xv +       = bitVectorToInt' xv (lengthV xv) - 2 ^ lengthV xv +bitVectorToInt (0:>xv) | isBitVector xv +       = bitVectorToInt' xv (lengthV xv)+bitVectorToInt _ = error "bitVectorToInt: Vector is not a BitVector!"+++-- |Helper function of 'bitVectorToInt'.+bitVectorToInt' :: (Integral a, Num t) => Vector t -> a -> t+bitVectorToInt' NullV   _   = 0+bitVectorToInt' (x:>xv) bit = x * 2^(bit-1) + bitVectorToInt' xv (bit-1)++data Parity = Even | Odd deriving (Show, Eq)++-- |To add even parity bit on the bit-vector in the tail.+addEvenParityBit :: (Num a, Eq a) => Vector a -> Vector a+addEvenParityBit = addParityBit Even+-- |To add odd parity bit on the bit-vector in the tail.+addOddParityBit :: (Num a, Eq a) => Vector a -> Vector a+addOddParityBit  = addParityBit Odd++addParityBit :: (Num a, Eq a) => Parity -> Vector a -> Vector a+addParityBit p v +  | isBitVector v = case p of+    Even -> resZero even+    Odd -> resZero (not even)+  | otherwise =  error "addParity: Vector is not a BitVector"  + where even = evenNumber v +       resZero b = v <+> unitV (if b then 0 else 1)+++-- |To remove the parity bit in the tail.+removeParityBit :: (Num t, Eq t) => Vector t -> Vector t+removeParityBit v + | isBitVector v = takeV (lengthV v - 1) v+ | otherwise = error "removeParityBit: Vector is not a BitVector "++-- |To check the even parity of the bit-vector.+isEvenParity :: (Num t, Eq t) => Vector t -> Bool+isEvenParity = isParityCorrect Even++-- |To check the odd parity of the bit-vector.+isOddParity :: (Num t, Eq t) => Vector t -> Bool+isOddParity = isParityCorrect Odd++isParityCorrect :: (Num t, Eq t) => Parity -> Vector t -> Bool +isParityCorrect Even xv = evenNumber xv+isParityCorrect Odd xv  = not $ evenNumber xv ++evenNumber :: (Num t, Eq t) => Vector t -> Bool+evenNumber NullV   = True+evenNumber (0:>xv) = xor False (evenNumber xv)+evenNumber (1:>xv) = xor True (evenNumber xv)+evenNumber (_:>_) = error "evenNumber: Vector is not a BitVector "+         +xor :: Bool -> Bool -> Bool+xor True  False = True+xor False True  = True+xor _     _     = False +

@@ -0,0 +1,222 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.Core.Signal+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- This module defines the shallow-embedded 'Signal' datatype and+-- functions operating on it.+-----------------------------------------------------------------------------+module ForSyDe.Shallow.Core.Signal(+  Signal (NullS, (:-)), (-:), (+-+), (!-), +  signal, fromSignal,+  unitS, nullS, headS, tailS, atS, takeS, dropS,+  lengthS, infiniteS, copyS, selectS, writeS, readS, fanS+  ) where++infixr 5    :-+infixr 5    -:+infixr 5    +-++infixr 5    !-+++-- | A signal is defined as a list of events. An event has a tag and a value. The tag of an event is defined by the position in the list. A signal is defined as an instance of the classes 'Read' and 'Show'. The signal 1 :- 2 :- NullS is represented as \{1,2\}.+data Signal a = NullS+      | a :- Signal a deriving (Eq)++-- | The function 'signal' converts a list into a signal.+signal     :: [a] -> Signal a ++-- | The function 'fromSignal' converts a signal into a list.+fromSignal     :: Signal a -> [a]++-- | The function 'unitS' creates a signal with one value.+unitS      :: a -> Signal a++-- | The function 'nullS' checks if a signal is empty.+nullS      :: Signal a -> Bool++-- | The function 'headS' gives the first value - the head -  of a signal.+headS      :: Signal a -> a++-- | The function 'tailS' gives the rest of the signal - the tail.+tailS      :: Signal a -> Signal a++-- | The function 'atS'  returns the n-th event in a signal. The numbering of events in a signal starts with 0. There is also an operator version of this function, '(!-)'.+atS        :: Int -> Signal a -> a++-- | The function 'takeS' returns the first n values of a signal.+takeS      :: Int -> Signal a -> Signal a++-- | The function 'dropS' drops the first $n$ values from a signal.+dropS      :: Int -> Signal a -> Signal a++-- | The function 'selectS' takes three parameters, an offset, a stepsize and a signal and returns some elements of the signal such as in the following example:+--+-- @+-- Signal> selectS 2 3 (signal[1,2,3,4,5,6,7,8,9,10])+-- {3,6,9} :: Signal Integer+-- @+selectS        :: Int -> Int -> Signal a -> Signal a++-- | The function 'lengthS' returns the length of a 'finite' signal.+lengthS        :: Signal b -> Int++-- | The function 'infiniteS' creates an infinite signal. The first argument 'f' is a function that is applied on the current value. The second argument 'x' gives the first value of the signal.+--+-- > Signal> takeS 5 (infiniteS (*3) 1)+-- > {1,3,9,27,81} :: Signal Integer+--+infiniteS      :: (a -> a) -> a -> Signal a++-- | The function 'writeS' transforms a signal into a string of the following format:+--+-- @ +-- Signal> writeS (signal[1,2,3,4,5])+-- "1\n2\n3\n4\n5\n" :: [Char]+-- @+writeS     :: Show a => Signal a -> [Char]++-- | The function 'readS' transforms a formatted string into a signal.+--+-- @+-- Signal> readS "1\n2\n3\n4\n5\n" :: Signal Int+-- {1,2,3,4,5} :: Signal Int+-- @+readS      :: Read a => [Char] -> Signal a++-- | The operator '-:' adds at an element to a signal at the tail.+(-:)       :: Signal a -> a -> Signal a++-- | The operator '+-+' concatinates two signals into one signal.  +(+-+)      :: Signal a -> Signal a -> Signal a +++-- | The function 'copyS' creates a signal with n values 'x'.+copyS :: (Num a, Eq a) => a -> b -> Signal b+++-- | The combinator 'fanS' takes two processes 'p1' and 'p2' and and generates a process network, where a signal is split and processed by the processes 'p1' and 'p2'.+fanS :: (Signal a -> Signal b) -> (Signal a -> Signal c) +      -> Signal a -> (Signal b, Signal c)++-- Implementation++instance (Show a) => Show (Signal a) where+  showsPrec p NullS = showParen (p > 9) (showString "{}")+  showsPrec p xs    = showParen (p > 9) (showChar '{' . showSignal1 xs)+    where+      showSignal1 NullS      = showChar '}'+      showSignal1 (y:-NullS) = shows y . showChar '}'+      showSignal1 (y:-ys)    = shows y . showChar ',' . showSignal1 ys++instance Read a => Read (Signal a) where+  readsPrec _ s = readsSignal s++readsSignal    :: (Read a) => ReadS (Signal a)+readsSignal s+  =  [((x:-NullS), rest)+     | ("{", r2)   <- lex s,+       (x, r3)     <- reads r2,+       ("}", rest) <- lex r3]+     ++ [(NullS, r4)       +        | ("{", r5) <- lex s,+          ("}", r4) <- lex r5]+     ++ [((x:-xs), r6)     +        | ("{", r7) <- lex s,+          (x, r8)   <- reads r7,+          (",", r9) <- lex r8,+          (xs, r6)  <- readsValues r9]++readsValues    :: (Read a) => ReadS (Signal a)+readsValues s+  =  [((x:-NullS), r1) +     | (x, r2)   <- reads s,+       ("}", r1) <- lex r2]+     ++ [((x:-xs), r3)    +        | (x, r4)   <- reads s,+          (",", r5) <- lex r4,+          (xs, r3)  <- readsValues r5]++signal []          =  NullS+signal (x:xs)      =  x :- signal xs ++fromSignal NullS   =  []+fromSignal (x:-xs) =  x : fromSignal xs++unitS x =  x :- NullS++nullS NullS =  True+nullS _     =  False++headS NullS  = error "headS : Signal is empty"+headS (x:-_) = x++tailS NullS   = error "tailS : Signal is empty"+tailS (_:-xs) = xs++atS _ NullS   = error "atS: Signal has not enough elements"+atS 0 (x:-_)  = x+atS n (_:-xs) = atS (n-1) xs++(!-) :: Signal a -> Int -> a+(!-) xs n = atS n xs++takeS 0 _      = NullS+takeS _ NullS  = NullS+takeS n (x:-xs)+  | n <= 0     = NullS+  | otherwise  = x :- takeS (n-1) xs++dropS 0 NullS  = NullS+dropS _ NullS  = NullS +dropS n (x:-xs)+  | n <= 0     = x:-xs+  | otherwise  = dropS (n-1) xs+++selectS offset step xs = select1S step (dropS offset xs) +  where+    select1S _  NullS   = NullS+    select1S st (y:-ys) = y :- select1S st (dropS (st-1) ys) ++(-:) xs x = xs +-+ (x :- NullS)++(+-+) NullS   ys = ys+(+-+) (x:-xs) ys = x :- (xs +-+ ys)++lengthS NullS   = 0+lengthS (_:-xs) = 1 + lengthS xs++infiniteS f x = x :- infiniteS f (f x)++copyS 0 _ = NullS+copyS n x = x :- copyS (n-1) x++fanS p1 p2 xs = (p1 xs, p2 xs)++writeS NullS   = []+writeS (x:-xs) = show x ++ "\n" ++ writeS xs++readS xs             = readS' (words xs)+  where+    readS' []        = NullS+    readS' ("\n":ys) = readS' ys+    readS' (y:ys)    = read y :- readS' ys+++++++++++++

@@ -0,0 +1,422 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.Core.Vector+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- This module defines the data type 'Vector' and the+-- corresponding functions. It is a development of the module+-- defined by Reekie.  Though the vector is modeled as a list, it+-- should be viewed as an array, i.e. a vector has a fixed+-- size. Unfortunately, it is not possible to have the size of the+-- vector as a parameter of the vector data type, due to restrictions+-- in Haskells type system. Still most operations are defined for+-- vectors with the same size.+-----------------------------------------------------------------------------+module ForSyDe.Shallow.Core.Vector ( +  Vector (..), vector, fromVector, unitV, nullV, lengthV,+  atV, replaceV, headV, tailV, lastV, initV, takeV, dropV, +  selectV, groupV, (<+>), (<:), mapV, foldlV, foldrV,+  reduceV, pipeV, zipWithV, filterV, zipV, unzipV, +  -- scanlV, scanrV, meshlV, meshrV, +  concatV, reverseV, shiftlV, shiftrV, rotrV, rotlV, rotateV,+  generateV, iterateV, copyV --, serialV, parallelV +  ) where++infixr 5 :>+infixl 5 <:+infixr 5 <+>++-- | The data type 'Vector' is modeled similar to a list. It has two data type constructors. 'NullV' constructs the empty vector, while ':>' constructsa vector by adding an value to an existing vector. Using the inheritance mechanism of Haskell we have declared 'Vector' as an instance of the classes 'Read' and 'Show'.+--+-- | This means that the vector 1:>2:>3:>NullV is shown as <1,2,3>.+data Vector a = NullV+              | a :> (Vector a) deriving (Eq)++-- | The function 'vector' converts a list into a vector.+vector     :: [a] -> Vector a++-- | The function 'fromVector' converts a vector into a list.+fromVector :: Vector a -> [a]++-- | The function 'unitV' creates a vector with one element. +unitV :: a -> Vector a++-- | The function 'nullV' returns 'True' if a vector is empty. +nullV :: Vector a -> Bool++-- | The function 'lengthV' returns the number of elements in a value. +lengthV :: Vector a -> Int++-- | The function 'atV' returns the n-th element in a vector, starting from zero.+atV  :: (Num a, Eq a) => Vector b -> a -> b++-- |  The function 'replaceV' replaces an element in a vector.+replaceV :: Vector a -> Int -> a -> Vector a++-- | The functions 'headV' returns the first element of a vector.+headV :: Vector a -> a++-- | The function 'lastV' returns the last element of a vector.+lastV :: Vector a -> a++-- | The functions 'tailV' returns all, but the first element of a vector.+tailV :: Vector a -> Vector a ++-- | The function 'initV' returns all but the last elements of a vector.+initV :: Vector a -> Vector a ++-- | The function 'takeV' returns the first n elements of a vector.+takeV :: (Num a, Ord a) => a -> Vector b -> Vector b++-- | The function 'dropV' drops the first n elements of a vector.+dropV :: (Num a, Ord a) => a -> Vector b -> Vector b++-- | The function 'selectV' selects elements in the vector. The first argument gives the initial element, starting from zero, the second argument gives the stepsize between elements and the last argument gives the number of elements. +selectV :: Int -> Int -> Int -> Vector a -> Vector a++-- | The function 'groupV' groups a vector into a vector of vectors of size n.+groupV :: Int -> Vector a -> Vector (Vector a)++-- | The operator '(<:)' adds an element at the end of a vector.+(<:)  :: Vector a -> a -> Vector a++-- | The operator '(<+>)' concatinates two vectors.+(<+>) :: Vector a -> Vector a -> Vector a+++-- | The higher-order function 'mapV' applies a function on all elements of a vector.+mapV :: (a -> b) -> Vector a -> Vector b    ++-- | The higher-order function 'zipWithV' applies a function pairwise on to vectors.+zipWithV :: (a -> b -> c) -> Vector a -> Vector b -> Vector c++-- | The higher-order functions 'foldlV' folds a function from the right to the left  over a vector using an initial value.+foldlV :: (a -> b -> a) -> a -> Vector b -> a ++-- | The higher-order functions 'foldrV' folds a function from the left to the right over a vector using an initial value.+foldrV :: (b -> a -> a) -> a -> Vector b -> a++-- | Reduces a vector of elements to a single element based on a binary function. +reduceV :: (a -> a -> a) -> Vector a -> a++-- | Pipes an element through a vector of functions. For example the code+--+-- >>> pipeV [(*2), (+1), (/3)] 3+-- > 2+--+-- is equivalent to+--+-- >>> ((*2) . (+1) . (/3)) 3+-- > 2+pipeV :: Vector (a -> a) -> a -> a++-- | The higher-function 'filterV' takes a predicate function and a vector and creates a new vector with the elements for which the predicate is true. +filterV :: (a -> Bool) -> Vector a -> Vector a++-- | The function 'zipV' zips two vectors into a vector of tuples.+zipV   :: Vector a -> Vector b -> Vector (a, b)++-- | The function 'unzipV' unzips a vector of tuples into two vectors.+unzipV :: Vector (a, b) -> (Vector a, Vector b)++-- | The function 'shiftlV' shifts a value from the left into a vector. +shiftlV :: Vector a -> a-> Vector a ++-- | The function 'shiftrV' shifts a value from the right into a vector. +shiftrV :: Vector a -> a -> Vector a++-- | The function 'rotlV' rotates a vector to the left. Note that this fuctions does not change the size of a vector.+rotlV   :: Vector a -> Vector a++-- | The function 'rotrV' rotates a vector to the right. Note that this fuction does not change the size of a vector.+rotrV   :: Vector a -> Vector a++-- | The function 'rotateV' rotates a vector based on an index offset.+--+-- * @(> 0)@ : rotates the vector left with the corresponding number+-- of positions.+--+-- * @(= 0)@ : does not modify the vector.+--+-- * @(< 0)@ : rotates the vector right with the corresponding number+-- of positions.+rotateV :: Int -> Vector a -> Vector a++-- | The function 'concatV' transforms a vector of vectors to a single vector. +concatV   :: Vector (Vector a) -> Vector a++-- | The function 'reverseV' reverses the order of elements in a vector. +reverseV  :: Vector a -> Vector a++-- | The function 'iterateV' generates a vector with a given number of elements starting from an initial element using a supplied function for the generation of elements. +--+-- > Vector> iterateV 5 (+1) 1+--+-- > <1,2,3,4,5> :: Vector Integer+iterateV :: (Num a, Eq a) => a -> (b -> b) -> b -> Vector b++-- | The function 'generateV' behaves in the same way, but starts with the application of the supplied function to the supplied value. +--+-- > Vector> generateV 5 (+1) 1+-- +-- > <2,3,4,5,6> :: Vector Integer+generateV :: (Num a, Eq a) => a -> (b -> b) -> b -> Vector b++-- | The function 'copyV' generates a vector with a given number of copies of the same element. +--+-- > Vector> copyV 7 5 +-- +-- > <5,5,5,5,5,5,5> :: Vector Integer+copyV     :: (Num a, Eq a) => a -> b -> Vector b++{-+-- | The function 'serialV' can be used to construct a serial network of processes.++--|The function \haskell{serialV} and \haskell{parallelV} can be used to construct serial and parallel networks of processes.+\begin{code}+serialV    :: Vector (a -> a) -> a -> a+parallelV  :: Vector (a -> b) -> Vector a -> Vector b+\end{code}++The functions \haskell{scanlV} and \haskell{scanrV} "scan" a function through a vector. The functions take an initial element apply a functions recursively first on the element and then on the result of the function application.+%+\begin{code}+scanlV    :: (a -> b -> a) -> a -> Vector b -> Vector a +scanrV    :: (b -> a -> a) -> a -> Vector b -> Vector a+\end{code}++\index{scanlV@\haskell{scanlV}}+\index{scanrV@\haskell{scanrV}}++Reekie also proposed the \haskell{meshlV} and \haskell{meshrV} iterators. They are like a combination of \haskell{mapV} and \haskell{scanlV} or \haskell{scanrV}. The argument function supplies a pair of values: the first is input into the next application of this function, and the second is the output value. As an example consider the expression:+%+\begin{code}+f x y = (x+y, x+y)++s1 = vector [1,2,3,4,5]+\end{code}+%+Here \haskell{meshlV} can be used to calculate the running sum. +%+\begin{verbatim}+Vector> meshlV f 0 s1+(15,<1,3,6,10,15>)+\end{verbatim}++\begin{code}+meshlV    :: (a -> b -> (a, c)) -> a -> Vector b -> (a, Vector c)+meshrV    :: (a -> b -> (c, b)) -> b -> Vector a -> (Vector c, b)+\end{code}++\index{meshlV@\haskell{meshlV}}+\index{meshrV@\haskell{meshrV}}+-}++instance (Show a) => Show (Vector a) where+   showsPrec p NullV = showParen (p > 9) (+             showString "<>")+   showsPrec p xs    = showParen (p > 9) (+             showChar '<' . showVector1 xs)+           where+          showVector1 NullV+             = showChar '>'            +          showVector1 (y:>NullV) +             = shows y . showChar '>'+          showVector1 (y:>ys)    +             = shows y . showChar ',' +           . showVector1 ys+++instance Read a => Read (Vector a) where+   readsPrec _ s = readsVector s++readsVector :: (Read a) => ReadS (Vector a)+readsVector s = [((x:>NullV), rest) | ("<", r2) <- lex s,+            (x, r3)   <- reads r2,+            (">", rest) <- lex r3]+       +++      [(NullV, r4)    | ("<", r5) <- lex s,+            (">", r4) <- lex r5]+       +++      [((x:>xs), r6)  | ("<", r7) <- lex s,+            (x, r8)   <- reads r7,+            (",", r9) <- lex r8,+            (xs, r6) <- readsValues r9]++readsValues :: (Read a) => ReadS (Vector a)+readsValues s = [((x:>NullV), r1) | (x, r2)   <- reads s,+              (">", r1) <- lex r2]+      +++      [((x:>xs), r3)    | (x, r4)   <- reads s,+              (",", r5) <- lex r4,+              (xs, r3)  <- readsValues r5]++vector []     = NullV+vector (x:xs) = x :> (vector xs)++fromVector NullV   = []+fromVector (x:>xs) = x : fromVector xs++unitV x = x :> NullV++nullV NullV   = True+nullV _     = False++lengthV NullV   = 0+lengthV (_:>xs) = 1 + lengthV xs++replaceV vs n x +    | n <= lengthV vs && n >= 0 = takeV n vs <+> unitV x +          <+> dropV (n+1) vs+    | otherwise         =  vs++NullV   `atV` _ = error "atV: Vector has not enough elements"+(x:>_)  `atV` 0 = x+(_:>xs) `atV` n = xs `atV` (n-1)++headV NullV   = error "headV: Vector is empty"+headV (v:>_) = v++tailV NullV   = error "tailV: Vector is empty"+tailV (_:>vs) = vs++lastV NullV  = error "lastV: Vector is empty"+lastV (v:>NullV) = v+lastV (_:>vs)    = lastV vs++initV NullV  = error "initV: Vector is empty"+initV (_:>NullV) = NullV+initV (v:>vs)    = v :> initV vs++takeV 0 _       = NullV+takeV _ NullV       = NullV+takeV n (v:>vs) | n <= 0    = NullV+        | otherwise = v :> takeV (n-1) vs++dropV 0 vs      = vs+dropV _ NullV       = NullV+dropV n (v:>vs) | n <= 0    = v :> vs+        | otherwise = dropV (n-1) vs++selectV f s n vs | n <= 0       +         = NullV+         | (f+s*n-1) > lengthV vs +        = error "selectV: Vector has not enough elements"+         | otherwise    +        = atV vs f :> selectV (f+s) s (n-1) vs++groupV n v +  | lengthV v < n = NullV+  | otherwise     = selectV 0 1 n v +      :> groupV n (selectV n 1 (lengthV v-n) v)++NullV <+> ys   = ys+(x:>xs) <+> ys = x :> (xs <+> ys) ++xs <: x = xs <+> unitV x     ++mapV _ NullV   = NullV+mapV f (x:>xs) = f x :> mapV f xs++zipWithV f (x:>xs) (y:>ys) = f x y :> (zipWithV f xs ys)+zipWithV _ _   _   = NullV++foldlV _ a NullV   = a+foldlV f a (x:>xs) = foldlV f (f a x) xs++foldrV _ a NullV   = a +foldrV f a (x:>xs) = f x (foldrV f a xs)++reduceV _ NullV      = error "Cannot reduce a null vector"+reduceV _ (x:>NullV) = x+reduceV f (x:>xs)    = foldrV f x xs++pipeV = reduceV (.)++filterV _ NullV   = NullV+filterV p (v:>vs) = if (p v) then+         v :> filterV p vs+      else +         filterV p vs++zipV (x:>xs) (y:>ys) = (x, y) :> zipV xs ys+zipV _   _   = NullV++unzipV NullV       = (NullV, NullV)+unzipV ((x, y) :> xys) = (x:>xs, y:>ys) +       where (xs, ys) = unzipV xys++shiftlV vs v = v :> initV vs++shiftrV vs v = tailV vs <: v++rotrV NullV = NullV+rotrV vs    = tailV vs <: headV vs++rotlV NullV = NullV+rotlV vs    = lastV vs :> initV vs++rotateV n+  | n > 0     = pipeV (copyV (abs n) rotlV)+  | n < 0     = pipeV (copyV (abs n) rotrV)+  | otherwise = id+++concatV = foldrV (<+>) NullV++reverseV NullV   = NullV+reverseV (v:>vs) = reverseV vs <: v++generateV 0 _ _ = NullV+generateV n f a = x :> generateV (n-1) f x +        where x = f a++iterateV 0 _ _ = NullV+iterateV n f a = a :> iterateV (n-1) f (f a)++copyV k x = iterateV k id x ++{-+serialV  fs  x = serialV' (reverseV fs ) x+  where+    serialV' NullV   x = x+    serialV' (f:>fs) x = serialV fs (f x)+++parallelV NullV   NullV   = NullV+parallelV _  NullV   +   = error "parallelV: Vectors have not the same size!"+parallelV NullV  _   +   = error "parallelV: Vectors have not the same size!"+parallelV (f:>fs) (x:>xs) = f x :> parallelV fs xs++scanlV _ _ NullV   = NullV+scanlV f a (x:>xs) = q :> scanlV f q xs +       where q = f a x++scanrV _ _ NullV  = NullV+scanrV f a (x:>NullV) = f x a :> NullV+scanrV f a (x:>xs)    = f x y :> ys +          where ys@(y:>_) = scanrV f a xs++meshlV _ a NullV   = (a, NullV)+meshlV f a (x:>xs) = (a'', y:>ys) +       where (a', y)   = f a x+         (a'', ys) = meshlV f a' xs++meshrV _ a NullV    = (NullV, a)+meshrV f a (x:>xs)  = (y:>ys, a'') +        where (y, a'') = f x a'+          (ys, a') = meshrV f a xs+-}++++++

@@ -1,37 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe--- Copyright   :  (c) SAM Group, KTH/ICT/ECS 2007-2008--- License     :  BSD-style (see the file LICENSE)--- --- Maintainer  :  forsyde@kth.se--- Stability   :  experimental--- Portability :  portable --- --- The CoreLib is the base for all MoC libraries and is a container--- that includes the following libraries:--- --- * "ForSyDe.Shallow.Signal"--- --- * "ForSyDe.Shallow.Vector"--- --- * "ForSyDe.Shallow.AbsentExt" --------------------------------------------------------------------------------module ForSyDe.Shallow.CoreLib(  -        module ForSyDe.Shallow.Signal,-        module ForSyDe.Shallow.Vector,-        module ForSyDe.Shallow.AbsentExt-        ) where--import ForSyDe.Shallow.Vector-import ForSyDe.Shallow.Signal-import ForSyDe.Shallow.AbsentExt--------

@@ -1,71 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.DFT--- 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------ This module includes the standard Discrete Fourier Transform (DFT)--- function, and a fast Fourier transform (FFT) algorithm, for--- computing the DFT, when the input vectors' length is a power of 2.-------------------------------------------------------------------------------module ForSyDe.Shallow.DFT(dft, fft) where--import ForSyDe.Shallow.Vector-import Data.Complex---- | The function 'dft' performs a standard Discrete Fourier Transformation-dft :: Int -> Vector (Complex Double) -> Vector (Complex Double)-dft bigN x | bigN == (lengthV x) = mapV (bigX_k bigN x) (nVector x)-   | otherwise = error "DFT: Vector has not the right size!"   -   where-     nVector x'   = iterateV (lengthV x') (+1) 0-     bigX_k bigN' x' k = sumV (zipWithV (*) x' (bigW' k bigN'))-     bigW' k' bigN'     = mapV (** k') (mapV cis (fullcircle bigN'))-     sumV    = foldlV (+) (0:+ 0)--fullcircle :: Int -> Vector Double -fullcircle n = fullcircle1 0 (fromIntegral n) n-  where-    fullcircle1 l m n' -      | l == m    = NullV-      | otherwise = -2*pi*l/(fromIntegral n') -                    :> fullcircle1 (l+1) m n' ---- | The function 'fft' implements a fast Fourier transform (FFT) algorithm, for computing the DFT, when the size N is a power of 2.-fft :: Int -> Vector (Complex Double) -> Vector (Complex Double)-fft bigN xv | bigN == (lengthV xv) = mapV (bigX xv) (kVector bigN)-    | otherwise = error "FFT: Vector has not the right size!"--kVector :: (Num b, Num a, Eq a) => a -> Vector b  -kVector bigN = iterateV bigN (+1) 0 ---bigX :: Vector (Complex Double) -> Int -> Complex Double-bigX (x0:>x1:>NullV) k | even k = x0 + x1 * bigW 2 0-     | odd k  = x0 - x1 * bigW 2 0-bigX xv k = bigF_even k + bigF_odd k * bigW bigN (fromIntegral k)-     where bigF_even k' = bigX (evens xv) k'-           bigF_odd k' = bigX (odds xv) k'-           bigN = lengthV xv--bigW :: Int -> Int -> Complex Double-bigW bigN k = cis (-2 * pi * (fromIntegral k) / (fromIntegral bigN))--evens :: Vector a -> Vector a-evens NullV   = NullV-evens (v1:>NullV) = v1 :> NullV-evens (v1:>_:>v)  = v1 :> evens v--odds :: Vector a -> Vector a-odds NullV    = NullV-odds (_:>NullV)   = NullV-odds (_:>v2:>v)   = v2 :> odds v-----

@@ -1,443 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.DataflowLib--- 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 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.-----------------------------------------------------------------------------------module ForSyDe.Shallow.DataflowLib-    (-  -- * 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:-  -- -  --   * [&#x22A5;] 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) -  -- -  FiringToken(Wild, Value),-  -- * 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 = {[*], &#x22A5;, [T]}-  ---  --   * R2 = {&#x22A5;, [*], [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, zipWithDF, zipWith3DF, -  -- * 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, mooreDF, mealyDF-    ) where--import ForSyDe.Shallow.CoreLib --------------------------------------------------------------------------------- DATA TYPES------------------------------------------------------------------------------data FiringToken a = Wild-       | Value a deriving (Eq, Show)--------------------------------------------------------------------------------- COMBINATIONAL PROCESS CONSTRUCTORS-------------------------------------------------------------------------------- |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.-mapDF       :: Eq a => [[FiringToken a]] -           -> (Signal a -> [[b]]) -> Signal a -> Signal b--mapDF _  _  NullS       =  NullS   -mapDF rs as xs      =  output +-+ mapDF rs as xs'-   where-       xs'      =  if matchedRule < 0 then-              NullS-               else-              consumeDF rule xs-       matchedRule      =  (matchDF rs xs)-       rule         =  rs !! matchedRule-       output       =  if matchedRule < 0 then-              NullS-               else-              signal ((as xs) !! matchedRule)--- |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.-zipWithDF       :: (Eq a, Eq b) => -           [([FiringToken b], [FiringToken a])] -           -> (Signal b -> Signal a -> [[c]]) -> Signal b -           -> Signal a -> Signal c--zipWithDF _  _  NullS NullS  = NullS-zipWithDF rs as xs  ys     = output +-+ zipWithDF rs as xs' ys'-   where -      (xs', ys')       = if matchedRule < 0 then-            (NullS, NullS)-             else-            consume2DF rule xs ys-      matchedRule      = (match2DF rs xs ys)-      rule         = rs !! matchedRule-      output       = if matchedRule < 0 then-            NullS-             else-            signal ((as xs ys) !! matchedRule)---- |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.-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-zipWith3DF _  _  NullS NullS NullS = NullS-zipWith3DF rs as xs ys zs   = output +-+ zipWith3DF rs as xs' ys' zs'-   where -     (xs', ys', zs')    = if matchedRule < 0 then-             (NullS, NullS, NullS)-              else-            consume3DF rule xs ys zs-     matchedRule    = (match3DF rs xs ys zs)-     rule       = rs !! matchedRule-     output         = if matchedRule < 0 then-             NullS-              else-             signal ((as xs ys zs) !! matchedRule)--------------------------------------------------------------------------------- SEQUENTIAL PROCESS CONSTRUCTORS------------------------------------------------------------------------------- | 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.-scanlDF           :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])]      -             -> (b -> Signal a -> [b]) -             -> b -> Signal a -> Signal b-scanlDF _  _  _     NullS   = NullS-scanlDF fs ns state xs      = (unitS state) -              +-+ scanlDF fs ns state' xs'-   where -       xs'      = if matchedRule < 0 then-             NullS-              else-             consumeDF rule xs-       matchedRule      = matchStDF fs state xs-       rule         = snd (fs !! matchedRule)-       state'       = if matchedRule < 0 then-             error "No rule matches the pattern!"-              else-             (ns state xs) !! matchedRule---- | 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.-mooreDF           :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])] -             -> (b -> Signal a -> [b]) -> (b -> [c]) -             -> b -> Signal a -> Signal c-mooreDF _  _  _ _     NullS     = NullS-mooreDF fs ns o state xs    = output +-+ mooreDF fs ns o state' xs'-   where -       xs'      = if matchedRule < 0 then-             NullS-              else-             consumeDF rule xs-       matchedRule      = matchStDF fs state xs-       rule         = snd (fs !! matchedRule)-       output       = signal (o state)-       state'       = if matchedRule < 0 then-             error "No rule matches the pattern!"-              else-             (ns state xs) !! matchedRule ----- | 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.-mealyDF     :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])] -    -> (b -> Signal a -> [b]) -> (b -> Signal a -> [[c]]) -    -> b -> Signal a -> Signal c-mealyDF _  _  _ _     NullS     = NullS-mealyDF fs ns o state xs    = output +-+ mealyDF fs ns o state' xs'-   where -       xs'      = if matchedRule < 0 then-             NullS-              else-             consumeDF rule xs-       matchedRule      = matchStDF fs state xs-       rule         = snd (fs !! matchedRule)-       output       = signal ((o state xs) !! matchedRule)-       state'       = if matchedRule < 0 then-             error "No rule matches the pattern!"-              else-             (ns state xs) !! matchedRule  --------------------------------------------------------------------------------- SUPPORTING FUNCTIONS-------------------------------------------------------------------------------- The function 'prefixDF' takes a pattern and a signal and returns--- 'True', if the pattern is a prefix from the signal.-prefixDF        :: Eq a => [FiringToken a] -> Signal a -> Bool-prefixDF []     _   =  True-prefixDF _      NullS   =  False-prefixDF (Wild:ps)  (_:-xs)     =  prefixDF ps xs-prefixDF ((Value p):ps) (x:-xs) =  if p == x then-              prefixDF ps xs-               else-              False---- The function 'consumeDF' takes a pattern and a signal and consumes--- the pattern from the signal. The functions 'consume2DF' and--- 'consume3DF' work in the same way as 'consumeDF', but with two and--- three input signals.-consumeDF           :: Eq a => [FiringToken a] -               -> Signal a -> Signal a-consumeDF _    NullS    =  NullS           -consumeDF []       xs   =  xs-consumeDF (Wild:ts)    (_:-xs)  =  consumeDF ts xs     -consumeDF (Value t:ts) (x:-xs)  =  if t == x then-              consumeDF ts xs-               else-              error "Tokens not correct"--consume2DF           :: (Eq a, Eq b) => -            ([FiringToken a], [FiringToken b]) -            -> Signal a -> Signal b -> (Signal a, Signal b)-consume2DF (px, py) xs ys    =  (consumeDF px xs,-             consumeDF py ys)--consume3DF           :: (Eq a, Eq b, Eq c) => -            ([FiringToken a], [FiringToken b], [FiringToken c]) -             -> Signal a -> Signal b -> Signal c -             -> (Signal a,Signal b,Signal c)-consume3DF (px, py, pz) xs ys zs = (consumeDF px xs,-            consumeDF py ys,-            consumeDF pz zs)---- The function 'matchDF' checks, which firing rule, starting from 0, is--- matched by the input signal. If no firing rule matches, the output is--- '-1'. The functions 'maptch2S' and 'match3DF' work in the same way--- for two and three inputs.-matchDF             :: (Num a, Eq b) => -               [[FiringToken b]] -> Signal b -> a-matchDF rs xs       =  matchDF' 0 rs xs-   where matchDF' _ []     _    =  -1-         matchDF' n (r:rs) xs   =  if prefixDF r xs then-                                     n-                                   else-                                     matchDF' (n+1) rs xs--match2DF        :: (Num a, Eq b, Eq c) => -               [([FiringToken b], [FiringToken c])]-               -> Signal b -> Signal c -> a-match2DF rs xs ys       =  match2DF' 0 rs xs ys-   where match2DF' _ [] _ _     =  -1-         match2DF' n ((rx, ry):rs) xs ys-           =  if prefixDF rx xs &&-                 prefixDF ry ys -              then-                n-              else-                match2DF' (n+1) rs xs ys--match3DF        :: (Num a, Eq b, Eq c, Eq d) => -               [([FiringToken b], [FiringToken d], [FiringToken c])]-            -> Signal b -> Signal d -> Signal c -> a-match3DF rs xs ys zs    = match3DF' 0 rs xs ys zs-   where match3DF' _ [] _ _ _   = -1 -         match3DF' n ((rx, ry, rz):rs) xs ys zs -           =  if prefixDF rx xs &&-                 prefixDF ry ys &&-                 prefixDF rz zs -              then-                n-              else-                match3DF' (n+1) rs xs ys zs  ---- The function 'matchStDF' works in the same way as 'matchDF', but it looks on patterns that include the state.-matchStDF           :: (Num a, Eq b, Eq c) => -               [(FiringToken c,[FiringToken b])] -               -> c -> Signal b -> a-matchStDF rs state xs       = matchStDF' 0 rs state xs-  where matchStDF' _ [] _ _     =  -1-        matchStDF' n (r:rs) state xs    -          =  if prefixDF (snd r) xs && -                matchState (fst r) state-             then-               n-             else-               matchStDF' (n+1) rs state xs  -        -matchState          :: Eq a => FiringToken a -> a -> Bool-matchState Wild  _      = True-matchState (Value v) x      = x == v ---------------------------------------------------------------------------------- CODE FOR TESTING------------------------------------------------------------------------------{--selectRules :: [([FiringToken a], [FiringToken a1], [FiringToken Bool])]-selectRules = [ ([Wild], [], [Value True]),-       ([], [Wild], [Value False]) ]---selectOutput :: Signal t1 -> Signal t1 -> t -> [[t1]]-selectOutput xs ys _ =  [ [headS xs], [headS ys] ]--selectDF        :: Eq a => Signal a -> Signal a -               -> Signal Bool -> Signal a-selectDF        =  zipWith3DF selectRules selectOutput----s1 :: Signal Integer-s1 = signal [1,2,3,4,5,6]-s2 :: Signal Integer-s2 = signal [7,8,9,10,11,12]-s3 :: Signal Bool-s3 = signal [True, True, False, False, True, True]--rs :: (Eq c, Num c) => Signal c -> Signal c-rs xs           = mealyDF firingRule nextState output initState xs-   where firingRule     = [(Wild, [Wild])]-     nextState state xs     = [(state + headS xs)]-     output state _         = [[state]]-     initState      = 0--rs2 :: Signal Integer -> Signal Integer-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)]]--}--------

@@ -1,130 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.DomainInterfaces--- 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------ This module defines domain interface constructors for the multi-rate computational --- model.-------------------------------------------------------------------------------module ForSyDe.Shallow.DomainInterfaces(downDI, upDI, par2serxDI, ser2parxDI, -        par2ser2DI, par2ser3DI, par2ser4DI, -        ser2par2DI, ser2par3DI, ser2par4DI) where--import ForSyDe.Shallow.CoreLib-import ForSyDe.Shallow.SynchronousLib----- | The domain interface constructor 'downDI' takes a parameter 'k' and downsamples an input signal.-downDI     :: (Num a, Eq a) => a -> Signal b -> Signal b---- | The domain interface constructors 'upDI' takes a parameter 'k' and upsamples an input signal.-upDI   :: (Num a, Eq a) => a -> Signal b -> Signal (AbstExt b)---- | The domain interface constructor 'par2ser2DI' converts two parallel signals into one signal.-par2ser2DI :: Signal a -> Signal a -> Signal a---- | The domain interface constructor 'par2ser3DI' converts three parallel signals into one signal-par2ser3DI :: Signal a -> Signal a -> Signal a -> Signal a---- | The domain interface constructor 'par2ser4DI' converts four parallel signals into one signal-par2ser4DI :: Signal a -> Signal a -> Signal a -> Signal a -       -> Signal a----- | The domain interface constructor 'par2serxDI' converts n parallel signals into one signal.-par2serxDI :: Vector (Signal a) -> Signal a---- | The domain interface constructor 'ser2par2DI' converts one signal into two parallel signals.-ser2par2DI :: Signal a -> (Signal (AbstExt a), Signal (AbstExt a))---- | The domain interface constructor 'ser2par3DI' converts one signal into three parallel signals.-ser2par3DI :: Signal a -> (Signal (AbstExt a), Signal (AbstExt a), Signal (AbstExt a))---- | The domain interface constructor 'ser2par4DI' converts one signal into four parallel signals.-ser2par4DI :: Signal a -       -> (Signal (AbstExt a), Signal (AbstExt a), -       Signal (AbstExt a), Signal (AbstExt a))---- | The domain interface constructors 'ser2parxDI' converts one signal into n parallel signals.-ser2parxDI :: (Num a, Ord a) => a -> Signal (AbstExt b) -              -> Vector (Signal (AbstExt b))---- Implementation--downDI n xs     = down1 n 1 xs -  where down1 _ _ NullS   = NullS-        down1 1 1 (x:-xs) = x :- down1 1 1 xs-        down1 n 1 (x:-xs) = x :- down1 n 2 xs-        down1 n m (_:-xs) = if m == n then-                              down1 n 1 xs-                            else-                              down1 n (m+1) xs --upDI _ NullS   = NullS-upDI n (x:-xs) = (Prst x) :- ((copyS (n-1) Abst) +-+ upDI n xs)--par2ser2DI xs ys  = par2ser2DI' (zipSY xs ys)-  where par2ser2DI' NullS = NullS-        par2ser2DI' ((x,y):-xys) = x:-y:-par2ser2DI' xys--par2ser3DI xs ys zs = par2ser3DI' (zip3SY xs ys zs)-  where par2ser3DI' NullS = NullS-        par2ser3DI' ((x,y,z):-xyzs) = x:- y :-z :- par2ser3DI' xyzs--par2ser4DI ws xs ys zs = par2ser4DI' (zip4SY ws xs ys zs)-  where par2ser4DI' NullS = NullS-        par2ser4DI' ((w,x,y,z):-wxyzs) -          = w:-x:-y:-z:- par2ser4DI' wxyzs--ser2par2DI = unzipSY . group2SY . delaynSY Abst 2 . mapSY abstExt--ser2par3DI = unzip3SY . group3SY . delaynSY Abst 3 . mapSY abstExt--ser2par4DI = unzip4SY . group4SY . delaynSY Abst 4 . mapSY abstExt---par2serxDI = par2serxDI' . zipxSY -  where par2serxDI' NullS    = NullS-        par2serxDI' (xv:-xs) = (signal . fromVector) xv -                               +-+ par2serxDI' xs --ser2parxDI n = unzipxSY . delaySY (copyV n Abst) -               . filterAbstDI . group n--group2SY :: Signal t -> Signal (t, t)-group2SY NullS = NullS-group2SY (_:-NullS) = NullS-group2SY (x:-y:-xys) = (x, y) :- group2SY xys--group3SY :: Signal t -> Signal (t, t, t)-group3SY NullS = NullS-group3SY (_:-NullS) = NullS-group3SY (_:-_:-NullS) = NullS-group3SY (x:-y:-z:-xyzs) = (x, y, z) :- group3SY xyzs--group4SY :: Signal t -> Signal (t, t, t, t)-group4SY NullS = NullS-group4SY (_:-NullS) = NullS-group4SY (_:-_:-NullS) = NullS-group4SY (_:-_:-_:-NullS) = NullS-group4SY (w:-x:-y:-z:-wxyzs) = (w, x, y, z) :- group4SY wxyzs ---filterAbstDI :: Signal (AbstExt a) -> Signal a-filterAbstDI NullS      = NullS-filterAbstDI (Abst:-xs)     = filterAbstDI xs-filterAbstDI ((Prst x):-xs) = x :- filterAbstDI xs--group :: (Ord a, Num a) => a -> Signal a1 -> Signal (AbstExt (Vector a1))-group n xs = mapSY (output n) (scanlSY (addElement n)  (NullV, 0) xs)-  where addElement m (vs, n) x | n < m  = (vs <: x, n+1)-                               | n == m = (unitV x, 1)-                               | otherwise = error "Vector of wrong size"-        output m (vs, n) | m == n = Prst vs-                         | otherwise = Abst-

@@ -1,36 +0,0 @@-------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.FIR--- 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------ This module implements a FIR filters for the synchronous computational model.-------------------------------------------------------------------------------module ForSyDe.Shallow.FIR (firSY) where--import ForSyDe.Shallow.SynchronousLib-import ForSyDe.Shallow.CoreLib---- | The function firSY implements a FIR-filter for the synchronous computational model. All kinds of FIR-filters can now be modeled by means of 'firSY'. The only argument needed is the list of coefficients, which is given as a vector of any size. To illustrate this, an 8-th order band pass filter is modeled as follows. ------ > bp = firSY (vector [0.06318761339784, 0.08131651217682, 0.09562326700432, --- >         0.10478344432968, 0.10793629404886, 0.10478344432968, --- >         0.09562326700432, 0.08131651217682, 0.06318761339784 ])--- -firSY :: Fractional a => Vector a -> Signal a -> Signal a-firSY h = innerProdSY h . sipoSY k 0.0-    where k = lengthV h--sipoSY :: Int -> b -> Signal b -> Vector (Signal b) -sipoSY n s0 = unzipxSY . scanldSY shiftrV initState-    where initState = copyV n s0--innerProdSY :: (Num a) => Vector a -> Vector (Signal a) -> Signal a-innerProdSY coeffs = zipWithxSY (ipV coeffs)-   where ipV NullV   NullV   = 0-         ipV (h:>hv) (x:>xv) = h*x + ipV hv xv-         ipV _   _   = error "Vector of different length"

@@ -1,313 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.FilterLib--- 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------ This is the filter library for ForSyDe heterogeneous MoCs - CT-MoC, SR-MoC,--- and Untimed-MoC.------ The filters at CT-MoC are based on the filters implemented at SR-MoC and Untimed-MoC, --- which means a signal in CT-MoC is always digitalized by a A\/D converter, processed by --- digital filters at SR or Untimed domain, and converted back into a CT domain signal by --- a D\/A converter. A CT-filter is composed of one A\/D converter, one digital filter, and --- one D\/A converter.------ The implementation of the filters at untimed and synchronous domains follows the--- way in a paper /An introduction to Haskell with applications to digital signal processing, --- David M. Goblirsch, in Proceedings of the 1994 ACM symposium on Applied computing./,--- where the details of the FIR\/IIR, AR, and ARMA filters are introduced. The ARMA filter--- is the kernel part of our general linear filter 'zLinearFilter' in Z-domain at SR\/Untimed--- MoC, and is also the kernel digital filter for the linear filter 'sLinearFilter' in --- S-domain at CT-MoC.-------------------------------------------------------------------------------module ForSyDe.Shallow.FilterLib (-      -- *FIR filter-      firFilter,-      -- *AR and ARMA filter trim-      arFilterTrim, armaFilterTrim,-      -- *The solver mode-      SolverMode(..),-      -- *The general linear filter in S-domain-      sLinearFilter,-      -- *The general linear filter in Z-domain-      zLinearFilter,-      -- *s2z domain coefficient tranformation-      s2zCoef,-      -- *The Z-domain to ARMA coefficient tranformation-      h2ARMACoef-     )-    where --import ForSyDe.Shallow.MoCLib---import ForSyDe.Shallow.CTLib-import ForSyDe.Shallow.CoreLib-import ForSyDe.Shallow.PolyArith-import Data.List (zipWith5)---- |The FIR filter. Let '[x_n]' denote the input signal, '[y_n]' denote the ouput--- signal, and '[h_n]' the impulse response of the filter. Suppose the length of--- the impulse responses is M samples. The formula for '[y_n]' is --- $sum_{k=0}^{M-1} h_k*x_{n-k}$.-firFilter :: (Num a) => [a]  -- ^Coefficients of the FIR filter-         -> Signal a -- ^Input signal-         -> Signal a -- ^Output signal-firFilter hs xs = mealySY stateF (outF hs) (repeatN (length hs) 0) xs-  where-    stateF xs0 x = fixedList xs0 x-    outF hs xs0 x = iprod hs $ fixedList xs0 x---- |The autoregressive filter is the simplest IIR filter. It is characterized --- by a list of numbers '[a_1,a_2,...,a_M]' called the autoregression --- coefficients and a single number 'b' called the gain. 'M' is the order of --- the filter. Let '[x_n]' denote the input signal, '[y_n]' denote the ouput--- signal. The formula for '[y_n]' is  $\sum_{k=1}^M {a_k*y_{n-k}+b*x_n}$. --- Although it is an IIR filter, here we only get the same length of ouput --- signal as the input signal.-arFilterTrim :: (Num a, Fractional a) => -           [a]   -- ^Coefficients of the AR filter.-         -> a    -- ^The gain-         -> Signal a -- ^Input signal-         -> Signal a -- ^Output signal-arFilterTrim as b xs = -    mealySY (stateF as b) (outF as b) (repeatN (length as) 0) xs-  where-    stateF as b xs0 x = fixedList xs0 $ outF as b xs0 x -    outF as b xs0 x = b*x + (iprod as xs0)---- |The ARMA filter combines the FIR and AR filters. Let '[x_n]' denote the --- input signal, '[y_n]' denote the ouput signal. The formula for '[y_n]' is---  $\sum_{k=1}^M {a_k*y_{n-k}+b*x_n} + sum_{i=0}^{N-1} b_i*x_{n-i}$. The ARMA--- filter can be defined as the composition of an FIR filter having the impulse--- reponse '[b_0,b_1,...,b_N-1]' and an AR filter having the regression --- coefficients '[a_1,a_2,...,a_M]' and a gain of '1'. Although it is an IIR --- filter, here we only get the same length of ouput signal as the input signal.-armaFilterTrim :: (Num a, Fractional a) => -             [a]  -- ^Coefficients of the FIR filter-          -> [a]  -- ^Coefficients of the AR filter.-          -> Signal a -- ^Input signal-          -> Signal a -- ^Output signal-armaFilterTrim bs as = arFilterTrim as 1 . firFilter bs----- |The solver mode.-data SolverMode = S2Z   -- ^Tustin tranfer from s-domain to z-domain-        | RK4   -- ^Runge Kutta 4 with fixed simulation steps-  deriving (Show, Eq)---- |The general linear filter in S-domain at CT-MoC. As the kernel--- implementation is in Z-domain, the smapling rate should be specified. --- It is used on the S-transformation with the following forms, with --- coefficients for the descending powers of 's' and m < n.------ >    b_0*s^m + b_1*s^m-1 + ... + b_m-1*s^1 + b_m*s^0--- >H(s) = ------------------------------------------------     (Eq 1)--- >    a_0*s^n + a_1*s^n-1 + ... + a_n-1*s^1 + a_n*s^0------ If we multiply both the numerator and the denominator with s^-n, we get --- another equivelent canonical form------ >    b_0*s^m-n + b_1*s^m-n-1 + ... + b_m-1*s^1-n + b_m*s^-n--- >H(s) = -----------------------------------------------------    (Eq 2)--- >    a_0*s^0 + a_1*s^-1 + ... + a_n-1*s^1-n + a_n*s^-n------ To instantiate a filter, with sampling interval 'T ', we use------ > filter1 = sLinearFilter T [1] [2,1]--- --- to get a filter  with the transfer function--- --- >      1--- >H(s) = ----------- >   2*s + 1--- --- and------ > filter2 = sLinearFilter T [2,1] [1,2,2]------ to get another filter with the transfer function--- --- >       2*s +1--- >H(s) = ------------------- >    s^2 + 2*s + 2------ There are two solver modes, 'S2Z' and 'RK4'.--- Caused by the precision problem, the time interval in CT uses Rational data--- type and the digital data types in all the domains are Double.-sLinearFilter :: (Num a, Fractional a, Show a, Eq a) =>-    SolverMode   -- ^Specify the solver mode-    ->  Rational     -- ^Fixed simulation interval-    -> [a]  -- ^Coefficients of the polynomial numerator in s-domain-    -> [a]  -- ^Coefficients of the polynomial denominator in s-domain-    -> Signal (SubsigCT a)-- ^Input CT-signal-    -> Signal (SubsigCT a)-- ^Output CT-signal-sLinearFilter filterMode step bs as inS =  outS -  where-    -- A2D conversion-    inSDigital = a2dConverter step inS-    -- D2A conversion-    outS =  d2aConverter DAhold step outSDigital-    -- Digital filter-    outSDigital | filterMode == S2Z = armaFilterTrim bs' as' inSDigital-        | otherwise =  rk4FilterDigital step as bs inSDigital-          where (bs',as') = h2ARMACoef $ s2zCoef step bs as---- |Digital filter using Runge Kutta 4 solver.-rk4FilterDigital :: (Fractional a, Show a, Eq a) => -        Rational -> [a] -> [a] -> Signal a -> Signal a-rk4FilterDigital step as bs inSDigital = outSDigital-  where-    -- Below are the skeletons of the RK-4 solver, with-    -- input signal 'inSDigital' and output signal 'outSDigital'-    -- Coefficients handling-    as'' = dropWhile (\x -> x==0.0) as-    a0 = head as''-    -- Normalized the coefficients-    as' = reverse $ tail $ map (\x -> -x/a0) as''-    bs' = reverse $ map (\x -> x/a0) bs-    -- Order of the filter-    orderFilter = length as'-    -- The last state function, '0' is for the time -    fXn = iprod (0:as')-    -- The functions for the observalbe state matrix 'A'-    stateFunctions = ffn' orderFilter ++ [fXn]-    -- Initial states-    initialStates = repeatN orderFilter 0.0-    inputSteps = signal $ repeat step'-    -- The states signal-    statesSignal = rks4InSY 0.0 initialStates stateFunctions -             inputSteps inSDigital --xs-    -- The ouput digital signal -    outSDigital = mapSY (iprod bs') statesSignal-    -- The fixed simulation step-    step' = fromRational step---- The length of the function list is 'n-1' for nth order filter-ffn' :: (Num t, Num t1, Eq t) => t -> [[t1] -> t1]-ffn' n = ffn 0 n---- Construct the functions for the diagonal '1'-ffn :: (Num t1, Num t, Eq t) => Int -> t -> [[t1] -> t1]-ffn _ 1 = []-ffn m n = ff1 m : ffn (m+1) (n-1) --ff1 :: Num t => Int -> [t] -> t-ff1 m = iprod ([0,0] ++ (repeatN m 0) ++ [1] ++ (repeat 0) )---- |RK-4 to solve the 1st-order ODEs, with input signal.-rks4InSY :: (Num a, Fractional a) =>-      a     -- ^The initial time-  -> [a]       -- ^The initial state values-  -> [([a] -> a)] -- ^List of the functions of the ODEs.-  ->  Signal  a  -- ^Input signal of steps-  ->  Signal  a  -- ^Input signal-  ->  Signal [a] -- ^Next state signal-rks4InSY x0 ys0 fFs hs us = scanl3SY stateF ys0 xs hs us-  where-    stateF ysn xn h ut = zipWith (+) (repeatN orderODE' 0.0 ++ [ut*h]) $ --Input value-              rks4 h xn fFs ysn -    xs = scanldSY (+) x0 hs-    -- Order -1 of the ODEs-    orderODE' = length ys0 - 1---- |One step RK-4 for the 1st-order ordinary differential equations (ODEs).-rks4 ::  (Num a, Fractional a) =>-     a    -- ^The step-     ->  a    -- ^Initial value of time-     -> [[a] -> a] -- ^List of the funcitons of the ODEs.-     -> [a]   -- ^List of the value at the current state-     -> [a]   -- ^List of the value at the next state-rks4 h x0 fFs ys0 = ys1-  where-    h_2 = h/2.0-    ks1 = map (h*) $ map' (x0:ys0) fFs  --    -- map (h *) $ applyFt x0 fFs ys0-    ks2 = map (h*) $ map' (x0+h_2:zipWith (\y k-> y+k/2.0) ys0 ks1) fFs -    ks3 = map (h*) $ map' (x0+h_2:zipWith (\y k-> y+k/2.0) ys0 ks2) fFs -    ks4 = map (h*) $ map' (x0+h:zipWith (\y k-> y+k) ys0 ks3) fFs -    ys1 = zipWith5 (\y0 k1 k2 k3 k4 -> y0 + k1/6 + k2/3 + k3/3 + k4/6)-        ys0 ks1 ks2 ks3 ks4---- |The general linear filter in Z-domain.-zLinearFilter :: Fractional a => [a] -> [a] -> Signal a -> Signal a-zLinearFilter bs as = armaFilterTrim bs' as'-  where-    bs' = map ((\x y-> y/x ) (head as)) bs-    as' = map ((\x y-> -y/x ) (head as)) $ tail as---- |s2z domain coefficient tranformation with a specified sampling rate.--- The Tustin transformation is used for the transfer, with------ >  2(z - 1)  --- > s = ----------                 (Eq 3)--- >  T(z + 1)------ in which, 'T' is the sampling interval.-s2zCoef :: (Num a, Fractional a, Eq a) =>-    Rational      -- ^ Sampling rate in Z-domain-    -> [a]        -- ^ Coefficients of the polynomial numerator in s-domain-    -> [a]        -- ^ Coefficients of the polynomial denominator in s-domain-    -> ([a], [a]) -- ^ Tuple of the numerator and denominator -                  --   coefficients in Z-domain-s2zCoef sampleT bs as = (reverse bs', reverse as')-  where-    (bs',as') = getCoef hZ    -    bsInv = reverse bs-    asInv = reverse as-    numerator' = foldl (\x y -> addPoly x $ scalePoly (fst y) (snd y)) -                 (Poly [0]) $ zip bsInv sList-    denominator' = foldl (\x y -> addPoly x $ scalePoly (fst y) (snd y)) -                   (Poly [0]) $ zip asInv sList-    hZ = divPoly numerator' denominator'-    -- Tustin transform-    s = PolyPair (Poly [-2,2],Poly [fromRational sampleT,fromRational sampleT])-    sList = map (powerPoly s) [0..]---- |The Z-domain to ARMA coefficient tranformation. It is used on the --- Z-transfer function------ >    b_0*z^m-n + b_1*z^m-n-1 + ... + b_m-1*z^1-n + b_m*z^-n--- >H(z) = -----------------------------------------------------    (Eq 4)--- >    a_0*z^0 + a_1*z^-1 + ... + a_n-1*z^1-n + a_n*z^-n------ which is normalized as------ >    b_0/a_0*z^m-n + b_1/a_0*z^m-n-1 + ... + b_m/a_0*z^-n--- >H(z) = -------------------------------------------------------  (Eq 5)--- >    1 + a_1/a_0*z^-1 + ... + a_n-1/a_0*z^1-n + a_n/a_0*z^-n------ The implementation coudl be------ >y(k) = b_0/a_0*x_k+m-n + b_1/a_0*x_k+m-n-1 + ... + b_m/a_0*x_k-n--- >                        (Eq 6)--- >           - a_1/a_0*y_k-1 - ... - a_n/a_0*y_k-n------ Then, we could get the coefficients of the ARMA filter.-h2ARMACoef :: (Num a, Fractional a) =>-       ([a], [a]) -- ^Coefficients in Z-domain-    -> ([a], [a]) -- ^Coefficients of the ARMA filter-h2ARMACoef (bs,as) = (scalePolyCoef a0_1 bs, -          scalePolyCoef (0-a0_1) $ tail as)-  where-    a0_1 = 1.0/ head as---- Helper functions--map' :: a -> [a->b] -> [b]-map' = flip $ sequence ----- |Computes the inner product.-iprod :: Num b => [b] -> [b] -> b-iprod xs ys = sum [x*y | (x, y) <- zip xs ys]---- |Repeat an element for a given times.-repeatN :: Int -> a -> [a]-repeatN n = take n . repeat---- |Maintain a fixed length of list like Fifo, except the outputs are ignored.-fixedList :: [a] -> a -> [a]-fixedList xs y = take (length xs) $ y:xs

@@ -1,68 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.Gaussian--- 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------ We follow the Box-Muller method to generate white gaussian noise, --- described at: <http://www.dspguru.com/howto/tech/wgn.htm>-------------------------------------------------------------------------------module ForSyDe.Shallow.Gaussian (-      pGaussianNoise-    )-where--import ForSyDe.Shallow.UntimedLib-import ForSyDe.Shallow.Signal--import System.Random---- |To generate an infinite Signal of Gaussian values-pGaussianNoise:: Double -- Mean value of the Gaussian noise-    -> Double   -- Variance of the Gaussian noise-    -> Int  -- The seed-    -> Signal Double -- Output gaussian noise signal-pGaussianNoise mean variance = mapU 2 gaussianXY . pUnitNormXY-  where-    gaussianXY [x, y] = [mean + sqrt(variance) * x,-         mean + sqrt(variance) * y]-    gaussianXY _  = error "gaussianXY: unexpected pattern."---- |To get a uniform random variable in the range [0, 1]-uniform :: (Fractional a, RandomGen g, Random a) => -  g -> (a, g)-uniform rGen = randomR (0.0,1.0) rGen---- |To generate an infinite signal of unit normal random variables,--- with the specified seed-pUnitNormXY :: Int     -- The seed-     -> Signal Double  -- The infinite ouput signal-pUnitNormXY = mapU 3 unitNormXY . signal . svGenerator . mkStdGen-  where-    unitNormXY [s, v1, v2] = [sqrt(-2 * log(s) / s) * v1,-          sqrt(-2 * log(s) / s) * v2]-    unitNormXY _ = error "pUnitNormXY: Unexpected pattern."----- |To generate the s, v1, v2 value-svGenerator :: StdGen -> [Double]-svGenerator s-    | sVal >=1 = []++ svGenerator newStdG-    | otherwise = svVal ++ svGenerator newStdG-  where-    svGen1 = svHelper  s-    svVal = fst svGen1-    sVal = head svVal-    newStdG = snd svGen1-    svHelper :: StdGen -> ([Double], StdGen)-    svHelper stdG = ([s, v1, v2], sNew2)-      where-        (u1, sNew1) = uniform stdG-        (u2, sNew2) = uniform sNew1-        v1=2 * u1 -1-        v2=2 * u2 -1-        s = v1*v1 + v2*v2

@@ -1,64 +0,0 @@--------------------------------------------------------------------------------- |--- Module  :  ForSyDe.Shallow.Model--- 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------ This module contains the data structure and access--- functions for the memory model.-------------------------------------------------------------------------------module ForSyDe.Shallow.Memory (-        Memory (..), Access (..), -        MemSize, Adr, newMem, memState, memOutput-      ) where--import ForSyDe.Shallow.Vector-import ForSyDe.Shallow.AbsentExt--type Adr    =  Int-type MemSize      =  Int---- | The data type 'Memory' is modeled as a vector. -data Memory a         =  Mem Adr (Vector (AbstExt a)) -            deriving (Eq, Show)---- | The data type 'Access' defines two access patterns.-data Access a         =  Read Adr     -- ^ 'Read adr' reads an address from the memory.-          |  Write Adr a  -- ^ 'Write Adr a' writes a value into an address.-            deriving (Eq, Show)---- | The function 'newMem' creates a new memory, where the number of entries is given by a parameter.-newMem        :: MemSize -> Memory a---- | The function 'memState' gives the new state of the memory, after an access to a memory. A 'Read' operation leaves the memory unchanged.-memState          :: Memory a -> Access a -> Memory a----- | The function 'memOutput' gives the output of the memory after an access to the memory. A 'Write' operation gives an absent value as output.-memOutput         :: Memory a -> Access a -> AbstExt a---- Implementation--newMem size       =  Mem size (copyV size Abst)--writeMem          :: Memory a -> (Int, a) -> Memory a-writeMem (Mem size vs) (i, x) -   | i < size && i >= 0   =  Mem size (replaceV vs i (abstExt x))-   | otherwise        =  Mem size vs--readMem           :: Memory a -> Int -> (AbstExt a)-readMem (Mem size vs) i   -   | i < size && i >= 0   =  vs `atV` i-   | otherwise        =  Abst--memState mem (Read _)     =  mem-memState mem (Write i x)  =  writeMem mem (i, x)--memOutput mem (Read i)    =  readMem mem i-memOutput _   (Write _ _)     =  Abst--

@@ -0,0 +1,44 @@+----------------------------------------------------------------------+-- |+-- Module      :  ForSyDe.Shallow.MoC+-- Copyright   :  (c) SAM/KTH 2007+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable +-- +-- The corrent module is a container including all MoC libraries and+-- their domain interfaces. +----------------------------------------------------------------------++module ForSyDe.Shallow.MoC (+  -- | The library for the synchronous MoC+  module ForSyDe.Shallow.MoC.Synchronous,++  -- | The library for the most general form of the untimed MoC+  module ForSyDe.Shallow.MoC.Untimed,++  -- | The library for a specialized untimed MoC+  module ForSyDe.Shallow.MoC.Dataflow,++  -- | The library for the Synchronous Dataflow MoC+  module ForSyDe.Shallow.MoC.SDF,+  +  -- | The library for the continuous time MoC+  module ForSyDe.Shallow.MoC.CT,++  -- | The library for the domain interfaces+  module ForSyDe.Shallow.MoC.DomainInterface,++  -- | The library for the MoC interfaces+  module ForSyDe.Shallow.MoC.MoCInterface+  ) where++import ForSyDe.Shallow.MoC.Dataflow+import ForSyDe.Shallow.MoC.DomainInterface+import ForSyDe.Shallow.MoC.CT hiding (delayCT, addTime)+import ForSyDe.Shallow.MoC.MoCInterface+import ForSyDe.Shallow.MoC.SDF+import ForSyDe.Shallow.MoC.Synchronous+import ForSyDe.Shallow.MoC.Untimed

@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  ForSyDe.Shallow.MoC.Adaptivity+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- Adaptivity Library, yet to be completed.+-- +-----------------------------------------------------------------------------+module ForSyDe.Shallow.MoC.Adaptivity (+  applyfSY, applyf2SY, applyf3SY, +    applyfU+  ) where++import ForSyDe.Shallow.Core.Signal+import ForSyDe.Shallow.MoC.Synchronous.Lib+import ForSyDe.Shallow.MoC.Untimed++applyfSY :: Signal (a -> b) -> Signal a -> Signal b+applyfSY = zipWithSY ($)++applyf2SY :: Signal (a -> c -> d) +      -> Signal a -> Signal c -> Signal d+applyf2SY = zipWith3SY ($)++applyf3SY :: Signal (a -> c -> d -> e) +      -> Signal a -> Signal c -> Signal d -> Signal e+applyf3SY = zipWith4SY ($)++applyfU :: Int -> Signal ([a] -> [b]) -> Signal a -> Signal b+applyfU tokenNum = comb2UC tokenNum apply+  where apply f = f

@@ -0,0 +1,1074 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.MoC.CT+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- This is the ForSyDe library for continuous time MoC (CT-MoC).+-- It is still experimental.+-- Right now there are only constructors 'combCT', 'scaleCT', 'addCT',+-- 'multCT' and 'absCT'.+--+-- The main idea is to represent continuous time signals as functions+-- @Real --> a@ with @a@ being a numerical type. This allows us to represent a +-- continuous time signal without loss of information because no sampling or +-- ADC is required. The sampling occurs only when a signal is evaluated, +-- for instance when it is plotted. +-- +-- Thus, a /signal/ is represented as a sequence of functions and intervals. For+-- instance a signal +-- +-- @s = \<(sin,[0,100])\>@ +--+-- represents a sinus signal in the interval between 0 and 100. The signal +--+-- @s2 = \<(f1(x)=2x, [0,2]), (f2(x)=3+x,[2,4])\>@+--+-- defines a signal that is defined by function @f1@ in the interval @[0,2]@ +-- and by function @f2@ in the interval @[2,4]@. +--+-- A /process/ transforms the incoming functions into outgoing functions. +-- The approach is described in more detail in the ANDRES deliverable D1.1a.+-- Here we only briefly comment the main functions and constructors.+----------------------------------------------------------------------------+module ForSyDe.Shallow.MoC.CT (+  -- * The signal data type+  SubsigCT(..),+  ctSignal,+  liftCT,+  timeStep,+  -- * Primary process constructors+  mapCT, zipWithCT,+  combCT, comb2CT,+  delayCT, addTime, -- initCT, mooreCT, mealyCT,+  -- * Derived process constructors+  -- | These constructors instantiate very useful processes.+  -- They could be defined in terms of the basic constructors+  -- but are typically defined in a more direct way for +  -- the sake of efficieny.+  scaleCT, addCT, multCT, absCT,+  -- * Convenient functions and processes+  -- | Several helper functions are available to obtain parts+  -- of a signal, the duration, the start time of a signal, and+  -- to generate a sine wave and constant signals.+  takeCT, dropCT, duration, startTime, sineWave, -- constCT, zeroCT,+  -- * AD and DA converters+  DACMode(..), a2dConverter, d2aConverter,+  -- * Some helper functions+  applyF1, applyF2, applyG1, cutEq, +  -- * Sampling, printing and plotting+  -- $plotdoc+  plot, plotCT, plotCT' ,showParts, vcdGen+  ) where++import ForSyDe.Shallow.Core+import System.Process+import System.Time+--import System.IO+import System.Directory+import Control.Exception as Except+import Data.Ratio+--import Numeric()++-- The revision number of this file:+revision :: String+revision=filter (\ c -> (not (c=='$'))) "$Revision: 1.7 $, $Date: 2007/07/11 08:38:34 $"++-- |The type of a sub-signal of a continuous signal. It consisits of the +--  function and the interval on which the function is defined.+-- The continuous time signal is then defined as a sequence of SubsigCT +-- elements: Signal SubsigCT+data SubsigCT a = SubsigCT ((Rational -> a),     -- The function Time -> Value+                            (Rational,Rational)) -- The interval on which the+                                                 -- function is defined++instance (Num a, Show a) => Show (SubsigCT a) where+  show ss = show (sampleSubsig timeStep ss)++-- | The function 'liftCT' creates a CT-compliant function (using the+-- Rationals as domain) from a normal mathematical function that uses+-- a fractional (Double) as domain+liftCT :: Fractional a => (a -> b) -> Rational -> b+liftCT f = f . fromRational++-- | The function 'ctSignal' creates a CT signal from a list of+-- subsignals that are given by a function, an a time range.+--+-- > *ForSyDe.Shallow.MoC.CT> ctsig1 = ctSignal [(liftCT sin, (0, 3.14)), (\t -> 1, (3.14, 6.28))]+-- > *ForSyDe.Shallow.MoC.CT> :t ctsig1+-- > ctsig1 :: Floating a => Signal (SubsigCT a)-- ctsig1 = ctSignal [(liftCT sin, (0, 3.14)), (\t -> 1, (3.14, 6.28))]+ctSignal :: [(Rational -> a, (Rational, Rational))] -> Signal (SubsigCT a)+ctSignal [] = NullS+ctSignal ((f, (start, end)) : xs) = SubsigCT (f, (start, end)) :- ctSignal xs++--unit :: String -- all time numbers are in terms of this unit.+--unit = "sec" ++-- | This constant gives the default time step for sampling and plotting.+-- Its value is 10ns.+timeStep :: Rational +--timeStep = 10.0e-9+timeStep = 10.0e-2++mapCT :: (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)+mapCT _ NullS = NullS+mapCT g (SubsigCT (f, (f_start, f_end)):-fs)+  = (SubsigCT (\x -> g (f x), (f_start, f_end)) :- mapCT g fs)++zipWithCT :: (a -> b -> c) -> Signal (SubsigCT a) -> Signal (SubsigCT b) -> Signal (SubsigCT c)+zipWithCT _ NullS _ = NullS+zipWithCT _ _ NullS = NullS+zipWithCT h (SubsigCT (f, (f_start, f_end)):-fs) (SubsigCT (g, (g_start, g_end)):-gs)+    | f_start /= g_start  = error "Start times not aligned"+    | f_end == g_end      = (SubsigCT (\x -> h (f x) (g x), (f_start, f_end)) :- zipWithCT h fs gs)+    | f_end < g_end       = (SubsigCT (\x -> h (f x) (g x), (f_start, f_end))+                             :- zipWithCT h fs (SubsigCT (g, (f_end, g_end)) :- gs))           +    | f_end > g_end       = (SubsigCT (\x -> h (f x) (g x), (f_start, g_end))+                             :- zipWithCT h (SubsigCT (f, (g_end, f_end)) :- fs) gs)+    | otherwise           = error "zipWithCT: pattern not covered"++combCT :: (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)+combCT = mapCT++comb2CT :: (a -> b -> c) -> Signal (SubsigCT a)+        -> Signal (SubsigCT b) -> Signal (SubsigCT c)+comb2CT = zipWithCT++delayCT :: Rational -> a -> Signal (SubsigCT a) -> Signal (SubsigCT a)    +delayCT period value fs+  = (SubsigCT (\_ -> value, (0,period))) :- addTime period fs            + +addTime :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)+addTime _ NullS = NullS+addTime delay (SubsigCT (f, (start, end)) :- fs)+  = (SubsigCT (f, (start+delay, end+delay)) :- addTime delay fs)++{-+----+-- | initCT takes an initial signal, outputs it and then copies its second +-- input signal, which is delayed by the duration of the initial signal.+-- The delay is realized by 'delayCT' +initCT :: (Num a, Show a) => +      Signal (SubsigCT a) -- ^ The initial signal output first.+   -> Signal (SubsigCT a) -- ^ Then this signal is output, but delayed.+   -> Signal (SubsigCT a) -- ^ The concatation of the two inputs.+initCT s0 s1 = s0 +-+ (delayCT (duration s0) s1)+-}+    +{-   +-----------------------------------------------------------------------------+-- |The state-full constructor 'mealyCT' resembles a Mealy machine.+mealyCT :: (Num b, Num c, Show b, Show c) =>+       (a -> Rational)      -- ^The gamma function which defines+               -- the partitioning of the input+               -- signal. +   -> (a -> (Rational -> b) -> a) -- ^The next state function g+   -> (a -> (Rational -> b) -> (Rational -> c))+               -- ^The output encoding function f +   -> a          -- ^The initial state+   -> Signal (SubsigCT b)        -- ^The input signal+   -> Signal (SubsigCT c)        -- ^The output signal+mealyCT _     _ _ _ NullS = NullS+mealyCT gamma g f w s+    | (duration (takeCT c s)) < c = NullS+    | otherwise = applyF1 (f w) (takeCT c s) +    +-+ mealyCT gamma g f w' (dropCT c s)+    where c = gamma w+  w' = applyG1 g w (takeCT c s)++-- |The state-full constructor 'mooreCT' resembles a Moore machine.+mooreCT :: (Num b, Num c, Show b, Show c) =>+       (a -> Rational)      -- ^The gamma function which defines+               -- the partitioning of the input+               -- signal. +   -> (a -> (Rational -> b) -> a) -- ^The next state function g+   -> (a -> (Rational -> c))+               -- ^The output encoding function f +   -> a          -- ^The initial state+   -> Signal (SubsigCT b)        -- ^The input signal+   -> Signal (SubsigCT c)        -- ^The output signal+mooreCT _     _ _ _ NullS = NullS+mooreCT gamma g f w s+    | (duration (takeCT c s)) < c = NullS+    | otherwise = (SubsigCT ((f w),(a,b))) +      :- mooreCT gamma g f w' (dropCT c s)+    where c = gamma w+      a = startTime s+      b = a + c+  w' = applyG1 g w (takeCT c s)++-------------------------------------------------------------------------+-- Some useful process constructors:+-- +-}+-- |'scaleCT' amplifies an input by a constant factor:+scaleCT :: (Num a, Show a) =>+           a                   -- ^The scaling factor+        -> Signal (SubsigCT a) -- ^The input signal+        -> Signal (SubsigCT a) -- ^The output signal of the process+scaleCT factor = mapCT (* factor)++-- |'addCT' adds two input signals together.+addCT :: (Num a, Show a) =>+         Signal (SubsigCT a) -- ^The first input signal+      -> Signal (SubsigCT a) -- ^The second input signal+      -> Signal (SubsigCT a) -- ^The output signal+addCT = zipWithCT (+)++-- |'multCT' multiplies two input signals together.+multCT :: (Num a, Show a) =>+          Signal (SubsigCT a) -- ^The first input signal+       -> Signal (SubsigCT a) -- ^The second input signal+       -> Signal (SubsigCT a) -- ^The output signal+multCT = zipWithCT (*)++-- |'absCT' takes the absolute value of a signal.+absCT :: (Num a,Ord a, Show a) =>+         Signal (SubsigCT a) -- ^The input signal+      -> Signal (SubsigCT a) -- ^The output signal+absCT = mapCT abs++--scaleCT k = applyF1 f'+--    where f' f x = k * (f x)++{-+-- |'scaleCT' has the same functionality as scaleCT but operates with a+-- given signal partitioning rather than on the +-- SubsigCT elements.+--scaleCT' :: (Num a) =>+--    Rational -- The sampling period+--     -> a    -- The scaling factor+--     -> Signal (SubsigCT a) -> Signal (SubsigCT a)+--scaleCT' step k = combCT step f+--    where f g = f'+--  where f' x = k * (g x)+-}+--addCT s1 s2 = applyF2 f s1' s2'+--    where (s1',s2') = cutEq s1 s2+--      f g1 g2 = f'+--      where f' x = (g1 x) + (g2 x)+{-  +-- addCT' has the same functionality as addCT but operates with a+-- given signal partitioning rather than on the SubsigCT elements.+-- addCT' :: (Num a) =>+--       Rational      -- The sampling period+--    -> Signal (SubsigCT a) -- The first input signal+--    -> Signal (SubsigCT a) -- The second input signal+--    -> Signal (SubsigCT a) -- The output signal+-- addCT' step = combCT2 step f+--     where f g1 g2 = f'+--   where f' x = (g1 x) + (g2 x)+-}+{-+multCT s1 s2 = applyF2 f s1' s2'+    where (s1',s2') = cutEq s1 s2+      f g1 g2 = f'+      where f' x = (g1 x) * (g2 x)++-- multCT' has the same functionality as multCT but operates with a+-- given signal partitioning rather than on the SubsigCT elements.+-- multCT' :: (Num a) =>+--    Rational      -- The sampling period+--     -> Signal (SubsigCT a) -- The first input signal+--     -> Signal (SubsigCT a) -- The second input signal+--     -> Signal (SubsigCT a) -- The output signal+-- multCT' step = combCT2 step f+--     where f g1 g2 = f'+--       where f' x = (g1 x) * (g2 x)+-}+{-  +absCT = applyF1 f+    where f g = f'+  where f' x | (g x) <= 0 = (-1) * (g x)+         | otherwise  = (g x)+-}+-- | 'sineWave' generates a sinus signal with the given frequency defined+-- over  a given period. The function is defined as @f(x)=sin(2*pi*freq*x)@.+sineWave :: (Floating a, Show a) =>+            Rational            -- ^The frequency+         -> (Rational,Rational) -- ^The interval of the signal+         -> Signal (SubsigCT a) -- ^The generated signal+sineWave freq timeInterval +  = signal [SubsigCT (sineFunction, timeInterval)]+  where +    sineFunction :: (Floating a) => Rational -> a+    --sineFunction t = sin (2*pi * freq * t)+    sineFunction t = (sin (2*pi * (fromRational (freq * t))))++{-+-- | constCT generates a constant signal for a given time duration.+constCT :: (Num a, Show a) => +       Rational -- ^ The time duration of the generated signal.+    -> a    -- ^ The constant value of the signal.+    -> Signal (SubsigCT a) -- ^ The resulting signal.+constCT t c = signal [SubsigCT ((\_->c), (0,t))]++-- | zeroCT generates a constant 0 signal for the given time duration.+zeroCT :: (Num a, Show a) => +      Rational    -- ^ The time duration+   -> Signal (SubsigCT a) -- ^ The generated signal.+zeroCT t = constCT t 0+-}+    +-----------------------------------------------------------------------------+-- DA and AD converter processes:+--+-- |For the digital-analog conversion we have two different possibilities+-- which is determined by this data type 'DACMode'.+data DACMode = DAlinear -- ^linear interpolation+             | DAhold   -- ^the last digital value is frozen+             deriving (Show, Eq)++{- |'d2aConverter' converts an untimes or synchronous signal into a + continuous time signal.+ The process 'd2aConverter' converts a signal of the digital domain+ into a continuous time signal. There are two modes, 'DAlinear',+ which makes a smooth transition between adjacent digital values and+ 'DAhold', where the analog value directly follows the digital+ value. This means that in 'DAhold'-mode a staircase function+ remains a staircase function, while in 'DAlinear' the staircase+ function would resemble at least partially a /saw tooth/-curve. ++ The resolution of the converter is given by the parameter+ 'timeStep'.++ Note, that the process 'd2aConverter' is an ideal component, i.e. there+ are no losses due to a limited resolution due to a fixed number of bits. +-}+d2aConverter :: (Fractional a, Show a) =>+                DACMode             -- ^Mode of conversion+             -> Rational            -- ^Duration of input signal+             -> Signal a            -- ^Input signal (untimed MoC)+             -> Signal (SubsigCT a) -- ^Output signal (continuous time MoC)+d2aConverter mode c xs+    | mode == DAlinear = d2aLinear c 0.0 xs+    | otherwise = d2aHolder c 0.0 xs+  where+    d2aHolder :: (Num a, Show a) => +                 Rational -> Rational -> Signal a -> Signal (SubsigCT a)+    d2aHolder _ _ NullS = NullS+    d2aHolder c holdT (x:-xs) = (SubsigCT (constRationalF x,(holdT,holdT+c)) )+                                :- d2aHolder c (holdT+c) xs++    d2aLinear :: (Fractional a, Show a) =>+                 Rational -> Rational -> Signal a -> Signal (SubsigCT a)+    d2aLinear _ _ NullS = NullS+    d2aLinear _ _ (_:-NullS) = NullS+    d2aLinear c holdT (x:-y:-xs)+      = (SubsigCT (linearRationalF c holdT x y,(holdT,holdT+c)) )+        :- d2aLinear c (holdT+c) (y:-xs)++constRationalF :: (Num a) => a -> Rational -> a+constRationalF = (\x _->x)++linearRationalF :: (Fractional a) =>+                   Rational -> Rational -> a -> a -> Rational -> a+linearRationalF c holdT m n x = (1-alpha)*m + alpha*n+  where alpha :: (Fractional a) => a+        alpha = fromRational ((x-holdT)/c)++{- | The process 'a2dConverter' converts a continuous time signal to+   an untimed or synchronous signal. The first parameter gives the+   sampling period of the converter.++   Note, that the process 'a2dConverter' is an ideal component,+   i.e. there are no losses due to a limited resolution due to a fixed+   number of bits.  +-}+a2dConverter :: (Num a, Show a) =>+                Rational            -- ^Sampling Period+             -> Signal (SubsigCT a) -- ^Input signal (continuous time)+             -> Signal a            -- ^Output signal (untimed)+a2dConverter _ NullS = NullS+a2dConverter c s | (duration (takeCT c s)) < c = NullS+                 | otherwise = f (takeCT c s)+                   +-+ a2dConverter c (dropCT c s)+  where f :: (Num a, Show a) => Signal (SubsigCT a) -> Signal a+        f NullS = NullS+        f (SubsigCT (g,(a,_)) :- _) = signal [g a]++--------------------------------------------------------------------+-- Helpter functions for the CT MoC:+-- | applyF1 applies a function on a sub-signal, which means the function of +-- the subsignal is transformed to another function:+applyF1 :: (Num a, Num b, Show a, Show b) =>+           ((Rational -> a) -> (Rational -> b)) -- The transformer+        -> Signal (SubsigCT a)                  -- The input signal+        -> Signal (SubsigCT b)                  -- The output signal+applyF1 _ NullS = NullS+applyF1 f (ss :- s) = (applyF' f ss) :- (applyF1 f s)+  where applyF' :: (Num a, Num b, Show a, Show b)+                => ((Rational -> a) -> (Rational -> b)) +                -> (SubsigCT a) -> (SubsigCT b)+        applyF' f (SubsigCT (f',(a,b))) = SubsigCT ((f f'), (a,b))++-- | applyF2 works just like applyF1 but operates on two incoming signals.+applyF2 :: (Num a, Num b, Num c, Show a, Show b, Show c) =>+           ((Rational -> a) -> (Rational->b) -> (Rational -> c))+        -> Signal (SubsigCT a) +        -> Signal (SubsigCT b) +        -> Signal (SubsigCT c) +applyF2 _ NullS _ = NullS+applyF2 _ _ NullS = NullS+applyF2 f (ss1 :- s1) (ss2 :- s2) = (applyF' f ss1 ss2) :- (applyF2 f s1 s2)+  where applyF' f (SubsigCT (f1,(a,b))) (SubsigCT (f2,(c,d))) +          | (a==c) && (b==d) +            || (abs (a-c)< 0)+            || (abs (b-d)< 0) = SubsigCT ((f f1 f2), (a,b))+          | otherwise = error ("applyF2: The two subintervals are"+                                ++ " not identical: (a,b) = ("+                                ++ (show a) ++ ", "+                                ++ (show b) ++ "); (c,d) = ("+                                ++ (show c) ++ ", "+                                ++ (show d) ++ ").")++-- | applyG1 is used to apply a next-state function. A very interesting+-- question is, what should be an argument to the next-state function: +-- the incoming function, defining the value of the input signal?+-- or the incoming function and the incoming interval?+-- or the value of the incoming signal at a particular point, e.g. at the +-- left most point of the interval?+-- To give the next-state function the interval itself as argument, would mean+-- that the process becomes time variant process, i.e. its behaviour is +-- dependent on the absolute time values. This is not a good thing to have!+-- Another possibility may be to give a sub-signal that is relative to the +-- current evaluation, i.e. the left most point is always 0. Would that make+-- sense?+applyG1 :: (Num b, Show b) =>+           (a -> (Rational -> b) -> a) -> a -> Signal (SubsigCT b) -> a+applyG1 _ w NullS = w+applyG1 g w (ss :- _) = applyG1' g w ss+  where +    applyG1' :: (Num b, Show b) =>+                (a -> (Rational -> b) -> a) -> a -> (SubsigCT b) -> a+    applyG1' g w (SubsigCT (f, (_,_))) = g w f++-- | cutEq partitions the two signals such that the partitioning are identical+-- in both result signals, but only up to the duration of the shorter of the +-- two signals:+cutEq :: (Num a, Num b, Show a, Show b) =>+     Signal (SubsigCT a) -> Signal (SubsigCT b) +  -> (Signal (SubsigCT a), Signal (SubsigCT b))+cutEq NullS s2 = (NullS, s2) +cutEq s1 NullS = (s1, NullS) +cutEq s1 s2 = unzipCT (cutEq' s1 s2)+  where +    cutEq' :: (Num a, Num b, Show a, Show b) =>+              Signal (SubsigCT a) -> Signal  (SubsigCT b) +           -> Signal ((SubsigCT a), (SubsigCT b))+    cutEq' NullS _    = NullS+    cutEq' _ NullS    = NullS+    cutEq' (ss1:-s1) (ss2:-s2) +      | dur1 == dur2 = (ss1,ss2) :- (cutEq' s1 s2)+      | dur1 <  dur2 = (ss1, takeSubSig dur1 ss2) +                       :- (cutEq' s1 ((dropSubSig dur1 ss2) :- s2))+      | dur1 >  dur2 = (takeSubSig dur2 ss1, ss2)+                       :- (cutEq' ((dropSubSig dur2 ss1) :- s1) s2)+      | otherwise = error ("cutEq' pattern match error: dur1="++(show dur1)+                           ++ ", dur2="++ (show dur2)++";")+      where dur1 = durationSS ss1+            dur2 = durationSS ss2++unzipCT :: Num a => Signal ((SubsigCT a), (SubsigCT b)) +        -> (Signal (SubsigCT a), Signal (SubsigCT b))+unzipCT NullS = (NullS, NullS)+unzipCT ((ss1,ss2) :- s) = (ss1:-s1, ss2:-s2)+    where (s1,s2) = unzipCT s++-- The take and drop functions on CT signals:+takeCT :: (Num a, Show a) => +          Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)+takeCT _ NullS = NullS+takeCT 0 _     = NullS+takeCT c (ss:-s) | (durationSS ss) >= c = (takeSubSig c ss) :- NullS+                 | otherwise    = ss :- (takeCT (c - (durationSS ss)) s)++dropCT :: (Num a, Show a) =>+          Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)+dropCT _ NullS   = NullS+dropCT 0 s   = s+dropCT c (ss:-s) | (durationSS ss > c) = dropSubSig c ss :- s+                 | otherwise       = dropCT (c - (durationSS ss)) s++-- The interval length of a signal:+duration :: (Num a, Show a) => Signal (SubsigCT a) -> Rational+duration NullS = 0+duration (ss:- s) = (durationSS ss) + (duration s)  ++-- The interval length of a sub-signal:+durationSS :: (Num a, Show a) => (SubsigCT a) -> Rational+durationSS (SubsigCT (_, (a,b))) = b-a++-- The start time of a signal:+startTime :: (Num a, Show a) => Signal (SubsigCT a) -> Rational+startTime NullS = 0+startTime (SubsigCT (_,(a,_)) :- _) = a++-- The take and drop functions for sub-signals:+takeSubSig :: (Num a, Show a) => Rational -> (SubsigCT a) -> (SubsigCT a)+takeSubSig c (SubsigCT (f,(a,b))) | c >= (b-a) = SubsigCT (f,(a,b))+                                  | otherwise  = SubsigCT (f,(a,a+c))+++dropSubSig :: (Num a, Show a) => Rational -> (SubsigCT a) -> (SubsigCT a)+dropSubSig c (SubsigCT (f,(a,b))) | c > (b-a) = SubsigCT (f,(b,b))+                                  | otherwise = SubsigCT (f,(a+c,b))++++-----------------------------------------------------------------------+-- Functions to display and plot signals:+-----------------------------------------------------------------------+-- The function 'sample' evaluates the signal and returns a list of +-- (time,value) pairs, which can be displayed as text or used in any other way.+{- $plotdoc+   Several functions are available to display a signal in textual or +   graphics form. All displaying of signals is based on sampling and +   evaluation the signal at regular sampling points. +   +   'showParts' does not evaluate the signal; it only shows how it is +   partitioned. Hence, it returns a sequence of intervals.+  +   'plot', 'plotCT' and 'plotCT'' can plot a signal or a list of signals +   in a graph. They use @gnuplot@ for doing the actual work.+   They are in the IO monad because they write to the file system.+  +   'plot' is defined in terms of 'plotCT' but it uses the default sampling +   period 'timeStep' and it can plot only one signal in a plot.+  +   'plotCT' can plot a list of signals in the same plot.+   'plotCT' is defined in terms of 'plotCT'' but uses +   default label names for the plot.++   'vcdGen' writes the values of signals in Value Change Dump (VCD) format to +   a file. There are public domain wave viewers which understand this format +   and can display the signals.+-}++-- |'sample' computes the values of a signal with a given step size. +-- It returns a list with (x, (f x)) pairs of type [(Rational,Rational)].+sample :: (Num a, Show a) =>+          Rational    -- ^ The sampling period+       -> Signal (SubsigCT a) -- ^The signal to be sampled+       -> [(Rational,a)]  -- ^The list of (time,value) pairs of the +          -- evaluated signal+sample _ NullS = []+sample step (ss :- s) = sampleSubsig step ss ++ (sample step s)++-- sampleSubsig samples a Subsig signal:+sampleSubsig :: (Num a, Show a) => Rational -> (SubsigCT  a) -> [(Rational,a)]+sampleSubsig step (SubsigCT (f,(a,b)))+  | b>a = (a,(f a)) : (sampleSubsig step (SubsigCT (f,(a+step,b))))+  | otherwise = []++-- |'showParts' allows to see how a signal is partitioned into+-- sub-signals.  It returns the sequence of intervals.+showParts :: (Num a, Show a) =>+             Signal (SubsigCT a)   -- ^The partitioned signal+          -> [(Double,Double)] -- ^The sequence of intervals+showParts NullS = []+showParts (SubsigCT (_,(a,b)):-s) = (fromRational a,fromRational b) : (showParts s)++-----------------------------------------------------------------------------+-- |'plot' plots one signal in a graph with the default sampling+-- period of 1\/200 of the duration of the signal.+plot :: (Num a, Show a) =>+        Signal (SubsigCT a) -- ^The signal to be plotted.+     -> IO String           -- ^A reporting message.+plot s = plotCT step [s]+  where step = (duration s) / 200.0++-- |'plotCT' plots a list of signals in the same graph. The sampling+-- period has to be given as argument. In the graph default label+-- names are used to identify the signals.+plotCT :: (Num a, Show a) =>+          Rational              -- ^The sampling period+       -> [Signal (SubsigCT a)] -- ^The list of signals to be ploted +                                -- in the same graph+       -> IO String             -- ^A messeage reporting what has been done.+plotCT step sigs = plotCT' step (map (\ s -> (s,"")) sigs)++{- |+   'plotCT'' is the work horse for plotting and the functions 'plot' and +   'plotCT' use it with specialising arguments.++   'plotCT'' plots all the signals in the list in one graph. If a label is+   given for a signal, this label appears in the graph. If the label string is +   \"\", a default label like \"sig-1\"  is used.++   In addition to displaying the graph on the screen, the following files+   are created in directory .\/fig:++   [ct-moc-graph.eps]      an eps file of the complete graph++   [ct-moc-graph.pdf]      A pdf file of the complete graph+ +   [ct-moc-graph-latex.eps]    included by ct-moc-graph-latex.tex++   [ct-moc-graph-latex.tex]    This is the tex file that should be included+           by your latex document. It in turn includes+        the file ct-moc-graph-latex.eps.+       These two files have to be used together;+        the .eps file contains only the graphics,+       while the .tex file contains the labels and +           text.+-}+plotCT' :: (Num a, Show a) =>+           Rational -- ^Sampling period+        -> [(Signal (SubsigCT a), String)]+        -- ^A list of (signal,label) pairs. The signals are plotted and+        -- denoted by the corresponding labels in the plot.+        -> IO String -- ^A simple message to report completion+plotCT' _ [] = return []+plotCT' 0 _    = error "plotCT: Cannot compute signal with step=0.\n"+plotCT' step sigs = plotSig (expandSig 1 sigs)+  where +    expandSig :: (Num a, Show a) => +                 Int -> [(Signal (SubsigCT a),String)] +              -> [(Int,String,[(Rational,a)])]+    expandSig _ [] = []+    expandSig i ((sig,label):sigs) +      = (i, label, (sample step sig)) : (expandSig (i+1) sigs)+    plotSig :: (Num a, Show a) => [(Int,String,[(Rational,a)])] -> IO String+    plotSig sigs +      = do mkDir "./fig"+           writeDatFiles sigs+           -- We write the gnuplot script to a file;+           -- But we try several times with a different name because +           -- with ghc on cygwin we cannot write to a script file while+           -- gnuplot is still running with the old script file:+           fname <- tryNTimes 10 +                    (\ file -> (writeFile file+                                (mkPlotScript (map mkDatFileName sigs))))+           -- We fire up gnuplot:+           _ <- system ("gnuplot -persist " ++ fname)+           -- We return some reporting string:+           return ("Signal(s) " ++(mkAllLabels sigs) ++ " plotted.")+    writeDatFiles [] = return ()+    writeDatFiles (s@(_, _, sig): sigs)+      = do writeFile (fst (mkDatFileName s)) (dumpSig sig)+           writeDatFiles sigs+    mkDatFileName :: (Int,String,a) -> (String,String)+    mkDatFileName (sigid,label,_) = ("./fig/ct-moc-" ++ (replChar ">" label) +                                     ++(show sigid)++".dat", +                                     (mkLabel label sigid))+    mkLabel :: String -> Int -> String+    mkLabel "" n = "sig-" ++ show n +    mkLabel l _  = l+    mkAllLabels :: (Num a) => [(Int,String,[(Rational,a)])] -> String+    mkAllLabels sigs = drop 2 (foldl f "" sigs)+      where f labelString (n,label,_) +              = labelString ++ ", " ++ (mkLabel label n)+    replChar :: String -- all characters given in this set are replaced by '_'+             -> String -- the string where characters are replaced+             -> String -- the result string with all characters replaced+    replChar [] s = s+    replChar _ [] = []+    replChar replSet (c:s) | elem c replSet = '_' : (replChar replSet s)+                           | otherwise  = c   : (replChar replSet s)++    dumpSig :: (Num a, Show a) => [(Rational,a)] -> String+    dumpSig points = concatMap f points+      where f (x,y) = show ((fromRational x) :: Float) ++ "    " +                      ++ show (y) ++ "\n"++    mkPlotScript :: [(String  -- the file name of the dat file+                     ,String  -- the label for the signal to be drawn+                     )] -> String  -- the gnuplot script+    mkPlotScript ns = "set xlabel \"seconds\" \n"+                      ++ "plot " ++ (f1 ns) ++ "\n"+                      ++ "set terminal postscript eps color\n"+                      ++ "set output \"" ++ plotFileName++".eps\"\n"+                      ++ "replot \n"+                      ++ "set terminal epslatex color\n"+                      ++ "set output \"" ++ plotFileName++"-latex.eps\"\n"+                      ++ "replot\n"+                      -- ++ "set terminal pdf\n"+                      -- ++ "set output \"fig/ct-moc-graph.pdf\"\n"+                      -- ++ "replot\n"+      where f1 :: [(String,String)] -> String+            f1 ((datfilename,label):(n:ns)) +              = "\t\"" ++ datfilename+                ++ "\" with linespoints title \""++label++"\",\\\n"+                ++ "    " ++ (f1 (n:ns))+            f1 ((datfilename,label):[]) +              = "\"" ++ datfilename +                ++ "\" with linespoints title \""++label++"\"\n"+            f1 [] = ""+            plotFileName = "fig/ct-moc-graph-" ++ (f2 ns)+            -- f2 generates part of the filename for the eps and latex+            -- files, which is determined by the signal labels.+            f2 :: [(String,String)] -> String +            f2 [] = ""+            f2 ((_,label):[]) = label+            f2 ((_,label):_) = label ++ "_"+    -- tryNTimes applies a given actions at most n times. Everytime+    -- the action is applied and an error occurrs, it tries again but +    -- with a decremented first argument. It also changes the file name+    -- because the file name uses the n as part of the name.+    -- The idea is that the action tries different files to operate on.+    -- The problem was that when gnuplot was called on a gnuplot script+    -- file, it was not possible to write a new script file with the same+    -- name and start a new gnuplot process (at least not with ghc or ghci on +    -- cygwin; it worked fine with hugs on cygwin). +    -- So we go around the problem here by trying different file names until+    -- we succeed or until the maximum number of attempts have been performed.+    tryNTimes :: Int -> (String -> IO ()) -> IO String+    tryNTimes n a | n <= 0 = error "tryNTimes: not succedded"+                  | n > 0 = +                      do Except.catch (action fname a) (handler a)+                           where handler :: (String -> IO()) -> IOError -> IO String+                                 handler a _ = tryNTimes (n-1) a+                                 fname = "./fig/ct-moc-" ++ (show n) ++ ".gnuplot"+                                 action :: String -> (String -> IO ()) -> IO String+                                 action fname a = do (a fname)+                                                     return fname+    tryNTimes _ _ = error "tryNTimes: Unexpected pattern."++----------------------------------------------------------------------------+{- |+vcdGen dumps the values of a list of signal in VCD (Value Change Dump) format +(IEEE Std 1364-2001), which is part of the Verilog standard +(<http://en.wikipedia.org/wiki/Value_change_dump>).+There are public domain tools to view VCD files. For instance, +GTKWave (<http://home.nc.rr.com/gtkwave/>) is a popular viewer available for+Windows and Linux.++The values are written to the file ./fig/ct-moc.vcd. If the file exists, it+is overwritten. If the directory does not exist, it is created.++-}+vcdGen :: (Num a, Show a) +      => Rational     -- ^Sampling period; defines for what+              -- time stamps the values are written.+      -> [(Signal (SubsigCT a), String)]+      -- ^A list of (signal,label) pairs. The signal values written and+      -- denoted by the corresponding labels.+      -> IO String    -- ^A simple message to report completion+vcdGen _ [] = return []+vcdGen 0    _  = error "vcdgen: Cannot compute signals with step=0.\n"+vcdGen step sigs = +    do +  -- putStr (show (distLabels (expandSig 1 sigs)))+  plotSig (expandSig 1 sigs)+    where +  expandSig :: (Num a, Show a) => +       Int -> [(Signal (SubsigCT a),String)] +           -> [(Int,String,[(Rational,a)])]+  expandSig _ [] = []+  expandSig i ((sig,label):sigs) +      = (i, label, (sample step sig)) : (expandSig (i+1) sigs)+  plotSig :: (Num a, Show a) => [(Int,String,[(Rational,a)])] -> IO String+  plotSig sigs +      = do writeVCDFile sigs+           -- We return some reporting string:+           return ("Signal(s) " ++(mkAllLabels sigs) ++ " dumped.")+  mkLabel :: String -> Int -> String+  mkLabel "" n = "sig-" ++ show n +  mkLabel l _  = l+  mkAllLabels sigs = drop 2 (foldl f "" sigs)+      where f labelString (n,label,_) +              = labelString ++ ", " ++ (mkLabel label n)+  writeVCDFile :: (Show a) => [(Int,String,[(Rational,a)])] -> IO()+  writeVCDFile sigs+    = do mkDir "./fig"+         clocktime <- getClockTime+         let {date = calendarTimeToString (toUTCTime clocktime);+              labels = getLabels sigs;+              timescale = findTimescale sigs;}+           in writeFile mkVCDFileName ((vcdHeader timescale labels date)+                                       ++ (valueDump timescale (prepSigValues sigs)))+  mkVCDFileName :: String+  mkVCDFileName = ("./fig/ct-moc.vcd")++mkDir :: String -> IO()+mkDir dir = do dirExists <- doesDirectoryExist dir+               if (not dirExists) +                 then (createDirectory dir) +                 else return ()++-- prepSigValues rearranges the [(label,[(time,value)])] lists such +-- that we get a list of time time stamps and for each time stamp +-- we have a list of (label,value) pairs to be dumped:+prepSigValues :: (Show a) => [(Int,String,[(Rational,a)])]+      -> [(Rational,[(String,a)])]+prepSigValues sigs = f2 (distLabels sigs)+    where +  -- f2 transforms a [[(label,time,value)]] +  -- into a [(time, [label,value])] structure:+  f2 :: (Show a) +    => [[(String,Rational,a)]] -> [(Rational,[(String,a)])]+  f2 [] = []+  f2 ([]:_) = []  +  f2 xs = f3 hdxs : f2 tailxs+      where +    -- here we take all first elements of the lists in xs+    -- and the tail of the lists in xs:+    (hdxs,tailxs) = (map g1 xs,+             map (\ (_:ys)-> ys) xs)+    g1 [] = error ("prepSig.f2.g1: first element of xs is empty:"+           ++ "xs="++show xs)+    g1 (y:_) = y+    f3 :: (Show a) +      => [(String,Rational,a)] -> (Rational,[(String,a)])+    f3 (valList@((_, time, _):_)) = (time, f4 time valList)+    f3 [] = error ("prepSigValues.f2.f3: "+           ++ "empty (label,time,value)-list")+    f4 :: (Show a) +      => Rational -> [(String,Rational,a)] -> [(String,a)]+    f4 _ [] = []+    f4 time ((label,time1,value):valList) +       | time == time1 = (label,value) : f4 time valList+       | otherwise +       = error ("prepSigValues: Time stamps in different"+            ++ " signals do not match: time="+            ++(show time)++", time1="++(show time1)+            ++", label="++label++", value="++(show value)+            ++"!")+-- distLabels inserts the labels into its corresponding +-- (time,value) pair list to get a (label,time,value) triple:+distLabels :: [(Int,String,[(Rational,a)])] +       -> [[(String,Rational,a)]]+distLabels [] = []+distLabels ((_,label,valList):sigs) +    = (map (\ (t,v) -> (label,t,v)) valList) : (distLabels sigs)+getLabels :: [(Int,String,[(Rational,a)])] -> [String]+getLabels = map (\(_,label,_)-> label)+vcdHeader :: Rational -> [String] -> String -> String+vcdHeader timescale labels date = "$date\n"+           ++ date ++ "\n"+           ++ "$end\n"+           ++ "$version\n"+           ++ "ForSyDe CTLib " ++ revision ++ "\n"+           ++ "$end\n"+           ++ "$timescale 1 " ++ (timeunit timescale) ++ " $end\n"+           ++ "$scope module top $end\n"+           ++ (concatMap (\ label -> ("$var real 64 "++label+                  ++ " " ++ label +                  ++ " $end\n")) labels)+           ++ "$upscope $end\n"+           ++ "$enddefinitions $end\n"+           ++ "#0\n"+           ++ "$dumpvars\n"+           ++ (concatMap (\ label -> "r0.0 "++label++ "\n") +             labels)+           ++ "\n"+valueDump :: (Show a) => Rational -> [(Rational,[(String,a)])] -> String+valueDump _ [] = ""+valueDump timescale ((t,values):valList) +  = "#"++(show (g (t/timescale)))++"\n" +    ++ (f values) ++ (valueDump timescale valList)+  where +    f :: (Show a) => [(String,a)] -> String+    f [] = ""+    f ((l,v):values) = "r"++(show v)++" "++l++"\n" ++ (f values)+    g :: Rational -> Integer+    -- Since the VCD format expects integers for the timestamp, we make+    -- sure that only an integer is printed in decimal format (no exponent):+    g t = round t+++timeunit :: Rational -> String+timeunit timescale | timescale == 1 % 1    = "s"+       | timescale == 1 % 1000 = "ms"+       | timescale == 1 % 1000000 = "us"+       | timescale == 1 % 1000000000 = "ns"+       | timescale == 1 % 1000000000000 = "ps"+       | timescale == 1 % 1000000000000000 = "fs"+       | otherwise = error ("timeunit: unexpected timescale: "+                ++ (show timescale))++findTimescale :: [(Int,String,[(Rational,a)])] -> Rational+findTimescale sigs +    = f 1 (concatMap (\ (_,_,valList) -> (fst (unzip valList))) sigs)+  where +    f :: Rational -> [Rational] -> Rational+    f scale [] = scale+    f scale (x:xs) | r == 0    = f scale xs+           | otherwise = f (scale/1000) xs+           where (_,r) = (properFraction (abs (x / scale))) +                         :: (Int,Rational)++-------------------------------------------------------------------------+-----------------------------------------------------------+-- Testing the CT signals and process constructors:++{--+main = testAll+testAll = +    do +  testScaleCT +  testAddCT +  testMultCT +  testAbsCT +  testDelayCT+  testConverters+  testFeedback+-- test scaleCT:+testScaleCT = plotCT' 1E-4 [(toneA, "Tone A"), +            ((scaleCT 1.5 toneA), "Tone A x 1.5"),+            ((scaleCT 2.0 toneA), "Tone A x 2.0")]++-- test addCT:+testAddCT = plotCT' 1e-4 [(toneA, "Tone A"),+          (toneE, "Tone E"), +          ((addCT toneA toneE), "Tones A+E")]++-- test multCT:+testMultCT = plotCT' 1e-4 [(toneA, "Tone A"),+          (toneE, "Tone E"), +          ((multCT toneA toneE), "Tones A x E")]++-- test absCT:+testAbsCT = plotCT' 1E-4 [(toneA, "Tone A"), +          ((absCT toneA), "abs (Tone A)")]++-- test delayCT:+testDelayCT = plotCT' 1E-4 +      [(toneA, "Tone A"), +       (takeCT 0.02 ((delayCT 0.0025 toneA)), +           "Tone A delayed by 2.5ms"),+       (takeCT 0.02 ((shiftCT 0.003 toneA)), "Tone A shifted by 3ms")]++-- test a2dConverter:+testConverters = +    do (plotCT' 1e-4+    [(toneA, "Tone A"),+     (d2aConverter DAlinear 1e-3 (a2dConverter 1e-3 toneA),+      "Tone A (A->D->A) converted with linear mode, 1ms sampling period")])+   (plotCT' 1e-4+    [(toneA, "Tone A"),+     (d2aConverter DAhold 1e-3 (a2dConverter 1e-3 toneA),+      "Tone A (A->D->A) converted with hold mode, 1ms sampling period")])++-- test a feed back loop:+block sin = [sin,s1,s2,sout]+    where sout = p2 s1+      s1 = p1 sin s2+      s2 = p3 sout+      -- The individual processes:+      p1 :: Signal (SubsigCT Double) -> Signal (SubsigCT Double)+     -> Signal (SubsigCT Double)+      p2,p3 :: Signal (SubsigCT Double) -> Signal (SubsigCT Double)+      p1 = addCT+      p2 = scaleCT 0.5+      p3 = initCT (zeroCT 0.0005)+testFeedback = plotCT' 0.0001 ss+    where ss = [(sin, "sin"), (s1, "s1"), (s2, "s2"), (sout, "sout")]+      [sin,s1,s2,sout] = block (takeCT 0.005 toneA)++++toneA = sineWave (440.0) (0, 0.02)+toneE = sineWave 520.0 (0, 0.02)+-}++{- Some performance tests on my laptop under cygwin:++***********************************************************************+With ghc:++with +toneA = sineWave (440.0) (0, 2.0)+toneE = sineWave 520.0 (0, 2.0)++****+we make testAll with Double data types on++ghc --make CTLib.hs -O3 -o ttt.exe+time ttt+   +real    0m33.749s+user    0m0.010s+sys     0m0.010s++****+we make testAll with Rational data types on++ghc --make CTLib.hs -O3 -o ttt.exe+time ttt+   +real    0m53.687s+user    0m0.010s+sys     0m0.010s++****+hence the performance penalty when using Rational instead of Double is+1.59 (60%) longer delay.+++************************************************************************+On hugs: (when using 0.2 second long waves, hugs aborted with an out of memory +message both with Double and Rational; but with Double it aborted much faster;)++toneA = sineWave (440.0) (0, 0.02)+toneE = sineWave 520.0 (0, 0.02)++****************+**** with Double:+time runhugs.exe -h500k CTLib.hs++real    0m1.702s+user    0m0.020s+sys     0m0.010s++******************+**** with Rational:++time runhugs.exe -h500k CTLib.hs++real    0m21.501s+user    0m0.010s+sys     0m0.020s++****************+hence we have a factor of 12.5 longer delay with Rational compared to Double.+++-}++--eulerCT :: Signal (SubsigCT a) -> Signal (SubsigCT a)+--eulerCT = undefined++{-+s1 = signal [SubsigCT (sine', (0,6.28)), SubsigCT (\x -> 1, (6.28, 10.0))]++sine' :: (Floating a) => Rational -> a+sine' t = sin (fromRational t)++s2 = mapCT (*2.0) s1+s3 = zipWithCT (+) s1 s2++s4 = delayCT 0.5 (-4.0) s1++integratorCT :: Signal (SubsigCT a) -> Signal (SubsigCT a)+integratorCT = undefined++--eulerCT :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)+--eulerCT step (SubsigCT (f, (t_start, t_end)) :- fs)+--  =  undefined++--eulerCT' :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)+eulerCT stepsize (SubsigCT (f, (t_start, t_end))) =+   signal (SubsigCT (\x -> stepsize * f t_start, (t_start, t_start + stepsize)) :+   eulerCT' stepsize (SubsigCT (f, (t_start + stepsize, t_end))) (stepsize * f t_start))++eulerCT' stepsize (SubsigCT (f, (t_start, t_end))) y_i+  | t_start <= t_end - stepsize+   = SubsigCT (\x -> y_i + stepsize * f t_start, (t_start, t_start + stepsize))+       : eulerCT' stepsize (SubsigCT (f, (t_start + stepsize, t_end))) (y_i + stepsize * f t_start)+  | otherwise+   = []++s6 = signal [SubsigCT (\x -> 1.0, (0.0, 5.0))]+s5 = eulerCT 0.5 (SubsigCT (\x -> 1.0, (0.0, 5.0)))++plotEuler = plotCT' 1e-1 [(s5, "s5")]++ctsig1 = ctSignal [(liftCT sin, (0, 3.14)), (\t -> 1, (3.14, 6.28))]+ctsig2 = ctSignal [(liftCT cos, (0, 6.28))]+-}

@@ -0,0 +1,466 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.MoC.Dataflow+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- 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.+--+-----------------------------------------------------------------------------++module ForSyDe.Shallow.MoC.Dataflow+    (+  -- * 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:+  -- +  --   * [&#x22A5;] 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) +  -- +  FiringToken(Wild, Value),+  -- * 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 = {[*], &#x22A5;, [T]}+  --+  --   * R2 = {&#x22A5;, [*], [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, zipWithDF, zipWith3DF, +  -- * 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, mooreDF, mealyDF+    ) where++import ForSyDe.Shallow.Core +++------------------------------------------------------------------------+-- DATA TYPES+------------------------------------------------------------------------++data FiringToken a = Wild+       | Value a deriving (Eq, Show)+++------------------------------------------------------------------------+-- COMBINATIONAL PROCESS CONSTRUCTORS+------------------------------------------------------------------------++-- |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.+mapDF :: Eq a => [[FiringToken a]] + -> (Signal a -> [[b]]) -> Signal a -> Signal b++mapDF _ _ NullS = NullS +mapDF rs as xs  = output +-+ mapDF rs as xs'+  where+    xs'         = if matchedRule < 0 then+                    NullS+                  else+                    consumeDF rule xs+    matchedRule = (matchDF rs xs)+    rule        = rs !! matchedRule+    output      = if matchedRule < 0 then+                    NullS+                  else+                    signal ((as xs) !! matchedRule)+               +-- |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.+zipWithDF :: (Eq a, Eq b) => +             [([FiringToken b], [FiringToken a])] +          -> (Signal b -> Signal a -> [[c]]) -> Signal b +          -> Signal a -> Signal c++zipWithDF _ _ NullS NullS = NullS+zipWithDF rs as xs ys     = output +-+ zipWithDF rs as xs' ys'+  where +    (xs', ys')  = if matchedRule < 0 then+                    (NullS, NullS)+                  else+                    consume2DF rule xs ys+    matchedRule = (match2DF rs xs ys)+    rule        = rs !! matchedRule+    output      = if matchedRule < 0 then+                    NullS+                  else+                    signal ((as xs ys) !! matchedRule)++-- |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.+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+zipWith3DF _ _ NullS NullS NullS = NullS+zipWith3DF rs as xs ys zs = output +-+ zipWith3DF rs as xs' ys' zs'+  where +    (xs', ys', zs') = if matchedRule < 0 then+                        (NullS, NullS, NullS)+                      else+                        consume3DF rule xs ys zs+    matchedRule     = (match3DF rs xs ys zs)+    rule            = rs !! matchedRule+    output          = if matchedRule < 0 then+                        NullS+                      else+                        signal ((as xs ys zs) !! matchedRule)+++------------------------------------------------------------------------+-- SEQUENTIAL PROCESS CONSTRUCTORS+------------------------------------------------------------------------+-- | 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.+scanlDF :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])]      +        -> (b -> Signal a -> [b]) +        -> b -> Signal a -> Signal b+scanlDF _  _  _     NullS   = NullS+scanlDF fs ns state xs      = (unitS state) +                              +-+ scanlDF fs ns state' xs'+  where +     xs'         = if matchedRule < 0 then+                     NullS+                   else+                     consumeDF rule xs+     matchedRule = matchStDF fs state xs+     rule        = snd (fs !! matchedRule)+     state'      = if matchedRule < 0 then+                     error "No rule matches the pattern!"+                   else+                     (ns state xs) !! matchedRule++-- | 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.+mooreDF :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])] +        -> (b -> Signal a -> [b]) -> (b -> [c]) +        -> b -> Signal a -> Signal c+mooreDF _  _  _ _     NullS = NullS+mooreDF fs ns o state xs    = output +-+ mooreDF fs ns o state' xs'+  where +    xs'         = if matchedRule < 0 then+                    NullS+                  else+                    consumeDF rule xs+    matchedRule = matchStDF fs state xs+    rule        = snd (fs !! matchedRule)+    output      = signal (o state)+    state'      = if matchedRule < 0 then+                    error "No rule matches the pattern!"+                  else+                    (ns state xs) !! matchedRule +++-- | 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.+mealyDF :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])] +        -> (b -> Signal a -> [b]) -> (b -> Signal a -> [[c]]) +        -> b -> Signal a -> Signal c+mealyDF _  _  _ _     NullS     = NullS+mealyDF fs ns o state xs = output +-+ mealyDF fs ns o state' xs'+  where +    xs'         = if matchedRule < 0 then+                    NullS+                  else+                    consumeDF rule xs+    matchedRule = matchStDF fs state xs+    rule        = snd (fs !! matchedRule)+    output      = signal ((o state xs) !! matchedRule)+    state'      = if matchedRule < 0 then+                    error "No rule matches the pattern!"+                  else+                    (ns state xs) !! matchedRule  +++------------------------------------------------------------------------+-- SUPPORTING FUNCTIONS+------------------------------------------------------------------------++-- The function 'prefixDF' takes a pattern and a signal and returns+-- 'True', if the pattern is a prefix from the signal.+prefixDF :: Eq a => [FiringToken a] -> Signal a -> Bool+prefixDF [] _    = True+prefixDF _ NullS = False+prefixDF (Wild:ps)      (_:-xs) = prefixDF ps xs+prefixDF ((Value p):ps) (x:-xs) = if p == x then+                                    prefixDF ps xs+                                  else+                                    False++-- The function 'consumeDF' takes a pattern and a signal and consumes+-- the pattern from the signal. The functions 'consume2DF' and+-- 'consume3DF' work in the same way as 'consumeDF', but with two and+-- three input signals.+consumeDF :: Eq a => [FiringToken a] +          -> Signal a -> Signal a+consumeDF _  NullS =  NullS           +consumeDF [] xs    =  xs+consumeDF (Wild:ts)    (_:-xs)  =  consumeDF ts xs     +consumeDF (Value t:ts) (x:-xs)  =  if t == x then+                                     consumeDF ts xs+                                   else+                                     error "Tokens not correct"++consume2DF :: (Eq a, Eq b) => +              ([FiringToken a], [FiringToken b]) +           -> Signal a -> Signal b -> (Signal a, Signal b)+consume2DF (px, py) xs ys = (consumeDF px xs,+                             consumeDF py ys)++consume3DF :: (Eq a, Eq b, Eq c) => +              ([FiringToken a], [FiringToken b], [FiringToken c]) +           -> Signal a -> Signal b -> Signal c +           -> (Signal a,Signal b,Signal c)+consume3DF (px, py, pz) xs ys zs = (consumeDF px xs,+                                    consumeDF py ys,+                                    consumeDF pz zs)++-- The function 'matchDF' checks, which firing rule, starting from 0, is+-- matched by the input signal. If no firing rule matches, the output is+-- '-1'. The functions 'maptch2S' and 'match3DF' work in the same way+-- for two and three inputs.+matchDF :: (Num a, Eq b) => +           [[FiringToken b]] -> Signal b -> a+matchDF rs xs       =  matchDF' 0 rs xs+  where matchDF' _ []     _    =  -1+        matchDF' n (r:rs) xs   =  if prefixDF r xs then+                                    n+                                  else+                                    matchDF' (n+1) rs xs++match2DF :: (Num a, Eq b, Eq c) => +            [([FiringToken b], [FiringToken c])]+         -> Signal b -> Signal c -> a+match2DF rs xs ys       =  match2DF' 0 rs xs ys+  where match2DF' _ [] _ _     =  -1+        match2DF' n ((rx, ry):rs) xs ys+          =  if prefixDF rx xs &&+                prefixDF ry ys +             then+               n+             else+               match2DF' (n+1) rs xs ys++match3DF :: (Num a, Eq b, Eq c, Eq d) => +            [([FiringToken b], [FiringToken d], [FiringToken c])]+         -> Signal b -> Signal d -> Signal c -> a+match3DF rs xs ys zs    = match3DF' 0 rs xs ys zs+  where match3DF' _ [] _ _ _   = -1 +        match3DF' n ((rx, ry, rz):rs) xs ys zs +          =  if prefixDF rx xs &&+                prefixDF ry ys &&+                prefixDF rz zs +             then+               n+             else+               match3DF' (n+1) rs xs ys zs  ++-- The function 'matchStDF' works in the same way as 'matchDF', but it+-- looks on patterns that include the state.+matchStDF :: (Num a, Eq b, Eq c) => +             [(FiringToken c,[FiringToken b])] +          -> c -> Signal b -> a+matchStDF rs state xs       = matchStDF' 0 rs state xs+  where matchStDF' _ [] _ _     =  -1+        matchStDF' n (r:rs) state xs    +          =  if prefixDF (snd r) xs && +                matchState (fst r) state+             then+               n+             else+               matchStDF' (n+1) rs state xs  +        +matchState :: Eq a => FiringToken a -> a -> Bool+matchState Wild      _ = True+matchState (Value v) x = x == v ++------------------------------------------------------------------------+--+-- CODE FOR TESTING+--+------------------------------------------------------------------------++{-+selectRules :: [([FiringToken a], [FiringToken a1], [FiringToken Bool])]+selectRules = [ ([Wild], [], [Value True]),+       ([], [Wild], [Value False]) ]+++selectOutput :: Signal t1 -> Signal t1 -> t -> [[t1]]+selectOutput xs ys _ =  [ [headS xs], [headS ys] ]++selectDF        :: Eq a => Signal a -> Signal a +               -> Signal Bool -> Signal a+selectDF        =  zipWith3DF selectRules selectOutput++++s1 :: Signal Integer+s1 = signal [1,2,3,4,5,6]+s2 :: Signal Integer+s2 = signal [7,8,9,10,11,12]+s3 :: Signal Bool+s3 = signal [True, True, False, False, True, True]++rs :: (Eq c, Num c) => Signal c -> Signal c+rs xs           = mealyDF firingRule nextState output initState xs+   where firingRule     = [(Wild, [Wild])]+     nextState state xs     = [(state + headS xs)]+     output state _         = [[state]]+     initState      = 0++rs2 :: Signal Integer -> Signal Integer+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)]]+-}++++++++

@@ -0,0 +1,130 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.MoC.DomainInterface+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- This module defines domain interface constructors for the multi-rate computational +-- model.+-----------------------------------------------------------------------------+module ForSyDe.Shallow.MoC.DomainInterface(downDI, upDI, par2serxDI, ser2parxDI, +        par2ser2DI, par2ser3DI, par2ser4DI, +        ser2par2DI, ser2par3DI, ser2par4DI) where++import ForSyDe.Shallow.Core+import ForSyDe.Shallow.MoC.Synchronous+++-- | The domain interface constructor 'downDI' takes a parameter 'k' and downsamples an input signal.+downDI     :: (Num a, Eq a) => a -> Signal b -> Signal b++-- | The domain interface constructors 'upDI' takes a parameter 'k' and upsamples an input signal.+upDI   :: (Num a, Eq a) => a -> Signal b -> Signal (AbstExt b)++-- | The domain interface constructor 'par2ser2DI' converts two parallel signals into one signal.+par2ser2DI :: Signal a -> Signal a -> Signal a++-- | The domain interface constructor 'par2ser3DI' converts three parallel signals into one signal+par2ser3DI :: Signal a -> Signal a -> Signal a -> Signal a++-- | The domain interface constructor 'par2ser4DI' converts four parallel signals into one signal+par2ser4DI :: Signal a -> Signal a -> Signal a -> Signal a +       -> Signal a+++-- | The domain interface constructor 'par2serxDI' converts n parallel signals into one signal.+par2serxDI :: Vector (Signal a) -> Signal a++-- | The domain interface constructor 'ser2par2DI' converts one signal into two parallel signals.+ser2par2DI :: Signal a -> (Signal (AbstExt a), Signal (AbstExt a))++-- | The domain interface constructor 'ser2par3DI' converts one signal into three parallel signals.+ser2par3DI :: Signal a -> (Signal (AbstExt a), Signal (AbstExt a), Signal (AbstExt a))++-- | The domain interface constructor 'ser2par4DI' converts one signal into four parallel signals.+ser2par4DI :: Signal a +       -> (Signal (AbstExt a), Signal (AbstExt a), +       Signal (AbstExt a), Signal (AbstExt a))++-- | The domain interface constructors 'ser2parxDI' converts one signal into n parallel signals.+ser2parxDI :: (Num a, Ord a) => a -> Signal (AbstExt b) +              -> Vector (Signal (AbstExt b))++-- Implementation++downDI n xs     = down1 n 1 xs +  where down1 _ _ NullS   = NullS+        down1 1 1 (x:-xs) = x :- down1 1 1 xs+        down1 n 1 (x:-xs) = x :- down1 n 2 xs+        down1 n m (_:-xs) = if m == n then+                              down1 n 1 xs+                            else+                              down1 n (m+1) xs ++upDI _ NullS   = NullS+upDI n (x:-xs) = (Prst x) :- ((copyS (n-1) Abst) +-+ upDI n xs)++par2ser2DI xs ys  = par2ser2DI' (zipSY xs ys)+  where par2ser2DI' NullS = NullS+        par2ser2DI' ((x,y):-xys) = x:-y:-par2ser2DI' xys++par2ser3DI xs ys zs = par2ser3DI' (zip3SY xs ys zs)+  where par2ser3DI' NullS = NullS+        par2ser3DI' ((x,y,z):-xyzs) = x:- y :-z :- par2ser3DI' xyzs++par2ser4DI ws xs ys zs = par2ser4DI' (zip4SY ws xs ys zs)+  where par2ser4DI' NullS = NullS+        par2ser4DI' ((w,x,y,z):-wxyzs) +          = w:-x:-y:-z:- par2ser4DI' wxyzs++ser2par2DI = unzipSY . group2SY . delaynSY Abst 2 . mapSY abstExt++ser2par3DI = unzip3SY . group3SY . delaynSY Abst 3 . mapSY abstExt++ser2par4DI = unzip4SY . group4SY . delaynSY Abst 4 . mapSY abstExt+++par2serxDI = par2serxDI' . zipxSY +  where par2serxDI' NullS    = NullS+        par2serxDI' (xv:-xs) = (signal . fromVector) xv +                               +-+ par2serxDI' xs ++ser2parxDI n = unzipxSY . delaySY (copyV n Abst) +               . filterAbstDI . group n++group2SY :: Signal t -> Signal (t, t)+group2SY NullS = NullS+group2SY (_:-NullS) = NullS+group2SY (x:-y:-xys) = (x, y) :- group2SY xys++group3SY :: Signal t -> Signal (t, t, t)+group3SY NullS = NullS+group3SY (_:-NullS) = NullS+group3SY (_:-_:-NullS) = NullS+group3SY (x:-y:-z:-xyzs) = (x, y, z) :- group3SY xyzs++group4SY :: Signal t -> Signal (t, t, t, t)+group4SY NullS = NullS+group4SY (_:-NullS) = NullS+group4SY (_:-_:-NullS) = NullS+group4SY (_:-_:-_:-NullS) = NullS+group4SY (w:-x:-y:-z:-wxyzs) = (w, x, y, z) :- group4SY wxyzs +++filterAbstDI :: Signal (AbstExt a) -> Signal a+filterAbstDI NullS      = NullS+filterAbstDI (Abst:-xs)     = filterAbstDI xs+filterAbstDI ((Prst x):-xs) = x :- filterAbstDI xs++group :: (Ord a, Num a) => a -> Signal a1 -> Signal (AbstExt (Vector a1))+group n xs = mapSY (output n) (scanlSY (addElement n)  (NullV, 0) xs)+  where addElement m (vs, n) x | n < m  = (vs <: x, n+1)+                               | n == m = (unitV x, 1)+                               | otherwise = error "Vector of wrong size"+        output m (vs, n) | m == n = Prst vs+                         | otherwise = Abst+

@@ -0,0 +1,38 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.MoC.MoCInterface+-- Copyright   :  KTH/ICT/ELE/ESY, 2017+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  ingo@kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- This module defines models of computation interfaces between the+-- different MOCs.+-----------------------------------------------------------------------------++module ForSyDe.Shallow.MoC.MoCInterface(+  -- * Interfaces between Synchronous MoC and Continuous Time MoC+  sy2ct, ct2sy) where++import ForSyDe.Shallow.MoC.CT+import ForSyDe.Shallow.Core.Signal+-- | The MoC interface 'sy2ct' converts a synchronous signal into a+-- continuous time signal. It uses the 'd2aConverter' function, which+-- currently is defined in the CT library.+sy2ct :: (Fractional a, Show a) =>+         DACMode             -- ^Mode of conversion+      -> Rational            -- ^Duration of input signal+      -> Signal a            -- ^Input signal (untimed MoC)+      -> Signal (SubsigCT a) -- ^Output signal (continuous time MoC)+sy2ct = d2aConverter     ++-- | The MoC interface 'ct2sy' converts a synchronous signal into a+-- continuous time signal. It uses the 'a2dConverter' function, which+-- currently is defined in the CT library.+ct2sy :: (Num a, Show a) =>+         Rational            -- ^Sampling Period+      -> Signal (SubsigCT a) -- ^Input signal (continuous time)+      -> Signal a            -- ^Output signal (untimed) = d2aConverter+ct2sy = a2dConverter

@@ -0,0 +1,455 @@+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.MoC.SDF+-- Copyright   :  (c) Ingo Sander, KTH/ICT/ES, ForSyDe-Group+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- SDFLib.hs, yet to be completed.+-- +-----------------------------------------------------------------------------++module ForSyDe.Shallow.MoC.SDF (+  -- * Combinational Process Constructors+  -- | Combinational process constructors are used for processes that+  -- do not have a state.+  mapSDF, zipWithSDF, zipWith3SDF, zipWith4SDF,+  -- * Sequential Process Constructors+  -- | Sequential process constructors are used for processes that+  -- have a state. One of the input parameters is the initial state.+  delaySDF, delaynSDF,+  -- * Processes+  -- | Processes to unzip a signal of tupels into a tuple of signals+  unzipSDF, unzip3SDF, unzip4SDF,+  -- * Actors+  -- | Based on the process constructors in the SDF-MoC, the+  -- SDF-library provides SDF-actors with single or multiple inputs+  actor11SDF, actor12SDF, actor13SDF, actor14SDF,+  actor21SDF, actor22SDF, actor23SDF, actor24SDF,+  actor31SDF, actor32SDF, actor33SDF, actor34SDF,+  actor41SDF, actor42SDF, actor43SDF, actor44SDF+  ) where  ++import ForSyDe.Shallow.Core++------------------------------------------------------------------------+-- COMBINATIONAL PROCESS CONSTRUCTORS+------------------------------------------------------------------------++-- | The process constructor 'mapSDF' takes the number of consumed+-- (@c@) and produced (@p@) tokens and a function @f@ that operates on+-- a list, and results in an SDF-process that takes an input signal+-- and results in an output signal+mapSDF :: Int -> Int -> ([a] -> [b]) -> Signal a -> Signal b+mapSDF _ _ _ NullS   = NullS+mapSDF c p f xs     +  | c <= 0 = error "mapSDF: Number of consumed tokens must be positive integer" +  | not $ sufficient_tokens c xs  = NullS+  | otherwise  = if length produced_tokens == p then+                   signal produced_tokens +-+ mapSDF c p f (dropS c xs) +                 else   +                   error "mapSDF: Function does not produce correct number of tokens" +  where consumed_tokens = fromSignal $ takeS c xs+        produced_tokens = f consumed_tokens++-- | The process constructor 'zipWithSDF' takes a tuple @(c1, c2)@+-- denoting the number of consumed tokens and an integer @p@ denoting+-- the number of produced tokens and a function @f@+-- that operates on two lists, and results in an SDF-process that takes two+-- input signals and results in an output signal+zipWithSDF :: (Int, Int) -> Int -> ([a] -> [b] -> [c])+           -> Signal a -> Signal b -> Signal c                  +zipWithSDF (_, _) _ _ NullS _ = NullS+zipWithSDF (_, _) _ _ _ NullS = NullS+zipWithSDF (c1, c2) p f as bs +  | c1 <= 0 || c2 <= 0  = error "zipWithSDF: Number of consumed tokens must be positive integer"+  | (not $ sufficient_tokens c1 as) +    || (not $ sufficient_tokens c2 bs) = NullS+  | otherwise = if length produced_tokens == p then+                  signal produced_tokens +-+ zipWithSDF (c1, c2) p f (dropS c1 as) (dropS c2 bs)  +                else+                  error "zipWithSDF: Function does not produce correct number of tokens"+  where consumed_tokens_as = fromSignal $ takeS c1 as+        consumed_tokens_bs = fromSignal $ takeS c2 bs+        produced_tokens = f consumed_tokens_as consumed_tokens_bs++-- | The process constructor 'zipWith3SDF' takes a tuple @(c1, c2, c3)@+-- denoting the number of consumed tokens and an integer @p@ denoting+-- the number of produced tokens and a function @f@+-- that operates on three lists, and results in an SDF-process that takes three+-- input signals and results in an output signal  +zipWith3SDF :: (Int, Int, Int) -> Int -> ([a] -> [b] -> [c] -> [d]) +            -> Signal a -> Signal b -> Signal c -> Signal d                 +zipWith3SDF (_, _, _) _ _ NullS _ _= NullS+zipWith3SDF (_, _, _) _ _ _ NullS _= NullS+zipWith3SDF (_, _, _) _ _ _ _ NullS= NullS+zipWith3SDF (c1, c2, c3) p f as bs cs+  | c1 <= 0 || c2 <= 0 || c3 <= 0+  = error "zipWith3SDF: Number of consumed tokens must be positive integer"+  | (not $ sufficient_tokens c1 as) +    || (not $ sufficient_tokens c2 bs)    +    || (not $ sufficient_tokens c3 cs)+  = NullS+  | otherwise+  = if length produced_tokens == p then+      signal produced_tokens +-+ zipWith3SDF (c1, c2, c3) p f+                                 (dropS c1 as) (dropS c2 bs) (dropS c3 cs)+    else+      error "zipWith3SDF: Function does not produce correct number of tokens"+  where consumed_tokens_as = fromSignal $ takeS c1 as+        consumed_tokens_bs = fromSignal $ takeS c2 bs+        consumed_tokens_cs = fromSignal $ takeS c3 cs+        produced_tokens = f consumed_tokens_as consumed_tokens_bs consumed_tokens_cs+  ++-- | The process constructor 'zipWith4SDF' takes a tuple @(c1, c2, c3,c4)@+-- denoting the number of consumed tokens and an integer @p@+-- denoting the number of produced tokens and a function @f@ that+-- operates on three lists, and results in an SDF-process that takes+-- three input signals and results in an output signal+zipWith4SDF :: (Int, Int, Int, Int) -> Int +            -> ([a] -> [b] -> [c] -> [d] -> [e]) +            -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e +zipWith4SDF (_, _, _, _) _ _ NullS _ _ _ = NullS+zipWith4SDF (_, _, _, _) _ _ _ NullS _ _ = NullS+zipWith4SDF (_, _, _, _) _ _ _ _ NullS _ = NullS+zipWith4SDF (_, _, _, _) _ _ _ _ _ NullS = NullS+zipWith4SDF (c1, c2, c3, c4) p f as bs cs ds+  | c1 <= 0 || c2 <= 0 || c3 <= 0 || c4 <= 0+  = error "zipWith4SDF: Number of consumed tokens must be positive integer"+  | (not $ sufficient_tokens c1 as) +    || (not $ sufficient_tokens c2 bs)    +    || (not $ sufficient_tokens c3 cs)    +    || (not $ sufficient_tokens c4 ds)    +  = NullS+  | otherwise    +  = if length produced_tokens == p then+      signal produced_tokens +-+ zipWith4SDF (c1, c2, c3, c4) p f+             (dropS c1 as) (dropS c2 bs) (dropS c3 cs) (dropS c4 ds)+    else+      error "zipWith4SDF: Function does not produce correct number of tokens"+  where consumed_tokens_as = fromSignal $ takeS c1 as+        consumed_tokens_bs = fromSignal $ takeS c2 bs+        consumed_tokens_cs = fromSignal $ takeS c3 cs+        consumed_tokens_ds = fromSignal $ takeS c4 ds+        produced_tokens = f consumed_tokens_as consumed_tokens_bs+                            consumed_tokens_cs consumed_tokens_ds+        ++-------------------------------------+--             --+-- SEQUENTIAL PROCESS CONSTRUCTORS --+--             --+-------------------------------------++-- | The process constructor 'delaySDF' 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.+delaySDF :: a -> Signal a -> Signal a+delaySDF x xs = x :- xs+++-- | The process constructor 'delaynSDF' delays the signal n event+--   cycles by introducing n initial values at the beginning of the+--   output signal.  +delaynSDF :: [a] -> Signal a -> Signal a +delaynSDF initial_tokens xs = signal initial_tokens +-+ xs ++------------------------------------------------------------------------+--+-- SDF ACTORS+--+------------------------------------------------------------------------++-- > Actors with one output++-- | The process constructor 'actor11SDF' constructs an SDF actor with+-- one input and one output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor11SDF :: Int -> Int -> ([a] -> [b]) -> Signal a -> Signal b+actor11SDF = mapSDF     ++-- | The process constructor 'actor21SDF' constructs an SDF actor with+-- two input and one output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor21SDF :: (Int, Int) -> Int -> ([a] -> [b] -> [c]) -> Signal a -> Signal b -> Signal c    +actor21SDF = zipWithSDF++-- | The process constructor 'actor31SDF' constructs an SDF actor with+-- three input and one output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor31SDF :: (Int, Int, Int) -> Int -> ([a] -> [b] -> [c] -> [d])+       -> Signal a -> Signal b -> Signal c -> Signal d   +actor31SDF = zipWith3SDF++-- | The process constructor 'actor41SDF' constructs an SDF actor with+-- four input and one output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor41SDF :: (Int, Int, Int, Int) -> Int +    -> ([a] -> [b] -> [c] -> [d] -> [e]) +    -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e +actor41SDF = zipWith4SDF+++-- > Actors with two outputs++-- | The process constructor 'actor12SDF' constructs an SDF actor with+-- one input and two output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor12SDF :: Int -> (Int, Int) -> ([a] -> [([b], [c])])+           -> Signal a -> (Signal b, Signal c)+actor12SDF c (p1,p2) f xs = unzipSDF (p1, p2) $ mapSDF c 1 f xs  ++-- | The process constructor 'actor22SDF' constructs an SDF actor with+-- two input and two output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor22SDF :: (Int, Int) -> (Int, Int) -> ([a] -> [b] -> [([c], [d])])+           -> Signal a -> Signal b -> (Signal c, Signal d)+actor22SDF (c1, c2) (p1, p2) f xs ys = unzipSDF (p1, p2) $ zipWithSDF (c1, c2) 1 f xs ys++-- | The process constructor 'actor32SDF' constructs an SDF actor with+-- three input and two output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor32SDF :: (Int, Int, Int) -> (Int, Int)+           -> ([a] -> [b] -> [c] -> [([d], [e])])+           -> Signal a -> Signal b -> Signal c -> (Signal d, Signal e)+actor32SDF (c1, c2, c3) (p1, p2) f as bs cs+  = unzipSDF (p1, p2) $ zipWith3SDF (c1, c2, c3) 1 f as bs cs++-- | The process constructor 'actor42SDF' constructs an SDF actor with+-- four input and two output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor42SDF :: (Int, Int, Int, Int) -> (Int, Int) +           -> ([a] -> [b] -> [c] -> [d] -> [([e], [f])]) +           -> Signal a -> Signal b -> Signal c -> Signal d +           -> (Signal e, Signal f)+actor42SDF (c1, c2, c3, c4) (p1, p2) f as bs cs ds +  = unzipSDF (p1, p2)$ zipWith4SDF (c1, c2, c3, c4) 1 f as bs cs ds++-- > Actors with three outputs++-- | The process constructor 'actor13SDF' constructs an SDF actor with+-- one input and three output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor13SDF :: Int -> (Int, Int, Int) +           -> ([a] -> [([b], [c], [d])]) +           -> Signal a -> (Signal b, Signal c, Signal d)+actor13SDF c (p1, p2, p3) f xs = unzip3SDF (p1, p2, p3) $ mapSDF c 1 f xs  ++-- | The process constructor 'actor23SDF' constructs an SDF actor with+-- two input and three output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor23SDF :: (Int, Int) -> (Int, Int, Int) +           -> ([a] -> [b] -> [([c], [d], [e])]) +           -> Signal a -> Signal b +           -> (Signal c, Signal d, Signal e)+actor23SDF (c1, c2) (p1, p2, p3) f xs ys+  = unzip3SDF (p1, p2, p3) $ zipWithSDF (c1, c2) 1 f xs ys++-- | The process constructor 'actor33SDF' constructs an SDF actor with+-- three input and three output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor33SDF :: (Int, Int, Int) -> (Int, Int, Int) +           -> ([a] -> [b] -> [c] -> [([d], [e], [f])]) +           -> Signal a -> Signal b -> Signal c -> (Signal d, Signal e, Signal f)+actor33SDF (c1, c2, c3) (p1, p2, p3) f as bs cs+  = unzip3SDF (p1, p2, p3) $ zipWith3SDF (c1, c2, c3) 1 f as bs cs++-- | The process constructor 'actor43SDF' constructs an SDF actor with+-- four input and three output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor43SDF :: (Int, Int, Int, Int) -> (Int, Int, Int) +           -> ([a] -> [b] -> [c] -> [d] -> [([e], [f], [g])]) +           -> Signal a -> Signal b -> Signal c -> Signal d +           -> (Signal e, Signal f, Signal g)+actor43SDF (c1, c2, c3, c4) (p1, p2, p3) f as bs cs ds +  = unzip3SDF (p1, p2, p3)$ zipWith4SDF (c1, c2, c3, c4) 1 f as bs cs ds++-- > Actors with four outputs++-- | The process constructor 'actor14SDF' constructs an SDF actor with+-- one input and four output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor14SDF :: Int -> (Int, Int, Int, Int) +           -> ([a] -> [([b], [c], [d], [e])]) +           -> Signal a -> (Signal b, Signal c, Signal d, Signal e)+actor14SDF c (p1, p2, p3, p4) f xs = unzip4SDF (p1, p2, p3, p4) $ mapSDF c 1 f xs  ++-- | The process constructor 'actor24SDF' constructs an SDF actor with+-- two input and four output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor24SDF :: (Int, Int) -> (Int, Int, Int, Int) +       -> ([a] -> [b] -> [([c], [d], [e], [f])]) +       -> Signal a -> Signal b +       -> (Signal c, Signal d, Signal e, Signal f)+actor24SDF (c1, c2) (p1, p2, p3, p4) f xs ys+  = unzip4SDF (p1, p2, p3, p4) $ zipWithSDF (c1, c2) 1 f xs ys++-- | The process constructor 'actor34SDF' constructs an SDF actor with+-- three input and four output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor34SDF :: (Int, Int, Int) -> (Int, Int, Int, Int) +           -> ([a] -> [b] -> [c] -> [([d], [e], [f], [g])]) +           -> Signal a -> Signal b -> Signal c+           -> (Signal d, Signal e, Signal f, Signal g)+actor34SDF (c1, c2, c3) (p1, p2, p3, p4) f as bs cs +  = unzip4SDF (p1, p2, p3, p4) $ zipWith3SDF (c1, c2, c3) 1 f as bs cs++-- | The process constructor 'actor14SDF' constructs an SDF actor with+-- four input and four output signals. For each input or output signal,+-- the process constructor takes the number of consumed and produced+-- tokens and the function of the actor as arguments.+actor44SDF :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) +           -> ([a] -> [b] -> [c] -> [d] -> [([e], [f], [g], [h])]) +           -> Signal a -> Signal b -> Signal c -> Signal d +           -> (Signal e, Signal f, Signal g, Signal h)+actor44SDF (c1, c2, c3, c4) (p1, p2, p3, p4) f as bs cs ds +  = unzip4SDF (p1, p2, p3, p4)$ zipWith4SDF (c1, c2, c3, c4) 1 f as bs cs ds++------------------------------------------------------------------------+-- unzipSDF Processes+------------------------------------------------------------------------++unzipSDF :: (Int, Int) -> Signal ([a], [b]) +         -> (Signal a, Signal b)+unzipSDF (p1, p2) xs = (s1, s2) +  where+    s1 = signal $ f1 xs+    s2 = signal $ f2 xs+    f1 NullS     = []+    f1 ((as, _):-xs)+      = if length as == p1 then +          as ++ f1 xs+        else  +          error "unzipSDF: Process does not produce correct number of tokens"+    f2 NullS     = []+    f2 ((_, bs):-xs)+      = if length bs == p2 then +          bs ++ f2 xs+        else  +          error "unzipSDF: Process does not produce correct number of tokens"  +++unzip3SDF :: (Int, Int, Int) -> Signal ([a], [b], [c]) +      -> (Signal a, Signal b, Signal c)+unzip3SDF (p1, p2, p3) xs = (s1, s2, s3) +  where+    s1 = signal $ f1 xs+    s2 = signal $ f2 xs+    s3 = signal $ f3 xs+    f1 NullS      = []+    f1 ((as, _, _):-xs) +      = if length as == p1 then+          as ++ f1 xs+        else  +          error "unzip3SDF: Process does not produce correct number of tokens"+    f2 NullS      = []+    f2 ((_, bs, _):-xs) +      = if length bs == p2 then +          bs ++ f2 xs+        else  +          error "unzip3SDF: Process does not produce correct number of tokens"  +    f3 NullS      = []+    f3 ((_, _, cs):-xs) +      = if length cs == p3 then +          cs ++ f3 xs+        else  +          error "unzip3SDF: Process does not produce correct number of tokens"  +  ++unzip4SDF :: (Int, Int, Int, Int) -> Signal ([a], [b], [c], [d]) +          -> (Signal a, Signal b, Signal c, Signal d)+unzip4SDF (p1, p2, p3, p4) xs = (s1, s2, s3, s4) +  where+    s1 = signal $ f1 xs+    s2 = signal $ f2 xs+    s3 = signal $ f3 xs+    s4 = signal $ f4 xs+    f1 NullS      = []+    f1 ((as, _, _, _):-xs) +      = if length as == p1 then+          as ++ f1 xs+        else  +          error "unzip4SDF: Process does not produce correct number of tokens"+    f2 NullS      = []+    f2 ((_, bs, _, _):-xs) +      = if length bs == p2 then +          bs ++ f2 xs+        else  +          error "unzip4SDF: Process does not produce correct number of tokens"  +    f3 NullS      = []+    f3 ((_, _, cs, _):-xs) +      = if length cs == p3 then +          cs ++ f3 xs+        else  +          error "unzip4SDF: Process does not produce correct number of tokens" +    f4 NullS      = []+    f4 ((_, _, _, ds):-xs) +      = if length ds == p4 then +          ds ++ f4 xs+        else  +          error "unzip4SDF: Process does not produce correct number of tokens" ++------------------------------------------------------------------------+--+-- Helper functions (not exported!)+--+------------------------------------------------------------------------++sufficient_tokens :: (Num a, Eq a, Ord a) => a -> Signal t -> Bool+sufficient_tokens 0 _     = True+sufficient_tokens _ NullS = False+sufficient_tokens n (_:-xs)+  = if n < 0 then+      error "sufficient_tokens: n must not be negative"+    else+      sufficient_tokens (n-1) xs++------------------------------------------------------------------------+--+-- Test of Library (not exported)+--+------------------------------------------------------------------------++{-+s1 = takeS 10 $ signal [1..]+s2 = takeS 10 $ signal [10,20..]++f1 [x] = [([x,x], [x,x,x])]++s3 = unzipSDF (2,3) $ mapSDF 1 1 f1 s1    +         +s4 = actor12SDF 1 (2,3) f1 s1++s5 = signal [1.0,2.0,3.0,4.0,5.0]++multiply [x1,x2] [y] = [(x1+x2)* y]+multiply _   _   = error "Single list item expected"++feedback input = (i1,output) +   where output = actor21SDF (2,1) 1 multiply input i1+     i1 = delaySDF 1 output+-}

@@ -0,0 +1,34 @@+{-# OPTIONS_HADDOCK not-home #-}+----------------------------------------------------------------------+-- |+-- Module      :  ForSyDe.Shallow.MoC.Synchronous+-- Copyright   :  (c) SAM/KTH 2007+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable +-- +-- The synchronuous library defines process constructors and processes+-- for the synchronous 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.MoC.Synchronous (+  -- * The Core Library+  module ForSyDe.Shallow.MoC.Synchronous.Lib,++  -- * Add-ons+  -- ** Utility Processes+  -- | Collection of process constructors commonly used in designs.+  module ForSyDe.Shallow.MoC.Synchronous.Process,++  -- ** Stochastic Processes+  -- | Library of stochastic process constructors+  module ForSyDe.Shallow.MoC.Synchronous.Stochastic+  ) where++import ForSyDe.Shallow.MoC.Synchronous.Lib+import ForSyDe.Shallow.MoC.Synchronous.Process+import ForSyDe.Shallow.MoC.Synchronous.Stochastic

@@ -0,0 +1,435 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module  :  ForSyDe.Shallow.MoC.Synchronous.Lib+-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  forsyde-dev@ict.kth.se+-- Stability   :  experimental+-- Portability :  portable+--+-- This module contains the core library of the Synchronous MoC.+-----------------------------------------------------------------------------+module ForSyDe.Shallow.MoC.Synchronous.Lib (+  -- ** Combinational process constructors+  -- | Combinational process constructors are used for processes that+  --   do not have a state.+  mapSY, zipWithSY, zipWith3SY, +  zipWith4SY, zipWithxSY,+  combSY, comb2SY, comb3SY, comb4SY,+  -- ** Sequential process constructors+  -- | Sequential process constructors are used for processes that+  --   have a state. One of the input parameters is the initial state.+  delaySY, delaynSY,+  scanlSY, scanl2SY, scanl3SY, scanldSY, scanld2SY,+  scanld3SY, mooreSY, moore2SY, moore3SY, mealySY,+  mealy2SY, mealy3SY, sourceSY, +  filterSY, fillSY, holdSY,+  -- ** Synchronous Processes+  -- | The library contains a few simple processes that are applicable+  --   to many cases.+  whenSY, zipSY, zip3SY, zip4SY, zip5SY, zip6SY, +  unzipSY, unzip3SY, unzip4SY, unzip5SY, unzip6SY,+  zipxSY, unzipxSY, mapxSY, +  fstSY, sndSY+  ) where++import ForSyDe.Shallow.Core++----------------------------------------+-- COMBINATIONAL PROCESS CONSTRUCTORS --+----------------------------------------++-- | The process constructor 'mapSY' takes a combinational function as+-- argument and returns a process with one input signal and one output+-- signal.++mapSY :: (a -> b) -> Signal a -> Signal b+mapSY _ NullS   = NullS+mapSY f (x:-xs) = f x :- (mapSY f xs)+  +-- | The process constructor 'zipWithSY' takes a combinational+-- function as argument and returns a process with two input signals+-- and one output signal.+zipWithSY :: (a -> b -> c) -> Signal a -> Signal b -> Signal c+zipWithSY _ NullS   _   = NullS+zipWithSY _ _   NullS   = NullS+zipWithSY f (x:-xs) (y:-ys) = f x y :- (zipWithSY f xs ys)++-- | The process constructor 'zipWith3SY' takes a combinational+-- function as argument and returns a process with three input signals+-- and one output signal.+zipWith3SY :: (a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d+zipWith3SY _ NullS   _   _   = NullS+zipWith3SY _ _   NullS   _   = NullS+zipWith3SY _ _   _   NullS   = NullS+zipWith3SY f (x:-xs) (y:-ys) (z:-zs)+  = f x y z :- (zipWith3SY f xs ys zs)++-- | The process constructor 'zipWith4SY' takes a combinational+-- function as argument and returns a process with four input signals+-- and one output signal.+zipWith4SY ::    (a -> b -> c -> d -> e) -> Signal a -> Signal b +      -> Signal c -> Signal d -> Signal e+zipWith4SY _ NullS   _   _   _  = NullS+zipWith4SY _ _   NullS   _   _  = NullS+zipWith4SY _ _   _   NullS   _  = NullS+zipWith4SY _ _   _   _   NullS  = NullS+zipWith4SY f (w:-ws) (x:-xs) (y:-ys) (z:-zs) +  = f w x y z :- (zipWith4SY f ws xs ys zs)++-- | The process constructor 'combSY' is an alias to 'mapSY' and+-- behaves exactly in the same way.+combSY :: (a -> b) -> Signal a -> Signal b+combSY = mapSY++-- | The process constructor 'comb2SY' is an alias to 'zipWithSY' and+-- behaves exactly in the same way.+comb2SY :: (a -> b -> c) -> Signal a -> Signal b -> Signal c+comb2SY = zipWithSY+    +-- | The process constructor 'comb3SY' is an alias to 'zipWith3SY' and+-- behaves exactly in the same way.+comb3SY :: (a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d+comb3SY = zipWith3SY+    +-- | The process constructor 'comb4SY' is an alias to 'zipWith4SY' and+-- behaves exactly in the same way.+comb4SY :: (a -> b -> c -> d -> e) -> Signal a -> Signal b+    -> Signal c -> Signal d -> Signal e+comb4SY = zipWith4SY+   +-- | The process constructor 'mapxSY' creates a process network that+-- maps a function onto all signals in a vector of signals.+mapxSY :: (a -> b) -> Vector (Signal a) -> Vector (Signal b)+mapxSY f = mapV (mapSY f)++-- | The process constructor 'zipWithxSY' works as 'zipWithSY', but+-- takes a vector of signals as input.+zipWithxSY :: (Vector a -> b) -> Vector (Signal a) -> Signal b+zipWithxSY f = mapSY f . zipxSY++-------------------------------------+-- SEQUENTIAL PROCESS CONSTRUCTORS --+-------------------------------------++-- | 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.+delaySY :: a        -- ^Initial state+        -> Signal a -- ^Input signal+        -> Signal a -- ^Output signal+delaySY e es = e:-es++-- | The process constructor 'delaynSY' delays the signal n events by+-- introducing n identical default values.+delaynSY :: a        -- ^Initial state+         -> Int      -- ^ Delay cycles +         -> Signal a -- ^Input signal+         -> Signal a -- ^Output signal+delaynSY e n xs | n <= 0 = xs+                | otherwise = e :- delaynSY e (n-1) xs ++-- | 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.+--+-- > SynchronousLib> scanlSY (+) 0 (signal [1,2,3,4])+--+-- > {1,3,6,10} :: Signal Integer+-- +-- This is in contrast to the function 'scanldSY', which has its+-- current state as its output value.+scanlSY :: (a -> b -> a) -- ^Combinational function for next state+                         -- decoder+       -> a              -- ^Initial state+       -> Signal b       -- ^ Input signal +       -> Signal a       -- ^ Output signal+scanlSY f mem xs = s'+  where s' = zipWithSY f (delaySY mem s') xs ++-- | The process constructor 'scanl2SY' behaves like 'scanlSY', but+-- has two input signals.+scanl2SY :: (a -> b -> c -> a) -> a -> Signal b -> Signal c -> Signal a+scanl2SY f mem xs ys = s'+  where s' = zipWith3SY f (delaySY mem s') xs ys++-- | The process constructor 'scanl3SY' behaves like 'scanlSY', but+-- has three input signals.+scanl3SY :: (a -> b -> c -> d -> a) -> a -> Signal b+         -> Signal c -> Signal d -> Signal a+scanl3SY f mem xs ys zs = s'+  where s' = zipWith4SY f (delaySY mem s') xs ys zs++-- | 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 similar 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.+--+-- > SynchronousLib> scanldSY (+) 0 (signal [1,2,3,4])+--+-- > {0,1,3,6,10} :: Signal Integer+scanldSY :: (a -> b -> a) -- ^Combinational function for next state+                          -- decoder+    -> a                  -- ^Initial state+    -> Signal b           -- ^ Input signal+    -> Signal a           -- ^ Output signal+scanldSY f mem xs = s'+    where s' = delaySY mem $ zipWithSY f s' xs ++-- | The process constructor 'scanld2SY' behaves like 'scanldSY', but+-- has two input signals.+scanld2SY ::    (a -> b -> c -> a) -> a -> Signal b -> Signal c +     -> Signal a+scanld2SY f mem xs ys = s'+    where s' = delaySY mem $ zipWith3SY f s' xs ys++-- | The process constructor 'scanld3SY' behaves like 'scanldSY', but has three input signals.+scanld3SY :: (a -> b -> c -> d -> a) -> a -> Signal b +          -> Signal c -> Signal d -> Signal a+scanld3SY f mem xs ys zs = s'+  where s' = delaySY mem $ zipWith4SY f s' xs ys zs++-- | 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.+mooreSY :: (a -> b -> a) -- ^Combinational function for next state+                         -- decoder+        -> (a -> c)      -- ^Combinational function for output decoder+        -> a             -- ^Initial state+        -> Signal b      -- ^Input signal+        -> Signal c      -- ^Output signal+mooreSY nextState output initial +    = mapSY output . (scanldSY nextState initial)++-- | The process constructor 'moore2SY' behaves like 'mooreSY', but+-- has two input signals.+moore2SY ::   (a -> b -> c -> a) -> (a -> d) -> a -> Signal b +         -> Signal c -> Signal d+moore2SY nextState output initial inp1 inp2 =+  mapSY output (scanld2SY nextState initial inp1 inp2)++-- | The process constructor 'moore3SY' behaves like 'mooreSY', but+-- has three input signals.+moore3SY :: (a -> b -> c -> d -> a) -> (a -> e) -> a -> Signal b +         -> Signal c -> Signal d -> Signal e+moore3SY nextState output initial inp1 inp2 inp3 =+  mapSY output (scanld3SY nextState initial inp1 inp2 inp3)++-- | 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.+mealySY :: (a -> b -> a) -- ^Combinational function for next state+                         -- decoder+       -> (a -> b -> c)  -- ^Combinational function for output decoder+       -> a              -- ^Initial state+       -> Signal b       -- ^Input signal +       -> Signal c       -- ^Output signal+mealySY nextState output initial sig =+  zipWithSY output state sig+  where state = scanldSY nextState initial sig++-- | The process constructor 'mealy2SY' behaves like 'mealySY', but+-- has two input signals.+mealy2SY :: (a -> b -> c -> a) -> (a -> b -> c -> d) -> a+         -> Signal b -> Signal c -> Signal d+mealy2SY nextState output initial inp1 inp2 =+  zipWith3SY output (scanld2SY nextState initial inp1 inp2) inp1 inp2  ++-- | The process constructor 'mealy3SY' behaves like 'mealySY', but+-- has three input signals.+mealy3SY :: (a -> b -> c -> d -> a) -> (a -> b -> c -> d -> e) -> a+         -> Signal b -> Signal c -> Signal d -> Signal e+mealy3SY nextState output initial inp1 inp2 inp3 =+  zipWith4SY output (scanld3SY nextState initial inp1 inp2 inp3) inp1 inp2 inp3 ++-- | The process constructor 'filterSY' discards the values who do not+-- fulfill a predicate given by a predicate function and replaces them+-- with absent events.+filterSY :: (a -> Bool)        -- ^Predicate function+         -> Signal a           -- ^Input signal+         -> Signal (AbstExt a) -- ^Output signal+filterSY _ NullS   = NullS+filterSY p (x:-xs) = if (p x == True) then+                       Prst x :- filterSY p xs+                     else+                       Abst :- filterSY p xs++-- | 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 constructed by+--+-- > SynchronousLib> takeS 5 (sourceSY (+1) 0)+--+-- > {0,1,2,3,4} :: Signal Integer+sourceSY :: (a -> a) -> a -> Signal a+sourceSY f s0 = o+   where o = delaySY s0 s+         s = mapSY f o++-- | 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'.+fillSY :: a                  -- ^Default value+       -> Signal (AbstExt a) -- ^Absent extended input signal+       -> Signal a           -- ^Output signal+fillSY a xs = mapSY (replaceAbst a) xs+      where replaceAbst a' Abst     = a'+            replaceAbst _  (Prst x) = x++-- | 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'.+holdSY :: a                  -- ^Default value+       -> Signal (AbstExt a) -- ^Absent extended input signal+       -> Signal a           -- ^Output signal+holdSY a xs = scanlSY hold a xs+      where hold a' Abst     = a'+            hold _  (Prst x) = x++---------------------------+-- SYNCHRONOUS PROCESSES --+---------------------------++-- | 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.+whenSY :: Signal (AbstExt a) -> Signal (AbstExt b) +       -> Signal (AbstExt a)+whenSY NullS   _          = NullS+whenSY _       NullS      = NullS+whenSY (_:-xs) (Abst:-ys) = Abst :- (whenSY xs ys)+whenSY (x:-xs) (_:-ys)    = x    :- (whenSY xs ys)++-- | The process 'zipSY' \"zips\" two incoming signals into one signal+-- of tuples.+zipSY :: Signal a -> Signal b -> Signal (a,b)+zipSY (x:-xs) (y:-ys) = (x, y) :- zipSY xs ys+zipSY _       _       = NullS++-- | The process 'zip3SY' works as 'zipSY', but takes three input+-- signals.+zip3SY :: Signal a -> Signal b -> Signal c -> Signal (a,b,c)+zip3SY (x:-xs) (y:-ys) (z:-zs) = (x, y, z) :- zip3SY xs ys zs+zip3SY _       _       _       = NullS++-- | The process 'zip4SY' works as 'zipSY', but takes four input+-- signals.+zip4SY ::    Signal a -> Signal b -> Signal c -> Signal d +      -> Signal (a,b,c,d)+zip4SY (w:-ws) (x:-xs) (y:-ys) (z:-zs)+  = (w, x, y, z) :- zip4SY ws xs ys zs+zip4SY _ _ _ _ = NullS++-- | The process 'zip5SY' works as 'zipSY', but takes four input+-- signals.+zip5SY :: Signal a -> Signal b -> Signal c -> Signal d -> Signal e+       -> Signal (a,b,c,d,e)+zip5SY (x1:-x1s) (x2:-x2s) (x3:-x3s) (x4:-x4s) (x5:-x5s) +  = (x1,x2,x3,x4,x5) :- zip5SY x1s x2s x3s x4s x5s+zip5SY _ _ _ _ _ = NullS++-- | The process 'zip6SY' works as 'zipSY', but takes four input+-- signals.+zip6SY :: Signal a -> Signal b -> Signal c -> Signal d -> Signal e+       -> Signal f -> Signal (a,b,c,d,e,f)+zip6SY (x1:-x1s) (x2:-x2s) (x3:-x3s) (x4:-x4s) (x5:-x5s)  (x6:-x6s) +    = (x1,x2,x3,x4,x5,x6) :- zip6SY x1s x2s x3s x4s x5s x6s+zip6SY _ _ _ _ _ _ = NullS++-- | The process 'unzipSY' \"unzips\" a signal of tuples into two+-- signals.+unzipSY :: Signal (a,b) -> (Signal a,Signal b)+unzipSY NullS         = (NullS, NullS)+unzipSY ((x, y):-xys) = (x:-xs, y:-ys)+  where (xs, ys) = unzipSY xys++-- | The process 'unzip3SY' works as 'unzipSY', but has three output+-- signals.+unzip3SY :: Signal (a, b, c) -> (Signal a, Signal b, Signal c)+unzip3SY NullS             = (NullS, NullS, NullS)+unzip3SY ((x, y, z):-xyzs) = (x:-xs, y:-ys, z:-zs)+  where (xs, ys, zs) = unzip3SY xyzs++-- | The process 'unzip4SY' works as 'unzipSY', but has four output+-- signals.+unzip4SY :: Signal (a,b,c,d) +         -> (Signal a,Signal b,Signal c,Signal d)+unzip4SY NullS      = (NullS, NullS, NullS, NullS)+unzip4SY ((w,x,y,z):-wxyzs) = (w:-ws, x:-xs, y:-ys, z:-zs)+  where (ws, xs, ys, zs) = unzip4SY wxyzs++-- | The process 'unzip5SY' works as 'unzipSY', but has four output+-- signals.+unzip5SY :: Signal (a,b,c,d,e) +         -> (Signal a,Signal b,Signal c,Signal d,Signal e)+unzip5SY NullS                  = (NullS, NullS, NullS, NullS,NullS)+unzip5SY ((x1,x2,x3,x4,x5):-xs) = (x1:-x1s, x2:-x2s, x3:-x3s, x4:-x4s, x5:-x5s)+  where (x1s, x2s, x3s, x4s,x5s) = unzip5SY xs++-- | The process 'unzip6SY' works as 'unzipSY', but has four output+-- signals.+unzip6SY :: Signal (a,b,c,d,e,f) +    -> (Signal a,Signal b,Signal c,Signal d,Signal e,Signal f)+unzip6SY NullS = (NullS, NullS, NullS, NullS,NullS,NullS)+unzip6SY ((x1,x2,x3,x4,x5,x6):-xs) +  = (x1:-x1s, x2:-x2s, x3:-x3s, x4:-x4s, x5:-x5s, x6:-x6s)+  where (x1s, x2s, x3s, x4s, x5s, x6s) = unzip6SY xs++-- | The process 'zipxSY' \"zips\" a signal of vectors into a vector+-- of signals.+zipxSY :: Vector (Signal a) -> Signal (Vector a)+zipxSY NullV            = NullS+zipxSY (NullS   :> xss) = zipxSY xss+zipxSY ((x:-xs) :> xss) = (x :> (mapV headS xss)) +                          :- (zipxSY (xs :> (mapV tailS xss)))++-- | The process 'unzipxSY' \"unzips\" a vector of signals into a+-- signal of vectors.+unzipxSY :: Signal (Vector a) -> Vector (Signal a)+unzipxSY NullS            = NullV+unzipxSY (NullV   :- vss) = unzipxSY vss+unzipxSY ((v:>vs) :- vss) = (v :- (mapSY headV vss)) +                            :> (unzipxSY (vs :- (mapSY tailV vss)))++-- | The process 'fstSY' selects always the first value from a signal+-- of pairs.+fstSY :: Signal (a,b) -> Signal a+fstSY = mapSY fst ++-- | The process 'sndSY' selects always the second value from a signal+-- of pairs.+sndSY :: Signal (a,b) -> Signal b+sndSY = mapSY snd