-----------------------------------------------------------------------------
-- |
-- 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 :: String
revision=(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\ Char
c -> (Bool -> Bool
not (Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'$'))) String
"$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 :: SubsigCT a -> String
show SubsigCT a
ss = [(Rational, a)] -> String
forall a. Show a => a -> String
show (Rational -> SubsigCT a -> [(Rational, a)]
forall a.
(Num a, Show a) =>
Rational -> SubsigCT a -> [(Rational, a)]
sampleSubsig Rational
timeStep SubsigCT a
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 :: (a -> b) -> Rational -> b
liftCT a -> b
f = a -> b
f (a -> b) -> (Rational -> a) -> Rational -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
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 :: [(Rational -> a, (Rational, Rational))] -> Signal (SubsigCT a)
ctSignal [] = Signal (SubsigCT a)
forall a. Signal a
NullS
ctSignal ((Rational -> a
f, (Rational
start, Rational
end)) : [(Rational -> a, (Rational, Rational))]
xs) = (Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
f, (Rational
start, Rational
end)) SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- [(Rational -> a, (Rational, Rational))] -> Signal (SubsigCT a)
forall a.
[(Rational -> a, (Rational, Rational))] -> Signal (SubsigCT a)
ctSignal [(Rational -> a, (Rational, Rational))]
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 :: Rational
timeStep = Rational
10.0e-2

mapCT :: (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
mapCT :: (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
mapCT a -> b
_ Signal (SubsigCT a)
NullS = Signal (SubsigCT b)
forall a. Signal a
NullS
mapCT a -> b
g (SubsigCT (Rational -> a
f, (Rational
f_start, Rational
f_end)):-Signal (SubsigCT a)
fs)
  = ((Rational -> b, (Rational, Rational)) -> SubsigCT b
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (\Rational
x -> a -> b
g (Rational -> a
f Rational
x), (Rational
f_start, Rational
f_end)) SubsigCT b -> Signal (SubsigCT b) -> Signal (SubsigCT b)
forall a. a -> Signal a -> Signal a
:- (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
forall a b. (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
mapCT a -> b
g Signal (SubsigCT a)
fs)

zipWithCT :: (a -> b -> c) -> Signal (SubsigCT a) -> Signal (SubsigCT b) -> Signal (SubsigCT c)
zipWithCT :: (a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
zipWithCT a -> b -> c
_ Signal (SubsigCT a)
NullS Signal (SubsigCT b)
_ = Signal (SubsigCT c)
forall a. Signal a
NullS
zipWithCT a -> b -> c
_ Signal (SubsigCT a)
_ Signal (SubsigCT b)
NullS = Signal (SubsigCT c)
forall a. Signal a
NullS
zipWithCT a -> b -> c
h (SubsigCT (Rational -> a
f, (Rational
f_start, Rational
f_end)):-Signal (SubsigCT a)
fs) (SubsigCT (Rational -> b
g, (Rational
g_start, Rational
g_end)):-Signal (SubsigCT b)
gs)
    | Rational
f_start Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
g_start  = String -> Signal (SubsigCT c)
forall a. HasCallStack => String -> a
error String
"Start times not aligned"
    | Rational
f_end Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
g_end      = ((Rational -> c, (Rational, Rational)) -> SubsigCT c
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (\Rational
x -> a -> b -> c
h (Rational -> a
f Rational
x) (Rational -> b
g Rational
x), (Rational
f_start, Rational
f_end)) SubsigCT c -> Signal (SubsigCT c) -> Signal (SubsigCT c)
forall a. a -> Signal a -> Signal a
:- (a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
forall a b c.
(a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
zipWithCT a -> b -> c
h Signal (SubsigCT a)
fs Signal (SubsigCT b)
gs)
    | Rational
f_end Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
g_end       = ((Rational -> c, (Rational, Rational)) -> SubsigCT c
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (\Rational
x -> a -> b -> c
h (Rational -> a
f Rational
x) (Rational -> b
g Rational
x), (Rational
f_start, Rational
f_end))
                             SubsigCT c -> Signal (SubsigCT c) -> Signal (SubsigCT c)
forall a. a -> Signal a -> Signal a
:- (a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
forall a b c.
(a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
zipWithCT a -> b -> c
h Signal (SubsigCT a)
fs ((Rational -> b, (Rational, Rational)) -> SubsigCT b
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> b
g, (Rational
f_end, Rational
g_end)) SubsigCT b -> Signal (SubsigCT b) -> Signal (SubsigCT b)
forall a. a -> Signal a -> Signal a
:- Signal (SubsigCT b)
gs))           
    | Rational
f_end Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
g_end       = ((Rational -> c, (Rational, Rational)) -> SubsigCT c
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (\Rational
x -> a -> b -> c
h (Rational -> a
f Rational
x) (Rational -> b
g Rational
x), (Rational
f_start, Rational
g_end))
                             SubsigCT c -> Signal (SubsigCT c) -> Signal (SubsigCT c)
forall a. a -> Signal a -> Signal a
:- (a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
forall a b c.
(a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
zipWithCT a -> b -> c
h ((Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
f, (Rational
g_end, Rational
f_end)) SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- Signal (SubsigCT a)
fs) Signal (SubsigCT b)
gs)
    | Bool
otherwise           = String -> Signal (SubsigCT c)
forall a. HasCallStack => String -> a
error String
"zipWithCT: pattern not covered"

combCT :: (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
combCT :: (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
combCT = (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
forall a b. (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
mapCT

comb2CT :: (a -> b -> c) -> Signal (SubsigCT a)
        -> Signal (SubsigCT b) -> Signal (SubsigCT c)
comb2CT :: (a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
comb2CT = (a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
forall a b c.
(a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
zipWithCT

delayCT :: Rational -> a -> Signal (SubsigCT a) -> Signal (SubsigCT a)    
delayCT :: Rational -> a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
delayCT Rational
period a
value Signal (SubsigCT a)
fs
  = ((Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (\Rational
_ -> a
value, (Rational
0,Rational
period))) SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
addTime Rational
period Signal (SubsigCT a)
fs            
 
addTime :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
addTime :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
addTime Rational
_ Signal (SubsigCT a)
NullS = Signal (SubsigCT a)
forall a. Signal a
NullS
addTime Rational
delay (SubsigCT (Rational -> a
f, (Rational
start, Rational
end)) :- Signal (SubsigCT a)
fs)
  = ((Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
f, (Rational
startRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
delay, Rational
endRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
delay)) SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
addTime Rational
delay Signal (SubsigCT a)
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 :: a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
scaleCT a
factor = (a -> a) -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a b. (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
mapCT (a -> a -> a
forall a. Num a => a -> a -> a
* a
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 :: Signal (SubsigCT a) -> Signal (SubsigCT a) -> Signal (SubsigCT a)
addCT = (a -> a -> a)
-> Signal (SubsigCT a)
-> Signal (SubsigCT a)
-> Signal (SubsigCT a)
forall a b c.
(a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
zipWithCT a -> a -> a
forall a. Num a => a -> a -> a
(+)

-- |'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 :: Signal (SubsigCT a) -> Signal (SubsigCT a) -> Signal (SubsigCT a)
multCT = (a -> a -> a)
-> Signal (SubsigCT a)
-> Signal (SubsigCT a)
-> Signal (SubsigCT a)
forall a b c.
(a -> b -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
zipWithCT a -> a -> a
forall a. Num a => a -> a -> a
(*)

-- |'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 :: Signal (SubsigCT a) -> Signal (SubsigCT a)
absCT = (a -> a) -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a b. (a -> b) -> Signal (SubsigCT a) -> Signal (SubsigCT b)
mapCT a -> a
forall a. Num a => a -> a
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 :: Rational -> (Rational, Rational) -> Signal (SubsigCT a)
sineWave Rational
freq (Rational, Rational)
timeInterval 
  = [SubsigCT a] -> Signal (SubsigCT a)
forall a. [a] -> Signal a
signal [(Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
forall a. Floating a => Rational -> a
sineFunction, (Rational, Rational)
timeInterval)]
  where 
    sineFunction :: (Floating a) => Rational -> a
    --sineFunction t = sin (2*pi * freq * t)
    sineFunction :: Rational -> a
sineFunction Rational
t = (a -> a
forall a. Floating a => a -> a
sin (a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Floating a => a
pi a -> a -> a
forall a. Num a => a -> a -> a
* (Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational
freq Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
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 (Int -> DACMode -> String -> String
[DACMode] -> String -> String
DACMode -> String
(Int -> DACMode -> String -> String)
-> (DACMode -> String)
-> ([DACMode] -> String -> String)
-> Show DACMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DACMode] -> String -> String
$cshowList :: [DACMode] -> String -> String
show :: DACMode -> String
$cshow :: DACMode -> String
showsPrec :: Int -> DACMode -> String -> String
$cshowsPrec :: Int -> DACMode -> String -> String
Show, DACMode -> DACMode -> Bool
(DACMode -> DACMode -> Bool)
-> (DACMode -> DACMode -> Bool) -> Eq DACMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DACMode -> DACMode -> Bool
$c/= :: DACMode -> DACMode -> Bool
== :: DACMode -> DACMode -> Bool
$c== :: DACMode -> DACMode -> Bool
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 :: DACMode -> Rational -> Signal a -> Signal (SubsigCT a)
d2aConverter DACMode
mode Rational
c Signal a
xs
    | DACMode
mode DACMode -> DACMode -> Bool
forall a. Eq a => a -> a -> Bool
== DACMode
DAlinear = Rational -> Rational -> Signal a -> Signal (SubsigCT a)
forall a.
(Fractional a, Show a) =>
Rational -> Rational -> Signal a -> Signal (SubsigCT a)
d2aLinear Rational
c Rational
0.0 Signal a
xs
    | Bool
otherwise = Rational -> Rational -> Signal a -> Signal (SubsigCT a)
forall a.
(Num a, Show a) =>
Rational -> Rational -> Signal a -> Signal (SubsigCT a)
d2aHolder Rational
c Rational
0.0 Signal a
xs
  where
    d2aHolder :: (Num a, Show a) => 
                 Rational -> Rational -> Signal a -> Signal (SubsigCT a)
    d2aHolder :: Rational -> Rational -> Signal a -> Signal (SubsigCT a)
d2aHolder Rational
_ Rational
_ Signal a
NullS = Signal (SubsigCT a)
forall a. Signal a
NullS
    d2aHolder Rational
c Rational
holdT (a
x:-Signal a
xs) = ((Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (a -> Rational -> a
forall a. Num a => a -> Rational -> a
constRationalF a
x,(Rational
holdT,Rational
holdTRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
c)) )
                                SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- Rational -> Rational -> Signal a -> Signal (SubsigCT a)
forall a.
(Num a, Show a) =>
Rational -> Rational -> Signal a -> Signal (SubsigCT a)
d2aHolder Rational
c (Rational
holdTRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
c) Signal a
xs

    d2aLinear :: (Fractional a, Show a) =>
                 Rational -> Rational -> Signal a -> Signal (SubsigCT a)
    d2aLinear :: Rational -> Rational -> Signal a -> Signal (SubsigCT a)
d2aLinear Rational
_ Rational
_ Signal a
NullS = Signal (SubsigCT a)
forall a. Signal a
NullS
    d2aLinear Rational
_ Rational
_ (a
_:-Signal a
NullS) = Signal (SubsigCT a)
forall a. Signal a
NullS
    d2aLinear Rational
c Rational
holdT (a
x:-a
y:-Signal a
xs)
      = ((Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> Rational -> a -> a -> Rational -> a
forall a.
Fractional a =>
Rational -> Rational -> a -> a -> Rational -> a
linearRationalF Rational
c Rational
holdT a
x a
y,(Rational
holdT,Rational
holdTRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
c)) )
        SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- Rational -> Rational -> Signal a -> Signal (SubsigCT a)
forall a.
(Fractional a, Show a) =>
Rational -> Rational -> Signal a -> Signal (SubsigCT a)
d2aLinear Rational
c (Rational
holdTRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
c) (a
ya -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
xs)

constRationalF :: (Num a) => a -> Rational -> a
constRationalF :: a -> Rational -> a
constRationalF = (\a
x Rational
_->a
x)

linearRationalF :: (Fractional a) =>
                   Rational -> Rational -> a -> a -> Rational -> a
linearRationalF :: Rational -> Rational -> a -> a -> Rational -> a
linearRationalF Rational
c Rational
holdT a
m a
n Rational
x = (a
1a -> a -> a
forall a. Num a => a -> a -> a
-a
forall a. Fractional a => a
alpha)a -> a -> a
forall a. Num a => a -> a -> a
*a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
forall a. Fractional a => a
alphaa -> a -> a
forall a. Num a => a -> a -> a
*a
n
  where alpha :: (Fractional a) => a
        alpha :: a
alpha = Rational -> a
forall a. Fractional a => Rational -> a
fromRational ((Rational
xRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
holdT)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
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 :: Rational -> Signal (SubsigCT a) -> Signal a
a2dConverter Rational
_ Signal (SubsigCT a)
NullS = Signal a
forall a. Signal a
NullS
a2dConverter Rational
c Signal (SubsigCT a)
s | (Signal (SubsigCT a) -> Rational
forall a. (Num a, Show a) => Signal (SubsigCT a) -> Rational
duration (Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
takeCT Rational
c Signal (SubsigCT a)
s)) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
c = Signal a
forall a. Signal a
NullS
                 | Bool
otherwise = Signal (SubsigCT a) -> Signal a
forall a. (Num a, Show a) => Signal (SubsigCT a) -> Signal a
f (Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
takeCT Rational
c Signal (SubsigCT a)
s)
                   Signal a -> Signal a -> Signal a
forall a. Signal a -> Signal a -> Signal a
+-+ Rational -> Signal (SubsigCT a) -> Signal a
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> Signal a
a2dConverter Rational
c (Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
dropCT Rational
c Signal (SubsigCT a)
s)
  where f :: (Num a, Show a) => Signal (SubsigCT a) -> Signal a
        f :: Signal (SubsigCT a) -> Signal a
f Signal (SubsigCT a)
NullS = Signal a
forall a. Signal a
NullS
        f (SubsigCT (Rational -> a
g,(Rational
a,Rational
_)) :- Signal (SubsigCT a)
_) = [a] -> Signal a
forall a. [a] -> Signal a
signal [Rational -> a
g Rational
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 :: ((Rational -> a) -> Rational -> b)
-> Signal (SubsigCT a) -> Signal (SubsigCT b)
applyF1 (Rational -> a) -> Rational -> b
_ Signal (SubsigCT a)
NullS = Signal (SubsigCT b)
forall a. Signal a
NullS
applyF1 (Rational -> a) -> Rational -> b
f (SubsigCT a
ss :- Signal (SubsigCT a)
s) = (((Rational -> a) -> Rational -> b) -> SubsigCT a -> SubsigCT b
forall a b.
(Num a, Num b, Show a, Show b) =>
((Rational -> a) -> Rational -> b) -> SubsigCT a -> SubsigCT b
applyF' (Rational -> a) -> Rational -> b
f SubsigCT a
ss) SubsigCT b -> Signal (SubsigCT b) -> Signal (SubsigCT b)
forall a. a -> Signal a -> Signal a
:- (((Rational -> a) -> Rational -> b)
-> Signal (SubsigCT a) -> Signal (SubsigCT b)
forall a b.
(Num a, Num b, Show a, Show b) =>
((Rational -> a) -> Rational -> b)
-> Signal (SubsigCT a) -> Signal (SubsigCT b)
applyF1 (Rational -> a) -> Rational -> b
f Signal (SubsigCT a)
s)
  where applyF' :: (Num a, Num b, Show a, Show b)
                => ((Rational -> a) -> (Rational -> b)) 
                -> (SubsigCT a) -> (SubsigCT b)
        applyF' :: ((Rational -> a) -> Rational -> b) -> SubsigCT a -> SubsigCT b
applyF' (Rational -> a) -> Rational -> b
f (SubsigCT (Rational -> a
f',(Rational
a,Rational
b))) = (Rational -> b, (Rational, Rational)) -> SubsigCT b
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (((Rational -> a) -> Rational -> b
f Rational -> a
f'), (Rational
a,Rational
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 :: ((Rational -> a) -> (Rational -> b) -> Rational -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
applyF2 (Rational -> a) -> (Rational -> b) -> Rational -> c
_ Signal (SubsigCT a)
NullS Signal (SubsigCT b)
_ = Signal (SubsigCT c)
forall a. Signal a
NullS
applyF2 (Rational -> a) -> (Rational -> b) -> Rational -> c
_ Signal (SubsigCT a)
_ Signal (SubsigCT b)
NullS = Signal (SubsigCT c)
forall a. Signal a
NullS
applyF2 (Rational -> a) -> (Rational -> b) -> Rational -> c
f (SubsigCT a
ss1 :- Signal (SubsigCT a)
s1) (SubsigCT b
ss2 :- Signal (SubsigCT b)
s2) = (((Rational -> a) -> (Rational -> b) -> Rational -> c)
-> SubsigCT a -> SubsigCT b -> SubsigCT c
forall a a a.
((Rational -> a) -> (Rational -> a) -> Rational -> a)
-> SubsigCT a -> SubsigCT a -> SubsigCT a
applyF' (Rational -> a) -> (Rational -> b) -> Rational -> c
f SubsigCT a
ss1 SubsigCT b
ss2) SubsigCT c -> Signal (SubsigCT c) -> Signal (SubsigCT c)
forall a. a -> Signal a -> Signal a
:- (((Rational -> a) -> (Rational -> b) -> Rational -> c)
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> Signal (SubsigCT c)
forall a b c.
(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 (Rational -> a) -> (Rational -> b) -> Rational -> c
f Signal (SubsigCT a)
s1 Signal (SubsigCT b)
s2)
  where applyF' :: ((Rational -> a) -> (Rational -> a) -> Rational -> a)
-> SubsigCT a -> SubsigCT a -> SubsigCT a
applyF' (Rational -> a) -> (Rational -> a) -> Rational -> a
f (SubsigCT (Rational -> a
f1,(Rational
a,Rational
b))) (SubsigCT (Rational -> a
f2,(Rational
c,Rational
d))) 
          | (Rational
aRational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
==Rational
c) Bool -> Bool -> Bool
&& (Rational
bRational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
==Rational
d) 
            Bool -> Bool -> Bool
|| (Rational -> Rational
forall a. Num a => a -> a
abs (Rational
aRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
c)Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0)
            Bool -> Bool -> Bool
|| (Rational -> Rational
forall a. Num a => a -> a
abs (Rational
bRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
d)Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0) = (Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (((Rational -> a) -> (Rational -> a) -> Rational -> a
f Rational -> a
f1 Rational -> a
f2), (Rational
a,Rational
b))
          | Bool
otherwise = String -> SubsigCT a
forall a. HasCallStack => String -> a
error (String
"applyF2: The two subintervals are"
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not identical: (a,b) = ("
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> String
forall a. Show a => a -> String
show Rational
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> String
forall a. Show a => a -> String
show Rational
b) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"); (c,d) = ("
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> String
forall a. Show a => a -> String
show Rational
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> String
forall a. Show a => a -> String
show Rational
d) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
").")

-- | 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 :: (a -> (Rational -> b) -> a) -> a -> Signal (SubsigCT b) -> a
applyG1 a -> (Rational -> b) -> a
_ a
w Signal (SubsigCT b)
NullS = a
w
applyG1 a -> (Rational -> b) -> a
g a
w (SubsigCT b
ss :- Signal (SubsigCT b)
_) = (a -> (Rational -> b) -> a) -> a -> SubsigCT b -> a
forall b a.
(Num b, Show b) =>
(a -> (Rational -> b) -> a) -> a -> SubsigCT b -> a
applyG1' a -> (Rational -> b) -> a
g a
w SubsigCT b
ss
  where 
    applyG1' :: (Num b, Show b) =>
                (a -> (Rational -> b) -> a) -> a -> (SubsigCT b) -> a
    applyG1' :: (a -> (Rational -> b) -> a) -> a -> SubsigCT b -> a
applyG1' a -> (Rational -> b) -> a
g a
w (SubsigCT (Rational -> b
f, (Rational
_,Rational
_))) = a -> (Rational -> b) -> a
g a
w Rational -> b
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 :: Signal (SubsigCT a)
-> Signal (SubsigCT b)
-> (Signal (SubsigCT a), Signal (SubsigCT b))
cutEq Signal (SubsigCT a)
NullS Signal (SubsigCT b)
s2 = (Signal (SubsigCT a)
forall a. Signal a
NullS, Signal (SubsigCT b)
s2) 
cutEq Signal (SubsigCT a)
s1 Signal (SubsigCT b)
NullS = (Signal (SubsigCT a)
s1, Signal (SubsigCT b)
forall a. Signal a
NullS) 
cutEq Signal (SubsigCT a)
s1 Signal (SubsigCT b)
s2 = Signal (SubsigCT a, SubsigCT b)
-> (Signal (SubsigCT a), Signal (SubsigCT b))
forall a b.
Num a =>
Signal (SubsigCT a, SubsigCT b)
-> (Signal (SubsigCT a), Signal (SubsigCT b))
unzipCT (Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
forall a b.
(Num a, Num b, Show a, Show b) =>
Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
cutEq' Signal (SubsigCT a)
s1 Signal (SubsigCT b)
s2)
  where 
    cutEq' :: (Num a, Num b, Show a, Show b) =>
              Signal (SubsigCT a) -> Signal  (SubsigCT b) 
           -> Signal ((SubsigCT a), (SubsigCT b))
    cutEq' :: Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
cutEq' Signal (SubsigCT a)
NullS Signal (SubsigCT b)
_    = Signal (SubsigCT a, SubsigCT b)
forall a. Signal a
NullS
    cutEq' Signal (SubsigCT a)
_ Signal (SubsigCT b)
NullS    = Signal (SubsigCT a, SubsigCT b)
forall a. Signal a
NullS
    cutEq' (SubsigCT a
ss1:-Signal (SubsigCT a)
s1) (SubsigCT b
ss2:-Signal (SubsigCT b)
s2) 
      | Rational
dur1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
dur2 = (SubsigCT a
ss1,SubsigCT b
ss2) (SubsigCT a, SubsigCT b)
-> Signal (SubsigCT a, SubsigCT b)
-> Signal (SubsigCT a, SubsigCT b)
forall a. a -> Signal a -> Signal a
:- (Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
forall a b.
(Num a, Num b, Show a, Show b) =>
Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
cutEq' Signal (SubsigCT a)
s1 Signal (SubsigCT b)
s2)
      | Rational
dur1 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<  Rational
dur2 = (SubsigCT a
ss1, Rational -> SubsigCT b -> SubsigCT b
forall a. (Num a, Show a) => Rational -> SubsigCT a -> SubsigCT a
takeSubSig Rational
dur1 SubsigCT b
ss2) 
                       (SubsigCT a, SubsigCT b)
-> Signal (SubsigCT a, SubsigCT b)
-> Signal (SubsigCT a, SubsigCT b)
forall a. a -> Signal a -> Signal a
:- (Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
forall a b.
(Num a, Num b, Show a, Show b) =>
Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
cutEq' Signal (SubsigCT a)
s1 ((Rational -> SubsigCT b -> SubsigCT b
forall a. (Num a, Show a) => Rational -> SubsigCT a -> SubsigCT a
dropSubSig Rational
dur1 SubsigCT b
ss2) SubsigCT b -> Signal (SubsigCT b) -> Signal (SubsigCT b)
forall a. a -> Signal a -> Signal a
:- Signal (SubsigCT b)
s2))
      | Rational
dur1 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>  Rational
dur2 = (Rational -> SubsigCT a -> SubsigCT a
forall a. (Num a, Show a) => Rational -> SubsigCT a -> SubsigCT a
takeSubSig Rational
dur2 SubsigCT a
ss1, SubsigCT b
ss2)
                       (SubsigCT a, SubsigCT b)
-> Signal (SubsigCT a, SubsigCT b)
-> Signal (SubsigCT a, SubsigCT b)
forall a. a -> Signal a -> Signal a
:- (Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
forall a b.
(Num a, Num b, Show a, Show b) =>
Signal (SubsigCT a)
-> Signal (SubsigCT b) -> Signal (SubsigCT a, SubsigCT b)
cutEq' ((Rational -> SubsigCT a -> SubsigCT a
forall a. (Num a, Show a) => Rational -> SubsigCT a -> SubsigCT a
dropSubSig Rational
dur2 SubsigCT a
ss1) SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- Signal (SubsigCT a)
s1) Signal (SubsigCT b)
s2)
      | Bool
otherwise = String -> Signal (SubsigCT a, SubsigCT b)
forall a. HasCallStack => String -> a
error (String
"cutEq' pattern match error: dur1="String -> String -> String
forall a. [a] -> [a] -> [a]
++(Rational -> String
forall a. Show a => a -> String
show Rational
dur1)
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", dur2="String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> String
forall a. Show a => a -> String
show Rational
dur2)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
";")
      where dur1 :: Rational
dur1 = SubsigCT a -> Rational
forall a. (Num a, Show a) => SubsigCT a -> Rational
durationSS SubsigCT a
ss1
            dur2 :: Rational
dur2 = SubsigCT b -> Rational
forall a. (Num a, Show a) => SubsigCT a -> Rational
durationSS SubsigCT b
ss2

unzipCT :: Num a => Signal ((SubsigCT a), (SubsigCT b)) 
        -> (Signal (SubsigCT a), Signal (SubsigCT b))
unzipCT :: Signal (SubsigCT a, SubsigCT b)
-> (Signal (SubsigCT a), Signal (SubsigCT b))
unzipCT Signal (SubsigCT a, SubsigCT b)
NullS = (Signal (SubsigCT a)
forall a. Signal a
NullS, Signal (SubsigCT b)
forall a. Signal a
NullS)
unzipCT ((SubsigCT a
ss1,SubsigCT b
ss2) :- Signal (SubsigCT a, SubsigCT b)
s) = (SubsigCT a
ss1SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:-Signal (SubsigCT a)
s1, SubsigCT b
ss2SubsigCT b -> Signal (SubsigCT b) -> Signal (SubsigCT b)
forall a. a -> Signal a -> Signal a
:-Signal (SubsigCT b)
s2)
    where (Signal (SubsigCT a)
s1,Signal (SubsigCT b)
s2) = Signal (SubsigCT a, SubsigCT b)
-> (Signal (SubsigCT a), Signal (SubsigCT b))
forall a b.
Num a =>
Signal (SubsigCT a, SubsigCT b)
-> (Signal (SubsigCT a), Signal (SubsigCT b))
unzipCT Signal (SubsigCT a, SubsigCT b)
s

-- The take and drop functions on CT signals:
takeCT :: (Num a, Show a) => 
          Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
takeCT :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
takeCT Rational
_ Signal (SubsigCT a)
NullS = Signal (SubsigCT a)
forall a. Signal a
NullS
takeCT Rational
0 Signal (SubsigCT a)
_     = Signal (SubsigCT a)
forall a. Signal a
NullS
takeCT Rational
c (SubsigCT a
ss:-Signal (SubsigCT a)
s) | (SubsigCT a -> Rational
forall a. (Num a, Show a) => SubsigCT a -> Rational
durationSS SubsigCT a
ss) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
c = (Rational -> SubsigCT a -> SubsigCT a
forall a. (Num a, Show a) => Rational -> SubsigCT a -> SubsigCT a
takeSubSig Rational
c SubsigCT a
ss) SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- Signal (SubsigCT a)
forall a. Signal a
NullS
                 | Bool
otherwise    = SubsigCT a
ss SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- (Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
takeCT (Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (SubsigCT a -> Rational
forall a. (Num a, Show a) => SubsigCT a -> Rational
durationSS SubsigCT a
ss)) Signal (SubsigCT a)
s)

dropCT :: (Num a, Show a) =>
          Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
dropCT :: Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
dropCT Rational
_ Signal (SubsigCT a)
NullS   = Signal (SubsigCT a)
forall a. Signal a
NullS
dropCT Rational
0 Signal (SubsigCT a)
s   = Signal (SubsigCT a)
s
dropCT Rational
c (SubsigCT a
ss:-Signal (SubsigCT a)
s) | (SubsigCT a -> Rational
forall a. (Num a, Show a) => SubsigCT a -> Rational
durationSS SubsigCT a
ss Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
c) = Rational -> SubsigCT a -> SubsigCT a
forall a. (Num a, Show a) => Rational -> SubsigCT a -> SubsigCT a
dropSubSig Rational
c SubsigCT a
ss SubsigCT a -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a. a -> Signal a -> Signal a
:- Signal (SubsigCT a)
s
                 | Bool
otherwise       = Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> Signal (SubsigCT a)
dropCT (Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (SubsigCT a -> Rational
forall a. (Num a, Show a) => SubsigCT a -> Rational
durationSS SubsigCT a
ss)) Signal (SubsigCT a)
s

-- The interval length of a signal:
duration :: (Num a, Show a) => Signal (SubsigCT a) -> Rational
duration :: Signal (SubsigCT a) -> Rational
duration Signal (SubsigCT a)
NullS = Rational
0
duration (SubsigCT a
ss:- Signal (SubsigCT a)
s) = (SubsigCT a -> Rational
forall a. (Num a, Show a) => SubsigCT a -> Rational
durationSS SubsigCT a
ss) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Signal (SubsigCT a) -> Rational
forall a. (Num a, Show a) => Signal (SubsigCT a) -> Rational
duration Signal (SubsigCT a)
s)  

-- The interval length of a sub-signal:
durationSS :: (Num a, Show a) => (SubsigCT a) -> Rational
durationSS :: SubsigCT a -> Rational
durationSS (SubsigCT (Rational -> a
_, (Rational
a,Rational
b))) = Rational
bRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
a

-- The start time of a signal:
startTime :: (Num a, Show a) => Signal (SubsigCT a) -> Rational
startTime :: Signal (SubsigCT a) -> Rational
startTime Signal (SubsigCT a)
NullS = Rational
0
startTime (SubsigCT (Rational -> a
_,(Rational
a,Rational
_)) :- Signal (SubsigCT a)
_) = Rational
a

-- The take and drop functions for sub-signals:
takeSubSig :: (Num a, Show a) => Rational -> (SubsigCT a) -> (SubsigCT a)
takeSubSig :: Rational -> SubsigCT a -> SubsigCT a
takeSubSig Rational
c (SubsigCT (Rational -> a
f,(Rational
a,Rational
b))) | Rational
c Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= (Rational
bRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
a) = (Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
f,(Rational
a,Rational
b))
                                  | Bool
otherwise  = (Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
f,(Rational
a,Rational
aRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
c))


dropSubSig :: (Num a, Show a) => Rational -> (SubsigCT a) -> (SubsigCT a)
dropSubSig :: Rational -> SubsigCT a -> SubsigCT a
dropSubSig Rational
c (SubsigCT (Rational -> a
f,(Rational
a,Rational
b))) | Rational
c Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> (Rational
bRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
a) = (Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
f,(Rational
b,Rational
b))
                                  | Bool
otherwise = (Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
f,(Rational
aRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
c,Rational
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 :: Rational -> Signal (SubsigCT a) -> [(Rational, a)]
sample Rational
_ Signal (SubsigCT a)
NullS = []
sample Rational
step (SubsigCT a
ss :- Signal (SubsigCT a)
s) = Rational -> SubsigCT a -> [(Rational, a)]
forall a.
(Num a, Show a) =>
Rational -> SubsigCT a -> [(Rational, a)]
sampleSubsig Rational
step SubsigCT a
ss [(Rational, a)] -> [(Rational, a)] -> [(Rational, a)]
forall a. [a] -> [a] -> [a]
++ (Rational -> Signal (SubsigCT a) -> [(Rational, a)]
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> [(Rational, a)]
sample Rational
step Signal (SubsigCT a)
s)

-- sampleSubsig samples a Subsig signal:
sampleSubsig :: (Num a, Show a) => Rational -> (SubsigCT  a) -> [(Rational,a)]
sampleSubsig :: Rational -> SubsigCT a -> [(Rational, a)]
sampleSubsig Rational
step (SubsigCT (Rational -> a
f,(Rational
a,Rational
b)))
  | Rational
bRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
a = (Rational
a,(Rational -> a
f Rational
a)) (Rational, a) -> [(Rational, a)] -> [(Rational, a)]
forall a. a -> [a] -> [a]
: (Rational -> SubsigCT a -> [(Rational, a)]
forall a.
(Num a, Show a) =>
Rational -> SubsigCT a -> [(Rational, a)]
sampleSubsig Rational
step ((Rational -> a, (Rational, Rational)) -> SubsigCT a
forall a. (Rational -> a, (Rational, Rational)) -> SubsigCT a
SubsigCT (Rational -> a
f,(Rational
aRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
step,Rational
b))))
  | Bool
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 :: Signal (SubsigCT a) -> [(Double, Double)]
showParts Signal (SubsigCT a)
NullS = []
showParts (SubsigCT (Rational -> a
_,(Rational
a,Rational
b)):-Signal (SubsigCT a)
s) = (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
a,Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
b) (Double, Double) -> [(Double, Double)] -> [(Double, Double)]
forall a. a -> [a] -> [a]
: (Signal (SubsigCT a) -> [(Double, Double)]
forall a.
(Num a, Show a) =>
Signal (SubsigCT a) -> [(Double, Double)]
showParts Signal (SubsigCT a)
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 :: Signal (SubsigCT a) -> IO String
plot Signal (SubsigCT a)
s = Rational -> [Signal (SubsigCT a)] -> IO String
forall a.
(Num a, Show a) =>
Rational -> [Signal (SubsigCT a)] -> IO String
plotCT Rational
step [Signal (SubsigCT a)
s]
  where step :: Rational
step = (Signal (SubsigCT a) -> Rational
forall a. (Num a, Show a) => Signal (SubsigCT a) -> Rational
duration Signal (SubsigCT a)
s) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
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 :: Rational -> [Signal (SubsigCT a)] -> IO String
plotCT Rational
step [Signal (SubsigCT a)]
sigs = Rational -> [(Signal (SubsigCT a), String)] -> IO String
forall a.
(Num a, Show a) =>
Rational -> [(Signal (SubsigCT a), String)] -> IO String
plotCT' Rational
step ((Signal (SubsigCT a) -> (Signal (SubsigCT a), String))
-> [Signal (SubsigCT a)] -> [(Signal (SubsigCT a), String)]
forall a b. (a -> b) -> [a] -> [b]
map (\ Signal (SubsigCT a)
s -> (Signal (SubsigCT a)
s,String
"")) [Signal (SubsigCT a)]
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' :: Rational -> [(Signal (SubsigCT a), String)] -> IO String
plotCT' Rational
_ [] = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return []
plotCT' Rational
0 [(Signal (SubsigCT a), String)]
_    = String -> IO String
forall a. HasCallStack => String -> a
error String
"plotCT: Cannot compute signal with step=0.\n"
plotCT' Rational
step [(Signal (SubsigCT a), String)]
sigs = [(Int, String, [(Rational, a)])] -> IO String
forall a.
(Num a, Show a) =>
[(Int, String, [(Rational, a)])] -> IO String
plotSig (Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
forall a.
(Num a, Show a) =>
Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
expandSig Int
1 [(Signal (SubsigCT a), String)]
sigs)
  where 
    expandSig :: (Num a, Show a) => 
                 Int -> [(Signal (SubsigCT a),String)] 
              -> [(Int,String,[(Rational,a)])]
    expandSig :: Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
expandSig Int
_ [] = []
    expandSig Int
i ((Signal (SubsigCT a)
sig,String
label):[(Signal (SubsigCT a), String)]
sigs) 
      = (Int
i, String
label, (Rational -> Signal (SubsigCT a) -> [(Rational, a)]
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> [(Rational, a)]
sample Rational
step Signal (SubsigCT a)
sig)) (Int, String, [(Rational, a)])
-> [(Int, String, [(Rational, a)])]
-> [(Int, String, [(Rational, a)])]
forall a. a -> [a] -> [a]
: (Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
forall a.
(Num a, Show a) =>
Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
expandSig (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Signal (SubsigCT a), String)]
sigs)
    plotSig :: (Num a, Show a) => [(Int,String,[(Rational,a)])] -> IO String
    plotSig :: [(Int, String, [(Rational, a)])] -> IO String
plotSig [(Int, String, [(Rational, a)])]
sigs 
      = do String -> IO ()
mkDir String
"./fig"
           [(Int, String, [(Rational, a)])] -> IO ()
forall a.
(Num a, Show a) =>
[(Int, String, [(Rational, a)])] -> IO ()
writeDatFiles [(Int, String, [(Rational, a)])]
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:
           String
fname <- Int -> (String -> IO ()) -> IO String
tryNTimes Int
10 
                    (\ String
file -> (String -> String -> IO ()
writeFile String
file
                                ([(String, String)] -> String
mkPlotScript (((Int, String, [(Rational, a)]) -> (String, String))
-> [(Int, String, [(Rational, a)])] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String, [(Rational, a)]) -> (String, String)
forall a. (Int, String, a) -> (String, String)
mkDatFileName [(Int, String, [(Rational, a)])]
sigs))))
           -- We fire up gnuplot:
           ExitCode
_ <- String -> IO ExitCode
system (String
"gnuplot -persist " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname)
           -- We return some reporting string:
           String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Signal(s) " String -> String -> String
forall a. [a] -> [a] -> [a]
++([(Int, String, [(Rational, a)])] -> String
forall a. Num a => [(Int, String, [(Rational, a)])] -> String
mkAllLabels [(Int, String, [(Rational, a)])]
sigs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" plotted.")
    writeDatFiles :: [(Int, String, [(Rational, a)])] -> IO ()
writeDatFiles [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    writeDatFiles (s :: (Int, String, [(Rational, a)])
s@(Int
_, String
_, [(Rational, a)]
sig): [(Int, String, [(Rational, a)])]
sigs)
      = do String -> String -> IO ()
writeFile ((String, String) -> String
forall a b. (a, b) -> a
fst ((Int, String, [(Rational, a)]) -> (String, String)
forall a. (Int, String, a) -> (String, String)
mkDatFileName (Int, String, [(Rational, a)])
s)) ([(Rational, a)] -> String
forall a. (Num a, Show a) => [(Rational, a)] -> String
dumpSig [(Rational, a)]
sig)
           [(Int, String, [(Rational, a)])] -> IO ()
writeDatFiles [(Int, String, [(Rational, a)])]
sigs
    mkDatFileName :: (Int,String,a) -> (String,String)
    mkDatFileName :: (Int, String, a) -> (String, String)
mkDatFileName (Int
sigid,String
label,a
_) = (String
"./fig/ct-moc-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String -> String
replChar String
">" String
label) 
                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++(Int -> String
forall a. Show a => a -> String
show Int
sigid)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
".dat", 
                                     (String -> Int -> String
mkLabel String
label Int
sigid))
    mkLabel :: String -> Int -> String
    mkLabel :: String -> Int -> String
mkLabel String
"" Int
n = String
"sig-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n 
    mkLabel String
l Int
_  = String
l
    mkAllLabels :: (Num a) => [(Int,String,[(Rational,a)])] -> String
    mkAllLabels :: [(Int, String, [(Rational, a)])] -> String
mkAllLabels [(Int, String, [(Rational, a)])]
sigs = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 ((String -> (Int, String, [(Rational, a)]) -> String)
-> String -> [(Int, String, [(Rational, a)])] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> (Int, String, [(Rational, a)]) -> String
forall c. String -> (Int, String, c) -> String
f String
"" [(Int, String, [(Rational, a)])]
sigs)
      where f :: String -> (Int, String, c) -> String
f String
labelString (Int
n,String
label,c
_) 
              = String
labelString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> Int -> String
mkLabel String
label Int
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 :: String -> String -> String
replChar [] String
s = String
s
    replChar String
_ [] = []
    replChar String
replSet (Char
c:String
s) | Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c String
replSet = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: (String -> String -> String
replChar String
replSet String
s)
                           | Bool
otherwise  = Char
c   Char -> String -> String
forall a. a -> [a] -> [a]
: (String -> String -> String
replChar String
replSet String
s)

    dumpSig :: (Num a, Show a) => [(Rational,a)] -> String
    dumpSig :: [(Rational, a)] -> String
dumpSig [(Rational, a)]
points = ((Rational, a) -> String) -> [(Rational, a)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Rational, a) -> String
forall a. Show a => (Rational, a) -> String
f [(Rational, a)]
points
      where f :: (Rational, a) -> String
f (Rational
x,a
y) = Float -> String
forall a. Show a => a -> String
show ((Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
x) :: Float) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    " 
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (a
y) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

    mkPlotScript :: [(String  -- the file name of the dat file
                     ,String  -- the label for the signal to be drawn
                     )] -> String  -- the gnuplot script
    mkPlotScript :: [(String, String)] -> String
mkPlotScript [(String, String)]
ns = String
"set xlabel \"seconds\" \n"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"plot " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(String, String)] -> String
f1 [(String, String)]
ns) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"set terminal postscript eps color\n"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"set output \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
plotFileNameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
".eps\"\n"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"replot \n"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"set terminal epslatex color\n"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"set output \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
plotFileNameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"-latex.eps\"\n"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"replot\n"
                      -- ++ "set terminal pdf\n"
                      -- ++ "set output \"fig/ct-moc-graph.pdf\"\n"
                      -- ++ "replot\n"
      where f1 :: [(String,String)] -> String
            f1 :: [(String, String)] -> String
f1 ((String
datfilename,String
label):((String, String)
n:[(String, String)]
ns)) 
              = String
"\t\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
datfilename
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" with linespoints title \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
labelString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\",\\\n"
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(String, String)] -> String
f1 ((String, String)
n(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:[(String, String)]
ns))
            f1 ((String
datfilename,String
label):[]) 
              = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
datfilename 
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" with linespoints title \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
labelString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\"\n"
            f1 [] = String
""
            plotFileName :: String
plotFileName = String
"fig/ct-moc-graph-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(String, String)] -> String
f2 [(String, String)]
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 :: [(String, String)] -> String
f2 [] = String
""
            f2 ((String
_,String
label):[]) = String
label
            f2 ((String
_,String
label):[(String, String)]
_) = String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
    -- 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 :: Int -> (String -> IO ()) -> IO String
tryNTimes Int
n String -> IO ()
a | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> IO String
forall a. HasCallStack => String -> a
error String
"tryNTimes: not succedded"
                  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = 
                      do IO String -> (IOError -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Except.catch (String -> (String -> IO ()) -> IO String
action String
fname String -> IO ()
a) ((String -> IO ()) -> IOError -> IO String
handler String -> IO ()
a)
                           where handler :: (String -> IO()) -> IOError -> IO String
                                 handler :: (String -> IO ()) -> IOError -> IO String
handler String -> IO ()
a IOError
_ = Int -> (String -> IO ()) -> IO String
tryNTimes (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String -> IO ()
a
                                 fname :: String
fname = String
"./fig/ct-moc-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".gnuplot"
                                 action :: String -> (String -> IO ()) -> IO String
                                 action :: String -> (String -> IO ()) -> IO String
action String
fname String -> IO ()
a = do (String -> IO ()
a String
fname)
                                                     String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fname
    tryNTimes Int
_ String -> IO ()
_ = String -> IO String
forall a. HasCallStack => String -> a
error String
"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 :: Rational -> [(Signal (SubsigCT a), String)] -> IO String
vcdGen Rational
_ [] = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return []
vcdGen Rational
0    [(Signal (SubsigCT a), String)]
_  = String -> IO String
forall a. HasCallStack => String -> a
error String
"vcdgen: Cannot compute signals with step=0.\n"
vcdGen Rational
step [(Signal (SubsigCT a), String)]
sigs = 
    do 
  -- putStr (show (distLabels (expandSig 1 sigs)))
  [(Int, String, [(Rational, a)])] -> IO String
forall a.
(Num a, Show a) =>
[(Int, String, [(Rational, a)])] -> IO String
plotSig (Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
forall a.
(Num a, Show a) =>
Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
expandSig Int
1 [(Signal (SubsigCT a), String)]
sigs)
    where 
  expandSig :: (Num a, Show a) => 
       Int -> [(Signal (SubsigCT a),String)] 
           -> [(Int,String,[(Rational,a)])]
  expandSig :: Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
expandSig Int
_ [] = []
  expandSig Int
i ((Signal (SubsigCT a)
sig,String
label):[(Signal (SubsigCT a), String)]
sigs) 
      = (Int
i, String
label, (Rational -> Signal (SubsigCT a) -> [(Rational, a)]
forall a.
(Num a, Show a) =>
Rational -> Signal (SubsigCT a) -> [(Rational, a)]
sample Rational
step Signal (SubsigCT a)
sig)) (Int, String, [(Rational, a)])
-> [(Int, String, [(Rational, a)])]
-> [(Int, String, [(Rational, a)])]
forall a. a -> [a] -> [a]
: (Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
forall a.
(Num a, Show a) =>
Int
-> [(Signal (SubsigCT a), String)]
-> [(Int, String, [(Rational, a)])]
expandSig (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Signal (SubsigCT a), String)]
sigs)
  plotSig :: (Num a, Show a) => [(Int,String,[(Rational,a)])] -> IO String
  plotSig :: [(Int, String, [(Rational, a)])] -> IO String
plotSig [(Int, String, [(Rational, a)])]
sigs 
      = do [(Int, String, [(Rational, a)])] -> IO ()
forall a. Show a => [(Int, String, [(Rational, a)])] -> IO ()
writeVCDFile [(Int, String, [(Rational, a)])]
sigs
           -- We return some reporting string:
           String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Signal(s) " String -> String -> String
forall a. [a] -> [a] -> [a]
++([(Int, String, [(Rational, a)])] -> String
forall (t :: * -> *) c. Foldable t => t (Int, String, c) -> String
mkAllLabels [(Int, String, [(Rational, a)])]
sigs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" dumped.")
  mkLabel :: String -> Int -> String
  mkLabel :: String -> Int -> String
mkLabel String
"" Int
n = String
"sig-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n 
  mkLabel String
l Int
_  = String
l
  mkAllLabels :: t (Int, String, c) -> String
mkAllLabels t (Int, String, c)
sigs = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 ((String -> (Int, String, c) -> String)
-> String -> t (Int, String, c) -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> (Int, String, c) -> String
forall c. String -> (Int, String, c) -> String
f String
"" t (Int, String, c)
sigs)
      where f :: String -> (Int, String, c) -> String
f String
labelString (Int
n,String
label,c
_) 
              = String
labelString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> Int -> String
mkLabel String
label Int
n)
  writeVCDFile :: (Show a) => [(Int,String,[(Rational,a)])] -> IO()
  writeVCDFile :: [(Int, String, [(Rational, a)])] -> IO ()
writeVCDFile [(Int, String, [(Rational, a)])]
sigs
    = do String -> IO ()
mkDir String
"./fig"
         ClockTime
clocktime <- IO ClockTime
getClockTime
         let {date :: String
date = CalendarTime -> String
calendarTimeToString (ClockTime -> CalendarTime
toUTCTime ClockTime
clocktime);
              labels :: [String]
labels = [(Int, String, [(Rational, a)])] -> [String]
forall a. [(Int, String, [(Rational, a)])] -> [String]
getLabels [(Int, String, [(Rational, a)])]
sigs;
              timescale :: Rational
timescale = [(Int, String, [(Rational, a)])] -> Rational
forall a. [(Int, String, [(Rational, a)])] -> Rational
findTimescale [(Int, String, [(Rational, a)])]
sigs;}
           in String -> String -> IO ()
writeFile String
mkVCDFileName ((Rational -> [String] -> String -> String
vcdHeader Rational
timescale [String]
labels String
date)
                                       String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> [(Rational, [(String, a)])] -> String
forall a.
Show a =>
Rational -> [(Rational, [(String, a)])] -> String
valueDump Rational
timescale ([(Int, String, [(Rational, a)])] -> [(Rational, [(String, a)])]
forall a.
Show a =>
[(Int, String, [(Rational, a)])] -> [(Rational, [(String, a)])]
prepSigValues [(Int, String, [(Rational, a)])]
sigs)))
  mkVCDFileName :: String
  mkVCDFileName :: String
mkVCDFileName = (String
"./fig/ct-moc.vcd")

mkDir :: String -> IO()
mkDir :: String -> IO ()
mkDir String
dir = do Bool
dirExists <- String -> IO Bool
doesDirectoryExist String
dir
               if (Bool -> Bool
not Bool
dirExists) 
                 then (String -> IO ()
createDirectory String
dir) 
                 else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 :: [(Int, String, [(Rational, a)])] -> [(Rational, [(String, a)])]
prepSigValues [(Int, String, [(Rational, a)])]
sigs = [[(String, Rational, a)]] -> [(Rational, [(String, a)])]
forall a.
Show a =>
[[(String, Rational, a)]] -> [(Rational, [(String, a)])]
f2 ([(Int, String, [(Rational, a)])] -> [[(String, Rational, a)]]
forall a.
[(Int, String, [(Rational, a)])] -> [[(String, Rational, a)]]
distLabels [(Int, String, [(Rational, a)])]
sigs)
    where 
  -- f2 transforms a [[(label,time,value)]] 
  -- into a [(time, [label,value])] structure:
  f2 :: (Show a) 
    => [[(String,Rational,a)]] -> [(Rational,[(String,a)])]
  f2 :: [[(String, Rational, a)]] -> [(Rational, [(String, a)])]
f2 [] = []
  f2 ([]:[[(String, Rational, a)]]
_) = []  
  f2 [[(String, Rational, a)]]
xs = [(String, Rational, a)] -> (Rational, [(String, a)])
forall a.
Show a =>
[(String, Rational, a)] -> (Rational, [(String, a)])
f3 [(String, Rational, a)]
hdxs (Rational, [(String, a)])
-> [(Rational, [(String, a)])] -> [(Rational, [(String, a)])]
forall a. a -> [a] -> [a]
: [[(String, Rational, a)]] -> [(Rational, [(String, a)])]
forall a.
Show a =>
[[(String, Rational, a)]] -> [(Rational, [(String, a)])]
f2 [[(String, Rational, a)]]
tailxs
      where 
    -- here we take all first elements of the lists in xs
    -- and the tail of the lists in xs:
    ([(String, Rational, a)]
hdxs,[[(String, Rational, a)]]
tailxs) = (([(String, Rational, a)] -> (String, Rational, a))
-> [[(String, Rational, a)]] -> [(String, Rational, a)]
forall a b. (a -> b) -> [a] -> [b]
map [(String, Rational, a)] -> (String, Rational, a)
forall p. [p] -> p
g1 [[(String, Rational, a)]]
xs,
             ([(String, Rational, a)] -> [(String, Rational, a)])
-> [[(String, Rational, a)]] -> [[(String, Rational, a)]]
forall a b. (a -> b) -> [a] -> [b]
map (\ ((String, Rational, a)
_:[(String, Rational, a)]
ys)-> [(String, Rational, a)]
ys) [[(String, Rational, a)]]
xs)
    g1 :: [p] -> p
g1 [] = String -> p
forall a. HasCallStack => String -> a
error (String
"prepSig.f2.g1: first element of xs is empty:"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"xs="String -> String -> String
forall a. [a] -> [a] -> [a]
++[[(String, Rational, a)]] -> String
forall a. Show a => a -> String
show [[(String, Rational, a)]]
xs)
    g1 (p
y:[p]
_) = p
y
    f3 :: (Show a) 
      => [(String,Rational,a)] -> (Rational,[(String,a)])
    f3 :: [(String, Rational, a)] -> (Rational, [(String, a)])
f3 (valList :: [(String, Rational, a)]
valList@((String
_, Rational
time, a
_):[(String, Rational, a)]
_)) = (Rational
time, Rational -> [(String, Rational, a)] -> [(String, a)]
forall a.
Show a =>
Rational -> [(String, Rational, a)] -> [(String, a)]
f4 Rational
time [(String, Rational, a)]
valList)
    f3 [] = String -> (Rational, [(String, a)])
forall a. HasCallStack => String -> a
error (String
"prepSigValues.f2.f3: "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"empty (label,time,value)-list")
    f4 :: (Show a) 
      => Rational -> [(String,Rational,a)] -> [(String,a)]
    f4 :: Rational -> [(String, Rational, a)] -> [(String, a)]
f4 Rational
_ [] = []
    f4 Rational
time ((String
label,Rational
time1,a
value):[(String, Rational, a)]
valList) 
       | Rational
time Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
time1 = (String
label,a
value) (String, a) -> [(String, a)] -> [(String, a)]
forall a. a -> [a] -> [a]
: Rational -> [(String, Rational, a)] -> [(String, a)]
forall a.
Show a =>
Rational -> [(String, Rational, a)] -> [(String, a)]
f4 Rational
time [(String, Rational, a)]
valList
       | Bool
otherwise 
       = String -> [(String, a)]
forall a. HasCallStack => String -> a
error (String
"prepSigValues: Time stamps in different"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" signals do not match: time="
            String -> String -> String
forall a. [a] -> [a] -> [a]
++(Rational -> String
forall a. Show a => a -> String
show Rational
time)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
", time1="String -> String -> String
forall a. [a] -> [a] -> [a]
++(Rational -> String
forall a. Show a => a -> String
show Rational
time1)
            String -> String -> String
forall a. [a] -> [a] -> [a]
++String
", label="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
labelString -> String -> String
forall a. [a] -> [a] -> [a]
++String
", value="String -> String -> String
forall a. [a] -> [a] -> [a]
++(a -> String
forall a. Show a => a -> String
show a
value)
            String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"!")
-- 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 :: [(Int, String, [(Rational, a)])] -> [[(String, Rational, a)]]
distLabels [] = []
distLabels ((Int
_,String
label,[(Rational, a)]
valList):[(Int, String, [(Rational, a)])]
sigs) 
    = (((Rational, a) -> (String, Rational, a))
-> [(Rational, a)] -> [(String, Rational, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Rational
t,a
v) -> (String
label,Rational
t,a
v)) [(Rational, a)]
valList) [(String, Rational, a)]
-> [[(String, Rational, a)]] -> [[(String, Rational, a)]]
forall a. a -> [a] -> [a]
: ([(Int, String, [(Rational, a)])] -> [[(String, Rational, a)]]
forall a.
[(Int, String, [(Rational, a)])] -> [[(String, Rational, a)]]
distLabels [(Int, String, [(Rational, a)])]
sigs)
getLabels :: [(Int,String,[(Rational,a)])] -> [String]
getLabels :: [(Int, String, [(Rational, a)])] -> [String]
getLabels = ((Int, String, [(Rational, a)]) -> String)
-> [(Int, String, [(Rational, a)])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_,String
label,[(Rational, a)]
_)-> String
label)
vcdHeader :: Rational -> [String] -> String -> String
vcdHeader :: Rational -> [String] -> String -> String
vcdHeader Rational
timescale [String]
labels String
date = String
"$date\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
date String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$end\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$version\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ForSyDe CTLib " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
revision String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$end\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$timescale 1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> String
timeunit Rational
timescale) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" $end\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$scope module top $end\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ String
label -> (String
"$var real 64 "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
label
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label 
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" $end\n")) [String]
labels)
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$upscope $end\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$enddefinitions $end\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"#0\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$dumpvars\n"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ String
label -> String
"r0.0 "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
labelString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") 
             [String]
labels)
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
valueDump :: (Show a) => Rational -> [(Rational,[(String,a)])] -> String
valueDump :: Rational -> [(Rational, [(String, a)])] -> String
valueDump Rational
_ [] = String
""
valueDump Rational
timescale ((Rational
t,[(String, a)]
values):[(Rational, [(String, a)])]
valList) 
  = String
"#"String -> String -> String
forall a. [a] -> [a] -> [a]
++(Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
g (Rational
tRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
timescale)))String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n" 
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(String, a)] -> String
forall a. Show a => [(String, a)] -> String
f [(String, a)]
values) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> [(Rational, [(String, a)])] -> String
forall a.
Show a =>
Rational -> [(Rational, [(String, a)])] -> String
valueDump Rational
timescale [(Rational, [(String, a)])]
valList)
  where 
    f :: (Show a) => [(String,a)] -> String
    f :: [(String, a)] -> String
f [] = String
""
    f ((String
l,a
v):[(String, a)]
values) = String
"r"String -> String -> String
forall a. [a] -> [a] -> [a]
++(a -> String
forall a. Show a => a -> String
show a
v)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
lString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(String, a)] -> String
forall a. Show a => [(String, a)] -> String
f [(String, a)]
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 :: Rational -> Integer
g Rational
t = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
t


timeunit :: Rational -> String
timeunit :: Rational -> String
timeunit Rational
timescale | Rational
timescale Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1    = String
"s"
       | Rational
timescale Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000 = String
"ms"
       | Rational
timescale Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000 = String
"us"
       | Rational
timescale Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000000 = String
"ns"
       | Rational
timescale Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000000000 = String
"ps"
       | Rational
timescale Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000000000000 = String
"fs"
       | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String
"timeunit: unexpected timescale: "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rational -> String
forall a. Show a => a -> String
show Rational
timescale))

findTimescale :: [(Int,String,[(Rational,a)])] -> Rational
findTimescale :: [(Int, String, [(Rational, a)])] -> Rational
findTimescale [(Int, String, [(Rational, a)])]
sigs 
    = Rational -> [Rational] -> Rational
f Rational
1 (((Int, String, [(Rational, a)]) -> [Rational])
-> [(Int, String, [(Rational, a)])] -> [Rational]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ (Int
_,String
_,[(Rational, a)]
valList) -> (([Rational], [a]) -> [Rational]
forall a b. (a, b) -> a
fst ([(Rational, a)] -> ([Rational], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Rational, a)]
valList))) [(Int, String, [(Rational, a)])]
sigs)
  where 
    f :: Rational -> [Rational] -> Rational
    f :: Rational -> [Rational] -> Rational
f Rational
scale [] = Rational
scale
    f Rational
scale (Rational
x:[Rational]
xs) | Rational
r Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0    = Rational -> [Rational] -> Rational
f Rational
scale [Rational]
xs
           | Bool
otherwise = Rational -> [Rational] -> Rational
f (Rational
scaleRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
1000) [Rational]
xs
           where (Int
_,Rational
r) = (Rational -> (Int, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational -> Rational
forall a. Num a => a -> a
abs (Rational
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
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))]
-}