1 files changed, 146 insertions, 0 deletions
diff --git a/testsuite/tests/programs/jtod_circint/Signal.hs b/testsuite/tests/programs/jtod_circint/Signal.hs
new file mode 100644
index 0000000000..38a1fc86f5
--- /dev/null
+++ b/testsuite/tests/programs/jtod_circint/Signal.hs
@@ -0,0 +1,146 @@
+module Signal where
+
+import LogFun
+
+class (Eq a, Show{-was:Text-} a, Num a) => Signal a where
+  showSig :: a -> String
+
+  zerO, one, initial :: a
+
+  tt1 :: TT1 -> a -> a
+  tt2 :: TT2 -> a -> a -> a
+
+  con10, buf, inv, con11 :: a -> a
+
+  con20, and2, nimp,  id21  :: a -> a -> a
+  nimp', id22, xor,   or2   :: a -> a -> a
+  nor2,  equ2, inv22, imp'  :: a -> a -> a
+  inv21, imp,  nand2, con21 :: a -> a -> a
+  and3,  or3,  nand3, nor3  :: a -> a -> a -> a
+  and4,  or4,  nand4, nor4  :: a -> a -> a -> a -> a
+
+  con10 = tt1 tt_con10
+  buf   = tt1 tt_id
+  inv   = tt1 tt_inv
+  con11 = tt1 tt_con11
+
+  con20 = tt2 tt_con20
+  and2  = tt2 tt_and2
+  nimp  = tt2 tt_nimp
+  id21  = tt2 tt_id21
+  nimp' = tt2 tt_nimp'
+  id22  = tt2 tt_id22
+  xor   = tt2 tt_xor
+  or2   = tt2 tt_or2
+  nor2  = tt2 tt_nor2
+  equ2  = tt2 tt_equ2
+  inv22 = tt2 tt_inv22
+  imp'  = tt2 tt_imp'
+  inv21 = tt2 tt_inv21
+  imp   = tt2 tt_imp
+  nand2 = tt2 tt_nand2
+  con21 = tt2 tt_con21
+
+  and3  a b c = a*b*c
+  or3   a b c = a+b+c
+  nand3 a b c = nand2 a (nand2 b c)
+  nor3  a b c = nor2 a (nor2 b c)
+
+  and4  a b c d = (a*b)*(c*d)
+  or4   a b c d = (a+b)+(c+d)
+  nand4 a b c d = nand2 (nand2 a b) (nand2 c d)
+  nor4  a b c d = nor2 (nor2 a b) (nor2 c d)
+
+class (Signal a) => Lattice a where
+  bot, top, weakZero, weakOne :: a
+  lub  :: a -> a -> a
+  pass :: a -> a -> a
+
+class (Signal a) => Static a where
+  intToSig :: Int -> a
+  sigToInt :: a -> Int
+  showStaticSig :: a -> String
+
+class (Signal a) => Dynamic a where
+  latch, dff :: a -> a
+
+class (Lattice a, Static a) => Log a where
+  dumLog :: a
+
+class (Lattice a, Dynamic a) => Sig a where
+  dumSig :: a
+
+data Stream a = Snil | Scons a (Stream a)  deriving (Eq,Show{-was:Text-})
+
+shead :: Stream a -> a
+shead (Scons x xs) = x
+
+stail :: Stream a -> Stream a
+stail (Scons x xs) = xs
+
+snull :: Stream a -> Bool
+snull Snil = True
+snull (Scons x xs) = False
+
+smap :: (a->b) -> Stream a -> Stream b
+smap f Snil = Snil
+smap f (Scons x xs) = Scons (f x) (smap f xs)
+
+stake, sdrop :: Int -> Stream a -> Stream a
+
+stake 0 xs = xs
+--should be: stake (i+1) (Scons x xs) = Scons x (stake i xs)
+stake i (Scons x xs) | i < 0     = error "Signal.stake: < 0"
+		     | otherwise = Scons x (stake (i-1) xs)
+
+sdrop 0 xs = xs
+--should be:sdrop (i+1) (Scons x xs) = sdrop i xs
+sdrop i (Scons x xs) | i < 0	 = error "Signal.sdrop: < 0"
+		     | otherwise = sdrop i xs
+
+smap2 :: (a->b->c) -> Stream a -> Stream b -> Stream c
+smap2 f as bs =
+  case as of
+    Snil -> Snil
+    Scons a as' ->
+      case bs of
+        Snil -> Snil
+        Scons b bs' -> Scons (f a b) (smap2 f as' bs')
+
+srepeat :: (Static a) => a -> Stream a
+srepeat x = xs where xs = Scons x xs
+
+stream :: [a] -> Stream a
+stream [] = Snil
+stream (x:xs) = Scons x (stream xs)
+
+instance (Signal a, Static a) => Dynamic (Stream a) where
+  latch xs = Scons initial xs
+  dff xs = Scons initial xs
+
+instance (Lattice a, Static a) => Lattice (Stream a) where
+  bot      = srepeat bot
+  top      = srepeat top
+  weakZero = srepeat weakZero
+  weakOne  = srepeat weakOne
+  lub      = smap2 lub
+  pass     = smap2 pass
+
+instance (Signal a, Static a) => Signal (Stream a) where
+  zerO = srepeat zerO
+  one  = srepeat one
+  tt1  = smap . tt1
+  tt2  = smap2 . tt2
+
+instance (Lattice a, Static a) => Sig (Stream a) where
+  dumSig = bot  -- ??? shouldn't be necessary, check compiler
+
+instance (Static a) => Num (Stream a) where
+  (+) = or2
+  (*) = and2
+  a - b  = xor a b
+  negate = inv
+  abs    = error "abs not defined for Signals"
+  signum = error "signum not defined for Signals"
+  fromInteger = error "fromInteger not defined for Signals"
+