    {-|
    Copyright : © 2015-2016, Christiaan Baaij,
                  2017     , Google Inc.
                  2019     , Myrtle Software Ltd
    Licence   : Creative Commons 4.0 (CC BY 4.0) (https://creativecommons.org/licenses/by/4.0/)
    -}

    {-# LANGUAGE NoImplicitPrelude #-}

    {-# OPTIONS_GHC -Wno-unused-imports #-}

    module Clash.Examples (
      -- * Decoders and Encoders
      -- $decoders_and_encoders

      -- * Counters
      -- $counters

      -- * Parity and CRC
      -- $parity_and_crc

      -- * UART model
      -- $uart
      )
    where

    import Clash.Prelude
    import Control.Lens
    import Control.Monad
    import Control.Monad.Trans.State

    {- $setup
    >>> :set -XDataKinds
    >>> import Clash.Prelude
    >>> import Test.QuickCheck ((===))
    >>> import Clash.Examples.Internal
    -}

    {- $decoders_and_encoders
    = Decoder

    Using a @case@ statement:

    @
    decoderCase :: Bool -> BitVector 4 -> BitVector 16
    decoderCase enable binaryIn | enable =
      case binaryIn of
        0x0 -> 0x0001
        0x1 -> 0x0002
        0x2 -> 0x0004
        0x3 -> 0x0008
        0x4 -> 0x0010
        0x5 -> 0x0020
        0x6 -> 0x0040
        0x7 -> 0x0080
        0x8 -> 0x0100
        0x9 -> 0x0200
        0xA -> 0x0400
        0xB -> 0x0800
        0xC -> 0x1000
        0xD -> 0x2000
        0xE -> 0x4000
        0xF -> 0x8000
    decoderCase _ _ = 0
    @

    Using the `shiftL` function:

    @
    decoderShift :: Bool -> BitVector 4 -> BitVector 16
    decoderShift enable binaryIn =
      if enable
         then 1 ``shiftL`` ('fromIntegral' binaryIn)
         else 0
    @

    Examples:

    >>> decoderCase True 3
    0b0000_0000_0000_1000
    >>> decoderShift True 7
    0b0000_0000_1000_0000

    The following property holds:

    prop> \enable binaryIn -> decoderShift enable binaryIn === decoderCase enable binaryIn

    = Encoder

    Using a @case@ statement:

    @
    encoderCase :: Bool -> BitVector 16 -> BitVector 4
    encoderCase enable binaryIn | enable =
      case binaryIn of
        0x0001 -> 0x0
        0x0002 -> 0x1
        0x0004 -> 0x2
        0x0008 -> 0x3
        0x0010 -> 0x4
        0x0020 -> 0x5
        0x0040 -> 0x6
        0x0080 -> 0x7
        0x0100 -> 0x8
        0x0200 -> 0x9
        0x0400 -> 0xA
        0x0800 -> 0xB
        0x1000 -> 0xC
        0x2000 -> 0xD
        0x4000 -> 0xE
        0x8000 -> 0xF
    encoderCase _ _ = 0
    @

    The following property holds:

    prop> \en decIn -> en ==> (encoderCase en (decoderCase en decIn) === decIn)
    -}

    {- $counters
    = 8-bit Simple Up Counter

    Using `register`:

    @
    upCounter
      :: HiddenClockResetEnable dom
      => Signal dom Bool
      -> Signal dom (Unsigned 8)
    upCounter enable = s
      where
        s = `register` 0 (`mux` enable (s + 1) s)
    @

    = 8-bit Up Counter With Load

    Using `mealy`:

    @
    upCounterLd
      :: HiddenClockResetEnable dom
      => Signal dom (Bool,Bool,Unsigned 8)
      -> Signal dom (Unsigned 8)
    upCounterLd = `mealy` upCounterLdT 0

    upCounterLdT s (ld,en,dIn) = (s',s)
      where
        s' | ld        = dIn
           | en        = s + 1
           | otherwise = s
    @

    = 8-bit Up-Down counter

    Using `register` and `mux`:

    @
    upDownCounter
      :: HiddenClockResetEnable dom
      => Signal dom Bool
      -> Signal dom (Unsigned 8)
    upDownCounter upDown = s
      where
        s = `register` 0 (`mux` upDown (s + 1) (s - 1))
    @

    The following property holds:

    prop> \en -> en ==> testFor 1000 (upCounter (pure en) .==. upDownCounter (pure en) :: Signal "System" Bool)

    = LFSR

    External/Fibonacci LFSR, for @n=16@ and using the primitive polynominal @1 + x^11 + x^13 + x^14 + x^16@

    @
    lfsrF' :: BitVector 16 -> BitVector 16
    lfsrF' s = 'pack' feedback '++#' 'slice' d15 d1 s
      where
        feedback = s'!'5 ``xor`` s'!'3 ``xor`` s'!'2 ``xor`` s'!'0

    lfsrF
      :: HiddenClockResetEnable dom
      => BitVector 16
      -> Signal dom Bit
    lfsrF seed = 'msb' '<$>' r
      where r = 'register' seed (lfsrF' '<$>' r)
    @

    We can also build a internal/Galois LFSR which has better timing characteristics.
    We first define a Galois LFSR parameterizable in its filter taps:

    @
    lfsrGP taps regs = 'zipWith' xorM taps (fb '+>>' regs)
      where
        fb  = 'last' regs
        xorM i x | i         = x ``xor`` fb
                 | otherwise = x
    @

    Then we can instantiate a 16-bit LFSR as follows:

    @
    lfsrG :: HiddenClockResetEnable dom  => BitVector 16 -> Signal dom Bit
    lfsrG seed = 'last' ('unbundle' r)
      where r = 'register' ('unpack' seed) (lfsrGP ('unpack' 0b0011010000000000) '<$>' r)
    @

    The following property holds:

    prop> testFor 100 (lfsrF 0xACE1 .==. lfsrG 0x4645 :: Signal "System" Bool)

    = Gray counter

    Using the previously defined @upCounter@:

    @
    grayCounter
      :: HiddenClockResetEnable dom
      => Signal dom Bool
      -> Signal dom (BitVector 8)
    grayCounter en = gray '<$>' upCounter en
      where gray xs = 'pack' ('msb' xs) '++#' 'xor' ('slice' d7 d1 xs) ('slice' d6 d0 xs)
    @

    = One-hot counter

    Basically a barrel-shifter:

    @
    oneHotCounter
      :: HiddenClockResetEnable dom
      => Signal dom Bool
      -> Signal dom (BitVector 8)
    oneHotCounter enable = s
      where
        s = 'register' 1 ('mux' enable ('rotateL' '<$>' s '<*>' 1) s)
    @
    -}

    {- $parity_and_crc
    = Parity

    Just 'reduceXor':

    @
    parity :: Unsigned 8 -> Bit
    parity data_in = `reduceXor` data_in
    @

    = Serial CRC

    * Width = 16 bits
    * Truncated polynomial = 0x1021
    * Initial value = 0xFFFF
    * Input data is NOT reflected
    * Output CRC is NOT reflected
    * No XOR is performed on the output CRC

    @
    crcT bv dIn = 'replaceBit' 0  dInXor
                $ 'replaceBit' 5  (bv'!'4  ``xor`` dInXor)
                $ 'replaceBit' 12 (bv'!'11 ``xor`` dInXor)
                  rotated
      where
        dInXor  = dIn ``xor`` fb
        rotated = 'rotateL' bv 1
        fb      = 'msb' bv

    crc
      :: HiddenClockResetEnable dom
      => Signal dom Bool
      -> Signal dom Bool
      -> Signal dom Bit
      -> Signal dom (BitVector 16)
    crc enable ld dIn = s
      where
        s = 'register' 0xFFFF ('mux' enable ('mux' ld 0xFFFF (crcT '<$>' s '<*>' dIn)) s)
    @
    -}

    {- $uart
    @
    {\-\# LANGUAGE RecordWildCards \#-\}

    module UART (uart) where

    import Clash.Prelude
    import Control.Lens
    import Control.Monad
    import Control.Monad.Trans.State

    -- UART RX Logic
    data RxReg
      = RxReg
      { _rx_reg        :: BitVector 8
      , _rx_data       :: BitVector 8
      , _rx_sample_cnt :: Unsigned 4
      , _rx_cnt        :: Unsigned 4
      , _rx_frame_err  :: Bool
      , _rx_over_run   :: Bool
      , _rx_empty      :: Bool
      , _rx_d1         :: Bit
      , _rx_d2         :: Bit
      , _rx_busy       :: Bool
      } deriving (Generic, NFDataX)

    makeLenses ''RxReg

    uartRX r\@(RxReg {..}) rx_in uld_rx_data rx_enable = 'flip' 'execState' r $ do
      -- Synchronize the async signal
      rx_d1 '.=' rx_in
      rx_d2 '.=' _rx_d1
      -- Uload the rx data
      'when' uld_rx_data $ do
        rx_data  '.=' _rx_reg
        rx_empty '.=' True
      -- Receive data only when rx is enabled
      if rx_enable then do
        -- Check if just received start of frame
        'when' (not _rx_busy && _rx_d2 == 0) $ do
          rx_busy       '.=' True
          rx_sample_cnt '.=' 1
          rx_cnt        '.=' 0
        -- Start of frame detected, proceed with rest of data
        'when' _rx_busy $ do
          rx_sample_cnt '+=' 1
          -- Logic to sample at middle of data
          'when' (_rx_sample_cnt == 7) $ do
            if _rx_d1 == 1 && _rx_cnt == 0 then
              rx_busy '.=' False
            else do
              rx_cnt '+=' 1
              -- start storing the rx data
              'when' (_rx_cnt > 0 && _rx_cnt < 9) $ do
                rx_reg '%=' 'replaceBit' (_rx_cnt - 1) _rx_d2
              'when' (_rx_cnt == 9) $ do
                rx_busy .= False
                -- Check if End of frame received correctly
                if _rx_d2 == 0 then
                  rx_frame_err '.=' True
                else do
                  rx_empty     '.=' False
                  rx_frame_err '.=' False
                  -- Check if last rx data was not unloaded
                  rx_over_run  '.=' not _rx_empty
      else do
        rx_busy .= False

    -- UART TX Logic
    data TxReg
      = TxReg
      { _tx_reg      :: BitVector 8
      , _tx_empty    :: Bool
      , _tx_over_run :: Bool
      , _tx_out      :: Bit
      , _tx_cnt      :: Unsigned 4
      } deriving (Generic, NFDataX)

    makeLenses ''TxReg

    uartTX t\@(TxReg {..}) ld_tx_data tx_data tx_enable = 'flip' 'execState' t $ do
      'when' ld_tx_data $ do
        if not _tx_empty then
          tx_over_run '.=' False
        else do
          tx_reg   '.=' tx_data
          tx_empty '.=' False
      'when' (tx_enable && not _tx_empty) $ do
        tx_cnt '+=' 1
        'when' (_tx_cnt == 0) $
          tx_out '.=' 0
        'when' (_tx_cnt > 0 && _tx_cnt < 9) $
          tx_out '.=' _tx_reg '!' (_tx_cnt - 1)
        'when' (_tx_cnt == 9) $ do
          tx_out   '.=' 1
          tx_cnt   '.=' 0
          tx_empty '.=' True
      'unless' tx_enable $
        tx_cnt '.=' 0

    -- Combine RX and TX logic
    uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable =
        ( _tx_out   '<$>' txReg
        , _tx_empty '<$>' txReg
        , _rx_data  '<$>' rxReg
        , _rx_empty '<$>' rxReg
        )
      where
        rxReg     = register rxRegInit (uartRX '<$>' rxReg '<*>' rx_in '<*>' uld_rx_data
                                               '<*>' rx_enable)
        rxRegInit = RxReg { _rx_reg        = 0
                          , _rx_data       = 0
                          , _rx_sample_cnt = 0
                          , _rx_cnt        = 0
                          , _rx_frame_err  = False
                          , _rx_over_run   = False
                          , _rx_empty      = True
                          , _rx_d1         = 1
                          , _rx_d2         = 1
                          , _rx_busy       = False
                          }

        txReg     = register txRegInit (uartTX '<$>' txReg '<*>' ld_tx_data '<*>' tx_data
                                               '<*>' tx_enable)
        txRegInit = TxReg { _tx_reg      = 0
                          , _tx_empty    = True
                          , _tx_over_run = False
                          , _tx_out      = 1
                          , _tx_cnt      = 0
                          }
    @
    -}