diff options
Diffstat (limited to 'testsuite/tests/programs/jtod_circint')
| -rw-r--r-- | testsuite/tests/programs/jtod_circint/Bit.hs | 183 | ||||
| -rw-r--r-- | testsuite/tests/programs/jtod_circint/LogFun.hs | 34 | ||||
| -rw-r--r-- | testsuite/tests/programs/jtod_circint/Main.hs | 12 | ||||
| -rw-r--r-- | testsuite/tests/programs/jtod_circint/Makefile | 3 | ||||
| -rw-r--r-- | testsuite/tests/programs/jtod_circint/Signal.hs | 146 | ||||
| -rw-r--r-- | testsuite/tests/programs/jtod_circint/jtod_circint.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/programs/jtod_circint/test.T | 10 |
7 files changed, 389 insertions, 0 deletions
diff --git a/testsuite/tests/programs/jtod_circint/Bit.hs b/testsuite/tests/programs/jtod_circint/Bit.hs new file mode 100644 index 0000000000..be11a6f517 --- /dev/null +++ b/testsuite/tests/programs/jtod_circint/Bit.hs @@ -0,0 +1,183 @@ +module Bit where +import LogFun +import Signal + +data Bit = Bot | WeakZero | WeakOne | Zero | One | Top + deriving (Eq,Show{-was:Text-}) + +instance Static Bit where + intToSig = intToSigBit + sigToInt = sigToIntBit + showStaticSig = showBit + +instance Lattice Bit where + bot = Bot + top = Top + weakZero = WeakZero + weakOne = WeakOne + lub = lubBit + pass = passBit + +instance Signal Bit where + showSig = showBit + initial = Zero + zerO = Zero + one = One + tt1 = tt1Bit + tt2 = tt2Bit + +instance Log Bit where + dumLog = Zero + +tt1Bit :: TT1 -> Bit -> Bit +tt1Bit (a,b) = + let p = intBit a + q = intBit b + f x = case x of + Bot -> Bot + Zero -> p + One -> q + Top -> Top + in f + +tt2Bit :: TT2 -> Bit -> Bit -> Bit +tt2Bit (a,b,c,d) = f + where p = intBit a + q = intBit b + r = intBit c + s = intBit d + f x y = case x of + Bot -> case y of + Bot -> Bot + WeakZero -> Bot + WeakOne -> Bot + Zero -> Bot + One -> Bot + Top -> Top + WeakZero -> case y of + Bot -> Bot + WeakZero -> p + WeakOne -> q + Zero -> p + One -> q + Top -> Top + WeakOne -> case y of + Bot -> Bot + WeakZero -> r + WeakOne -> s + Zero -> r + One -> s + Top -> Top + Zero -> case y of + Bot -> Bot + WeakZero -> p + WeakOne -> q + Zero -> p + One -> q + Top -> Top + One -> case y of + Bot -> Bot + WeakZero -> r + WeakOne -> s + Zero -> r + One -> s + Top -> Top + Top -> case y of + Bot -> Top + WeakZero -> Top + WeakOne -> Top + Zero -> Top + One -> Top + Top -> Top + +lubBit :: Bit -> Bit -> Bit +lubBit a b = + case a of + Bot -> case b of + Bot -> Bot + WeakZero -> WeakZero + WeakOne -> WeakOne + Zero -> Zero + One -> One + Top -> Top + WeakZero -> case b of + Bot -> Zero + WeakZero -> WeakZero + WeakOne -> Top + Zero -> Zero + One -> One + Top -> Top + WeakOne -> case b of + Bot -> WeakOne + WeakZero -> Top + WeakOne -> WeakOne + Zero -> Zero + One -> One + Top -> Top + Zero -> case b of + Bot -> Zero + WeakZero -> Zero + WeakOne -> Zero + Zero -> Zero + One -> Top + Top -> Top + One -> case b of + Bot -> One + WeakZero -> One + WeakOne -> One + Zero -> Top + One -> One + Top -> Top + Top -> case b of + Bot -> Top + WeakZero -> Top + WeakOne -> Top + Zero -> Top + One -> Top + Top -> Top + +showBit :: Bit -> String +showBit Bot = "v" +showBit WeakZero = "z" +showBit WeakOne = "o" +showBit Zero = "0" +showBit One = "1" +showBit Top = "^" + + +intBit :: Int -> Bit +intBit 0 = Zero +intBit 1 = One +intBit x = + error ("\nintBit received bad Int " ++ show x ++ ".\n") + +intToSigBit :: Int -> Bit +intToSigBit i + | i==0 = Zero + | i==1 = One + | i==8 = Bot + | i==9 = Top + +sigToIntBit :: Bit -> Int +sigToIntBit Zero = 0 +sigToIntBit One = 1 +sigToIntBit Bot = 8 +sigToIntBit Top = 9 + +passBit :: Bit -> Bit -> Bit +passBit c a = + case c of + Bot -> Bot + Zero -> Bot + One -> a + Top -> Top + +instance Num Bit 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" + diff --git a/testsuite/tests/programs/jtod_circint/LogFun.hs b/testsuite/tests/programs/jtod_circint/LogFun.hs new file mode 100644 index 0000000000..b9a5bf169d --- /dev/null +++ b/testsuite/tests/programs/jtod_circint/LogFun.hs @@ -0,0 +1,34 @@ +module LogFun where + +type TT1 = (Int,Int) +type TT2 = (Int,Int,Int,Int) + +tt_con10, tt_id, tt_inv, tt_con11 :: TT1 + +tt_con10 = (0,0) +tt_id = (0,1) +tt_inv = (1,0) +tt_con11 = (1,1) + +tt_con20, tt_and2, tt_nimp, tt_id21 :: TT2 +tt_nimp', tt_id22, tt_xor, tt_or2 :: TT2 +tt_nor2, tt_equ2, tt_inv22, tt_imp' :: TT2 +tt_inv21, tt_imp, tt_nand2, tt_con21 :: TT2 + +tt_con20 = (0,0,0,0) +tt_and2 = (0,0,0,1) +tt_nimp = (0,0,1,0) +tt_id21 = (0,0,1,1) +tt_nimp' = (0,1,0,0) +tt_id22 = (0,1,0,1) +tt_xor = (0,1,1,0) +tt_or2 = (0,1,1,1) +tt_nor2 = (1,0,0,0) +tt_equ2 = (1,0,0,1) +tt_inv22 = (1,0,1,0) +tt_imp' = (1,0,1,1) +tt_inv21 = (1,1,0,0) +tt_imp = (1,1,0,1) +tt_nand2 = (1,1,1,0) +tt_con21 = (1,1,1,1) + diff --git a/testsuite/tests/programs/jtod_circint/Main.hs b/testsuite/tests/programs/jtod_circint/Main.hs new file mode 100644 index 0000000000..a1907dc6a9 --- /dev/null +++ b/testsuite/tests/programs/jtod_circint/Main.hs @@ -0,0 +1,12 @@ +module Main where +import Signal +import Bit + +main = putStr test + +test = stest + +type B = Stream Bit + +stest = take 80 (shows z "\n") + where z = one :: B diff --git a/testsuite/tests/programs/jtod_circint/Makefile b/testsuite/tests/programs/jtod_circint/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/programs/jtod_circint/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk 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" + diff --git a/testsuite/tests/programs/jtod_circint/jtod_circint.stdout b/testsuite/tests/programs/jtod_circint/jtod_circint.stdout new file mode 100644 index 0000000000..bc629dadd2 --- /dev/null +++ b/testsuite/tests/programs/jtod_circint/jtod_circint.stdout @@ -0,0 +1 @@ +Scons One (Scons One (Scons One (Scons One (Scons One (Scons One (Scons One (Sco
\ No newline at end of file diff --git a/testsuite/tests/programs/jtod_circint/test.T b/testsuite/tests/programs/jtod_circint/test.T new file mode 100644 index 0000000000..47338d7b89 --- /dev/null +++ b/testsuite/tests/programs/jtod_circint/test.T @@ -0,0 +1,10 @@ + +test('jtod_circint', + [skip_if_fast, + extra_clean(['Bit.hi', 'Bit.o', + 'LogFun.hi', 'LogFun.o', + 'Main.hi', 'Main.o', + 'Signal.hi', 'Signal.o'])], + multimod_compile_and_run, + ['Main', '']) + |