[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

ghc/tests/programs/barton-mangler-bug/Basic.hs

+{-# 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

ghc/tests/programs/barton-mangler-bug/Bug.hs

+module Bug where
+
+data Eq a => Foo a = Foo { x :: a }
+
+foo :: Foo Int
+foo = Foo{}

ghc/tests/programs/barton-mangler-bug/Main.hs

+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

ghc/tests/programs/barton-mangler-bug/Makefile

+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+

ghc/tests/programs/barton-mangler-bug/Physical.hs

+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
+    toPhysical x = Sec x
+data Voltage =
+     V Float |
+     Kv Float |
+     Mv Float |
+     Uv Float
+     deriving (Eq, Show)
+instance Physical Voltage where
+    fromPhysical (V x) = x
+    fromPhysical (Kv x) = realmul 1000 x
+    fromPhysical (Mv x) = realdiv x 1000
+    fromPhysical (Uv x) = realdiv x 1000000
+    toPhysical x = V x
+data Volume =
+     L Float            |
+     Ml Float
+     deriving (Eq, Show)
+instance Physical Volume where
+    fromPhysical (L x) = x
+    fromPhysical (Ml x) = realdiv x 1000
+    toPhysical x = L x

ghc/tests/programs/barton-mangler-bug/Plot.lhs

+The functions in this file (well, the single function) will allow the
+user to plot different functions using the Gnuplot program.  In fact,
+all it really does is output a number of points on the list and allow
+the user to activate Gnuplot and use the plotting program to get the
+appropriate output.
+
+The first line just gives the module name.  For the moment, I don't
+anticipate using any modules (although this may change).
+
+> module Plot where
+> import IO
+
+Now we give the type of the function.  This consists of a file name, a
+list of values, and a function that goes from the appropriate types.
+
+> plot2d:: (Show a, Show b) => String -> [a] -> (a -> b) -> IO()
+> plot2d fl inp f = openFile fl WriteMode      >>= \flh ->
+>                   plot2d' flh inp f         >>
+>                   hClose flh
+
+> plot2d':: (Show a, Show b) => Handle -> [a] -> (a -> b) -> IO()
+> plot2d' fl [] f     = return ()
+> plot2d' fl (x:xs) f = hPutStr fl  (show x)        >>
+>                       hPutStr fl  "  "            >>
+>                       hPutStr fl  (show (f x))    >>
+>                       hPutStr fl  "\n"            >>
+>                       plot2d' fl xs f
+
+> plot3d:: (Show a, Show b, Show c) => String -> [a] -> [b] -> 
+>                                      (a -> b -> c) -> IO()
+> plot3d fl inp1 inp2 f = openFile fl WriteMode      >>= \flh ->
+>                         plot3d' flh inp1 inp2 f    >>
+>                         hClose flh
+
+> plot3d':: (Show a, Show b, Show c) => Handle -> [a] -> [b] -> 
+>                                       (a -> b -> c) -> IO()
+> plot3d' fl []     inp f = return ()
+> plot3d' fl (x:xs) inp f = plot3d'' fl x inp f           >>
+>                           hPutStr fl "\n"               >>
+>                           plot3d' fl xs inp f
+
+> plot3d'':: (Show a, Show b, Show c) => Handle -> a -> [b] -> 
+>                                        (a -> b -> c) -> IO()
+> plot3d'' fl inp [] f        = return ()
+> plot3d'' fl x (y:ys) f = hPutStr fl  (show x)        >>
+>                          hPutStr fl  "  "            >>
+>                          hPutStr fl  (show y)        >>
+>                          hPutStr fl  "  "            >>
+>                          hPutStr fl  (show (f x y))  >>
+>                          hPutStr fl  "\n"            >>
+>                          plot3d'' fl x ys f
+
+
+And now, let's create a function to make a range out of a triple of a
+start point, an end point, and an increment.
+
+> createRange:: (Num a, Ord a) => a -> a -> a -> [a]
+> createRange s e i = if s > e then []
+>                     else s : createRange (s+i) e i
+
+We now settle down to a couple of more specific functions that do
+things that are more unique to gnuplot.  First, we have something that
+creates the appropriate gnuplot command file.
+
+> createGnuPlot:: Show a => String -> a -> a -> IO()
+> createGnuPlot fl s e = openFile (fl ++ ".gnp") WriteMode   >>= \flh ->
+>                        hPutStr flh "set terminal latex\n"  >>
+>                        hPutStr flh "set output \""         >>
+>                        hPutStr flh (fl ++ ".tex\"\n")      >>
+>                        hPutStr flh "set nokey\n"           >>
+>                        hPutStr flh "plot ["                >>
+>                        hPutStr flh (show s)                >>
+>                        hPutStr flh ":"                     >>
+>                        hPutStr flh (show e)                >>
+>                        hPutStr flh "] \""                  >>
+>                        hPutStr flh (fl ++ ".plt\"")        >>
+>                        hPutStr flh " with lines\n"         >>
+>                        hClose  flh
+
+And now we create a fairly specific plotExam function that takes a
+string, a function, and two floats and produces the correct files
+
+> plotExam:: String -> Float -> Float -> (Float -> Float) -> IO()
+> plotExam fl s e f = plot2d (fl++".plt") r f                >>
+>                     createGnuPlot fl s e
+>               where r = createRange s e ((e - s) / 2500)

ghc/tests/programs/barton-mangler-bug/PlotExample.lhs

+This file contains code that is explicitly designed to plot examples
+from the signal modeling language.
+
+> module PlotExample where
+
+> import Plot
+> import Physical
+> import Basic
+
+Our main task is to take a signal and a begin and start point (both
+reals) and convert it into something that plotExam can take in the
+Plot module.
+
+> plotExample:: (Signal s, Physical a, Physical b) =>
+>               String -> s a b -> Float -> Float -> IO()
+> plotExample fl sig s e = plotExam fl s e f
+>                    where f  = toFloatFunc f'
+>                          f' = mapSignal sig
+
+> toFloatFunc:: (Physical a, Physical b) => (a -> b) -> Float -> Float
+> toFloatFunc f x = fromPhysical (f (toPhysical x))

ghc/tests/programs/barton-mangler-bug/TypesettingTricks.hs

+-- The functions in this file are expressly for the purpose of aiding
+-- the typesetting of some functions with Smugweb.  To this end, in
+-- some cases I will use named, prefix functions rather than operators
+-- (since under Smugweb operators cannot accept arguments).  This file
+-- will define those infix functions.
+
+module TypesettingTricks where
+
+realdiv:: Floating a => a -> a -> a
+realdiv = (/)
+
+realmul:: Num a => a -> a -> a
+realmul = (*)
+
+dotmul:: Num a => a -> a -> a
+dotmul = (*)
+
+rand:: Integer -> [ Float ]
+rand i = r : rand i'
+   where i' = ( (3146757 * i) + 1731) `mod` 4194304
+         r = (fromInteger i') / 4194304.0