package Mcp(mcpBuffered, mcpUnit, mcpUnitF, IMcpUnitF(..)) where

import Pull
import ConfigReg

-- ====================

interface IMcpUnitF b =
  result :: b
  isValid :: Bool

mcpBuffered :: (IsModule m c, Bits b sb) => Integer -> (a -> b) -> Pull a -> m (Pull b)
mcpBuffered 2 = mcp2_buffered
mcpBuffered 3 = mcp3_buffered
mcpBuffered 4 = mcp4_buffered

mcpUnit :: (IsModule m c, Bits a sa, Bits b sb) => Integer -> (a -> b) -> a -> Bool -> m (Reg b)
mcpUnit 2 = mcp2_unit
mcpUnit 3 = mcp3_unit
mcpUnit 4 = mcp4_unit

mcpUnitF :: (IsModule m c, Bits a sa, Bits b sb) => Integer -> (a -> b) -> a -> Bool -> m (IMcpUnitF b)
mcpUnitF 2 = mcp2_unitF
mcpUnitF 3 = mcp3_unitF
mcpUnitF 4 = mcp4_unitF

-- ====================

delay2 :: Integer
delay2 = 9
delay3 :: Integer
delay3 = 14
delay4 :: Integer
delay4 = 19

-- ====================

mcp2_buffer :: (IsModule m c, Bits a sa) => a -> Pull a -> m (Pull a)
mcp2_buffer init src =
    module
      r_mcp2 :: Reg a <- mkReg init
      mcp_en_src :: Reg Bool <- mkReg False

      rules
       "toggle":
         when not mcp_en_src ==> mcp_en_src := True

      interface
        pull = do x :: a
                  x <- src.pull
                  action {r_mcp2 := x; mcp_en_src := False }
                  return r_mcp2
               when mcp_en_src

mcp2_buffered :: (IsModule m c, Bits b sb) => (a -> b) -> Pull a -> m (Pull b)
mcp2_buffered f = mcp2_buffer _ · apply f -- · buffer

-- -------------

mcp3_buffer :: (IsModule m c, Bits a sa) => a -> Pull a -> m (Pull a)
mcp3_buffer init src =
    module
      r_mcp3 :: Reg a <- mkReg init
      mcp_en_src :: Reg Bool <- mkReg False
      counter :: Reg (Bit 2) <- mkReg 0

      rules
       "count":
         when counter/= 0 ==> counter := counter - 1

       "toggle":
         when True ==> mcp_en_src := (counter == 0)

      interface
        pull = do x :: a
                  x <- src.pull
                  action {r_mcp3 := x; counter := 2} -- counter must be set to
                                                     -- (length of path) - 1
                  return r_mcp3
               when mcp_en_src

mcp3_buffered :: (IsModule m c, Bits b sb) => (a -> b) -> Pull a -> m (Pull b)
mcp3_buffered f = mcp3_buffer _ · apply f -- · buffer

-- -------------
mcp4_buffer :: (IsModule m c, Bits a sa) => a -> Pull a -> m (Pull a)
mcp4_buffer init src =
    module
      r_mcp4 :: Reg a <- mkReg init
      mcp_en_src :: Reg Bool <- mkReg False
      counter :: Reg (Bit 2) <- mkReg 0

      rules
       "count":
         when counter/= 0 ==> counter := counter - 1

       "toggle":
         when True ==> mcp_en_src := (counter == 0)

      interface
        pull = do x :: a
                  x <- src.pull
                  action {r_mcp4 := x; counter := 3} -- counter must be set to
                                                     -- (length of path) - 1
                  return r_mcp4
               when mcp_en_src

mcp4_buffered :: (IsModule m c, Bits b sb) => (a -> b) -> Pull a -> m (Pull b)
mcp4_buffered f = mcp4_buffer _ · apply f -- · buffer

-- ====================

mcp2_unit :: (IsModule m c, Bits a sa, Bits b sb) => (a -> b) -> a -> Bool -> m (Reg b)
mcp2_unit f src changed =                       -- src and changed are run-time values
  module
      r_mcp2 :: Reg b <- mkMcpRegU delay2
      mcp_en_src :: Reg Bool <- mkReg False
      valid      :: Reg Bool <- mkConfigReg False

      rules
        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set":
              when mcp_en_src  ==>  r_mcp2 := f src

        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set valid":
              when (mcp_en_src && not changed)  ==>
                action
                  valid := True
                  mcp_en_src := False

      addRules $
        (rules
           {-# ASSERT no implicit conditions #-}
           {-# ASSERT fire when enabled #-}
           "Mcp changed":
              when changed  ==>
                action
                  mcp_en_src := False
                  valid := False
        )
        <+
        (rules
           "Mcp toggle":  -- only when not changed (by <+)
              when True  ==>  mcp_en_src := True
        )

      interface
        _read    = r_mcp2 when valid
        _write _ = _

-- -------------

mcp3_unit :: (IsModule m c, Bits a sa, Bits b sb) => (a -> b) -> a -> Bool -> m (Reg b)
mcp3_unit f src changed =                       -- src and changed are run-time values
  module
      r_mcp3 :: Reg b <- mkMcpRegU delay3
      counter :: Reg (Bit 1) <- mkReg 0
      mcp_en_src :: Reg Bool <- mkReg False
      valid      :: Reg Bool <- mkConfigReg False

      rules
        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set":
              when mcp_en_src  ==>  r_mcp3 := f src

        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set valid":
              when (mcp_en_src && not changed)  ==>
                action
                  valid := True
                  mcp_en_src := False

      addRules $
        (rules
           {-# ASSERT no implicit conditions #-}
           {-# ASSERT fire when enabled #-}
           "Mcp changed":
              when changed ==>
                action
                  counter := 1                -- cycle-multiplicity minus two
                  mcp_en_src := False
                  valid := False
        )
        <+
        (rules
           "Mcp toggle":  -- only when not changed (by <+)
              when counter == 0 ==> mcp_en_src := True

           "Mcp count":
              when counter /= 0 ==> counter := counter - 1
        )
      interface
        _read    = r_mcp3 when valid
        _write _ = _

-- -------------

mcp4_unit :: (IsModule m c, Bits a sa, Bits b sb) => (a -> b) -> a -> Bool -> m (Reg b)
mcp4_unit f src changed =                       -- src and changed are run-time values
  module
      r_mcp4 :: Reg b <- mkMcpRegU delay4
      counter :: Reg (Bit 2) <- mkReg 0
      mcp_en_src :: Reg Bool <- mkReg False
      valid      :: Reg Bool <- mkConfigReg False

      rules
        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set":
              when mcp_en_src  ==>  r_mcp4 := f src

        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set valid":
              when (mcp_en_src && not changed)  ==>
                action
                  valid := True
                  mcp_en_src := False

      addRules $
        (rules
           {-# ASSERT no implicit conditions #-}
           {-# ASSERT fire when enabled #-}
           "Mcp changed":
              when changed ==>
                action
                  counter := 2                -- cycle-multiplicity minus two
                  mcp_en_src := False
                  valid := False
        )
        <+
        (rules
           "Mcp toggle":  -- only when not changed (by <+)
              when counter == 0 && not valid  ==> mcp_en_src := True

           "Mcp count":
              when counter /= 0 ==> counter := counter - 1
        )
      interface
        _read    = r_mcp4 when valid
        _write _ = _


-- ====================


mcp2_unitF :: (IsModule m c, Bits a sa, Bits b sb) => (a -> b) -> a -> Bool -> m (IMcpUnitF b)
mcp2_unitF f src changed =                       -- src and changed are run-time values
  module
      r_mcp2 :: Reg b <- mkMcpRegU delay2
      mcp_en_src :: Reg Bool <- mkReg False
      valid      :: Reg Bool <- mkConfigReg False

      rules
        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set":
              when mcp_en_src  ==>  r_mcp2 := f src

        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set valid":
              when (mcp_en_src && not changed)  ==>
                action
                  valid := True
                  mcp_en_src := False

      addRules $
        (rules
           {-# ASSERT no implicit conditions #-}
           {-# ASSERT fire when enabled #-}
           "Mcp changed":
              when changed  ==>
                action
                  mcp_en_src := False
                  valid := False
        )
        <+
        (rules
           "Mcp toggle":  -- only when not changed (by <+)
              when True  ==>  mcp_en_src := True
        )

      interface
        result = r_mcp2
        isValid = valid

-- -------------

mcp3_unitF :: (IsModule m c, Bits a sa, Bits b sb) => (a -> b) -> a -> Bool -> m (IMcpUnitF b)
mcp3_unitF f src changed =                       -- src and changed are run-time values
  module
      r_mcp3 :: Reg b <- mkMcpRegU delay3
      counter :: Reg (Bit 1) <- mkReg 0
      mcp_en_src :: Reg Bool <- mkReg False
      valid      :: Reg Bool <- mkConfigReg False

      rules
        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set":
              when mcp_en_src  ==>  r_mcp3 := f src

        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set valid":
              when (mcp_en_src && not changed)  ==>
                action
                  valid := True
                  mcp_en_src := False

      addRules $
        (rules
           {-# ASSERT no implicit conditions #-}
           {-# ASSERT fire when enabled #-}
           "Mcp changed":
              when changed ==>
                action
                  counter := 1                -- cycle-multiplicity minus two
                  mcp_en_src := False
                  valid := False
        )
        <+
        (rules
           "Mcp toggle":  -- only when not changed (by <+)
              when counter == 0 ==> mcp_en_src := True

           "Mcp count":
              when counter /= 0 ==> counter := counter - 1
        )
      interface
        result = r_mcp3
        isValid = valid

-- -------------

mcp4_unitF :: (IsModule m c, Bits a sa, Bits b sb) => (a -> b) -> a -> Bool -> m (IMcpUnitF b)
mcp4_unitF f src changed =                       -- src and changed are run-time values
  module
      r_mcp4 :: Reg b <- mkMcpRegU delay4
      counter :: Reg (Bit 2) <- mkReg 0
      mcp_en_src :: Reg Bool <- mkReg False
      valid      :: Reg Bool <- mkConfigReg False

      rules
        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set":
              when mcp_en_src  ==>  r_mcp4 := f src

        {-# ASSERT no implicit conditions #-}
        {-# ASSERT fire when enabled #-}
        "Mcp set valid":
              when (mcp_en_src && not changed)  ==>
                action
                  valid := True
                  mcp_en_src := False

      addRules $
        (rules
           {-# ASSERT no implicit conditions #-}
           {-# ASSERT fire when enabled #-}
           "Mcp changed":
              when changed ==>
                action
                  counter := 2                -- cycle-multiplicity minus two
                  mcp_en_src := False
                  valid := False
        )
        <+
        (rules
           "Mcp toggle":  -- only when not changed (by <+)
              when counter == 0 ==> mcp_en_src := True

           "Mcp count":
              when counter /= 0 ==> counter := counter - 1
        )
      interface
        result = r_mcp4
        isValid = valid


-- ========================================

mkMcpRegU :: (IsModule m c, Bits a sa) => Integer -> m (Reg a)
mkMcpRegU d = liftModule $
  if valueOf sa == 0 then
    module
      interface
        _read = unpack 0
        _write _ = return ()
  else
    module
      _r :: VReg sa
      _r <- vMkMcpRegU d

      let name = Valid (primGetModuleName _r)
      let t = typeOf (_ :: a)
      primSavePortType name "get" t
      primSavePortType name "val" t

      interface
        _read = unpack _r.get
        _write x = fromPrimAction (_r.set (pack x))

interface VReg n =
    set :: Bit n -> PrimAction
    get :: Bit n

vMkMcpRegU :: Integer -> Module (VReg n)
vMkMcpRegU d =
    module verilog "McpRegUN" (("width",valueOf n),("delay",d)) "CLK" "RST" {
        get = "get"{reg};
        set = "val"{reg} "SET";
    } [ get <> [get, set], set << set ]