1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
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"
|
