module ForSyDe.Shallow.MoC.CT (
SubsigCT(..),
ctSignal,
liftCT,
timeStep,
mapCT, zipWithCT,
combCT, comb2CT,
delayCT, addTime,
scaleCT, addCT, multCT, absCT,
takeCT, dropCT, duration, startTime, sineWave,
DACMode(..), a2dConverter, d2aConverter,
applyF1, applyF2, applyG1, cutEq,
plot, plotCT, plotCT' ,showParts, vcdGen
) where
import ForSyDe.Shallow.Core
import System.Process
import System.Time
import System.Directory
import Control.Exception as Except
import Data.Ratio
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 $"
data SubsigCT a = SubsigCT ((Rational -> a),
(Rational,Rational))
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)
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
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
timeStep :: Rational
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)
scaleCT :: (Num a, Show a) =>
a
-> Signal (SubsigCT a)
-> Signal (SubsigCT a)
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 :: (Num a, Show a) =>
Signal (SubsigCT a)
-> Signal (SubsigCT a)
-> Signal (SubsigCT a)
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 :: (Num a, Show a) =>
Signal (SubsigCT a)
-> Signal (SubsigCT a)
-> Signal (SubsigCT a)
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 :: (Num a,Ord a, Show a) =>
Signal (SubsigCT a)
-> Signal (SubsigCT a)
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
sineWave :: (Floating a, Show a) =>
Rational
-> (Rational,Rational)
-> Signal (SubsigCT a)
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 :: 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))))
data DACMode = DAlinear
| DAhold
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 :: (Fractional a, Show a) =>
DACMode
-> Rational
-> Signal a
-> Signal (SubsigCT a)
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)
a2dConverter :: (Num a, Show a) =>
Rational
-> Signal (SubsigCT a)
-> Signal a
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]
applyF1 :: (Num a, Num b, Show a, Show b) =>
((Rational -> a) -> (Rational -> b))
-> Signal (SubsigCT a)
-> Signal (SubsigCT b)
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 :: (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 :: (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 :: (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
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
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)
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
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
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))
sample :: (Num a, Show a) =>
Rational
-> Signal (SubsigCT a)
-> [(Rational,a)]
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 :: (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 :: (Num a, Show a) =>
Signal (SubsigCT a)
-> [(Double,Double)]
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 :: (Num a, Show a) =>
Signal (SubsigCT a)
-> IO String
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 :: (Num a, Show a) =>
Rational
-> [Signal (SubsigCT a)]
-> IO String
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' :: (Num a, Show a) =>
Rational
-> [(Signal (SubsigCT a), String)]
-> IO String
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
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))))
ExitCode
_ <- String -> IO ExitCode
system (String
"gnuplot -persist " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname)
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
-> String
-> String
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
,String
)] -> String
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"
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 :: [(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 :: 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 :: (Num a, Show a)
=> Rational
-> [(Signal (SubsigCT a), String)]
-> IO String
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
[(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
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 :: (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 :: (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
([(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 :: [(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
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
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)