{-|
Copyright  :  (C) 2013-2016, University of Twente,
                  2016-2017, Myrtle Software Ltd,
                  2017     , Google Inc.,
                  2021-2022, QBayLogic B.V.
License    :  BSD2 (see the file LICENSE)
Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

Block RAM primitives

= Using RAMs #usingrams#

We will show a rather elaborate example on how you can, and why you might want
to use block RAMs. We will build a \"small\" CPU + Memory + Program ROM where we
will slowly evolve to using block RAMs. 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, Generic, NFDataX)

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, bitCoerce 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 @\"undefined\"@ in the first few leading outputs.

@
>>> printX $ sampleN 32 $ system2 prog systemClockGen resetGen enableGen
[undefined,undefined,undefined,undefined,undefined,undefined,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 is that they have a /synchronous/ read port,
meaning unlike an 'Clash.Prelude.RAM.asyncRam', the result of a read command
given at time @t@ is output 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. We
will be using a block RAM, so the value is delayed until the next cycle. Thus,
we will also need to 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, bitCoerce 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 depends on this memory value. In our example, this was only the case
when we 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 @\"undefined\"@.

@
>>> printX $ sampleN 34 $ system3 prog2 systemClockGen resetGen enableGen
[undefined,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 DeriveAnyClass #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE Trustworthy #-}

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

-- See [Note: eta port names for trueDualPortBlockRam]
{-# OPTIONS_GHC -fno-do-lambda-eta-expansion #-}

-- 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
  ( -- * Block RAM synchronized to an arbitrary clock
    blockRam
  , blockRamPow2
  , blockRamU
  , blockRam1
  , ResetStrategy(..)
    -- ** Read/write conflict resolution
  , readNew
    -- * True dual-port block RAM
    -- $tdpbram
  , trueDualPortBlockRam
  , RamOp(..)
    -- * Internal
  , blockRam#
  , blockRamU#
  , blockRam1#
  , trueDualPortBlockRam#
  )
where

import           Clash.HaskellPrelude

import           Control.Exception      (catch, throw)
import           Control.Monad          (forM_)
import           Control.Monad.ST       (ST, runST)
import           Control.Monad.ST.Unsafe (unsafeInterleaveST, unsafeIOToST, unsafeSTToIO)
import           Data.Array.MArray      (newListArray)
import qualified Data.List              as L
import           Data.Maybe             (isJust, fromMaybe)
import           GHC.Arr
  (STArray, unsafeReadSTArray, unsafeWriteSTArray)
import qualified Data.Sequence          as Seq
import           Data.Sequence          (Seq)
import           Data.Tuple             (swap)
import           GHC.Generics           (Generic)
import           GHC.Stack              (HasCallStack, withFrozenCallStack)
import           GHC.TypeLits           (KnownNat, type (^), type (<=))
import           Unsafe.Coerce          (unsafeCoerce)

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(..), snatToNum, natToNum)
import           Clash.Signal.Bundle    (unbundle, bundle)
import           Clash.Signal.Internal.Ambiguous (clockPeriod)
import           Clash.Sized.Unsigned   (Unsigned)
import           Clash.Sized.Index      (Index)
import           Clash.Sized.Vector     (Vec, replicate, iterateI)
import qualified Clash.Sized.Vector     as CV
import           Clash.XException
  (maybeIsX, NFDataX(deepErrorX), defaultSeqX, fromJustX, undefined,
   XException (..), seqX, isX, errorX)

{- $tdpbram
A true dual-port block RAM has two fully independent, fully functional access
ports: port A and port B. Either port can do both RAM reads and writes. These
two ports can even be on distinct clock domains, but the memory itself is shared
between the ports. This also makes a true dual-port block RAM suitable as a
component in a domain crossing circuit (but it needs additional logic for it to
be safe, see e.g. 'Clash.Explicit.Synchronizer.asyncFIFOSynchronizer').

A version with implicit clocks can be found in "Clash.Prelude.BlockRam".
-}

-- start benchmark only
-- import GHC.Arr (listArray, unsafeThawSTArray)
-- end benchmark only

{- $setup
>>> 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,bitCoerce 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,bitCoerce 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 block RAM with space for @n@ elements
--
-- * __NB__: Read value is delayed by 1 cycle
-- * __NB__: Initial output value is /undefined/, reading it will throw an
-- 'XException'
--
-- === See also:
--
-- * 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 en ('blockRam' clk inits) rd wrM@.
-- * A large 'Vec' for the initial content may be too inefficient, depending
-- on how it is constructed. See 'Clash.Explicit.BlockRam.File.blockRamFile' and
-- 'Clash.Explicit.BlockRam.Blob.blockRamBlob' for different approaches that
-- scale well.
--
-- === __Example__
-- @
-- 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)
-- @
blockRam
  :: ( KnownDomain dom
     , HasCallStack
     , NFDataX a
     , Enum addr )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ 'Enable' line
  -> 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 BRAM 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 block RAM with space for 2^@n@ elements
--
-- * __NB__: Read value is delayed by 1 cycle
-- * __NB__: Initial output value is /undefined/, reading it will throw an
-- 'XException'
--
-- === See also:
--
-- * 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 en ('blockRamPow2' clk inits) rd wrM@.
-- * A large 'Vec' for the initial content may be too inefficient, depending
-- on how it is constructed. See 'Clash.Explicit.BlockRam.File.blockRamFilePow2'
-- and 'Clash.Explicit.BlockRam.Blob.blockRamBlobPow2' for different approaches
-- that scale well.
--
-- === __Example__
-- @
-- 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)
-- @
blockRamPow2
  :: ( KnownDomain dom
     , HasCallStack
     , NFDataX a
     , KnownNat n )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ 'Enable' line
  -> Vec (2^n) a
  -- ^ Initial content 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 BRAM 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

-- | A version of 'blockRam' that has no default values set. May be cleared to
-- an 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. This needs to be asserted for at least /n/ cycles in order
  -- for the BRAM to be reset to its initial state.
  -> Enable dom
  -- ^ 'Enable' line
  -> ResetStrategy r
  -- ^ Whether to clear BRAM on asserted reset ('ClearOnReset') or
  -- not ('NoClearOnReset'). The reset needs to be asserted for at least /n/
  -- cycles to clear the BRAM.
  -> SNat n
  -- ^ Number of elements in BRAM
  -> (Index n -> a)
  -- ^ If applicable (see 'ResetStrategy' 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 BRAM 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
  -- ^ 'Enable' line
  -> 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 BRAM 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 #-}

-- | A 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. This needs to be asserted for at least /n/ cycles in order
  -- for the BRAM to be reset to its initial state.
  -> Enable dom
  -- ^ 'Enable' line
  -> ResetStrategy r
  -- ^ Whether to clear BRAM on asserted reset ('ClearOnReset') or
  -- not ('NoClearOnReset'). The reset needs to be asserted for 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 BRAM 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
  -- ^ 'Enable' line
  -> 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 BRAM 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#
  :: forall dom a n
   . ( KnownDomain dom
     , HasCallStack
     , NFDataX a )
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ 'Enable' line
  -> 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 BRAM 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 Signal dom Int
waS Signal dom a
wd -> (forall s. ST s (Signal dom a)) -> Signal dom a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Signal dom a)) -> Signal dom a)
-> (forall s. ST s (Signal dom a)) -> Signal dom a
forall a b. (a -> b) -> a -> b
$ do
  STArray s Int a
ramStart <- (Int, Int) -> [a] -> ST s (STArray s Int a)
forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
(i, i) -> [e] -> m (a i e)
newListArray (Int
0,Int
szIInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
contentL
  -- start benchmark only
  -- ramStart <- unsafeThawSTArray ramArr
  -- end benchmark only
  STArray s Int a
-> a
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> ST s (Signal dom a)
forall s.
STArray s Int a
-> a
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> ST s (Signal dom a)
go
    STArray s Int a
ramStart
    ((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)
    Signal dom Int
waS
    Signal dom a
wd
 where
  contentL :: [a]
contentL = Vec n a -> [a]
forall a b. a -> b
unsafeCoerce Vec n a
content :: [a]
  szI :: Int
szI = [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
L.length [a]
contentL
  -- start benchmark only
  -- ramArr = listArray (0,szI-1) contentL
  -- end benchmark only

  go :: STArray s Int a -> a -> Signal dom Bool -> Signal dom Int
     -> Signal dom Bool -> Signal dom Int -> Signal dom a
     -> ST s (Signal dom a)
  go :: STArray s Int a
-> a
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> ST s (Signal dom a)
go !STArray s Int a
ram a
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 Int
wt@(~(Int
w :- Signal dom Int
wr)) dt :: Signal dom a
dt@(~(a
d :- Signal dom a
din)) = do
    a
o a -> ST s (Signal dom a) -> ST s (Signal dom a)
forall a b. a -> b -> b
`seqX` (a
o a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:-) (Signal dom a -> Signal dom a)
-> ST s (Signal dom a) -> ST s (Signal dom a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Signal dom Bool
ret Signal dom Bool -> ST s (Signal dom a) -> ST s (Signal dom a)
`seq` Signal dom Int
rt Signal dom Int -> ST s (Signal dom a) -> ST s (Signal dom a)
`seq` Signal dom Bool
et Signal dom Bool -> ST s (Signal dom a) -> ST s (Signal dom a)
`seq` Signal dom Int
wt Signal dom Int -> ST s (Signal dom a) -> ST s (Signal dom a)
`seq` Signal dom a
dt Signal dom a -> ST s (Signal dom a) -> ST s (Signal dom a)
`seq`
      ST s (Signal dom a) -> ST s (Signal dom a)
forall s a. ST s a -> ST s a
unsafeInterleaveST
        (do a
o' <- IO a -> ST s a
forall a s. IO a -> ST s a
unsafeIOToST
                    (IO a -> (XException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (if Bool
re then ST s a -> IO a
forall s a. ST s a -> IO a
unsafeSTToIO (STArray s Int a
ram STArray s Int a -> Int -> ST s a
forall s. HasCallStack => STArray s Int a -> Int -> ST s a
`safeAt` Int
r) else a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
o)
                    (\err :: XException
err@XException {} -> a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (XException -> a
forall a e. Exception e => e -> a
throw XException
err)))
            a
d a -> ST s () -> ST s ()
forall a b. NFDataX a => a -> b -> b
`defaultSeqX` STArray s Int a -> Bool -> Int -> a -> ST s ()
forall s. STArray s Int a -> Bool -> Int -> a -> ST s ()
upd STArray s Int a
ram Bool
e (Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
w) a
d
            STArray s Int a
-> a
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> ST s (Signal dom a)
forall s.
STArray s Int a
-> a
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom a
-> ST s (Signal dom a)
go STArray s Int a
ram a
o' Signal dom Bool
res Signal dom Int
rs Signal dom Bool
en Signal dom Int
wr Signal dom a
din))

  upd :: STArray s Int a -> Bool -> Int -> a -> ST s ()
  upd :: STArray s Int a -> Bool -> Int -> a -> ST s ()
upd STArray s Int 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 -> -- Put the XException from `waddr` as the value in all
                 -- locations of `ram`.
                 [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
szIInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] (\Int
i -> STArray s Int a -> Int -> a -> ST s ()
forall s i e. STArray s i e -> Int -> e -> ST s ()
unsafeWriteSTArray STArray s Int a
ram Int
i (Int -> a -> a
seq Int
waddr a
d))
      Just Int
wa -> -- Put the XException from `we` as the value at address
                 -- `waddr`.
                 Int -> a -> STArray s Int a -> ST s ()
forall s. HasCallStack => Int -> a -> STArray s Int a -> ST s ()
safeUpdate Int
wa (Bool -> a -> a
seq Bool
we a
d) STArray s Int a
ram
    Just Bool
True -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
      Maybe Int
Nothing -> -- Put the XException from `waddr` as the value in all
                 -- locations of `ram`.
                 [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
szIInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] (\Int
i -> STArray s Int a -> Int -> a -> ST s ()
forall s i e. STArray s i e -> Int -> e -> ST s ()
unsafeWriteSTArray STArray s Int a
ram Int
i (Int -> a -> a
seq Int
waddr a
d))
      Just Int
wa -> Int -> a -> STArray s Int a -> ST s ()
forall s. HasCallStack => Int -> a -> STArray s Int a -> ST s ()
safeUpdate Int
wa a
d STArray s Int a
ram
    Maybe Bool
_ -> () -> ST s ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

  safeAt :: HasCallStack => STArray s Int a -> Int -> ST s a
  safeAt :: STArray s Int a -> Int -> ST s a
safeAt STArray s Int a
s Int
i =
    if (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i) Bool -> Bool -> Bool
&& (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
szI) then
      STArray s Int a -> Int -> ST s a
forall s i e. STArray s i e -> Int -> ST s e
unsafeReadSTArray STArray s Int a
s Int
i
    else a -> ST s a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> ST s a) -> a -> ST s a
forall a b. (a -> b) -> a -> b
$
      (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
        (String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String
"blockRam: read address " 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
" not in range [0.." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
szI String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"))
  {-# INLINE safeAt #-}

  safeUpdate :: HasCallStack => Int -> a -> STArray s Int a -> ST s ()
  safeUpdate :: Int -> a -> STArray s Int a -> ST s ()
safeUpdate Int
i a
a STArray s Int a
s =
    if (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i) Bool -> Bool -> Bool
&& (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
szI) then
      STArray s Int a -> Int -> a -> ST s ()
forall s i e. STArray s i e -> Int -> e -> ST s ()
unsafeWriteSTArray STArray s Int a
s Int
i a
a
    else
      let d :: a
d = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
                (String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String
"blockRam: write address " 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
" not in range [0.." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
szI String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"))
       in [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
szIInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] (\Int
j -> STArray s Int a -> Int -> a -> ST s ()
forall s i e. STArray s i e -> Int -> e -> ST s ()
unsafeWriteSTArray STArray s Int a
s Int
j a
d)
  {-# INLINE safeUpdate #-}
{-# ANN blockRam# hasBlackBox #-}
{-# NOINLINE blockRam# #-}

-- | Create a read-after-write block RAM 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 BRAM component
  -> Signal dom addr
  -- ^ Read address @r@
  -> Signal dom (Maybe (addr, a))
  -- ^ (Write address @w@, value to write)
  -> Signal dom a
  -- ^ Value of the BRAM 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))

-- | Port operation
data RamOp n a
  = RamRead (Index n)
  -- ^ Read from address
  | RamWrite (Index n) a
  -- ^ Write data to address
  | RamNoOp
  -- ^ No operation
  deriving ((forall x. RamOp n a -> Rep (RamOp n a) x)
-> (forall x. Rep (RamOp n a) x -> RamOp n a)
-> Generic (RamOp n a)
forall x. Rep (RamOp n a) x -> RamOp n a
forall x. RamOp n a -> Rep (RamOp n a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: Nat) a x. Rep (RamOp n a) x -> RamOp n a
forall (n :: Nat) a x. RamOp n a -> Rep (RamOp n a) x
$cto :: forall (n :: Nat) a x. Rep (RamOp n a) x -> RamOp n a
$cfrom :: forall (n :: Nat) a x. RamOp n a -> Rep (RamOp n a) x
Generic, HasCallStack => String -> RamOp n a
RamOp n a -> Bool
RamOp n a -> ()
RamOp n a -> RamOp n a
(HasCallStack => String -> RamOp n a)
-> (RamOp n a -> Bool)
-> (RamOp n a -> RamOp n a)
-> (RamOp n a -> ())
-> NFDataX (RamOp n a)
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
forall (n :: Nat) a.
(NFDataX a, HasCallStack) =>
String -> RamOp n a
forall (n :: Nat) a. NFDataX a => RamOp n a -> Bool
forall (n :: Nat) a. NFDataX a => RamOp n a -> ()
forall (n :: Nat) a. NFDataX a => RamOp n a -> RamOp n a
rnfX :: RamOp n a -> ()
$crnfX :: forall (n :: Nat) a. NFDataX a => RamOp n a -> ()
ensureSpine :: RamOp n a -> RamOp n a
$censureSpine :: forall (n :: Nat) a. NFDataX a => RamOp n a -> RamOp n a
hasUndefined :: RamOp n a -> Bool
$chasUndefined :: forall (n :: Nat) a. NFDataX a => RamOp n a -> Bool
deepErrorX :: String -> RamOp n a
$cdeepErrorX :: forall (n :: Nat) a.
(NFDataX a, HasCallStack) =>
String -> RamOp n a
NFDataX, Int -> RamOp n a -> String -> String
[RamOp n a] -> String -> String
RamOp n a -> String
(Int -> RamOp n a -> String -> String)
-> (RamOp n a -> String)
-> ([RamOp n a] -> String -> String)
-> Show (RamOp n a)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (n :: Nat) a. Show a => Int -> RamOp n a -> String -> String
forall (n :: Nat) a. Show a => [RamOp n a] -> String -> String
forall (n :: Nat) a. Show a => RamOp n a -> String
showList :: [RamOp n a] -> String -> String
$cshowList :: forall (n :: Nat) a. Show a => [RamOp n a] -> String -> String
show :: RamOp n a -> String
$cshow :: forall (n :: Nat) a. Show a => RamOp n a -> String
showsPrec :: Int -> RamOp n a -> String -> String
$cshowsPrec :: forall (n :: Nat) a. Show a => Int -> RamOp n a -> String -> String
Show)

ramOpAddr :: RamOp n a -> Index n
ramOpAddr :: RamOp n a -> Index n
ramOpAddr (RamRead Index n
addr)    = Index n
addr
ramOpAddr (RamWrite Index n
addr a
_) = Index n
addr
ramOpAddr RamOp n a
RamNoOp           = String -> Index n
forall a. HasCallStack => String -> a
errorX String
"Address for No operation undefined"

isRamWrite :: RamOp n a -> Bool
isRamWrite :: RamOp n a -> Bool
isRamWrite (RamWrite {}) = Bool
True
isRamWrite RamOp n a
_             = Bool
False

ramOpWriteVal :: RamOp n a -> Maybe a
ramOpWriteVal :: RamOp n a -> Maybe a
ramOpWriteVal (RamWrite Index n
_ a
val) = a -> Maybe a
forall a. a -> Maybe a
Just a
val
ramOpWriteVal RamOp n a
_                = Maybe a
forall a. Maybe a
Nothing

isOp :: RamOp n a -> Bool
isOp :: RamOp n a -> Bool
isOp RamOp n a
RamNoOp = Bool
False
isOp RamOp n a
_       = Bool
True

-- | Produces vendor-agnostic HDL that will be inferred as a true dual-port
-- block RAM
--
-- Any value that is being written on a particular port is also the
-- value that will be read on that port, i.e. the same-port read/write behavior
-- is: WriteFirst. For mixed-port read/write, when port A writes to the address
-- port B reads from, the output of port B is undefined, and vice versa.
trueDualPortBlockRam ::
  forall nAddrs domA domB a .
  ( HasCallStack
  , KnownNat nAddrs
  , KnownDomain domA
  , KnownDomain domB
  , NFDataX a
  )
  => Clock domA
  -- ^ Clock for port A
  -> Clock domB
  -- ^ Clock for port B
  -> Signal domA (RamOp nAddrs a)
  -- ^ RAM operation for port A
  -> Signal domB (RamOp nAddrs a)
  -- ^ RAM operation for port B
  -> (Signal domA a, Signal domB a)
  -- ^ Outputs data on /next/ cycle. When writing, the data written
  -- will be echoed. When reading, the read data is returned.

{-# INLINE trueDualPortBlockRam #-}
trueDualPortBlockRam :: Clock domA
-> Clock domB
-> Signal domA (RamOp nAddrs a)
-> Signal domB (RamOp nAddrs a)
-> (Signal domA a, Signal domB a)
trueDualPortBlockRam = \Clock domA
clkA Clock domB
clkB Signal domA (RamOp nAddrs a)
opA Signal domB (RamOp nAddrs a)
opB ->
  Clock domA
-> Signal domA Bool
-> Signal domA Bool
-> Signal domA (Index nAddrs)
-> Signal domA a
-> Clock domB
-> Signal domB Bool
-> Signal domB Bool
-> Signal domB (Index nAddrs)
-> Signal domB a
-> (Signal domA a, Signal domB a)
forall (nAddrs :: Nat) (domA :: Domain) (domB :: Domain) a.
(HasCallStack, KnownNat nAddrs, KnownDomain domA, KnownDomain domB,
 NFDataX a) =>
Clock domA
-> Signal domA Bool
-> Signal domA Bool
-> Signal domA (Index nAddrs)
-> Signal domA a
-> Clock domB
-> Signal domB Bool
-> Signal domB Bool
-> Signal domB (Index nAddrs)
-> Signal domB a
-> (Signal domA a, Signal domB a)
trueDualPortBlockRamWrapper
    Clock domA
clkA (RamOp nAddrs a -> Bool
forall (n :: Nat) a. RamOp n a -> Bool
isOp (RamOp nAddrs a -> Bool)
-> Signal domA (RamOp nAddrs a) -> Signal domA Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domA (RamOp nAddrs a)
opA) (RamOp nAddrs a -> Bool
forall (n :: Nat) a. RamOp n a -> Bool
isRamWrite (RamOp nAddrs a -> Bool)
-> Signal domA (RamOp nAddrs a) -> Signal domA Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domA (RamOp nAddrs a)
opA) (RamOp nAddrs a -> Index nAddrs
forall (n :: Nat) a. RamOp n a -> Index n
ramOpAddr (RamOp nAddrs a -> Index nAddrs)
-> Signal domA (RamOp nAddrs a) -> Signal domA (Index nAddrs)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domA (RamOp nAddrs a)
opA) (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJustX (Maybe a -> a)
-> (RamOp nAddrs a -> Maybe a) -> RamOp nAddrs a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RamOp nAddrs a -> Maybe a
forall (n :: Nat) a. RamOp n a -> Maybe a
ramOpWriteVal (RamOp nAddrs a -> a)
-> Signal domA (RamOp nAddrs a) -> Signal domA a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domA (RamOp nAddrs a)
opA)
    Clock domB
clkB (RamOp nAddrs a -> Bool
forall (n :: Nat) a. RamOp n a -> Bool
isOp (RamOp nAddrs a -> Bool)
-> Signal domB (RamOp nAddrs a) -> Signal domB Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domB (RamOp nAddrs a)
opB) (RamOp nAddrs a -> Bool
forall (n :: Nat) a. RamOp n a -> Bool
isRamWrite (RamOp nAddrs a -> Bool)
-> Signal domB (RamOp nAddrs a) -> Signal domB Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domB (RamOp nAddrs a)
opB) (RamOp nAddrs a -> Index nAddrs
forall (n :: Nat) a. RamOp n a -> Index n
ramOpAddr (RamOp nAddrs a -> Index nAddrs)
-> Signal domB (RamOp nAddrs a) -> Signal domB (Index nAddrs)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domB (RamOp nAddrs a)
opB) (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJustX (Maybe a -> a)
-> (RamOp nAddrs a -> Maybe a) -> RamOp nAddrs a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RamOp nAddrs a -> Maybe a
forall (n :: Nat) a. RamOp n a -> Maybe a
ramOpWriteVal (RamOp nAddrs a -> a)
-> Signal domB (RamOp nAddrs a) -> Signal domB a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domB (RamOp nAddrs a)
opB)

toMaybeX :: a -> MaybeX a
toMaybeX :: a -> MaybeX a
toMaybeX a
a =
  case a -> Either String a
forall a. a -> Either String a
isX a
a of
    Left String
_ -> MaybeX a
forall a. MaybeX a
IsX
    Right a
_ -> a -> MaybeX a
forall a. a -> MaybeX a
IsDefined a
a

data MaybeX a = IsX | IsDefined !a

data Conflict = Conflict
  { Conflict -> MaybeX Bool
cfRWA     :: !(MaybeX Bool) -- ^ Read/Write conflict for output A
  , Conflict -> MaybeX Bool
cfRWB     :: !(MaybeX Bool) -- ^ Read/Write conflict for output B
  , Conflict -> MaybeX Bool
cfWW      :: !(MaybeX Bool) -- ^ Write/Write conflict
  , Conflict -> MaybeX Int
cfAddress :: !(MaybeX Int) }

-- [Note: eta port names for trueDualPortBlockRam]
--
-- By naming all the arguments and setting the -fno-do-lambda-eta-expansion GHC
-- option for this module, the generated HDL also contains names based on the
-- argument names used here. This greatly improves readability of the HDL.

-- [Note: true dual-port blockRAM separate architecture]
--
-- A multi-clock true dual-port block RAM is only inferred from the generated HDL
-- when it lives in its own Verilog module / VHDL architecture. Add any other
-- logic to the module / architecture, and synthesis will no longer infer a
-- multi-clock true dual-port block RAM. This wrapper pushes the primitive out
-- into its own module / architecture.
trueDualPortBlockRamWrapper :: Clock domA
-> Signal domA Bool
-> Signal domA Bool
-> Signal domA (Index nAddrs)
-> Signal domA a
-> Clock domB
-> Signal domB Bool
-> Signal domB Bool
-> Signal domB (Index nAddrs)
-> Signal domB a
-> (Signal domA a, Signal domB a)
trueDualPortBlockRamWrapper Clock domA
clkA Signal domA Bool
enA Signal domA Bool
weA Signal domA (Index nAddrs)
addrA Signal domA a
datA Clock domB
clkB Signal domB Bool
enB Signal domB Bool
weB Signal domB (Index nAddrs)
addrB Signal domB a
datB =
  Clock domA
-> Signal domA Bool
-> Signal domA Bool
-> Signal domA (Index nAddrs)
-> Signal domA a
-> Clock domB
-> Signal domB Bool
-> Signal domB Bool
-> Signal domB (Index nAddrs)
-> Signal domB a
-> (Signal domA a, Signal domB a)
forall (nAddrs :: Nat) (domA :: Domain) (domB :: Domain) a.
(HasCallStack, KnownNat nAddrs, KnownDomain domA, KnownDomain domB,
 NFDataX a) =>
Clock domA
-> Signal domA Bool
-> Signal domA Bool
-> Signal domA (Index nAddrs)
-> Signal domA a
-> Clock domB
-> Signal domB Bool
-> Signal domB Bool
-> Signal domB (Index nAddrs)
-> Signal domB a
-> (Signal domA a, Signal domB a)
trueDualPortBlockRam# Clock domA
clkA Signal domA Bool
enA Signal domA Bool
weA Signal domA (Index nAddrs)
addrA Signal domA a
datA Clock domB
clkB Signal domB Bool
enB Signal domB Bool
weB Signal domB (Index nAddrs)
addrB Signal domB a
datB
{-# NOINLINE trueDualPortBlockRamWrapper #-}

-- | Primitive of 'trueDualPortBlockRam'.
trueDualPortBlockRam#, trueDualPortBlockRamWrapper ::
  forall nAddrs domA domB a .
  ( HasCallStack
  , KnownNat nAddrs
  , KnownDomain domA
  , KnownDomain domB
  , NFDataX a
  )
  => Clock domA
  -- ^ Clock for port A
  -> Signal domA Bool
  -- ^ Enable for port A
  -> Signal domA Bool
  -- ^ Write enable for port A
  -> Signal domA (Index nAddrs)
  -- ^ Address to read from or write to on port A
  -> Signal domA a
  -- ^ Data in for port A; ignored when /write enable/ is @False@

  -> Clock domB
  -- ^ Clock for port B
  -> Signal domB Bool
  -- ^ Enable for port B
  -> Signal domB Bool
  -- ^ Write enable for port B
  -> Signal domB (Index nAddrs)
  -- ^ Address to read from or write to on port B
  -> Signal domB a
  -- ^ Data in for port B; ignored when /write enable/ is @False@

  -> (Signal domA a, Signal domB a)
  -- ^ Outputs data on /next/ cycle. If write enable is @True@, the data written
  -- will be echoed. If write enable is @False@, the read data is returned. If
  -- port enable is @False@, it is /undefined/.
trueDualPortBlockRam# :: Clock domA
-> Signal domA Bool
-> Signal domA Bool
-> Signal domA (Index nAddrs)
-> Signal domA a
-> Clock domB
-> Signal domB Bool
-> Signal domB Bool
-> Signal domB (Index nAddrs)
-> Signal domB a
-> (Signal domA a, Signal domB a)
trueDualPortBlockRam# Clock domA
clkA Signal domA Bool
enA Signal domA Bool
weA Signal domA (Index nAddrs)
addrA Signal domA a
datA Clock domB
clkB Signal domB Bool
enB Signal domB Bool
weB Signal domB (Index nAddrs)
addrB Signal domB a
datB
  | SNat (DomainConfigurationPeriod (KnownConf domA)) -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum @Int (forall (period :: Nat).
(KnownDomain domA,
 DomainConfigurationPeriod (KnownConf domA) ~ period) =>
SNat period
forall (dom :: Domain) (period :: Nat).
(KnownDomain dom, DomainPeriod dom ~ period) =>
SNat period
clockPeriod @domA) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SNat (DomainConfigurationPeriod (KnownConf domB)) -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum @Int (forall (period :: Nat).
(KnownDomain domB,
 DomainConfigurationPeriod (KnownConf domB) ~ period) =>
SNat period
forall (dom :: Domain) (period :: Nat).
(KnownDomain dom, DomainPeriod dom ~ period) =>
SNat period
clockPeriod @domB)
  = (Signal domB a, Signal domA a) -> (Signal domA a, Signal domB a)
forall a b. (a, b) -> (b, a)
swap (String
-> Clock domB
-> Signal domB Bool
-> Signal domB Bool
-> Signal domB (Index nAddrs)
-> Signal domB a
-> String
-> Clock domA
-> Signal domA Bool
-> Signal domA Bool
-> Signal domA (Index nAddrs)
-> Signal domA a
-> (Signal domB a, Signal domA a)
forall (nAddrs :: Nat) (domFast :: Domain) (domSlow :: Domain) a.
(HasCallStack, KnownNat nAddrs, KnownDomain domSlow,
 KnownDomain domFast, NFDataX a) =>
String
-> Clock domSlow
-> Signal domSlow Bool
-> Signal domSlow Bool
-> Signal domSlow (Index nAddrs)
-> Signal domSlow a
-> String
-> Clock domFast
-> Signal domFast Bool
-> Signal domFast Bool
-> Signal domFast (Index nAddrs)
-> Signal domFast a
-> (Signal domSlow a, Signal domFast a)
trueDualPortBlockRamModel String
labelB Clock domB
clkB Signal domB Bool
enB Signal domB Bool
weB Signal domB (Index nAddrs)
addrB Signal domB a
datB String
labelA Clock domA
clkA Signal domA Bool
enA Signal domA Bool
weA Signal domA (Index nAddrs)
addrA Signal domA a
datA)
  | Bool
otherwise
  =       String
-> Clock domA
-> Signal domA Bool
-> Signal domA Bool
-> Signal domA (Index nAddrs)
-> Signal domA a
-> String
-> Clock domB
-> Signal domB Bool
-> Signal domB Bool
-> Signal domB (Index nAddrs)
-> Signal domB a
-> (Signal domA a, Signal domB a)
forall (nAddrs :: Nat) (domFast :: Domain) (domSlow :: Domain) a.
(HasCallStack, KnownNat nAddrs, KnownDomain domSlow,
 KnownDomain domFast, NFDataX a) =>
String
-> Clock domSlow
-> Signal domSlow Bool
-> Signal domSlow Bool
-> Signal domSlow (Index nAddrs)
-> Signal domSlow a
-> String
-> Clock domFast
-> Signal domFast Bool
-> Signal domFast Bool
-> Signal domFast (Index nAddrs)
-> Signal domFast a
-> (Signal domSlow a, Signal domFast a)
trueDualPortBlockRamModel String
labelA Clock domA
clkA Signal domA Bool
enA Signal domA Bool
weA Signal domA (Index nAddrs)
addrA Signal domA a
datA String
labelB Clock domB
clkB Signal domB Bool
enB Signal domB Bool
weB Signal domB (Index nAddrs)
addrB Signal domB a
datB
 where
  labelA :: String
labelA = String
"Port A"
  labelB :: String
labelB = String
"Port B"
{-# NOINLINE trueDualPortBlockRam# #-}
{-# ANN trueDualPortBlockRam# hasBlackBox #-}


-- | Haskell model for the primitive 'trueDualPortBlockRam#'.
--
-- Warning: this model only works if @domFast@'s clock is faster (or equal to)
-- @domSlow@'s clock.
trueDualPortBlockRamModel ::
  forall nAddrs domFast domSlow a .
  ( HasCallStack
  , KnownNat nAddrs
  , KnownDomain domSlow
  , KnownDomain domFast
  , NFDataX a
  ) =>

  String ->
  Clock domSlow ->
  Signal domSlow Bool ->
  Signal domSlow Bool ->
  Signal domSlow (Index nAddrs) ->
  Signal domSlow a ->

  String ->
  Clock domFast ->
  Signal domFast Bool ->
  Signal domFast Bool ->
  Signal domFast (Index nAddrs) ->
  Signal domFast a ->

  (Signal domSlow a, Signal domFast a)
trueDualPortBlockRamModel :: String
-> Clock domSlow
-> Signal domSlow Bool
-> Signal domSlow Bool
-> Signal domSlow (Index nAddrs)
-> Signal domSlow a
-> String
-> Clock domFast
-> Signal domFast Bool
-> Signal domFast Bool
-> Signal domFast (Index nAddrs)
-> Signal domFast a
-> (Signal domSlow a, Signal domFast a)
trueDualPortBlockRamModel String
labelA !Clock domSlow
_clkA Signal domSlow Bool
enA Signal domSlow Bool
weA Signal domSlow (Index nAddrs)
addrA Signal domSlow a
datA String
labelB !Clock domFast
_clkB Signal domFast Bool
enB Signal domFast Bool
weB Signal domFast (Index nAddrs)
addrB Signal domFast a
datB =
  ( a
startA a -> Signal domSlow a -> Signal domSlow a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domSlow a
outA
  , a
startB a -> Signal domFast a -> Signal domFast a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domFast a
outB )
 where
  (Signal domSlow a
outA, Signal domFast a
outB) =
    Seq a
-> Int
-> Signal domSlow (Bool, Bool, Int, a)
-> Signal domFast (Bool, Bool, Int, a)
-> a
-> a
-> (Signal domSlow a, Signal domFast a)
go
      (Int -> (Int -> a) -> Seq a
forall a. Int -> (Int -> a) -> Seq a
Seq.fromFunction (forall a. (Num a, KnownNat nAddrs) => a
forall (n :: Nat) a. (Num a, KnownNat n) => a
natToNum @nAddrs) Int -> a
initElement)
      Int
tB -- ensure 'go' hits fast clock first for 1 cycle, then execute slow
         -- clock for 1 cycle, followed by the regular cadence of 'ceil(tA / tB)'
         -- cycles for the fast clock followed by 1 cycle of the slow clock
      (Unbundled domSlow (Bool, Bool, Int, a)
-> Signal domSlow (Bool, Bool, Int, a)
forall a (dom :: Domain).
Bundle a =>
Unbundled dom a -> Signal dom a
bundle (Signal domSlow Bool
enA, Signal domSlow Bool
weA, Index nAddrs -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Index nAddrs -> Integer)
-> Signal domSlow (Index nAddrs) -> Signal domSlow Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domSlow (Index nAddrs)
addrA, Signal domSlow a
datA))
      (Unbundled domFast (Bool, Bool, Int, a)
-> Signal domFast (Bool, Bool, Int, a)
forall a (dom :: Domain).
Bundle a =>
Unbundled dom a -> Signal dom a
bundle (Signal domFast Bool
enB, Signal domFast Bool
weB, Index nAddrs -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Index nAddrs -> Integer)
-> Signal domFast (Index nAddrs) -> Signal domFast Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal domFast (Index nAddrs)
addrB, Signal domFast a
datB))
      a
startA a
startB

  tA :: Int
tA = SNat (DomainConfigurationPeriod (KnownConf domSlow)) -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum @Int (forall (period :: Nat).
(KnownDomain domSlow,
 DomainConfigurationPeriod (KnownConf domSlow) ~ period) =>
SNat period
forall (dom :: Domain) (period :: Nat).
(KnownDomain dom, DomainPeriod dom ~ period) =>
SNat period
clockPeriod @domSlow)
  tB :: Int
tB = SNat (DomainConfigurationPeriod (KnownConf domFast)) -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum @Int (forall (period :: Nat).
(KnownDomain domFast,
 DomainConfigurationPeriod (KnownConf domFast) ~ period) =>
SNat period
forall (dom :: Domain) (period :: Nat).
(KnownDomain dom, DomainPeriod dom ~ period) =>
SNat period
clockPeriod @domFast)

  startA :: a
startA = String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"trueDualPortBlockRam: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
labelA String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": First value undefined"
  startB :: a
startB = String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"trueDualPortBlockRam: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
labelB String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": First value undefined"

  initElement :: Int -> a
  initElement :: Int -> a
initElement Int
n =
    String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String
"Unknown initial element; position " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n)

  unknownEnableAndAddr :: String -> String -> Int -> a
  unknownEnableAndAddr :: String -> String -> Int -> a
unknownEnableAndAddr String
enaMsg String
addrMsg Int
n =
    String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String
"Write enable and data unknown; position " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                String
"\nWrite enable error message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
enaMsg String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                String
"\nAddress error message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
addrMsg)

  unknownAddr :: String -> Int -> a
  unknownAddr :: String -> Int -> a
unknownAddr String
msg Int
n =
    String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String
"Write enabled, but address unknown; position " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                String
"\nAddress error message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg)

  getConflict :: Bool -> Bool -> Bool -> Int -> Bool -> Int -> Maybe Conflict
  getConflict :: Bool -> Bool -> Bool -> Int -> Bool -> Int -> Maybe Conflict
getConflict Bool
enA_ Bool
enB_ Bool
wenA Int
addrA_ Bool
wenB Int
addrB_ =
    -- If port A or port B is writing on (potentially!) the same address,
    -- there's a conflict
    if Bool
sameAddr then Conflict -> Maybe Conflict
forall a. a -> Maybe a
Just Conflict
conflict else Maybe Conflict
forall a. Maybe a
Nothing
   where
    wenAX :: MaybeX Bool
wenAX = Bool -> MaybeX Bool
forall a. a -> MaybeX a
toMaybeX Bool
wenA
    wenBX :: MaybeX Bool
wenBX = Bool -> MaybeX Bool
forall a. a -> MaybeX a
toMaybeX Bool
wenB

    mergeX :: MaybeX Bool -> MaybeX Bool -> MaybeX Bool
mergeX MaybeX Bool
IsX MaybeX Bool
b = MaybeX Bool
b
    mergeX MaybeX Bool
a MaybeX Bool
IsX = MaybeX Bool
a
    mergeX (IsDefined Bool
a) (IsDefined Bool
b) = Bool -> MaybeX Bool
forall a. a -> MaybeX a
IsDefined (Bool
a Bool -> Bool -> Bool
&& Bool
b)

    conflict :: Conflict
conflict = Conflict :: MaybeX Bool -> MaybeX Bool -> MaybeX Bool -> MaybeX Int -> Conflict
Conflict
      { cfRWA :: MaybeX Bool
cfRWA     = if Bool
enB_ then MaybeX Bool
wenBX else Bool -> MaybeX Bool
forall a. a -> MaybeX a
IsDefined Bool
False
      , cfRWB :: MaybeX Bool
cfRWB     = if Bool
enA_ then MaybeX Bool
wenAX else Bool -> MaybeX Bool
forall a. a -> MaybeX a
IsDefined Bool
False
      , cfWW :: MaybeX Bool
cfWW      = if Bool
enA_ Bool -> Bool -> Bool
&& Bool
enB_ then MaybeX Bool -> MaybeX Bool -> MaybeX Bool
mergeX MaybeX Bool
wenAX MaybeX Bool
wenBX else Bool -> MaybeX Bool
forall a. a -> MaybeX a
IsDefined Bool
False
      , cfAddress :: MaybeX Int
cfAddress = Int -> MaybeX Int
forall a. a -> MaybeX a
toMaybeX Int
addrA_ }

    sameAddr :: Bool
sameAddr =
      case (Int -> Either String Int
forall a. a -> Either String a
isX Int
addrA_, Int -> Either String Int
forall a. a -> Either String a
isX Int
addrB_) of
        (Left String
_, Either String Int
_) -> Bool
True
        (Either String Int
_, Left String
_) -> Bool
True
        (Either String Int, Either String Int)
_           -> Int
addrA_ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
addrB_

  writeRam :: Bool -> Int -> a -> Seq a -> (Maybe a, Seq a)
  writeRam :: Bool -> Int -> a -> Seq a -> (Maybe a, Seq a)
writeRam Bool
enable Int
addr a
dat Seq a
mem
    | Left String
enaMsg <- Either String Bool
enableUndefined
    , Left String
addrMsg <- Either String Int
addrUndefined
    = let msg :: String
msg = String
"Unknown enable and address" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                String
"\nWrite enable error message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
enaMsg String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                String
"\nAddress error message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
addrMsg
       in ( a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
msg)
          , Int -> (Int -> a) -> Seq a
forall a. Int -> (Int -> a) -> Seq a
Seq.fromFunction (forall a. (Num a, KnownNat nAddrs) => a
forall (n :: Nat) a. (Num a, KnownNat n) => a
natToNum @nAddrs)
                             (String -> String -> Int -> a
unknownEnableAndAddr String
enaMsg String
addrMsg) )
    | Left String
enaMsg <- Either String Bool
enableUndefined
    = let msg :: String
msg = String
"Write enable unknown; position" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
addr String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                String
"\nWrite enable error message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
enaMsg
       in Bool -> Int -> a -> Seq a -> (Maybe a, Seq a)
writeRam Bool
True Int
addr (String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
msg) Seq a
mem
    | Bool
enable
    , Left String
addrMsg <- Either String Int
addrUndefined
    = ( a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"Unknown address")
      , Int -> (Int -> a) -> Seq a
forall a. Int -> (Int -> a) -> Seq a
Seq.fromFunction (forall a. (Num a, KnownNat nAddrs) => a
forall (n :: Nat) a. (Num a, KnownNat n) => a
natToNum @nAddrs) (String -> Int -> a
unknownAddr String
addrMsg) )
    | Bool
enable
    = (a -> Maybe a
forall a. a -> Maybe a
Just a
dat, Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
addr a
dat Seq a
mem)
    | Bool
otherwise
    = (Maybe a
forall a. Maybe a
Nothing, Seq a
mem)
   where
    enableUndefined :: Either String Bool
enableUndefined = Bool -> Either String Bool
forall a. a -> Either String a
isX Bool
enable
    addrUndefined :: Either String Int
addrUndefined = Int -> Either String Int
forall a. a -> Either String a
isX Int
addr

  go ::
    Seq a ->
    Int ->
    Signal domSlow (Bool, Bool, Int, a) ->
    Signal domFast (Bool, Bool, Int, a) ->
    a -> a ->
    (Signal domSlow a, Signal domFast a)
  go :: Seq a
-> Int
-> Signal domSlow (Bool, Bool, Int, a)
-> Signal domFast (Bool, Bool, Int, a)
-> a
-> a
-> (Signal domSlow a, Signal domFast a)
go Seq a
ram0 Int
relativeTime Signal domSlow (Bool, Bool, Int, a)
as0 Signal domFast (Bool, Bool, Int, a)
bs0 =
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
relativeTime Int
0 of
      Ordering
LT -> a -> a -> (Signal domSlow a, Signal domFast a)
goSlow
      Ordering
EQ -> a -> a -> (Signal domSlow a, Signal domFast a)
goBoth
      Ordering
GT -> a -> a -> (Signal domSlow a, Signal domFast a)
goFast
   where
    (Bool
enA_, Bool
weA_, Int
addrA_, a
datA_) :- Signal domSlow (Bool, Bool, Int, a)
as1 = Signal domSlow (Bool, Bool, Int, a)
as0
    (Bool
enB_, Bool
weB_, Int
addrB_, a
datB_) :- Signal domFast (Bool, Bool, Int, a)
bs1 = Signal domFast (Bool, Bool, Int, a)
bs0

    goBoth :: a -> a -> (Signal domSlow a, Signal domFast a)
goBoth a
prevA a
prevB = a
outA2 a
-> (Signal domSlow a, Signal domFast a)
-> (Signal domSlow a, Signal domFast a)
forall a b. a -> b -> b
`seqX` a
outB2 a
-> (Signal domSlow a, Signal domFast a)
-> (Signal domSlow a, Signal domFast a)
forall a b. a -> b -> b
`seqX` (a
outA2 a -> Signal domSlow a -> Signal domSlow a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domSlow a
as2, a
outB2 a -> Signal domFast a -> Signal domFast a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domFast a
bs2)
     where
      conflict :: Maybe Conflict
conflict = Bool -> Bool -> Bool -> Int -> Bool -> Int -> Maybe Conflict
getConflict Bool
enA_ Bool
enB_ Bool
weA_ Int
addrA_ Bool
weB_ Int
addrB_

      (a
datA1_,a
datB1_) = case Maybe Conflict
conflict of
        Just Conflict{cfWW :: Conflict -> MaybeX Bool
cfWW=IsDefined Bool
True} ->
          ( String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"trueDualPortBlockRam: conflicting write/write queries"
          , String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"trueDualPortBlockRam: conflicting write/write queries" )
        Just Conflict{cfWW :: Conflict -> MaybeX Bool
cfWW=MaybeX Bool
IsX} ->
          ( String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"trueDualPortBlockRam: conflicting write/write queries"
          , String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"trueDualPortBlockRam: conflicting write/write queries" )
        Maybe Conflict
_ -> (a
datA_,a
datB_)

      (Maybe a
wroteA,Seq a
ram1) = Bool -> Int -> a -> Seq a -> (Maybe a, Seq a)
writeRam Bool
weA_ Int
addrA_ a
datA1_ Seq a
ram0
      (Maybe a
wroteB,Seq a
ram2) = Bool -> Int -> a -> Seq a -> (Maybe a, Seq a)
writeRam Bool
weB_ Int
addrB_ a
datB1_ Seq a
ram1

      outA1 :: a
outA1 = case Maybe Conflict
conflict of
        Just Conflict{cfRWA :: Conflict -> MaybeX Bool
cfRWA=IsDefined Bool
True} ->
          String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"trueDualPortBlockRam: conflicting read/write queries"
        Just Conflict{cfRWA :: Conflict -> MaybeX Bool
cfRWA=MaybeX Bool
IsX} ->
          String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"trueDualPortBlockRam: conflicting read/write queries"
        Maybe Conflict
_ -> a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Seq a
ram0 Seq a -> Int -> a
forall a. Seq a -> Int -> a
`Seq.index` Int
addrA_) Maybe a
wroteA

      outB1 :: a
outB1 = case Maybe Conflict
conflict of
        Just Conflict{cfRWB :: Conflict -> MaybeX Bool
cfRWB=IsDefined Bool
True} ->
          String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"trueDualPortBlockRam: conflicting read/write queries"
        Just Conflict{cfRWB :: Conflict -> MaybeX Bool
cfRWB=MaybeX Bool
IsX} ->
          String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
"trueDualPortBlockRam: conflicting read/write queries"
        Maybe Conflict
_ -> a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Seq a
ram0 Seq a -> Int -> a
forall a. Seq a -> Int -> a
`Seq.index` Int
addrB_) Maybe a
wroteB

      outA2 :: a
outA2 = if Bool
enA_ then a
outA1 else a
prevA
      outB2 :: a
outB2 = if Bool
enB_ then a
outB1 else a
prevB
      (Signal domSlow a
as2,Signal domFast a
bs2) = Seq a
-> Int
-> Signal domSlow (Bool, Bool, Int, a)
-> Signal domFast (Bool, Bool, Int, a)
-> a
-> a
-> (Signal domSlow a, Signal domFast a)
go Seq a
ram2 (Int
relativeTime Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tA) Signal domSlow (Bool, Bool, Int, a)
as1 Signal domFast (Bool, Bool, Int, a)
bs1 a
outA2 a
outB2

    -- 1 iteration here, as this is the slow clock.
    goSlow :: a -> a -> (Signal domSlow a, Signal domFast a)
goSlow a
_ a
prevB | Bool
enA_ = a
out0 a
-> (Signal domSlow a, Signal domFast a)
-> (Signal domSlow a, Signal domFast a)
forall a b. a -> b -> b
`seqX` (a
out0 a -> Signal domSlow a -> Signal domSlow a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domSlow a
as2, Signal domFast a
bs2)
     where
      (Maybe a
wrote, !Seq a
ram1) = Bool -> Int -> a -> Seq a -> (Maybe a, Seq a)
writeRam Bool
weA_ Int
addrA_ a
datA_ Seq a
ram0
      out0 :: a
out0 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Seq a
ram1 Seq a -> Int -> a
forall a. Seq a -> Int -> a
`Seq.index` Int
addrA_) Maybe a
wrote
      (Signal domSlow a
as2, Signal domFast a
bs2) = Seq a
-> Int
-> Signal domSlow (Bool, Bool, Int, a)
-> Signal domFast (Bool, Bool, Int, a)
-> a
-> a
-> (Signal domSlow a, Signal domFast a)
go Seq a
ram1 (Int
relativeTime Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tA) Signal domSlow (Bool, Bool, Int, a)
as1 Signal domFast (Bool, Bool, Int, a)
bs0 a
out0 a
prevB

    goSlow a
prevA a
prevB = (a
prevA a -> Signal domSlow a -> Signal domSlow a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domSlow a
as2, Signal domFast a
bs2)
      where
        (Signal domSlow a
as2,Signal domFast a
bs2) = Seq a
-> Int
-> Signal domSlow (Bool, Bool, Int, a)
-> Signal domFast (Bool, Bool, Int, a)
-> a
-> a
-> (Signal domSlow a, Signal domFast a)
go Seq a
ram0 (Int
relativeTime Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tA) Signal domSlow (Bool, Bool, Int, a)
as1 Signal domFast (Bool, Bool, Int, a)
bs0 a
prevA a
prevB

    -- 1 or more iterations here, as this is the fast clock. First iteration
    -- happens here.
    goFast :: a -> a -> (Signal domSlow a, Signal domFast a)
goFast a
prevA a
_ | Bool
enB_ = a
out0 a
-> (Signal domSlow a, Signal domFast a)
-> (Signal domSlow a, Signal domFast a)
forall a b. a -> b -> b
`seqX` (Signal domSlow a
as2, a
out0 a -> Signal domFast a -> Signal domFast a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domFast a
bs2)
     where
      (Maybe a
wrote, !Seq a
ram1) = Bool -> Int -> a -> Seq a -> (Maybe a, Seq a)
writeRam Bool
weB_ Int
addrB_ a
datB_ Seq a
ram0
      out0 :: a
out0 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Seq a
ram1 Seq a -> Int -> a
forall a. Seq a -> Int -> a
`Seq.index` Int
addrB_) Maybe a
wrote
      (Signal domSlow a
as2, Signal domFast a
bs2) = Seq a
-> Int
-> Signal domSlow (Bool, Bool, Int, a)
-> Signal domFast (Bool, Bool, Int, a)
-> a
-> a
-> (Signal domSlow a, Signal domFast a)
go Seq a
ram1 (Int
relativeTime Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tB) Signal domSlow (Bool, Bool, Int, a)
as0 Signal domFast (Bool, Bool, Int, a)
bs1 a
prevA a
out0

    goFast a
prevA a
prevB = (Signal domSlow a
as2, a
prevB a -> Signal domFast a -> Signal domFast a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domFast a
bs2)
     where
       (Signal domSlow a
as2,Signal domFast a
bs2) = Seq a
-> Int
-> Signal domSlow (Bool, Bool, Int, a)
-> Signal domFast (Bool, Bool, Int, a)
-> a
-> a
-> (Signal domSlow a, Signal domFast a)
go Seq a
ram0 (Int
relativeTime Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tB) Signal domSlow (Bool, Bool, Int, a)
as0 Signal domFast (Bool, Bool, Int, a)
bs1 a
prevA a
prevB