{-|
Module      : Ice40.Mac
Description : Ice40 Multiply-Accumulate primitive wrapper
Copyright   : (c) David Cox, 2021
License     : BSD-3-Clause
Maintainer  : standardsemiconductor@gmail.com

MAC primitive wrapper. See "Ice40.Mac.Prim" for the original primitive. For more information see [LATTICE ICE Technology Library](https://github.com/standardsemiconductor/VELDT-info/blob/master/SBTICETechnologyLibrary201708.pdf) and [DSP Function Usage Guide](https://github.com/standardsemiconductor/VELDT-info/blob/master/DSPFunctionUsageGuideforICE40Devices.pdf).
-}
module Ice40.Mac 
  ( mac
  , Input(..)
  , defaultInput
  , Parameter(..)
  , defaultParameter
  ) where

import Clash.Prelude
import Ice40.Mac.Prim

-- | MAC inputs
data Input dom = Input
  { Input dom -> Signal dom Bit
ce        :: Signal dom Bit -- ^ clock enable input. applies to all clocked elemets, default = 1
  , Input dom -> Signal dom (BitVector 16)
c         :: Signal dom (BitVector 16) -- ^ 16-bits data of input c, default = 0
  , Input dom -> Signal dom (BitVector 16)
a         :: Signal dom (BitVector 16) -- ^ 16-bits data of input a, default = 0
  , Input dom -> Signal dom (BitVector 16)
b         :: Signal dom (BitVector 16) -- ^ 16-bits data of input b, default = 0
  , Input dom -> Signal dom (BitVector 16)
d         :: Signal dom (BitVector 16) -- ^ 16-bits data of input d, default = 0
  , Input dom -> Signal dom Bit
irsttop   :: Signal dom Bit -- ^ reset input to registers A and C. Also reset upper 8x8 multiplier output register (8x8 MAC pipeline register) 0 = not reset (default), 1 = reset
  , Input dom -> Signal dom Bit
irstbot   :: Signal dom Bit -- ^ reset input to registers B and D. Also reset lower 8x8 multiplier output register (8x8 MAC pipeline register) and the 16x16 multiplier output register (16x16 MAC pipeline register). 0 = not reset (default), 1 = reset
  , Input dom -> Signal dom Bit
orsttop   :: Signal dom Bit -- ^ reset input to top accumulator register (for adder/subtractor, accumulator, and MAC functions) 0 = not reset (default), 1 = reset
  , Input dom -> Signal dom Bit
orstbot   :: Signal dom Bit -- ^ reset input to bottom accumulator register (for adder/subtractor, accumulator, and MAC functions) 0 = not reset (default), 1 = rest
  , Input dom -> Signal dom Bit
ahold     :: Signal dom Bit -- ^ register A hold input. Control data flow input register A. 0 = load (default), 1 = hold
  , Input dom -> Signal dom Bit
bhold     :: Signal dom Bit -- ^ register B hold input. Control data flow input register B. 0 = load (default), 1 = hold
  , Input dom -> Signal dom Bit
chold     :: Signal dom Bit -- ^ register C hold input. Control data flow input register C. 0 = load (default), 1 = hold
  , Input dom -> Signal dom Bit
dhold     :: Signal dom Bit -- ^ register D hold input. Control data flow input register D. 0 = load (default), 1 = hold
  , Input dom -> Signal dom Bit
oholdtop  :: Signal dom Bit -- ^ top accumulator output register hold input. control data flow into the register. 0 = load (default), 1 = hold
  , Input dom -> Signal dom Bit
oholdbot  :: Signal dom Bit -- ^ bottom accumulator output register hold input. control data flow into the register. 0 = load (default), 1 = hold
  , Input dom -> Signal dom Bit
addsubtop :: Signal dom Bit -- ^ add/subtract control input to top accumulator. 0 = add (default), 1 = subtract
  , Input dom -> Signal dom Bit
addsubbot :: Signal dom Bit -- ^ add/subtract control input to bottom accumulator. 0 = add (default), 1 = subtract
  , Input dom -> Signal dom Bit
oloadtop  :: Signal dom Bit -- ^ load control input to top accumulator register (initialize on MAC function). 0 = not load (default), 1 = load data from register/input C
  , Input dom -> Signal dom Bit
oloadbot  :: Signal dom Bit -- ^ load control input to bottom accumulator register (initialize on MAC function). 0 = not load (default), 1 = load data from register/input D
  , Input dom -> Signal dom Bit
accumci   :: Signal dom Bit -- ^ cascaded accumulator carry input from previous DSP block, default = 0
  , Input dom -> Signal dom Bit
signextin :: Signal dom Bit -- ^ sign extension input from previous DSP block, default = 0
  , Input dom -> Signal dom Bit
ci        :: Signal dom Bit -- ^ cascaded add/sub carry input from previous DSP block, default = 0
  }

-- | default MAC inputs
defaultInput :: Input dom
defaultInput :: Input dom
defaultInput = Input :: forall (dom :: Domain).
Signal dom Bit
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Input dom
Input
  { ce :: Signal dom Bit
ce        = Signal dom Bit
1
  , c :: Signal dom (BitVector 16)
c         = Signal dom (BitVector 16)
0
  , a :: Signal dom (BitVector 16)
a         = Signal dom (BitVector 16)
0
  , b :: Signal dom (BitVector 16)
b         = Signal dom (BitVector 16)
0
  , d :: Signal dom (BitVector 16)
d         = Signal dom (BitVector 16)
0
  , irsttop :: Signal dom Bit
irsttop   = Signal dom Bit
0
  , irstbot :: Signal dom Bit
irstbot   = Signal dom Bit
0
  , orsttop :: Signal dom Bit
orsttop   = Signal dom Bit
0
  , orstbot :: Signal dom Bit
orstbot   = Signal dom Bit
0
  , ahold :: Signal dom Bit
ahold     = Signal dom Bit
0
  , bhold :: Signal dom Bit
bhold     = Signal dom Bit
0
  , chold :: Signal dom Bit
chold     = Signal dom Bit
0
  , dhold :: Signal dom Bit
dhold     = Signal dom Bit
0
  , oholdtop :: Signal dom Bit
oholdtop  = Signal dom Bit
0
  , oholdbot :: Signal dom Bit
oholdbot  = Signal dom Bit
0
  , addsubtop :: Signal dom Bit
addsubtop = Signal dom Bit
0
  , addsubbot :: Signal dom Bit
addsubbot = Signal dom Bit
0
  , oloadtop :: Signal dom Bit
oloadtop  = Signal dom Bit
0
  , oloadbot :: Signal dom Bit
oloadbot  = Signal dom Bit
0
  , accumci :: Signal dom Bit
accumci   = Signal dom Bit
0
  , signextin :: Signal dom Bit
signextin = Signal dom Bit
0
  , ci :: Signal dom Bit
ci        = Signal dom Bit
0
  }

-- | MAC parameters
data Parameter = Parameter
  { Parameter -> Bit
negTrigger :: Bit -- ^ input clock polarity, 0 = rising edge (default), 1 = falling edge
  , Parameter -> Bit
aReg :: Bit -- ^ input A register control, 0 = not registered (default), 1 = registered
  , Parameter -> Bit
bReg :: Bit -- ^ input B register control, 0 = not registered (default), 1 = registered
  , Parameter -> Bit
cReg :: Bit -- ^ input C register control, 0 = not registered (default), 1 = registered
  , Parameter -> Bit
dReg :: Bit -- ^ input D register control, 0 = not registered (default), 1 = registered
  , Parameter -> Bit
top8x8MultReg :: Bit -- ^ top 8x8 multiplier output register control (pipeline register for MAC). 0 = not registered (default), 1 = registered
  , Parameter -> Bit
bot8x8MultReg :: Bit -- ^ bottom 8x8 multiplier output register control (pipeline register for MAC). 0 = not registered (default), 1 = registered
  , Parameter -> Bit
pipeline16x16MultReg1 :: Bit -- ^ 16x16 multiplier pipeline register control. 0 = not registered (default), 1 = registered
  , Parameter -> Bit
pipeline16x16MultReg2 :: Bit -- ^ 16x16 multiplier output register control (pipeline register for MAC). 0 = not registered (default), 1 = registered
  , Parameter -> BitVector 2
topOutputSelect      :: BitVector 2 -- ^ top output select. 00 = adder-subtractor not registered (default), 01 = adder-subtractor registered, 10 = 8x8 multiplier, 11 = 16x16 multiplier
  , Parameter -> BitVector 2
topAddSubLowerInput  :: BitVector 2 -- ^ input X of upper adder-subtractor. 00 = input A (default), 01 = 8x8 multiplier output at top, 10 = 16x16 multiplier upper 16-bit outputs, 11 = sign extension from Z15 (lower adder-subtractor input)
  , Parameter -> Bit
topAddSubUpperInput  :: Bit -- ^ input W of upper adder-subtractor. 0 = output of adder-subtractor register (accumulation function) (default), 1 = input C
  , Parameter -> BitVector 2
topAddSubCarrySelect :: BitVector 2 -- ^ carry input select top adder-subtractor, 00 = constant 0 (default), 01 = constant 1, 10 = cascade ACCUMOUT from lower adder-subtractor, 11 = cascade CO from lower adder-subtractor
  , Parameter -> BitVector 2
botOutputSelect      :: BitVector 2 -- ^ bottom output select. 00 = adder-subtractor not registered (default), 01 = adder-subtractor registered, 10 = 8x8 multiplier, 16x16 multiplier
  , Parameter -> BitVector 2
botAddSubLowerInput  :: BitVector 2 -- ^ input Z of upper adder-subtractor. 00 = input B (default), 01 = 8x8 multiplier output at top, 10 = 16x16 multiplier upper 16-bit outputs, 11 = sign extension from SIGNEXTIN
  , Parameter -> Bit
botAddSubUpperInput  :: Bit -- ^ input Y of upper adder-subtractor. 0 = output of adder-subtractor output register (accumulation function) (default), 1 = input D
  , Parameter -> BitVector 2
botAddSubCarrySelect :: BitVector 2 -- ^ carry input select bottom adder-subtractor. 00 = constant 0 (default), 01 = constant 1, 10 = cascade ACCUMOUT from lower DSP block, 11 = cascade CO from lower DSP block
  , Parameter -> Bit
mode8x8 :: Bit -- ^ select 8x8 multiplier mode (power saving. 0 = not selected (default), 1 = selected
  , Parameter -> Bit
aSigned :: Bit -- ^ input A sign. 0 = input A is unsigned (default), 1 = input A is signed
  , Parameter -> Bit
bSigned :: Bit -- ^ input B sign. 0 = input B is unsigned (default), 1 = input B is signed
  }

-- | default MAC parameters
defaultParameter :: Parameter
defaultParameter :: Parameter
defaultParameter = Parameter :: Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> BitVector 2
-> BitVector 2
-> Bit
-> BitVector 2
-> BitVector 2
-> BitVector 2
-> Bit
-> BitVector 2
-> Bit
-> Bit
-> Bit
-> Parameter
Parameter
  { negTrigger :: Bit
negTrigger = Bit
0
  , aReg :: Bit
aReg = Bit
0
  , bReg :: Bit
bReg = Bit
0
  , cReg :: Bit
cReg = Bit
0
  , dReg :: Bit
dReg = Bit
0
  , top8x8MultReg :: Bit
top8x8MultReg = Bit
0
  , bot8x8MultReg :: Bit
bot8x8MultReg = Bit
0
  , pipeline16x16MultReg1 :: Bit
pipeline16x16MultReg1 = Bit
0
  , pipeline16x16MultReg2 :: Bit
pipeline16x16MultReg2 = Bit
0
  , topOutputSelect :: BitVector 2
topOutputSelect = BitVector 2
0
  , topAddSubLowerInput :: BitVector 2
topAddSubLowerInput = BitVector 2
0
  , topAddSubUpperInput :: Bit
topAddSubUpperInput = Bit
0
  , topAddSubCarrySelect :: BitVector 2
topAddSubCarrySelect = BitVector 2
0
  , botOutputSelect :: BitVector 2
botOutputSelect = BitVector 2
0
  , botAddSubLowerInput :: BitVector 2
botAddSubLowerInput = BitVector 2
0
  , botAddSubUpperInput :: Bit
botAddSubUpperInput = Bit
0
  , botAddSubCarrySelect :: BitVector 2
botAddSubCarrySelect = BitVector 2
0
  , mode8x8 :: Bit
mode8x8 = Bit
0
  , aSigned :: Bit
aSigned = Bit
0
  , bSigned :: Bit
bSigned = Bit
0
  }

-- | MAC primitive wrapper
mac
  :: HiddenClock dom
  => Parameter
  -> Input dom
  -> ( Signal dom (BitVector 32)
     , Signal dom Bit
     , Signal dom Bit
     , Signal dom Bit
     )
mac :: Parameter
-> Input dom
-> (Signal dom (BitVector 32), Signal dom Bit, Signal dom Bit,
    Signal dom Bit)
mac Parameter{BitVector 2
Bit
bSigned :: Bit
aSigned :: Bit
mode8x8 :: Bit
botAddSubCarrySelect :: BitVector 2
botAddSubUpperInput :: Bit
botAddSubLowerInput :: BitVector 2
botOutputSelect :: BitVector 2
topAddSubCarrySelect :: BitVector 2
topAddSubUpperInput :: Bit
topAddSubLowerInput :: BitVector 2
topOutputSelect :: BitVector 2
pipeline16x16MultReg2 :: Bit
pipeline16x16MultReg1 :: Bit
bot8x8MultReg :: Bit
top8x8MultReg :: Bit
dReg :: Bit
cReg :: Bit
bReg :: Bit
aReg :: Bit
negTrigger :: Bit
bSigned :: Parameter -> Bit
aSigned :: Parameter -> Bit
mode8x8 :: Parameter -> Bit
botAddSubCarrySelect :: Parameter -> BitVector 2
botAddSubUpperInput :: Parameter -> Bit
botAddSubLowerInput :: Parameter -> BitVector 2
botOutputSelect :: Parameter -> BitVector 2
topAddSubCarrySelect :: Parameter -> BitVector 2
topAddSubUpperInput :: Parameter -> Bit
topAddSubLowerInput :: Parameter -> BitVector 2
topOutputSelect :: Parameter -> BitVector 2
pipeline16x16MultReg2 :: Parameter -> Bit
pipeline16x16MultReg1 :: Parameter -> Bit
bot8x8MultReg :: Parameter -> Bit
top8x8MultReg :: Parameter -> Bit
dReg :: Parameter -> Bit
cReg :: Parameter -> Bit
bReg :: Parameter -> Bit
aReg :: Parameter -> Bit
negTrigger :: Parameter -> Bit
..} Input{Signal dom (BitVector 16)
Signal dom Bit
ci :: Signal dom Bit
signextin :: Signal dom Bit
accumci :: Signal dom Bit
oloadbot :: Signal dom Bit
oloadtop :: Signal dom Bit
addsubbot :: Signal dom Bit
addsubtop :: Signal dom Bit
oholdbot :: Signal dom Bit
oholdtop :: Signal dom Bit
dhold :: Signal dom Bit
chold :: Signal dom Bit
bhold :: Signal dom Bit
ahold :: Signal dom Bit
orstbot :: Signal dom Bit
orsttop :: Signal dom Bit
irstbot :: Signal dom Bit
irsttop :: Signal dom Bit
d :: Signal dom (BitVector 16)
b :: Signal dom (BitVector 16)
a :: Signal dom (BitVector 16)
c :: Signal dom (BitVector 16)
ce :: Signal dom Bit
ci :: forall (dom :: Domain). Input dom -> Signal dom Bit
signextin :: forall (dom :: Domain). Input dom -> Signal dom Bit
accumci :: forall (dom :: Domain). Input dom -> Signal dom Bit
oloadbot :: forall (dom :: Domain). Input dom -> Signal dom Bit
oloadtop :: forall (dom :: Domain). Input dom -> Signal dom Bit
addsubbot :: forall (dom :: Domain). Input dom -> Signal dom Bit
addsubtop :: forall (dom :: Domain). Input dom -> Signal dom Bit
oholdbot :: forall (dom :: Domain). Input dom -> Signal dom Bit
oholdtop :: forall (dom :: Domain). Input dom -> Signal dom Bit
dhold :: forall (dom :: Domain). Input dom -> Signal dom Bit
chold :: forall (dom :: Domain). Input dom -> Signal dom Bit
bhold :: forall (dom :: Domain). Input dom -> Signal dom Bit
ahold :: forall (dom :: Domain). Input dom -> Signal dom Bit
orstbot :: forall (dom :: Domain). Input dom -> Signal dom Bit
orsttop :: forall (dom :: Domain). Input dom -> Signal dom Bit
irstbot :: forall (dom :: Domain). Input dom -> Signal dom Bit
irsttop :: forall (dom :: Domain). Input dom -> Signal dom Bit
d :: forall (dom :: Domain). Input dom -> Signal dom (BitVector 16)
b :: forall (dom :: Domain). Input dom -> Signal dom (BitVector 16)
a :: forall (dom :: Domain). Input dom -> Signal dom (BitVector 16)
c :: forall (dom :: Domain). Input dom -> Signal dom (BitVector 16)
ce :: forall (dom :: Domain). Input dom -> Signal dom Bit
..}
  = Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> BitVector 2
-> BitVector 2
-> Bit
-> BitVector 2
-> BitVector 2
-> BitVector 2
-> Bit
-> BitVector 2
-> Bit
-> Bit
-> Bit
-> Clock dom
-> Signal dom Bit
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> (Signal dom (BitVector 32), Signal dom Bit, Signal dom Bit,
    Signal dom Bit)
forall (dom :: Domain).
Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> Bit
-> BitVector 2
-> BitVector 2
-> Bit
-> BitVector 2
-> BitVector 2
-> BitVector 2
-> Bit
-> BitVector 2
-> Bit
-> Bit
-> Bit
-> Clock dom
-> Signal dom Bit
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom (BitVector 16)
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> Signal dom Bit
-> (Signal dom (BitVector 32), Signal dom Bit, Signal dom Bit,
    Signal dom Bit)
macPrim Bit
negTrigger
            Bit
aReg
            Bit
bReg
            Bit
cReg
            Bit
dReg
            Bit
top8x8MultReg
            Bit
bot8x8MultReg
            Bit
pipeline16x16MultReg1
            Bit
pipeline16x16MultReg2
            BitVector 2
topOutputSelect
            BitVector 2
topAddSubLowerInput
            Bit
topAddSubUpperInput
            BitVector 2
topAddSubCarrySelect
            BitVector 2
botOutputSelect
            BitVector 2
botAddSubLowerInput
            Bit
botAddSubUpperInput
            BitVector 2
botAddSubCarrySelect
            Bit
mode8x8
            Bit
aSigned
            Bit
bSigned
            Clock dom
forall (dom :: Domain). HiddenClock dom => Clock dom
hasClock
            Signal dom Bit
ce
            Signal dom (BitVector 16)
c
            Signal dom (BitVector 16)
a
            Signal dom (BitVector 16)
b
            Signal dom (BitVector 16)
d
            Signal dom Bit
irsttop
            Signal dom Bit
irstbot
            Signal dom Bit
orsttop
            Signal dom Bit
orstbot
            Signal dom Bit
ahold
            Signal dom Bit
bhold
            Signal dom Bit
chold
            Signal dom Bit
dhold
            Signal dom Bit
oholdtop
            Signal dom Bit
oholdbot
            Signal dom Bit
addsubtop
            Signal dom Bit
addsubbot
            Signal dom Bit
oloadtop
            Signal dom Bit
oloadbot
            Signal dom Bit
accumci
            Signal dom Bit
signextin
            Signal dom Bit
ci