{-|
Copyright  :  (C) 2013-2016, University of Twente,
                  2016-2017, Myrtle Software Ltd,
                  2017     , Google Inc.
License    :  BSD2 (see the file LICENSE)
Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>

BlockRAM primitives

= Using RAMs #usingrams#

We will show a rather elaborate example on how you can, and why you might want
to use 'blockRam's. We will build a \"small\" CPU+Memory+Program ROM where we
will slowly evolve to using blockRams. Note that the code is /not/ meant as a
de-facto standard on how to do CPU design in Clash.

We start with the definition of the Instructions, Register names and machine
codes:

@
{\-\# LANGUAGE RecordWildCards, TupleSections, DeriveAnyClass \#-\}

module CPU where

import Clash.Explicit.Prelude

type InstrAddr = Unsigned 8
type MemAddr   = Unsigned 5
type Value     = Signed 8

data Instruction
  = Compute Operator Reg Reg Reg
  | Branch Reg Value
  | Jump Value
  | Load MemAddr Reg
  | Store Reg MemAddr
  | Nop
  deriving (Eq,Show)

data Reg
  = Zero
  | PC
  | RegA
  | RegB
  | RegC
  | RegD
  | RegE
  deriving (Eq,Show,Enum)

data Operator = Add | Sub | Incr | Imm | CmpGt
  deriving (Eq,Show)

data MachCode
  = MachCode
  { inputX  :: Reg
  , inputY  :: Reg
  , result  :: Reg
  , aluCode :: Operator
  , ldReg   :: Reg
  , rdAddr  :: MemAddr
  , wrAddrM :: Maybe MemAddr
  , jmpM    :: Maybe Value
  }

nullCode = MachCode { inputX = Zero, inputY = Zero, result = Zero, aluCode = Imm
                    , ldReg = Zero, rdAddr = 0, wrAddrM = Nothing
                    , jmpM = Nothing
                    }
@

Next we define the CPU and its ALU:

@
cpu
  :: Vec 7 Value
  -- ^ Register bank
  -> (Value,Instruction)
  -- ^ (Memory output, Current instruction)
  -> ( Vec 7 Value
     , (MemAddr, Maybe (MemAddr,Value), InstrAddr)
     )
cpu regbank (memOut,instr) = (regbank',(rdAddr,(,aluOut) '<$>' wrAddrM,fromIntegral ipntr))
  where
    -- Current instruction pointer
    ipntr = regbank 'Clash.Sized.Vector.!!' PC

    -- Decoder
    (MachCode {..}) = case instr of
      Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}
      Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}
      Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}
      Load a r             -> nullCode {ldReg=r,rdAddr=a}
      Store r a            -> nullCode {inputX=r,wrAddrM=Just a}
      Nop                  -> nullCode

    -- ALU
    regX   = regbank 'Clash.Sized.Vector.!!' inputX
    regY   = regbank 'Clash.Sized.Vector.!!' inputY
    aluOut = alu aluCode regX regY

    -- next instruction
    nextPC = case jmpM of
               Just a | aluOut /= 0 -> ipntr + a
               _                    -> ipntr + 1

    -- update registers
    regbank' = 'Clash.Sized.Vector.replace' Zero   0
             $ 'Clash.Sized.Vector.replace' PC     nextPC
             $ 'Clash.Sized.Vector.replace' result aluOut
             $ 'Clash.Sized.Vector.replace' ldReg  memOut
             $ regbank

alu Add   x y = x + y
alu Sub   x y = x - y
alu Incr  x _ = x + 1
alu Imm   x _ = x
alu CmpGt x y = if x > y then 1 else 0
@

We initially create a memory out of simple registers:

@
dataMem
  :: KnownDomain dom
  => Clock dom
  -> Reset dom
  -> Enable dom
  -> Signal dom MemAddr
  -- ^ Read address
  -> Signal dom (Maybe (MemAddr,Value))
  -- ^ (write address, data in)
  -> Signal dom Value
  -- ^ data out
dataMem clk rst en rd wrM = 'Clash.Explicit.Mealy.mealy' clk rst en dataMemT ('Clash.Sized.Vector.replicate' d32 0) (bundle (rd,wrM))
  where
    dataMemT mem (rd,wrM) = (mem',dout)
      where
        dout = mem 'Clash.Sized.Vector.!!' rd
        mem' = case wrM of
                 Just (wr,din) -> 'Clash.Sized.Vector.replace' wr din mem
                 _ -> mem
@

And then connect everything:

@
system
  :: ( KnownDomain dom
     , KnownNat n )
  => Vec n Instruction
  -> Clock dom
  -> Reset dom
  -> Enable dom
  -> Signal dom Value
system instrs clk rst en = memOut
  where
    memOut = dataMem clk rst en rdAddr dout
    (rdAddr,dout,ipntr) = 'Clash.Explicit.Mealy.mealyB' clk rst en cpu ('Clash.Sized.Vector.replicate' d7 0) (memOut,instr)
    instr  = 'Clash.Explicit.Prelude.asyncRom' instrs '<$>' ipntr
@

Create a simple program that calculates the GCD of 4 and 6:

@
-- Compute GCD of 4 and 6
prog = -- 0 := 4
       Compute Incr Zero RegA RegA :>
       replicate d3 (Compute Incr RegA Zero RegA) ++
       Store RegA 0 :>
       -- 1 := 6
       Compute Incr Zero RegA RegA :>
       replicate d5 (Compute Incr RegA Zero RegA) ++
       Store RegA 1 :>
       -- A := 4
       Load 0 RegA :>
       -- B := 6
       Load 1 RegB :>
       -- start
       Compute CmpGt RegA RegB RegC :>
       Branch RegC 4 :>
       Compute CmpGt RegB RegA RegC :>
       Branch RegC 4 :>
       Jump 5 :>
       -- (a > b)
       Compute Sub RegA RegB RegA :>
       Jump (-6) :>
       -- (b > a)
       Compute Sub RegB RegA RegB :>
       Jump (-8) :>
       -- end
       Store RegA 2 :>
       Load 2 RegC :>
       Nil
@

And test our system:

@
>>> sampleN 32 $ system prog systemClockGen resetGen enableGen
[0,0,0,0,0,0,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2]

@

to see that our system indeed calculates that the GCD of 6 and 4 is 2.

=== Improvement 1: using @asyncRam@

As you can see, it's fairly straightforward to build a memory using registers
and read ('Clash.Sized.Vector.!!') and write ('Clash.Sized.Vector.replace')
logic. This might however not result in the most efficient hardware structure,
especially when building an ASIC.

Instead it is preferable to use the 'Clash.Prelude.RAM.asyncRam' function which
has the potential to be translated to a more efficient structure:

@
system2
  :: ( KnownDomain dom
     , KnownNat n )
  => Vec n Instruction
  -> Clock dom
  -> Reset dom
  -> Enable dom
  -> Signal dom Value
system2 instrs clk rst en = memOut
  where
    memOut = 'Clash.Explicit.RAM.asyncRam' clk clk en d32 rdAddr dout
    (rdAddr,dout,ipntr) = 'Clash.Explicit.Prelude.mealyB' clk rst en cpu ('Clash.Sized.Vector.replicate' d7 0) (memOut,instr)
    instr  = 'Clash.Prelude.ROM.asyncRom' instrs '<$>' ipntr
@

Again, we can simulate our system and see that it works. This time however,
we need to disregard the first few output samples, because the initial content of an
'Clash.Prelude.RAM.asyncRam' is /undefined/, and consequently, the first few
output samples are also /undefined/. We use the utility function
'Clash.XException.printX' to conveniently filter out the undefinedness and
replace it with the string "X" in the few leading outputs.

@
>>> printX $ sampleN 32 $ system2 prog systemClockGen resetGen enableGen
[X,X,X,X,X,X,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2]

@

=== Improvement 2: using @blockRam@

Finally we get to using 'blockRam'. On FPGAs, 'Clash.Prelude.RAM.asyncRam' will
be implemented in terms of LUTs, and therefore take up logic resources. FPGAs
also have large(r) memory structures called /Block RAMs/, which are preferred,
especially as the memories we need for our application get bigger. The
'blockRam' function will be translated to such a /Block RAM/.

One important aspect of Block RAMs have a /synchronous/ read port, meaning that,
unlike the behavior of 'Clash.Prelude.RAM.asyncRam', given a read address @r@
at time @t@, the value @v@ in the RAM at address @r@ is only available at time
@t+1@.

For us that means we need to change the design of our CPU. Right now, upon a
load instruction we generate a read address for the memory, and the value at
that read address is immediately available to be put in the register bank.
Because we will be using a BlockRAM, the value is delayed until the next cycle.
We hence need to also delay the register address to which the memory address
is loaded:

@
cpu2
  :: (Vec 7 Value,Reg)
  -- ^ (Register bank, Load reg addr)
  -> (Value,Instruction)
  -- ^ (Memory output, Current instruction)
  -> ( (Vec 7 Value,Reg)
     , (MemAddr, Maybe (MemAddr,Value), InstrAddr)
     )
cpu2 (regbank,ldRegD) (memOut,instr) = ((regbank',ldRegD'),(rdAddr,(,aluOut) '<$>' wrAddrM,fromIntegral ipntr))
  where
    -- Current instruction pointer
    ipntr = regbank 'Clash.Sized.Vector.!!' PC

    -- Decoder
    (MachCode {..}) = case instr of
      Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}
      Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}
      Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}
      Load a r             -> nullCode {ldReg=r,rdAddr=a}
      Store r a            -> nullCode {inputX=r,wrAddrM=Just a}
      Nop                  -> nullCode

    -- ALU
    regX   = regbank 'Clash.Sized.Vector.!!' inputX
    regY   = regbank 'Clash.Sized.Vector.!!' inputY
    aluOut = alu aluCode regX regY

    -- next instruction
    nextPC = case jmpM of
               Just a | aluOut /= 0 -> ipntr + a
               _                    -> ipntr + 1

    -- update registers
    ldRegD'  = ldReg -- Delay the ldReg by 1 cycle
    regbank' = 'Clash.Sized.Vector.replace' Zero   0
             $ 'Clash.Sized.Vector.replace' PC     nextPC
             $ 'Clash.Sized.Vector.replace' result aluOut
             $ 'Clash.Sized.Vector.replace' ldRegD memOut
             $ regbank
@

We can now finally instantiate our system with a 'blockRam':

@
system3
  :: ( KnownDomain dom
     , KnownNat n )
  => Vec n Instruction
  -> Clock dom
  -> Reset dom
  -> Enable dom
  -> Signal dom Value
system3 instrs clk rst en = memOut
  where
    memOut = 'blockRam' clk en (replicate d32 0) rdAddr dout
    (rdAddr,dout,ipntr) = 'Clash.Explicit.Prelude.mealyB' clk rst en cpu2 (('Clash.Sized.Vector.replicate' d7 0),Zero) (memOut,instr)
    instr  = 'Clash.Explicit.Prelude.asyncRom' instrs '<$>' ipntr
@

We are, however, not done. We will also need to update our program. The reason
being that values that we try to load in our registers won't be loaded into the
register until the next cycle. This is a problem when the next instruction
immediately depended on this memory value. In our case, this was only the case
when the loaded the value @6@, which was stored at address @1@, into @RegB@.
Our updated program is thus:

@
prog2 = -- 0 := 4
       Compute Incr Zero RegA RegA :>
       replicate d3 (Compute Incr RegA Zero RegA) ++
       Store RegA 0 :>
       -- 1 := 6
       Compute Incr Zero RegA RegA :>
       replicate d5 (Compute Incr RegA Zero RegA) ++
       Store RegA 1 :>
       -- A := 4
       Load 0 RegA :>
       -- B := 6
       Load 1 RegB :>
       Nop :> -- Extra NOP
       -- start
       Compute CmpGt RegA RegB RegC :>
       Branch RegC 4 :>
       Compute CmpGt RegB RegA RegC :>
       Branch RegC 4 :>
       Jump 5 :>
       -- (a > b)
       Compute Sub RegA RegB RegA :>
       Jump (-6) :>
       -- (b > a)
       Compute Sub RegB RegA RegB :>
       Jump (-8) :>
       -- end
       Store RegA 2 :>
       Load 2 RegC :>
       Nil
@

When we simulate our system we see that it works. This time again,
we need to disregard the first sample, because the initial output of a
'blockRam' is /undefined/. We use the utility function 'Clash.XException.printX'
to conveniently filter out the undefinedness and replace it with the string "X".

@
>>> printX $ sampleN 34 $ system3 prog2 systemClockGen resetGen enableGen
[X,0,0,0,0,0,0,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2]

@

This concludes the short introduction to using 'blockRam'.

-}

{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude#-}

{-# LANGUAGE Trustworthy #-}

{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c
-- as to why we need this.
{-# OPTIONS_GHC -fno-cpr-anal #-}

module Clash.Explicit.BlockRam
  ( -- * BlockRAM synchronized to the system clock
    blockRam
  , blockRamPow2
  , blockRamU
  , blockRam1
  , ResetStrategy(..)
    -- * Read/Write conflict resolution
  , readNew
    -- * Internal
  , blockRam#
  )
where

import           Clash.HaskellPrelude

import           Data.Maybe             (isJust)
import qualified Data.Sequence          as Seq
import           GHC.Stack              (HasCallStack, withFrozenCallStack)
import           GHC.TypeLits           (KnownNat, type (^), type (<=))

import           Clash.Annotations.Primitive
  (hasBlackBox)
import           Clash.Class.Num        (SaturationMode(SatBound), satSucc)
import           Clash.Explicit.Signal  (KnownDomain, Enable, register, fromEnable)
import           Clash.Signal.Internal
  (Clock(..), Reset, Signal (..), invertReset, (.&&.), mux)
import           Clash.Promoted.Nat     (SNat(..))
import           Clash.Signal.Bundle    (unbundle)
import           Clash.Sized.Unsigned   (Unsigned)
import           Clash.Sized.Index      (Index)
import           Clash.Sized.Vector     (Vec, replicate, toList, iterateI)
import qualified Clash.Sized.Vector     as CV
import           Clash.XException
  (maybeIsX, seqX, NFDataX, deepErrorX, defaultSeqX, fromJustX, undefined)

{- $setup
>>> :m -Clash.Prelude
>>> :m -Clash.Prelude.Safe
>>> import Clash.Explicit.Prelude as C
>>> import qualified Data.List as L
>>> :set -XDataKinds -XRecordWildCards -XTupleSections -XDeriveAnyClass -XDeriveGeneric
>>> type InstrAddr = Unsigned 8
>>> type MemAddr = Unsigned 5
>>> type Value = Signed 8
>>> :{
data Reg
  = Zero
  | PC
  | RegA
  | RegB
  | RegC
  | RegD
  | RegE
  deriving (Eq,Show,Enum,C.Generic,NFDataX)
:}

>>> :{
data Operator = Add | Sub | Incr | Imm | CmpGt
  deriving (Eq,Show)
:}

>>> :{
data Instruction
  = Compute Operator Reg Reg Reg
  | Branch Reg Value
  | Jump Value
  | Load MemAddr Reg
  | Store Reg MemAddr
  | Nop
  deriving (Eq,Show)
:}

>>> :{
data MachCode
  = MachCode
  { inputX  :: Reg
  , inputY  :: Reg
  , result  :: Reg
  , aluCode :: Operator
  , ldReg   :: Reg
  , rdAddr  :: MemAddr
  , wrAddrM :: Maybe MemAddr
  , jmpM    :: Maybe Value
  }
:}

>>> :{
nullCode = MachCode { inputX = Zero, inputY = Zero, result = Zero, aluCode = Imm
                    , ldReg = Zero, rdAddr = 0, wrAddrM = Nothing
                    , jmpM = Nothing
                    }
:}

>>> :{
alu Add   x y = x + y
alu Sub   x y = x - y
alu Incr  x _ = x + 1
alu Imm   x _ = x
alu CmpGt x y = if x > y then 1 else 0
:}

>>> :{
let cpu :: Vec 7 Value          -- ^ Register bank
        -> (Value,Instruction)  -- ^ (Memory output, Current instruction)
        -> ( Vec 7 Value
           , (MemAddr,Maybe (MemAddr,Value),InstrAddr)
           )
    cpu regbank (memOut,instr) = (regbank',(rdAddr,(,aluOut) <$> wrAddrM,fromIntegral ipntr))
      where
        -- Current instruction pointer
        ipntr = regbank C.!! PC
        -- Decoder
        (MachCode {..}) = case instr of
          Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}
          Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}
          Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}
          Load a r             -> nullCode {ldReg=r,rdAddr=a}
          Store r a            -> nullCode {inputX=r,wrAddrM=Just a}
          Nop                  -> nullCode
        -- ALU
        regX   = regbank C.!! inputX
        regY   = regbank C.!! inputY
        aluOut = alu aluCode regX regY
        -- next instruction
        nextPC = case jmpM of
                   Just a | aluOut /= 0 -> ipntr + a
                   _                    -> ipntr + 1
        -- update registers
        regbank' = replace Zero   0
                 $ replace PC     nextPC
                 $ replace result aluOut
                 $ replace ldReg  memOut
                 $ regbank
:}

>>> :{
let dataMem
      :: KnownDomain dom
      => Clock  dom
      -> Reset  dom
      -> Enable dom
      -> Signal dom MemAddr
      -> Signal dom (Maybe (MemAddr,Value))
      -> Signal dom Value
    dataMem clk rst en rd wrM = mealy clk rst en dataMemT (C.replicate d32 0) (bundle (rd,wrM))
      where
        dataMemT mem (rd,wrM) = (mem',dout)
          where
            dout = mem C.!! rd
            mem' = case wrM of
                     Just (wr,din) -> replace wr din mem
                     Nothing       -> mem
:}

>>> :{
let system
      :: ( KnownDomain dom
         , KnownNat n )
      => Vec n Instruction
      -> Clock dom
      -> Reset dom
      -> Enable dom
      -> Signal dom Value
    system instrs clk rst en = memOut
      where
        memOut = dataMem clk rst en rdAddr dout
        (rdAddr,dout,ipntr) = mealyB clk rst en cpu (C.replicate d7 0) (memOut,instr)
        instr  = asyncRom instrs <$> ipntr
:}

>>> :{
-- Compute GCD of 4 and 6
prog = -- 0 := 4
       Compute Incr Zero RegA RegA :>
       C.replicate d3 (Compute Incr RegA Zero RegA) C.++
       Store RegA 0 :>
       -- 1 := 6
       Compute Incr Zero RegA RegA :>
       C.replicate d5 (Compute Incr RegA Zero RegA) C.++
       Store RegA 1 :>
       -- A := 4
       Load 0 RegA :>
       -- B := 6
       Load 1 RegB :>
       -- start
       Compute CmpGt RegA RegB RegC :>
       Branch RegC 4 :>
       Compute CmpGt RegB RegA RegC :>
       Branch RegC 4 :>
       Jump 5 :>
       -- (a > b)
       Compute Sub RegA RegB RegA :>
       Jump (-6) :>
       -- (b > a)
       Compute Sub RegB RegA RegB :>
       Jump (-8) :>
       -- end
       Store RegA 2 :>
       Load 2 RegC :>
       Nil
:}

>>> :{
let system2
      :: ( KnownDomain dom
         , KnownNat n )
      => Vec n Instruction
      -> Clock dom
      -> Reset dom
      -> Enable dom
      -> Signal dom Value
    system2 instrs clk rst en = memOut
      where
        memOut = asyncRam clk clk en d32 rdAddr dout
        (rdAddr,dout,ipntr) = mealyB clk rst en cpu (C.replicate d7 0) (memOut,instr)
        instr  = asyncRom instrs <$> ipntr
:}

>>> :{
let cpu2 :: (Vec 7 Value,Reg)    -- ^ (Register bank, Load reg addr)
         -> (Value,Instruction)  -- ^ (Memory output, Current instruction)
         -> ( (Vec 7 Value,Reg)
            , (MemAddr,Maybe (MemAddr,Value),InstrAddr)
            )
    cpu2 (regbank,ldRegD) (memOut,instr) = ((regbank',ldRegD'),(rdAddr,(,aluOut) <$> wrAddrM,fromIntegral ipntr))
      where
        -- Current instruction pointer
        ipntr = regbank C.!! PC
        -- Decoder
        (MachCode {..}) = case instr of
          Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}
          Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}
          Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}
          Load a r             -> nullCode {ldReg=r,rdAddr=a}
          Store r a            -> nullCode {inputX=r,wrAddrM=Just a}
          Nop                  -> nullCode
        -- ALU
        regX   = regbank C.!! inputX
        regY   = regbank C.!! inputY
        aluOut = alu aluCode regX regY
        -- next instruction
        nextPC = case jmpM of
                   Just a | aluOut /= 0 -> ipntr + a
                   _                    -> ipntr + 1
        -- update registers
        ldRegD'  = ldReg -- Delay the ldReg by 1 cycle
        regbank' = replace Zero   0
                 $ replace PC     nextPC
                 $ replace result aluOut
                 $ replace ldRegD memOut
                 $ regbank
:}

>>> :{
let system3
      :: ( KnownDomain dom
         , KnownNat n )
      => Vec n Instruction
      -> Clock dom
      -> Reset dom
      -> Enable dom
      -> Signal dom Value
    system3 instrs clk rst en = memOut
      where
        memOut = blockRam clk en (C.replicate d32 0) rdAddr dout
        (rdAddr,dout,ipntr) = mealyB clk rst en cpu2 ((C.replicate d7 0),Zero) (memOut,instr)
        instr  = asyncRom instrs <$> ipntr
:}

>>> :{
prog2 = -- 0 := 4
       Compute Incr Zero RegA RegA :>
       C.replicate d3 (Compute Incr RegA Zero RegA) C.++
       Store RegA 0 :>
       -- 1 := 6
       Compute Incr Zero RegA RegA :>
       C.replicate d5 (Compute Incr RegA Zero RegA) C.++
       Store RegA 1 :>
       -- A := 4
       Load 0 RegA :>
       -- B := 6
       Load 1 RegB :>
       Nop :> -- Extra NOP
       -- start
       Compute CmpGt RegA RegB RegC :>
       Branch RegC 4 :>
       Compute CmpGt RegB RegA RegC :>
       Branch RegC 4 :>
       Jump 5 :>
       -- (a > b)
       Compute Sub RegA RegB RegA :>
       Jump (-6) :>
       -- (b > a)
       Compute Sub RegB RegA RegB :>
       Jump (-8) :>
       -- end
       Store RegA 2 :>
       Load 2 RegC :>
       Nil
:}

-}

-- | Create a blockRAM with space for @n@ elements
--
-- * __NB__: Read value is delayed by 1 cycle
-- * __NB__: Initial output value is /undefined/
--
-- @
-- bram40
--   :: 'Clock'  dom
--   -> 'Enable'  dom
--   -> 'Signal' dom ('Unsigned' 6)
--   -> 'Signal' dom (Maybe ('Unsigned' 6, 'Clash.Sized.BitVector.Bit'))
--   -> 'Signal' dom 'Clash.Sized.BitVector.Bit'
-- bram40 clk en = 'blockRam' clk en ('Clash.Sized.Vector.replicate' d40 1)
-- @
--
-- Additional helpful information:
--
-- * See "Clash.Explicit.BlockRam#usingrams" for more information on how to use a
-- Block RAM.
-- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @'readNew' clk rst ('blockRam' clk inits) rd wrM@.
blockRam
  :: ( KnownDomain dom
     , HasCallStack
     , NFDataX a
     , Enum addr )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ Global enable
  -> Vec n a
  -- ^ Initial content of the BRAM, also determines the size, @n@, of the BRAM.
   --
   -- __NB__: __MUST__ be a constant.
  -> Signal dom addr
  -- ^ Read address @r@
  -> Signal dom (Maybe (addr, a))
  -- ^ (write address @w@, value to write)
  -> Signal dom a
  -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle
blockRam :: Clock dom
-> Enable dom
-> Vec n a
-> Signal dom addr
-> Signal dom (Maybe (addr, a))
-> Signal dom a
blockRam = \Clock dom
clk Enable dom
gen Vec n a
content Signal dom addr
rd Signal dom (Maybe (addr, a))
wrM ->
  let en :: Signal dom Bool
en       = Maybe (addr, a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (addr, a) -> Bool)
-> Signal dom (Maybe (addr, a)) -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, a))
wrM
      (Signal dom addr
wr,Signal dom a
din) = Signal dom (addr, a) -> Unbundled dom (addr, a)
forall a (dom :: Domain).
Bundle a =>
Signal dom a -> Unbundled dom a
unbundle (Maybe (addr, a) -> (addr, a)
forall a. HasCallStack => Maybe a -> a
fromJustX (Maybe (addr, a) -> (addr, a))
-> Signal dom (Maybe (addr, a)) -> Signal dom (addr, a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, a))
wrM)
  in  (HasCallStack => Signal dom a) -> Signal dom a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
      (Clock dom
-> Enable dom
-> Vec n a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
forall (dom :: Domain) a (n :: Nat).
(KnownDomain dom, HasCallStack, NFDataX a) =>
Clock dom
-> Enable dom
-> Vec n a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRam# Clock dom
clk Enable dom
gen Vec n a
content (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
rd) Signal dom Bool
en (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
wr) Signal dom a
din)
{-# INLINE blockRam #-}

-- | Create a blockRAM with space for 2^@n@ elements
--
-- * __NB__: Read value is delayed by 1 cycle
-- * __NB__: Initial output value is /undefined/
--
-- @
-- bram32
--   :: 'Clock' dom
--   -> 'Enable' dom
--   -> 'Signal' dom ('Unsigned' 5)
--   -> 'Signal' dom (Maybe ('Unsigned' 5, 'Clash.Sized.BitVector.Bit'))
--   -> 'Signal' dom 'Clash.Sized.BitVector.Bit'
-- bram32 clk en = 'blockRamPow2' clk en ('Clash.Sized.Vector.replicate' d32 1)
-- @
--
-- Additional helpful information:
--
-- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a
-- Block RAM.
-- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @'readNew' clk rst ('blockRamPow2' clk inits) rd wrM@.
blockRamPow2
  :: ( KnownDomain dom
     , HasCallStack
     , NFDataX a
     , KnownNat n )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ Global enable
  -> Vec (2^n) a
  -- ^ Initial content of the BRAM, also
  -- determines the size, @2^n@, of
  -- the BRAM.
  --
  -- __NB__: __MUST__ be a constant.
  -> Signal dom (Unsigned n)
  -- ^ Read address @r@
  -> Signal dom (Maybe (Unsigned n, a))
  -- ^ (Write address @w@, value to write)
  -> Signal dom a
  -- ^ Value of the @blockRAM@ at address @r@ from the previous
  -- clock cycle
blockRamPow2 :: Clock dom
-> Enable dom
-> Vec (2 ^ n) a
-> Signal dom (Unsigned n)
-> Signal dom (Maybe (Unsigned n, a))
-> Signal dom a
blockRamPow2 = \Clock dom
clk Enable dom
en Vec (2 ^ n) a
cnt Signal dom (Unsigned n)
rd Signal dom (Maybe (Unsigned n, a))
wrM -> (HasCallStack => Signal dom a) -> Signal dom a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
  (Clock dom
-> Enable dom
-> Vec (2 ^ n) a
-> Signal dom (Unsigned n)
-> Signal dom (Maybe (Unsigned n, a))
-> Signal dom a
forall (dom :: Domain) a addr (n :: Nat).
(KnownDomain dom, HasCallStack, NFDataX a, Enum addr) =>
Clock dom
-> Enable dom
-> Vec n a
-> Signal dom addr
-> Signal dom (Maybe (addr, a))
-> Signal dom a
blockRam Clock dom
clk Enable dom
en Vec (2 ^ n) a
cnt Signal dom (Unsigned n)
rd Signal dom (Maybe (Unsigned n, a))
wrM)
{-# INLINE blockRamPow2 #-}

data ResetStrategy (r :: Bool) where
  ClearOnReset :: ResetStrategy 'True
  NoClearOnReset :: ResetStrategy 'False

-- | Version of blockram that has no default values set. May be cleared to a
-- arbitrary state using a reset function.
blockRamU
   :: forall n dom a r addr
   . ( KnownDomain dom
     , HasCallStack
     , NFDataX a
     , Enum addr
     , 1 <= n )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Reset dom
  -- ^ 'Reset' line to listen to. Needs to be held at least /n/ cycles in order
  -- for the BRAM to be reset to its initial state.
  -> Enable dom
  -- ^ Global enable
  -> ResetStrategy r
  -- ^ Whether to clear BRAM on asserted reset ('ClearOnReset') or
  -- not ('NoClearOnReset'). Reset needs to be asserted at least /n/ cycles to
  -- clear the BRAM.
  -> SNat n
  -- ^ Number of elements in BRAM
  -> (Index n -> a)
  -- ^ If applicable (see first argument), reset BRAM using this function.
  -> Signal dom addr
  -- ^ Read address @r@
  -> Signal dom (Maybe (addr, a))
  -- ^ (write address @w@, value to write)
  -> Signal dom a
  -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle
blockRamU :: Clock dom
-> Reset dom
-> Enable dom
-> ResetStrategy r
-> SNat n
-> (Index n -> a)
-> Signal dom addr
-> Signal dom (Maybe (addr, a))
-> Signal dom a
blockRamU Clock dom
clk Reset dom
rst0 Enable dom
en ResetStrategy r
rstStrategy n :: SNat n
n@SNat n
SNat Index n -> a
initF Signal dom addr
rd0 Signal dom (Maybe (addr, a))
mw0 =
  case ResetStrategy r
rstStrategy of
    ResetStrategy r
ClearOnReset ->
      -- Use reset infrastructure
      Clock dom
-> Enable dom
-> SNat n
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
forall (n :: Nat) (dom :: Domain) a.
(KnownDomain dom, HasCallStack, NFDataX a) =>
Clock dom
-> Enable dom
-> SNat n
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRamU# Clock dom
clk Enable dom
en SNat n
n Signal dom Int
rd1 Signal dom Bool
we1 Signal dom Int
wa1 Signal dom a
w1
    ResetStrategy r
NoClearOnReset ->
      -- Ignore reset infrastructure, pass values unchanged
      Clock dom
-> Enable dom
-> SNat n
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
forall (n :: Nat) (dom :: Domain) a.
(KnownDomain dom, HasCallStack, NFDataX a) =>
Clock dom
-> Enable dom
-> SNat n
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRamU# Clock dom
clk Enable dom
en SNat n
n
        (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
rd0)
        Signal dom Bool
we0
        (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
wa0)
        Signal dom a
w0
 where
  rstBool :: Signal dom Bool
rstBool = Clock dom
-> Reset dom
-> Enable dom
-> Bool
-> Signal dom Bool
-> Signal dom Bool
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a) =>
Clock dom
-> Reset dom -> Enable dom -> a -> Signal dom a -> Signal dom a
register Clock dom
clk Reset dom
rst0 Enable dom
en Bool
True (Bool -> Signal dom Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False)
  rstInv :: Reset dom
rstInv = Reset dom -> Reset dom
forall (dom :: Domain). Reset dom -> Reset dom
invertReset Reset dom
rst0

  waCounter :: Signal dom (Index n)
  waCounter :: Signal dom (Index n)
waCounter = Clock dom
-> Reset dom
-> Enable dom
-> Index n
-> Signal dom (Index n)
-> Signal dom (Index n)
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a) =>
Clock dom
-> Reset dom -> Enable dom -> a -> Signal dom a -> Signal dom a
register Clock dom
clk Reset dom
rstInv Enable dom
en Index n
0 (SaturationMode -> Index n -> Index n
forall a. SaturatingNum a => SaturationMode -> a -> a
satSucc SaturationMode
SatBound (Index n -> Index n)
-> Signal dom (Index n) -> Signal dom (Index n)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index n)
waCounter)

  wa0 :: Signal dom addr
wa0 = (addr, a) -> addr
forall a b. (a, b) -> a
fst ((addr, a) -> addr)
-> (Maybe (addr, a) -> (addr, a)) -> Maybe (addr, a) -> addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (addr, a) -> (addr, a)
forall a. HasCallStack => Maybe a -> a
fromJustX (Maybe (addr, a) -> addr)
-> Signal dom (Maybe (addr, a)) -> Signal dom addr
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, a))
mw0
  w0 :: Signal dom a
w0  = (addr, a) -> a
forall a b. (a, b) -> b
snd ((addr, a) -> a)
-> (Maybe (addr, a) -> (addr, a)) -> Maybe (addr, a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (addr, a) -> (addr, a)
forall a. HasCallStack => Maybe a -> a
fromJustX (Maybe (addr, a) -> a)
-> Signal dom (Maybe (addr, a)) -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, a))
mw0
  we0 :: Signal dom Bool
we0 = Maybe (addr, a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (addr, a) -> Bool)
-> Signal dom (Maybe (addr, a)) -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, a))
mw0

  rd1 :: Signal dom Int
rd1 = Signal dom Bool
-> Signal dom Int -> Signal dom Int -> Signal dom Int
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
rstBool Signal dom Int
0 (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
rd0)
  we1 :: Signal dom Bool
we1 = Signal dom Bool
-> Signal dom Bool -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
rstBool (Bool -> Signal dom Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True) Signal dom Bool
we0
  wa1 :: Signal dom Int
wa1 = Signal dom Bool
-> Signal dom Int -> Signal dom Int -> Signal dom Int
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
rstBool (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Index n -> Integer) -> Index n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index n -> Integer
forall a. Integral a => a -> Integer
toInteger (Index n -> Int) -> Signal dom (Index n) -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index n)
waCounter) (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
wa0)
  w1 :: Signal dom a
w1  = Signal dom Bool -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
rstBool (Index n -> a
initF (Index n -> a) -> Signal dom (Index n) -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index n)
waCounter) Signal dom a
w0

-- | blockRAMU primitive
blockRamU#
  :: forall n dom a
   . ( KnownDomain dom
     , HasCallStack
     , NFDataX a )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ Global Enable
  -> SNat n
  -- ^ Number of elements in BRAM
  -> Signal dom Int
  -- ^ Read address @r@
  -> Signal dom Bool
  -- ^ Write enable
  -> Signal dom Int
  -- ^ Write address @w@
  -> Signal dom a
  -- ^ Value to write (at address @w@)
  -> Signal dom a
  -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle
blockRamU# :: Clock dom
-> Enable dom
-> SNat n
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRamU# Clock dom
clk Enable dom
en SNat n
SNat =
  -- TODO: Generalize to single BRAM primitive taking an initialization function
  Clock dom
-> Enable dom
-> Vec n a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
forall (dom :: Domain) a (n :: Nat).
(KnownDomain dom, HasCallStack, NFDataX a) =>
Clock dom
-> Enable dom
-> Vec n a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRam#
    Clock dom
clk
    Enable dom
en
    ((Int -> a) -> Vec n Int -> Vec n a
forall a b (n :: Nat). (a -> b) -> Vec n a -> Vec n b
CV.map
      (\Int
i -> String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Initial value at index " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" undefined.")
      ((Int -> Int) -> Int -> Vec n Int
forall (n :: Nat) a. KnownNat n => (a -> a) -> a -> Vec n a
iterateI @n Int -> Int
forall a. Enum a => a -> a
succ (Int
0 :: Int)))
{-# NOINLINE blockRamU# #-}
{-# ANN blockRamU# hasBlackBox #-}

-- | Version of blockram that is initialized with the same value on all
-- memory positions.
blockRam1
   :: forall n dom a r addr
   . ( KnownDomain dom
     , HasCallStack
     , NFDataX a
     , Enum addr
     , 1 <= n )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Reset dom
  -- ^ 'Reset' line to listen to. Needs to be held at least /n/ cycles in order
  -- for the BRAM to be reset to its initial state.
  -> Enable dom
  -- ^ Global enable
  -> ResetStrategy r
  -- ^ Whether to clear BRAM on asserted reset ('ClearOnReset') or
  -- not ('NoClearOnReset'). Reset needs to be asserted at least /n/ cycles to
  -- clear the BRAM.
  -> SNat n
  -- ^ Number of elements in BRAM
  -> a
  -- ^ Initial content of the BRAM (replicated /n/ times)
  -> Signal dom addr
  -- ^ Read address @r@
  -> Signal dom (Maybe (addr, a))
  -- ^ (write address @w@, value to write)
  -> Signal dom a
  -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle
blockRam1 :: Clock dom
-> Reset dom
-> Enable dom
-> ResetStrategy r
-> SNat n
-> a
-> Signal dom addr
-> Signal dom (Maybe (addr, a))
-> Signal dom a
blockRam1 Clock dom
clk Reset dom
rst0 Enable dom
en ResetStrategy r
rstStrategy n :: SNat n
n@SNat n
SNat a
a Signal dom addr
rd0 Signal dom (Maybe (addr, a))
mw0 =
  case ResetStrategy r
rstStrategy of
    ResetStrategy r
ClearOnReset ->
      -- Use reset infrastructure
      Clock dom
-> Enable dom
-> SNat n
-> a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
forall (n :: Nat) (dom :: Domain) a.
(KnownDomain dom, HasCallStack, NFDataX a) =>
Clock dom
-> Enable dom
-> SNat n
-> a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRam1# Clock dom
clk Enable dom
en SNat n
n a
a Signal dom Int
rd1 Signal dom Bool
we1 Signal dom Int
wa1 Signal dom a
w1
    ResetStrategy r
NoClearOnReset ->
      -- Ignore reset infrastructure, pass values unchanged
      Clock dom
-> Enable dom
-> SNat n
-> a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
forall (n :: Nat) (dom :: Domain) a.
(KnownDomain dom, HasCallStack, NFDataX a) =>
Clock dom
-> Enable dom
-> SNat n
-> a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRam1# Clock dom
clk Enable dom
en SNat n
n a
a
        (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
rd0)
        Signal dom Bool
we0
        (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
wa0)
        Signal dom a
w0
 where
  rstBool :: Signal dom Bool
rstBool = Clock dom
-> Reset dom
-> Enable dom
-> Bool
-> Signal dom Bool
-> Signal dom Bool
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a) =>
Clock dom
-> Reset dom -> Enable dom -> a -> Signal dom a -> Signal dom a
register Clock dom
clk Reset dom
rst0 Enable dom
en Bool
True (Bool -> Signal dom Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False)
  rstInv :: Reset dom
rstInv = Reset dom -> Reset dom
forall (dom :: Domain). Reset dom -> Reset dom
invertReset Reset dom
rst0

  waCounter :: Signal dom (Index n)
  waCounter :: Signal dom (Index n)
waCounter = Clock dom
-> Reset dom
-> Enable dom
-> Index n
-> Signal dom (Index n)
-> Signal dom (Index n)
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a) =>
Clock dom
-> Reset dom -> Enable dom -> a -> Signal dom a -> Signal dom a
register Clock dom
clk Reset dom
rstInv Enable dom
en Index n
0 (SaturationMode -> Index n -> Index n
forall a. SaturatingNum a => SaturationMode -> a -> a
satSucc SaturationMode
SatBound (Index n -> Index n)
-> Signal dom (Index n) -> Signal dom (Index n)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index n)
waCounter)

  wa0 :: Signal dom addr
wa0 = (addr, a) -> addr
forall a b. (a, b) -> a
fst ((addr, a) -> addr)
-> (Maybe (addr, a) -> (addr, a)) -> Maybe (addr, a) -> addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (addr, a) -> (addr, a)
forall a. HasCallStack => Maybe a -> a
fromJustX (Maybe (addr, a) -> addr)
-> Signal dom (Maybe (addr, a)) -> Signal dom addr
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, a))
mw0
  w0 :: Signal dom a
w0  = (addr, a) -> a
forall a b. (a, b) -> b
snd ((addr, a) -> a)
-> (Maybe (addr, a) -> (addr, a)) -> Maybe (addr, a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (addr, a) -> (addr, a)
forall a. HasCallStack => Maybe a -> a
fromJustX (Maybe (addr, a) -> a)
-> Signal dom (Maybe (addr, a)) -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, a))
mw0
  we0 :: Signal dom Bool
we0 = Maybe (addr, a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (addr, a) -> Bool)
-> Signal dom (Maybe (addr, a)) -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, a))
mw0

  rd1 :: Signal dom Int
rd1 = Signal dom Bool
-> Signal dom Int -> Signal dom Int -> Signal dom Int
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
rstBool Signal dom Int
0 (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
rd0)
  we1 :: Signal dom Bool
we1 = Signal dom Bool
-> Signal dom Bool -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
rstBool (Bool -> Signal dom Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True) Signal dom Bool
we0
  wa1 :: Signal dom Int
wa1 = Signal dom Bool
-> Signal dom Int -> Signal dom Int -> Signal dom Int
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
rstBool (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Index n -> Integer) -> Index n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index n -> Integer
forall a. Integral a => a -> Integer
toInteger (Index n -> Int) -> Signal dom (Index n) -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index n)
waCounter) (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
wa0)
  w1 :: Signal dom a
w1  = Signal dom Bool -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
rstBool (a -> Signal dom a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a) Signal dom a
w0

-- | blockRAM1 primitive
blockRam1#
  :: forall n dom a
   . ( KnownDomain dom
     , HasCallStack
     , NFDataX a )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ Global Enable
  -> SNat n
  -- ^ Number of elements in BRAM
  -> a
  -- ^ Initial content of the BRAM (replicated /n/ times)
  -> Signal dom Int
  -- ^ Read address @r@
  -> Signal dom Bool
  -- ^ Write enable
  -> Signal dom Int
  -- ^ Write address @w@
  -> Signal dom a
  -- ^ Value to write (at address @w@)
  -> Signal dom a
  -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle
blockRam1# :: Clock dom
-> Enable dom
-> SNat n
-> a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRam1# Clock dom
clk Enable dom
en SNat n
n a
a =
  -- TODO: Generalize to single BRAM primitive taking an initialization function
  Clock dom
-> Enable dom
-> Vec n a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
forall (dom :: Domain) a (n :: Nat).
(KnownDomain dom, HasCallStack, NFDataX a) =>
Clock dom
-> Enable dom
-> Vec n a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRam# Clock dom
clk Enable dom
en (SNat n -> a -> Vec n a
forall (n :: Nat) a. SNat n -> a -> Vec n a
replicate SNat n
n a
a)
{-# NOINLINE blockRam1# #-}
{-# ANN blockRam1# hasBlackBox #-}

-- | blockRAM primitive
blockRam#
  :: ( KnownDomain dom
     , HasCallStack
     , NFDataX a )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ Global enable
  -> Vec n a
  -- ^ Initial content of the BRAM, also
  -- determines the size, @n@, of the BRAM.
  --
  -- __NB__: __MUST__ be a constant.
  -> Signal dom Int
  -- ^ Read address @r@
  -> Signal dom Bool
  -- ^ Write enable
  -> Signal dom Int
  -- ^ Write address @w@
  -> Signal dom a
  -- ^ Value to write (at address @w@)
  -> Signal dom a
  -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle
blockRam# :: Clock dom
-> Enable dom
-> Vec n a
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
blockRam# (Clock SSymbol dom
_) Enable dom
gen Vec n a
content Signal dom Int
rd Signal dom Bool
wen =
  Seq a
-> a
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> Signal dom a
forall t a (dom :: Domain) (dom :: Domain) (dom :: Domain)
       (dom :: Domain) (dom :: Domain) (dom :: Domain).
(NFDataX t, Enum a) =>
Seq t
-> t
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom a
-> Signal dom t
-> Signal dom t
go
    ([a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList (Vec n a -> [a]
forall (n :: Nat) a. Vec n a -> [a]
toList Vec n a
content))
    ((HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"blockRam: intial value undefined"))
    (Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable Enable dom
gen)
    Signal dom Int
rd
    (Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable Enable dom
gen Signal dom Bool -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type).
Applicative f =>
f Bool -> f Bool -> f Bool
.&&. Signal dom Bool
wen)
 where
  go :: Seq t
-> t
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom a
-> Signal dom t
-> Signal dom t
go !Seq t
ram t
o ret :: Signal dom Bool
ret@(~(Bool
re :- Signal dom Bool
res)) rt :: Signal dom Int
rt@(~(Int
r :- Signal dom Int
rs)) et :: Signal dom Bool
et@(~(Bool
e :- Signal dom Bool
en)) wt :: Signal dom a
wt@(~(a
w :- Signal dom a
wr)) dt :: Signal dom t
dt@(~(t
d :- Signal dom t
din)) =
    let ram' :: Seq t
ram' = t
d t -> Seq t -> Seq t
forall a b. NFDataX a => a -> b -> b
`defaultSeqX` Seq t -> Bool -> Int -> t -> Seq t
forall a. Seq a -> Bool -> Int -> a -> Seq a
upd Seq t
ram Bool
e (a -> Int
forall a. Enum a => a -> Int
fromEnum a
w) t
d
        o' :: t
o'   = if Bool
re then Seq t
ram Seq t -> Int -> t
forall a. Seq a -> Int -> a
`Seq.index` Int
r else t
o
    in  t
o t -> Signal dom t -> Signal dom t
forall a b. a -> b -> b
`seqX` t
o t -> Signal dom t -> Signal dom t
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (Signal dom Bool
ret Signal dom Bool -> Signal dom t -> Signal dom t
`seq` Signal dom Int
rt Signal dom Int -> Signal dom t -> Signal dom t
`seq` Signal dom Bool
et Signal dom Bool -> Signal dom t -> Signal dom t
`seq` Signal dom a
wt Signal dom a -> Signal dom t -> Signal dom t
`seq` Signal dom t
dt Signal dom t -> Signal dom t -> Signal dom t
`seq` Seq t
-> t
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom a
-> Signal dom t
-> Signal dom t
go Seq t
ram' t
o' Signal dom Bool
res Signal dom Int
rs Signal dom Bool
en Signal dom a
wr Signal dom t
din)

  upd :: Seq a -> Bool -> Int -> a -> Seq a
upd Seq a
ram Bool
we Int
waddr a
d = case Bool -> Maybe Bool
forall a. a -> Maybe a
maybeIsX Bool
we of
    Maybe Bool
Nothing -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
      Maybe Int
Nothing -> (a -> a) -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
seq Int
waddr a
d)) Seq a
ram
      Just Int
wa -> Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
wa a
d Seq a
ram
    Just Bool
True -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
      Maybe Int
Nothing -> (a -> a) -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
seq Int
waddr a
d)) Seq a
ram
      Just Int
wa -> Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
wa a
d Seq a
ram
    Maybe Bool
_ -> Seq a
ram
{-# ANN blockRam# hasBlackBox #-}
{-# NOINLINE blockRam# #-}

-- | Create read-after-write blockRAM from a read-before-write one
readNew
  :: ( KnownDomain dom
     , NFDataX a
     , Eq addr )
  => Clock dom
  -> Reset dom
  -> Enable dom
  -> (Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a)
  -- ^ The @ram@ component
  -> Signal dom addr
  -- ^ Read address @r@
  -> Signal dom (Maybe (addr, a))
  -- ^ (Write address @w@, value to write)
  -> Signal dom a
  -- ^ Value of the @ram@ at address @r@ from the previous clock cycle
readNew :: Clock dom
-> Reset dom
-> Enable dom
-> (Signal dom addr
    -> Signal dom (Maybe (addr, a)) -> Signal dom a)
-> Signal dom addr
-> Signal dom (Maybe (addr, a))
-> Signal dom a
readNew Clock dom
clk Reset dom
rst Enable dom
en Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a
ram Signal dom addr
rdAddr Signal dom (Maybe (addr, a))
wrM = Signal dom Bool -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
wasSame Signal dom a
wasWritten (Signal dom a -> Signal dom a) -> Signal dom a -> Signal dom a
forall a b. (a -> b) -> a -> b
$ Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a
ram Signal dom addr
rdAddr Signal dom (Maybe (addr, a))
wrM
  where readNewT :: a -> Maybe (a, b) -> (Bool, b)
readNewT a
rd (Just (a
wr, b
wrdata)) = (a
wr a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
rd, b
wrdata)
        readNewT a
_  Maybe (a, b)
Nothing             = (Bool
False   , b
forall a. HasCallStack => a
undefined)

        (Signal dom Bool
wasSame,Signal dom a
wasWritten) =
          Signal dom (Bool, a) -> Unbundled dom (Bool, a)
forall a (dom :: Domain).
Bundle a =>
Signal dom a -> Unbundled dom a
unbundle (Clock dom
-> Reset dom
-> Enable dom
-> (Bool, a)
-> Signal dom (Bool, a)
-> Signal dom (Bool, a)
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a) =>
Clock dom
-> Reset dom -> Enable dom -> a -> Signal dom a -> Signal dom a
register Clock dom
clk Reset dom
rst Enable dom
en (Bool
False, a
forall a. HasCallStack => a
undefined)
                             (addr -> Maybe (addr, a) -> (Bool, a)
forall a b. Eq a => a -> Maybe (a, b) -> (Bool, b)
readNewT (addr -> Maybe (addr, a) -> (Bool, a))
-> Signal dom addr -> Signal dom (Maybe (addr, a) -> (Bool, a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
rdAddr Signal dom (Maybe (addr, a) -> (Bool, a))
-> Signal dom (Maybe (addr, a)) -> Signal dom (Bool, a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Signal dom (Maybe (addr, a))
wrM))