Commit 05368fd3 authored by simonm's avatar simonm

[project @ 1997-09-03 15:33:15 by simonm]

Add David Barton's example which shows up a couple of bugs:
	-> not parsed correctly in interface files
	mangler bug when compiling with -monly-n-regs
parent 2220d42a
{-# OPTIONS -H12m #-}
module Basic where
import TypesettingTricks
import Physical
--import GHC( (->) )
infixr 7 |>
class Signal s where
mapSignal:: (Physical a, Physical b) => (s a b) -> a -> b
mapSigList:: (Physical a, Physical b) => (s a b) -> [a] -> [b]
toSig:: (Physical a, Physical b) => (s a b) -> SignalRep a b
mapSignal = mapSignal . toSig
mapSigList = map . mapSignal
toSig = FunctionRep . mapSignal
instance Signal (->) where
mapSignal f = f
toSig = FunctionRep
data {- (Physical a, Physical b) => -} SignalRep a b =
FunctionRep (a -> b) |
PieceContRep (PieceCont a b)
deriving (Eq, Show)
instance Signal SignalRep where
mapSignal (FunctionRep f) = mapSignal f
mapSignal (PieceContRep f) = mapSignal f
mapSigList (FunctionRep f) = mapSigList f
mapSigList (PieceContRep f) = mapSigList f
toSig = id
instance (Physical a, Physical b) => Eq (a -> b) where
a == b = error "Attempt to apply equality to functions"
binop:: (Physical a, Physical b) => (Float -> Float -> Float) ->
(a -> b) -> (a -> b) -> a -> b
binop op f g t = toPhysical ((fromPhysical (f t)) `op` (fromPhysical (g t)))
unop:: (Physical a, Physical b ) => (Float -> Float) ->
(a -> b) -> a -> b
unop op f t = toPhysical (op (fromPhysical (f t)))
instance (Physical a, Physical b) => Num (SignalRep a b) where
f + g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
f * g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
negate f = FunctionRep (unop negate (mapSignal f))
abs f = FunctionRep (unop abs (mapSignal f))
signum f = FunctionRep (unop abs (mapSignal f))
fromInteger i = FunctionRep (\t -> toPhysical (fromInteger i))
fromInt i = FunctionRep (\t -> toPhysical (fromInt i))
instance (Physical a, Physical b) =>
Fractional (SignalRep a b) where
f / g = FunctionRep (binop (/) (mapSignal f) (mapSignal g))
fromRational r = FunctionRep (\t -> (toPhysical (fromRational r)))
instance (Physical a, Physical b) =>
Floating (SignalRep a b) where
pi = FunctionRep (\t -> (toPhysical pi))
exp f = FunctionRep (unop exp (mapSignal f))
log f = FunctionRep (unop log (mapSignal f))
sin f = FunctionRep (unop sin (mapSignal f))
cos f = FunctionRep (unop cos (mapSignal f))
asin f = FunctionRep (unop asin (mapSignal f))
acos f = FunctionRep (unop acos (mapSignal f))
atan f = FunctionRep (unop atan (mapSignal f))
sinh f = FunctionRep (unop sinh (mapSignal f))
cosh f = FunctionRep (unop cosh (mapSignal f))
asinh f = FunctionRep (unop asinh (mapSignal f))
acosh f = FunctionRep (unop acosh (mapSignal f))
atanh f = FunctionRep (unop atanh (mapSignal f))
data Event =
TimeEvent Float |
FunctionEvent (Float -> Bool) |
BurstEvent Int Event
deriving (Show)
instance Eq Event where
(TimeEvent x) == (TimeEvent y) = x == y
(BurstEvent i e) == (BurstEvent i' e') = (i' == i) && (e' == e)
eventOccurs:: Event -> Float -> Float
eventOccurs (TimeEvent t) x = if x < t then x else t
eventOccurs (FunctionEvent f) x = stepEval f x
eventOccurs (BurstEvent i e) x =
if i == 1 then
eventOccurs e x
else
eventOccurs (BurstEvent (i-1) e) ((eventOccurs e x) + eventEps x)
stepEval:: (Float -> Bool) -> Float -> Float
stepEval f x = if f x then x else stepEval f (x + eventEps x)
data ZeroIndicator = LocalZero | GlobalZero deriving (Eq, Show)
data {- (Physical a, Physical b) => -} FunctionWindow a b =
Window ZeroIndicator Event (SignalRep a b)
deriving (Eq, Show)
data PieceCont a b = Windows [FunctionWindow a b]
deriving (Eq, Show)
instance Signal PieceCont where
mapSignal (Windows []) t = toPhysical 0.0
mapSignal (Windows wl) t = (mapSignal s) (toPhysical t')
where (t', (Window z e s), wl') = getWindow 0.0 (fromPhysical t) wl
toSig = PieceContRep
getWindow:: (Physical a, Physical b) =>
Float -> Float -> [ FunctionWindow a b ] ->
(Float, FunctionWindow a b, [ FunctionWindow a b ])
getWindow st t [] = (t, Window LocalZero e f, [])
where e = TimeEvent (realmul 2 t)
f = FunctionRep (\t -> toPhysical 0.0)
getWindow st t (w:wl) = if t' <= wt then (t',w,w:wl)
else getWindow (st+wt) t wl
where wt = eventOccurs e t'
(Window z e s) = w
t' = if z == LocalZero then t-st else t
(|>) :: (Physical a, Physical b) => FunctionWindow a b ->
PieceCont a b -> PieceCont a b
w |> (Windows wl) = Windows (w:wl)
nullWindow = Windows []
cycleWindows:: (Physical a, Physical b) =>
PieceCont a b -> PieceCont a b
cycleWindows (Windows wl) = Windows (cycle wl)
constant:: (Physical a, Physical b) => b -> SignalRep a b
constant x = FunctionRep (\t -> x)
linear:: (Physical a, Physical b) => Float -> b -> SignalRep a b
linear m b = FunctionRep (\x -> toPhysical (realmul m (fromPhysical x) + (fromPhysical b)))
sine:: (Physical a, Physical b) =>
b -> Frequency -> Float -> SignalRep a b
sine mag omeg phase = FunctionRep (\x -> toPhysical (realmul (fromPhysical mag) (sin (realmul (realmul (realmul 2 pi) (fromPhysical omeg)) (fromPhysical x) + phase))))
waveform:: (Physical a, Physical b) => a -> [b] -> SignalRep a b
waveform samp ampls =
let stepSlope y y' = realdiv ((fromPhysical y') - (fromPhysical y)) (fromPhysical samp)
makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp))
(linear (stepSlope v v') v)
points = cycle ampls
in PieceContRep (Windows (map makeWin (zip points (tail points))))
random:: (Physical a, Physical b) =>
Integer -> a -> SignalRep a b
random i s = waveform s (map toPhysical (rand i))
ramp:: (Physical a, Physical b) => a -> b -> SignalRep a b
ramp per v =
let sig = linear (realdiv (fromPhysical v) (fromPhysical per)) (toPhysical 0.0)
in PieceContRep (Windows (cycle ([Window LocalZero (TimeEvent (fromPhysical per)) sig ])))
triangle:: (Physical a, Physical b) => a -> b -> SignalRep a b
triangle per v =
let sl = realmul 2.0 (realdiv (fromPhysical v) (fromPhysical per))
qper = realdiv (fromPhysical v) 4.0
wins = (Window LocalZero (TimeEvent qper) (linear sl (toPhysical 0.0))) |>
(Window LocalZero (TimeEvent (realmul 2.0 qper)) (linear (- sl) v)) |>
(Window LocalZero (TimeEvent qper) (linear sl (toPhysical (- (fromPhysical v))))) |>
nullWindow
in PieceContRep (cycleWindows wins)
step:: (Physical a, Physical b) => a -> b -> SignalRep a b
step tr lvl = FunctionRep (\t -> if (fromPhysical t) < (fromPhysical tr) then (toPhysical 0.0) else lvl)
square:: (Physical a, Physical b) => a -> b -> SignalRep a b
square per lvl =
let trans = realdiv (fromPhysical per) 2.0
nlvl = asTypeOf (toPhysical (- (fromPhysical lvl))) lvl
f t = if (fromPhysical t) < trans then lvl else nlvl
wins = Windows [Window LocalZero (TimeEvent (fromPhysical per)) (FunctionRep f)]
in PieceContRep (cycleWindows wins)
pulse:: (Physical a, Physical b) => a -> a -> b -> SignalRep a b
pulse st wid lvl =
let tr = (fromPhysical st) + (fromPhysical wid)
f t = if (fromPhysical t) < (fromPhysical st) then (toPhysical 0.0)
else if (fromPhysical t) < tr then lvl else (toPhysical 0.0)
in FunctionRep f
trap:: (Physical a, Physical b) => a -> a -> a -> a -> b ->
SignalRep a b
trap st r wid f lvl =
let stepSlope y y' t = realdiv (y' - y) (fromPhysical t)
bigwin = realmul 10000000 ((fromPhysical st) + (fromPhysical wid))
wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
Window LocalZero (TimeEvent (fromPhysical r)) (linear (stepSlope 0.0 (fromPhysical lvl) r) (toPhysical 0.0)) |>
Window LocalZero (TimeEvent (fromPhysical wid)) (constant lvl) |>
Window LocalZero (TimeEvent (fromPhysical f)) (linear (stepSlope (fromPhysical lvl) 0.0 f) lvl) |>
Window LocalZero (TimeEvent bigwin) (constant (toPhysical 0.0)) |>
nullWindow
in PieceContRep wins
expc:: (Physical a, Physical b) => Float -> SignalRep a b
expc damp = FunctionRep (\t -> toPhysical (exp (- (realmul (fromPhysical t) damp))))
data {- (Physical indep, Physical dep) => -} BasicSignal indep dep =
Overshoot {start_delay::indep,
pulse_width::indep,
ringing::dep,
oscillation::Frequency,
damp_fac::Float}
| Pulse_dc {start_delay::indep,
pulse_width::indep,
rise_time::indep,
fall_time::indep,
period::indep,
dc_offset::dep,
amplitude::dep,
over::BasicSignal indep dep,
under::BasicSignal indep dep}
| Pulse_ac {start_delay::indep,
pulse_width::indep,
period::indep,
dc_offset::dep,
amplitude::dep,
frequency::Frequency,
phase::Float}
deriving (Eq, Show)
data {- (Eq a, Eq b) => -} Foo a b = Foo { x :: a, y :: b}
foo :: (Eq a, Eq b) => Foo a b
foo = Foo{}
{-
overshoot:: (Physical a, Physical b) => BasicSignal a b
overshoot = Overshoot{}
pulse_dc:: (Physical a, Physical b) => BasicSignal a b
pulse_dc = Pulse_dc {over = Overshoot{start_delay=toPhysical 0.0,
ringing=(toPhysical 0.0),
oscillation=toPhysical 1.0,
damp_fac=1.0},
under = Overshoot{start_delay=toPhysical 0.0,
ringing=(toPhysical 0.0),
oscillation=toPhysical 1.0,
damp_fac=1.0},
start_delay = toPhysical 0.0,
dc_offset = toPhysical 0.0}
pulse_ac:: (Physical a, Physical b) => BasicSignal a b
pulse_ac = Pulse_ac {dc_offset = toPhysical 0.0,
amplitude = toPhysical 0.0}
-}
makeWin:: (Physical a, Physical b) => a -> a ->
SignalRep a b -> SignalRep a b
makeWin st wid sig =
let wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
Window LocalZero (TimeEvent (fromPhysical wid)) sig |>
nullWindow
in PieceContRep wins
instance Signal BasicSignal where
toSig Overshoot{start_delay,pulse_width,
ringing,oscillation,damp_fac} =
let ring = sine ringing oscillation 0.0
cond = asTypeOf (expc damp_fac) ring
sig = temp ring cond
temp:: (Physical a, Physical b) => SignalRep a b ->
SignalRep a b -> SignalRep a b
temp f g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
-- temp f g = f * g
-- temp f g = asTypeOf (f * g) ring
wins = Window LocalZero (TimeEvent (fromPhysical start_delay)) (constant (toPhysical 0.0)) |>
Window LocalZero (TimeEvent (fromPhysical pulse_width)) sig |>
nullWindow
in PieceContRep wins
toSig Pulse_dc{start_delay,rise_time,pulse_width,fall_time,
dc_offset,period,amplitude,over,under} =
let pul = trap start_delay rise_time pulse_width fall_time amplitude
so = toPhysical ((fromPhysical start_delay) + (fromPhysical rise_time))
su = toPhysical ((fromPhysical so) + (fromPhysical pulse_width) + (fromPhysical fall_time))
oversh = toSig over{start_delay=so}
undersh = toSig under{start_delay=su}
off = constant dc_offset
temp:: (Physical a, Physical b) => SignalRep a b ->
SignalRep a b -> SignalRep a b
temp f g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
sig = temp (temp (temp pul oversh) undersh) off
wins = (Window LocalZero (TimeEvent (fromPhysical period)) sig) |>
nullWindow
in PieceContRep (cycleWindows wins)
sumSig:: (Physical a, Physical b, Signal s, Signal s') =>
(s a b) -> (s' a b) -> SignalRep a b
sumSig f f' =
let s1 t = fromPhysical (mapSignal f t)
s2 t = fromPhysical (mapSignal f' t)
in FunctionRep (\t -> toPhysical ((s1 t) + (s2 t)))
mulSig:: (Physical a, Physical b, Signal s, Signal s') =>
(s a b) -> (s' a b) -> SignalRep a b
mulSig f f' =
let f1 t = fromPhysical (mapSignal f t)
f2 t = fromPhysical (mapSignal f' t)
in FunctionRep (\t -> toPhysical ((f1 t) * (f2 t)))
eventEps:: Float -> Float
eventEps x = let eps = realdiv x 1000 in if 0.01 < eps then 0.01 else eps
module Bug where
data Eq a => Foo a = Foo { x :: a }
foo :: Foo Int
foo = Foo{}
module Main where
import Physical
import Basic
import TypesettingTricks
import PlotExample
sinExample:: SignalRep Time Voltage
sinExample = sine (V 2.0) (Hz 10) 0.0
sinPlot = plotExample "sine" sinExample 0.0 1.0
pieceExample = toSig Pulse_dc
{ start_delay=(Sec 1.0),
rise_time=(Sec 0.2),
pulse_width=(Sec 3.0),
fall_time=(Sec 0.3),
dc_offset=(V (- 1.0)),
period=(Sec 10.0),
amplitude=(V 5.0),
over=Overshoot{ringing=(V 0.2),
pulse_width=(Sec 3.0),
oscillation=(Hz 2.0),
damp_fac=1.0},
under=Overshoot{ringing=(V (- 0.25)),
pulse_width=(Sec 3.0),
oscillation=(Hz 2.10),
damp_fac=1.10} }
piecePlot = plotExample "piece" pieceExample 0.0 20.0
main = sinPlot >>
piecePlot
TOP = ../..
include $(TOP)/mk/boilerplate.mk
all :: runtest
include $(TOP)/mk/target.mk
module Physical where
import TypesettingTricks
class (Eq a, Show a) => Physical a where
fromPhysical:: a -> Float
toPhysical:: Float -> a
instance Physical Float where
fromPhysical x = x
toPhysical x = x
data PlaneAngle =
Rad Float |
Mrad Float |
Urad Float |
Deg Float |
Rev Float
deriving (Eq, Show)
instance Physical PlaneAngle where
fromPhysical (Rad x) = x
fromPhysical (Mrad x) = realdiv x 1000
fromPhysical (Urad x) = realdiv x 1000000
fromPhysical (Deg x) = realdiv (realmul x pi) 180
fromPhysical (Rev x) = realdiv x (realmul 2.0 pi)
toPhysical x = Rad x
data SolidAngle =
Sr Float |
Msr Float
deriving (Eq, Show)
instance Physical SolidAngle where
fromPhysical (Sr x) = x
fromPhysical (Msr x) = realdiv x 1000
toPhysical x = Sr x
data BurstLength =
Cycle Float |
Pulse Float
deriving (Eq, Show)
instance Physical BurstLength where
fromPhysical (Cycle x) = x
fromPhysical (Pulse x) = x
toPhysical x = Cycle x
data Capacitance =
Fd Float |
Ufd Float |
Nfd Float |
Pfd Float
deriving (Eq, Show)
instance Physical Capacitance where
fromPhysical (Fd x) = x
fromPhysical (Ufd x) = realdiv x 1000000
fromPhysical (Nfd x) = realdiv x 1000000000
fromPhysical (Pfd x) = realdiv x 1000000000000
toPhysical x = Fd x
data Charge =
C Float |
Kc Float |
Uc Float |
Nc Float
deriving (Eq, Show)
instance Physical Charge where
fromPhysical (C x) = x
fromPhysical (Kc x) = realmul 1000 x
fromPhysical (Uc x) = realdiv x 1000000
fromPhysical (Nc x) = realdiv x 1000000000
toPhysical x = C x
data Current =
A Float |
Ka Float |
Ma Float |
Ua Float |
Na Float
deriving (Eq, Show)
instance Physical Current where
fromPhysical (A x) = x
fromPhysical (Ka x) = realmul 1000 x
fromPhysical (Ma x) = realdiv x 1000
fromPhysical (Ua x) = realdiv x 1000000
fromPhysical (Na x) = realdiv x 1000000000
toPhysical x = A x
data Distance =
M Float |
Km Float |
Mm Float |
Um Float |
Nm Float |
In Float |
Ft Float |
SMi Float |
NMi Float
deriving (Eq, Show)
instance Physical Distance where
fromPhysical (M x) = x
fromPhysical (Km x) = realmul 1000 x
fromPhysical (Mm x) = realdiv x 1000
fromPhysical (Um x) = realdiv x 1000000
fromPhysical (Nm x) = realdiv x 1000000000
fromPhysical (In x) = realmul 25.4 x
fromPhysical (Ft x) = realmul 2.12 x
fromPhysical (SMi x) = realdiv x 2490.57
fromPhysical (NMi x) = realdiv x 1825
toPhysical x = M x
data Energy =
J Float |
Kj Float |
Mj Float |
Ev Float |
Kev Float |
Mev Float
deriving (Eq, Show)
instance Physical Energy where
fromPhysical (J x) = x
fromPhysical (Kj x) = realmul 1000 x
fromPhysical (Mj x) = realdiv x 1000
fromPhysical (Ev x) = realmul 1.6E-19 x
fromPhysical (Kev x) = realmul 1.6E-16 x
fromPhysical (Mev x) = realmul 1.6E-13 x
toPhysical x = J x
data MagFlux =
Wb Float |
Mwb Float
deriving (Eq, Show)
instance Physical MagFlux where
fromPhysical (Wb x) = x
fromPhysical (Mwb x) = realdiv x 1000
toPhysical x = Wb x
data FluxDensity =
T Float |
Mt Float |
Ut Float |
Gam Float
deriving (Eq, Show)
instance Physical FluxDensity where
fromPhysical (T x) = x
fromPhysical (Mt x) = realdiv x 1000
fromPhysical (Ut x) = realdiv x 1000000
fromPhysical (Gam x) = realdiv x 1000000000
toPhysical x = T x
data Force =
N Float |
Kn Float |
Mn Float |
Un Float
deriving (Eq, Show)
instance Physical Force where
fromPhysical (N x) = x
fromPhysical (Kn x) = realmul 1000 x
fromPhysical (Mn x) = realdiv x 1000
fromPhysical (Un x) = realdiv x 1000000
toPhysical x = N x
data Frequency =
Hz Float |
Khz Float |
Mhz Float |
Ghz Float
deriving (Eq, Show)
instance Physical Frequency where
fromPhysical (Hz x) = x
fromPhysical (Khz x) = realmul 1000 x
fromPhysical (Mhz x) = realmul 1000000 x
fromPhysical (Ghz x) = realmul 1000000000 x
toPhysical x = Hz x
data Illuminance =
Lx Float
deriving (Eq, Show)
instance Physical Illuminance where
fromPhysical (Lx x) = x
toPhysical x = Lx x
data Inductance =
H Float |
Mh Float |
Uh Float |
Nh Float |
Ph Float
deriving (Eq, Show)
instance Physical Inductance where
fromPhysical (H x) = x
fromPhysical (Mh x) = realdiv x 1000
fromPhysical (Uh x) = realdiv x 1000000
fromPhysical (Nh x) = realdiv x 1000000000
fromPhysical (Ph x) = realdiv x 1000000000000
toPhysical x = H x
data Luminance =
Nt Float
deriving (Eq, Show)
instance Physical Luminance where
fromPhysical (Nt x) = x
toPhysical x = Nt x
data LuminFlux =
Lm Float
deriving (Eq, Read, Show)
instance Physical LuminFlux where
fromPhysical (Lm x) = x
toPhysical x = Lm x
data LuminInten =
Cd Float
deriving (Eq, Read, Show)
instance Physical LuminInten where
fromPhysical (Cd x) = x
toPhysical x = Cd x
data Mass =
Kg Float |
G Float |
Mg Float |
Ug Float
deriving (Eq, Show)
instance Physical Mass where
fromPhysical (Kg x) = x
fromPhysical (G x) = realdiv x 1000
fromPhysical (Mg x) = realdiv x 1000000
fromPhysical (Ug x) = realdiv x 1000000000
toPhysical x = Kg x
data Power =
W Float |
Kw Float |
Mw Float |
Uw Float
deriving (Eq, Show)
instance Physical Power where
fromPhysical (W x) = x
fromPhysical (Kw x) = realmul 1000 x
fromPhysical (Mw x) = realdiv x 1000
fromPhysical (Uw x) = realdiv x 1000000
toPhysical x = W x
data Pressure =
Pa Float |
Kpa Float |
Mpa Float |
Upa Float |
Mb Float
deriving (Eq, Show)
instance Physical Pressure where
fromPhysical (Pa x) = x
fromPhysical (Kpa x) = realmul 1000 x
fromPhysical (Mpa x) = realdiv x 1000
fromPhysical (Upa x) = realdiv x 1000000
fromPhysical (Mb x) = realmul 100 x
toPhysical x = Pa x
data Pulse =
Pulses Float
deriving (Eq, Show)
instance Physical Pulse where
fromPhysical (Pulses x) = x
toPhysical x = Pulses x
data RatioInOut =
Db Float
deriving (Eq, Show)
instance Physical RatioInOut where
fromPhysical (Db x) = x
toPhysical x = Db x
data Resistance =
Ohm Float |
Kohm Float |
Mohm Float
deriving (Eq, Show)
instance Physical Resistance where
fromPhysical (Ohm x) = x
fromPhysical (Kohm x) = realmul 1000 x
fromPhysical (Mohm x) = realmul 1000000 x
toPhysical x = Ohm x
data Temperature =
Degk Float |
Degc Float |
Degf Float
deriving (Eq, Show)
instance Physical Temperature where
fromPhysical (Degk x) = x
fromPhysical (Degc x) = x + 273
fromPhysical (Degf x) = (realdiv (realmul 5 (x-32)) 9) + 273
toPhysical x = Degk x
data Time =
Sec Float |
Msec Float |
Usec Float |
Nsec Float |
Min Float |
Hr Float
deriving (Eq, Show)
instance Physical Time where
fromPhysical (Sec x) = x
fromPhysical (Msec x) = realdiv x 1000
fromPhysical (Usec x) = realdiv x 1000000
fromPhysical (Nsec x) = realdiv x 1000000000
fromPhysical (Min x) = realmul 60 x
fromPhysical (Hr x) = realmul 3600 x