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

RAM primitives with a combinational read port.
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

{-# LANGUAGE Trustworthy #-}

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

{-# OPTIONS_HADDOCK show-extensions #-}

module Clash.Explicit.RAM
  ( -- * RAM synchronized to an arbitrary clock
    asyncRam
  , asyncRamPow2
    -- * Internal
  , asyncRam#
  )
where

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

import Clash.Annotations.Primitive (hasBlackBox)
import Clash.Explicit.Signal (unbundle, KnownDomain, andEnable)
import Clash.Promoted.Nat    (SNat (..), snatToNum, pow2SNat)
import Clash.Signal.Internal (Clock (..), Signal (..), Enable, fromEnable)
import Clash.Signal.Internal.Ambiguous (clockPeriod)
import Clash.Sized.Unsigned  (Unsigned)
import Clash.XException
  (defaultSeqX, errorX, fromJustX, maybeIsX, NFDataX)

-- | Create a RAM with space for 2^@n@ elements
--
-- * __NB__: Initial content of the RAM is /undefined/, reading it will throw an
-- 'Clash.XException.XException'
--
-- Additional helpful information:
--
-- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a
-- RAM.
asyncRamPow2
  :: forall wdom rdom n a
   . ( KnownNat n
     , HasCallStack
     , KnownDomain wdom
     , KnownDomain rdom
     , NFDataX a
     )
  => Clock wdom
  -- ^ 'Clock' to which to synchronize the write port of the RAM
  -> Clock rdom
  -- ^ 'Clock' to which the read address signal, @r@, is synchronized
  -> Enable wdom
  -- ^ Global enable
  -> Signal rdom (Unsigned n)
  -- ^ Read address @r@
  -> Signal wdom (Maybe (Unsigned n, a))
  -- ^ (write address @w@, value to write)
  -> Signal rdom a
  -- ^ Value of the @RAM@ at address @r@
asyncRamPow2 :: Clock wdom
-> Clock rdom
-> Enable wdom
-> Signal rdom (Unsigned n)
-> Signal wdom (Maybe (Unsigned n, a))
-> Signal rdom a
asyncRamPow2 = \Clock wdom
wclk Clock rdom
rclk Enable wdom
en Signal rdom (Unsigned n)
rd Signal wdom (Maybe (Unsigned n, a))
wrM -> (HasCallStack => Signal rdom a) -> Signal rdom a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
  (Clock wdom
-> Clock rdom
-> Enable wdom
-> SNat (2 ^ n)
-> Signal rdom (Unsigned n)
-> Signal wdom (Maybe (Unsigned n, a))
-> Signal rdom a
forall addr (wdom :: Domain) (rdom :: Domain) a (n :: Nat).
(Enum addr, HasCallStack, KnownDomain wdom, KnownDomain rdom,
 NFDataX a) =>
Clock wdom
-> Clock rdom
-> Enable wdom
-> SNat n
-> Signal rdom addr
-> Signal wdom (Maybe (addr, a))
-> Signal rdom a
asyncRam Clock wdom
wclk Clock rdom
rclk Enable wdom
en (SNat n -> SNat (2 ^ n)
forall (a :: Nat). SNat a -> SNat (2 ^ a)
pow2SNat (KnownNat n => SNat n
forall (n :: Nat). KnownNat n => SNat n
SNat @n)) Signal rdom (Unsigned n)
rd Signal wdom (Maybe (Unsigned n, a))
wrM)
{-# INLINE asyncRamPow2 #-}


-- | Create a RAM with space for @n@ elements
--
-- * __NB__: Initial content of the RAM is /undefined/, reading it will throw an
-- 'Clash.XException.XException'
--
-- Additional helpful information:
--
-- * See "Clash.Explicit.BlockRam#usingrams" for more information on how to use a
-- RAM.
asyncRam
  :: ( Enum addr
     , HasCallStack
     , KnownDomain wdom
     , KnownDomain rdom
     , NFDataX a
     )
  => Clock wdom
   -- ^ 'Clock' to which to synchronize the write port of the RAM
  -> Clock rdom
   -- ^ 'Clock' to which the read address signal, @r@, is synchronized to
  -> Enable wdom
  -- ^ Global enable
  -> SNat n
  -- ^ Size @n@ of the RAM
  -> Signal rdom addr
  -- ^ Read address @r@
  -> Signal wdom (Maybe (addr, a))
  -- ^ (write address @w@, value to write)
  -> Signal rdom a
   -- ^ Value of the @RAM@ at address @r@
asyncRam :: Clock wdom
-> Clock rdom
-> Enable wdom
-> SNat n
-> Signal rdom addr
-> Signal wdom (Maybe (addr, a))
-> Signal rdom a
asyncRam = \Clock wdom
wclk Clock rdom
rclk Enable wdom
gen SNat n
sz Signal rdom addr
rd Signal wdom (Maybe (addr, a))
wrM ->
  let en :: Signal wdom Bool
en       = Maybe (addr, a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (addr, a) -> Bool)
-> Signal wdom (Maybe (addr, a)) -> Signal wdom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal wdom (Maybe (addr, a))
wrM
      (Signal wdom addr
wr,Signal wdom a
din) = Signal wdom (addr, a) -> Unbundled wdom (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 wdom (Maybe (addr, a)) -> Signal wdom (addr, a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal wdom (Maybe (addr, a))
wrM)
  in  (HasCallStack => Signal rdom a) -> Signal rdom a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
      (Clock wdom
-> Clock rdom
-> Enable wdom
-> SNat n
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
forall (wdom :: Domain) (rdom :: Domain) (n :: Nat) a.
(HasCallStack, KnownDomain wdom, KnownDomain rdom, NFDataX a) =>
Clock wdom
-> Clock rdom
-> Enable wdom
-> SNat n
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
asyncRam# Clock wdom
wclk Clock rdom
rclk Enable wdom
gen SNat n
sz (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal rdom addr -> Signal rdom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal rdom addr
rd) Signal wdom Bool
en (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal wdom addr -> Signal wdom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal wdom addr
wr) Signal wdom a
din)
{-# INLINE asyncRam #-}

-- | RAM primitive
asyncRam#
  :: forall wdom rdom n a
   . ( HasCallStack
     , KnownDomain wdom
     , KnownDomain rdom
     , NFDataX a
     )
  => Clock wdom
  -- ^ 'Clock' to which to synchronize the write port of the RAM
  -> Clock rdom
  -- ^ 'Clock' to which the read address signal, @r@, is synchronized
  -> Enable wdom
  -- ^ Global enable
  -> SNat n
  -- ^ Size @n@ of the RAM
  -> Signal rdom Int
  -- ^ Read address @r@
  -> Signal wdom Bool
  -- ^ Write enable
  -> Signal wdom Int
  -- ^ Write address @w@
  -> Signal wdom a
  -- ^ Value to write (at address @w@)
  -> Signal rdom a
  -- ^ Value of the @RAM@ at address @r@
asyncRam# :: Clock wdom
-> Clock rdom
-> Enable wdom
-> SNat n
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
asyncRam# !Clock wdom
_ !Clock rdom
_ Enable wdom
en SNat n
sz Signal rdom Int
rd Signal wdom Bool
we Signal wdom Int
wr Signal wdom a
din = Signal rdom a
dout
  where
    ramI :: Seq a
ramI = Int -> a -> Seq a
forall a. Int -> a -> Seq a
Seq.replicate
              Int
szI
              ((HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (String -> a
forall a. HasCallStack => String -> a
errorX String
"asyncRam#: initial value undefined"))
    en0 :: Signal wdom Bool
en0 = Enable wdom -> Signal wdom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable (Enable wdom -> Signal wdom Bool -> Enable wdom
forall (dom :: Domain). Enable dom -> Signal dom Bool -> Enable dom
andEnable Enable wdom
en Signal wdom Bool
we)
    dout :: Signal rdom a
dout = if Int
rPeriod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
wPeriod
           then Seq a
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
goSingle Seq a
ramI Signal rdom Int
rd Signal wdom Bool
en0 Signal wdom Int
wr Signal wdom a
din
           else Int
-> Seq a
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
go Int
0 Seq a
ramI Signal rdom Int
rd Signal wdom Bool
en0 Signal wdom Int
wr Signal wdom a
din
    rPeriod :: Int
rPeriod = SNat (DomainConfigurationPeriod (KnownConf rdom)) -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum (forall (period :: Nat).
(KnownDomain rdom,
 DomainConfigurationPeriod (KnownConf rdom) ~ period) =>
SNat period
forall (dom :: Domain) (period :: Nat).
(KnownDomain dom, DomainPeriod dom ~ period) =>
SNat period
clockPeriod @rdom) :: Int
    wPeriod :: Int
wPeriod = SNat (DomainConfigurationPeriod (KnownConf wdom)) -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum (forall (period :: Nat).
(KnownDomain wdom,
 DomainConfigurationPeriod (KnownConf wdom) ~ period) =>
SNat period
forall (dom :: Domain) (period :: Nat).
(KnownDomain dom, DomainPeriod dom ~ period) =>
SNat period
clockPeriod @wdom) :: Int
    szI :: Int
szI = SNat n -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum SNat n
sz :: Int

    goSingle :: Seq.Seq a -> Signal rdom Int -> Signal wdom Bool
       -> Signal wdom Int -> Signal wdom a -> Signal rdom a
    goSingle :: Seq a
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
goSingle !Seq a
ram (Int
r :- Signal rdom Int
rs) ~(Bool
e :- Signal wdom Bool
es) wt :: Signal wdom Int
wt@(~(Int
w :- Signal wdom Int
ws)) dt :: Signal wdom a
dt@(~(a
d :- Signal wdom a
ds)) =
      let ram0 :: Seq a
ram0 = Seq a -> Bool -> Int -> a -> Seq a
upd Seq a
ram Bool
e Int
w a
d
          o :: a
o    = Seq a
ram HasCallStack => Seq a -> Int -> a
Seq a -> Int -> a
`safeAt` Int
r
      in  a
o a -> Signal rdom a -> Signal rdom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (a
o a -> Signal rdom a -> Signal rdom a
forall a b. NFDataX a => a -> b -> b
`defaultSeqX` Signal wdom Int
wt Signal wdom Int -> Signal rdom a -> Signal rdom a
`seq` Signal wdom a
dt Signal wdom a -> Signal rdom a -> Signal rdom a
`seq` Seq a
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
goSingle Seq a
ram0 Signal rdom Int
rs Signal wdom Bool
es Signal wdom Int
ws Signal wdom a
ds)

    -- Given
    --   tR = absolute time of next active edge of read clock
    --   tW = absolute time of next active edge of write clock
    -- relTime is defined as relTime = tW - tR
    --
    -- Put differently, relative time 0 points at the next active edge of the
    -- read clock, and relTime points at the next active edge of the write
    -- clock.
    go :: Int -> Seq.Seq a -> Signal rdom Int -> Signal wdom Bool
       -> Signal wdom Int -> Signal wdom a -> Signal rdom a
    go :: Int
-> Seq a
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
go   Int
relTime !Seq a
ram rt :: Signal rdom Int
rt@(~(Int
r :- Signal rdom Int
rs)) et :: Signal wdom Bool
et@(~(Bool
e :- Signal wdom Bool
es)) wt :: Signal wdom Int
wt@(~(Int
w :- Signal wdom Int
ws))
         dt :: Signal wdom a
dt@(~(a
d :- Signal wdom a
ds))
      | Int
relTime Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = let ram0 :: Seq a
ram0 = Seq a -> Bool -> Int -> a -> Seq a
upd Seq a
ram Bool
e Int
w a
d
                      in Signal wdom Int
wt Signal wdom Int -> Signal rdom a -> Signal rdom a
`seq` Signal wdom a
dt Signal wdom a -> Signal rdom a -> Signal rdom a
`seq`
                         Int
-> Seq a
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
go (Int
relTime Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wPeriod) Seq a
ram0 Signal rdom Int
rt Signal wdom Bool
es Signal wdom Int
ws Signal wdom a
ds
      | Bool
otherwise   = let o :: a
o = Seq a
ram HasCallStack => Seq a -> Int -> a
Seq a -> Int -> a
`safeAt` Int
r
                      in a
o a -> Signal rdom a -> Signal rdom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (a
o a -> Signal rdom a -> Signal rdom a
forall a b. NFDataX a => a -> b -> b
`defaultSeqX` Int
-> Seq a
-> Signal rdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal rdom a
go (Int
relTime Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rPeriod) Seq a
ram Signal rdom Int
rs Signal wdom Bool
et Signal wdom Int
wt Signal wdom a
dt)

    upd :: Seq a -> Bool -> Int -> a -> Seq a
upd Seq a
ram Bool
we0 Int
waddr a
d = case Bool -> Maybe Bool
forall a. a -> Maybe a
maybeIsX Bool
we0 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 -> a -> a
seq Int
waddr a
d a -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ Seq a
ram
        Just Int
wa -> -- Put the XException from `we` as the value at address
                   -- `waddr`.
                   HasCallStack => Int -> a -> Seq a -> Seq a
Int -> a -> Seq a -> Seq a
safeUpdate Int
wa (Bool -> a -> a
seq Bool
we0 a
d) Seq 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 -> a -> a
seq Int
waddr a
d a -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ Seq a
ram
        Just Int
wa -> a
d a -> Seq a -> Seq a
forall a b. NFDataX a => a -> b -> b
`defaultSeqX` HasCallStack => Int -> a -> Seq a -> Seq a
Int -> a -> Seq a -> Seq a
safeUpdate Int
wa a
d Seq a
ram
      Maybe Bool
_ -> Seq a
ram

    safeAt :: HasCallStack => Seq.Seq a -> Int -> a
    safeAt :: Seq a -> Int -> a
safeAt Seq 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
        Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index Seq a
s Int
i
      else
        (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
          (String -> a
forall a. HasCallStack => String -> a
errorX (String
"asyncRam: read address " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
                   String
" not in range [0.." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
szI String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"))
    {-# INLINE safeAt #-}

    safeUpdate :: HasCallStack => Int -> a -> Seq.Seq a ->  Seq.Seq a
    safeUpdate :: Int -> a -> Seq a -> Seq a
safeUpdate Int
i a
a Seq 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
        Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
i a
a Seq a
s
      else
        let d :: a
d = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
                  (String -> a
forall a. HasCallStack => String -> a
errorX (String
"asyncRam: write address " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String
" not in range [0.." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
szI String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"))
        in a
d a -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ Seq a
s
    {-# INLINE safeUpdate #-}
{-# NOINLINE asyncRam# #-}
{-# ANN asyncRam# hasBlackBox #-}