package Uart where

import FIFOF
import GetPut
import Util

interface Clock =
  clk :: Bool

mkDivider :: Integer -> Module Clock
mkDivider divisor =
  module
    count :: Reg (Bit 32) <- mkReg 0

    rules
      "increment_divider": when True ==> do
        if count == fromInteger (divisor - 1) then do
          count := 0
        else
          count := count + 1

    interface Clock
      clk = count == 0

-- | The state of the TX side of the UART.
data TxState
  = -- | The UART is not currently sending anything. May transition to
    -- 'Start b' when ready to send 'b'.
    Idle
  | -- | The UART is about to send the start bit. 'Start b' transitions to
    -- 'Data b 7' by sending the start bit.
    Start (Bit 8)
  | -- | The UART is about to send a data bit. 'Data b n' transitions to
    -- 'Data (b >> 1) (n - 1)' by sending a data bit. 'Data b 0' transitions to
    -- 'Stop' by sending the last data bit.
    Data (Bit 8) (Bit 3)
  | -- | The UART is about to send the stop bit. Transitions to 'Idle'.
    Stop
  deriving (Bits)

-- | The TX side of the UART.
interface TxUart =
  -- | The TX pin.
  pin :: Bit 1
  -- | Writes a byte to the UART's transmit buffer.
  send :: Put (Bit 8)

mkTxUart :: Clock -> Integer -> Module TxUart
mkTxUart baudClock bufferSize =
  module
    fifo :: FIFOF (Bit 8) <- mkSizedFIFOF bufferSize
    state :: Reg TxState <- mkReg Idle
    pin :: Reg (Bit 1) <- mkReg 1

    rules
      "uart_tx": when baudClock.clk
        rules
          "uart_tx_idle": when Idle <- state ==> do
            pin := 1
            b <- (toGet fifo).get
            state := Start b
          "uart_tx_start": when Start b <- state ==> do
            pin := 0
            state := Data b 7
          "uart_tx_data": when Data b n <- state ==> do
            pin := b[0:0]
            if n == 0 then
              state := Stop
            else
              state := Data (b >> 1) (n - 1)
          "uart_tx_stop": when Stop <- state ==> do
            pin := 1
            state := Idle
    interface TxUart
      pin = pin
      send = toPut fifo

-- | The state of the RX side of the UART.
data RxState
  = -- | The UART is not currently receiving anything. May transition to
    -- 'Data 0 0' when the start bit is received.
    Idle
  | -- | In the 'Data _ n' state, the UART has received the start bit and 'n'
    -- data bits, and is about to receive more data bits. 'Data _ n'
    -- transitions to 'Data _ (n + 1)' by receiving a data bit. 'Data b 7'
    -- transitions to 'Stop' by receving the last data bit.
    Data (Bit 8) (Bit 3)
  | -- | In the 'Stop' state, the UART has received the start and data bits,
    -- and is waiting for the stop bit (which is ignored). Transitions to
    -- 'Idle'.
    Stop
  deriving (Bits)

-- | The RX side of the UART.
interface RxUart =
  -- | The RX pin.
  pin :: Bit 1 -> Action
  -- | Reads a byte from the UART's receive buffer.
  recv :: Get (Bit 8)

  debugBit :: Bit 1

mkRxUart :: Clock -> Integer -> Module RxUart
mkRxUart baudClock bufferSize =
  module
    fifo :: FIFOF (Bit 8) <- mkGSizedFIFOF True False bufferSize
    state :: Reg RxState <- mkReg Idle
    pin :: Wire (Bit 1) <- mkWire
    debugBit :: Reg (Bit 1) <- mkReg 1

    rules
      "uart_rx": when baudClock.clk
        rules
          "uart_rx_idle": when Idle <- state ==>
            if pin == 0 then do
              debugBit := pin
              state := Data 0 0
            else
              state := Idle
          "uart_rx_data": when Data oldBits n <- state ==> do
            let newBits = pin ++ oldBits[6:0]
            if n == 7 then do
              fifo.enq newBits
              state := Stop
            else
              state := Data newBits (n + 1)
          "uart_rx_stop": when Stop <- state ==> do
            debugBit := pin
            state := Idle

    interface RxUart
      pin bit = pin := bit
      recv = toGet fifo
      debugBit = debugBit

-- | An 8n1 UART.
interface Uart =
  -- | The RX pin.
  rxPin :: Bit 1 -> Action
  -- | The TX pin.
  txPin :: Bit 1

  -- | Reads a byte from the UART's receive buffer.
  recv :: Get (Bit 8)
  -- | Writes a byte to the UART's transmit buffer.
  send :: Put (Bit 8)
  debugBit :: Bit 1

mkUart :: Integer -> Module Uart
mkUart baudDivisor =
  module
    baudClock <- mkDivider baudDivisor
    rx <- mkRxUart baudClock 8
    tx <- mkTxUart baudClock 8

    interface Uart
      rxPin = rx.pin
      txPin = tx.pin
      recv = rx.recv
      send = tx.send
      debugBit = rx.debugBit

-- vim: set ft=haskell :