blob: 5b48b2b8fd7815dc3afd4a1d4776522da32af754 (
plain)
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
|
package App where
-- import BRAM
-- ebrServer1 :: BRAM2Port (Bit 8) (Bit 16) <- mkBRAM2Server defaultValue
import GetPut
interface App =
led :: Bit 1
hexToBits :: Bit 8 -> Maybe (Bit 4)
hexToBits 0x30 = Just 0b0000
hexToBits 0x31 = Just 0b0001
hexToBits 0x32 = Just 0b0010
hexToBits 0x33 = Just 0b0011
hexToBits 0x34 = Just 0b0100
hexToBits 0x35 = Just 0b0101
hexToBits 0x36 = Just 0b0110
hexToBits 0x37 = Just 0b0111
hexToBits 0x38 = Just 0b1000
hexToBits 0x39 = Just 0b1001
hexToBits 0x41 = Just 0b1010
hexToBits 0x42 = Just 0b1011
hexToBits 0x43 = Just 0b1100
hexToBits 0x44 = Just 0b1101
hexToBits 0x45 = Just 0b1110
hexToBits 0x46 = Just 0b1111
hexToBits 0x61 = Just 0b1010
hexToBits 0x62 = Just 0b1011
hexToBits 0x63 = Just 0b1100
hexToBits 0x64 = Just 0b1101
hexToBits 0x65 = Just 0b1110
hexToBits 0x66 = Just 0b1111
hexToBits _ = Nothing
data State
= WaitingForHiNybble
| WaitingForLoNybble (Bit 4)
deriving (Bits)
mkApp :: Get (Bit 8) -> Put (Bit 8) -> Module App
mkApp uartRecv uartSend =
module
led :: Reg (Bit 1) <- mkReg 0
state :: Reg State <- mkReg WaitingForHiNybble
rules
"get_hi_nybble": when WaitingForHiNybble <- state ==> do
byte <- uartRecv.get
case hexToBits byte of
Just hiNybble -> do
state := WaitingForLoNybble hiNybble
led := 1
Nothing -> return ()
"get_lo_nybble": when WaitingForLoNybble hiNybble <- state ==> do
byte <- uartRecv.get
case hexToBits byte of
Just loNybble -> do
uartSend.put (hiNybble ++ loNybble)
state := WaitingForHiNybble
led := 0
Nothing -> return ()
interface App
led = led
-- vim: set ft=haskell :
|
