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

RAM primitives with a combinational read port.
-}

{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}

{-# 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            (fromJust, isJust)
import GHC.Stack             (HasCallStack, withFrozenCallStack)
import GHC.TypeLits          (KnownNat)
import qualified Data.Vector as V

import Clash.Explicit.Signal
  (unbundle, unsafeSynchronizer, KnownDomain, enable)
import Clash.Promoted.Nat    (SNat (..), snatToNum, pow2SNat)
import Clash.Signal.Internal (Clock (..), Signal (..), Enable, fromEnable)
import Clash.Sized.Unsigned  (Unsigned)
import Clash.XException      (errorX, maybeIsX)

-- | Create a RAM with space for 2^@n@ elements
--
-- * __NB__: Initial content of the RAM is 'undefined'
--
-- 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
     )
  => 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 = \wclk :: Clock wdom
wclk rclk :: Clock rdom
rclk en :: Enable wdom
en rd :: Signal rdom (Unsigned n)
rd wrM :: 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) (n :: Nat) a.
(Enum addr, HasCallStack, KnownDomain wdom, KnownDomain rdom) =>
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'
--
-- 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
     )
  => 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 = \wclk :: Clock wdom
wclk rclk :: Clock rdom
rclk gen :: Enable wdom
gen sz :: SNat n
sz rd :: Signal rdom addr
rd wrM :: 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal wdom (Maybe (addr, a))
wrM
      (wr :: Signal wdom addr
wr,din :: 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
fromJust (Maybe (addr, a) -> (addr, a))
-> Signal wdom (Maybe (addr, a)) -> Signal wdom (addr, a)
forall (f :: * -> *) 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) =>
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 :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal wdom addr
wr) Signal wdom a
din)
{-# INLINE asyncRam #-}

-- | RAM primitive
asyncRam#
  :: ( HasCallStack
     , KnownDomain wdom
     , KnownDomain rdom )
  => 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# wclk :: Clock wdom
wclk rclk :: Clock rdom
rclk en :: Enable wdom
en sz :: SNat n
sz rd :: Signal rdom Int
rd we :: Signal wdom Bool
we wr :: Signal wdom Int
wr din :: Signal wdom a
din =
    Clock wdom -> Clock rdom -> Signal wdom a -> Signal rdom a
forall (dom1 :: Domain) (dom2 :: Domain) a.
(KnownDomain dom1, KnownDomain dom2) =>
Clock dom1 -> Clock dom2 -> Signal dom1 a -> Signal dom2 a
unsafeSynchronizer Clock wdom
wclk Clock rdom
rclk Signal wdom a
dout
  where
    rd' :: Signal wdom Int
rd'  = Clock rdom -> Clock wdom -> Signal rdom Int -> Signal wdom Int
forall (dom1 :: Domain) (dom2 :: Domain) a.
(KnownDomain dom1, KnownDomain dom2) =>
Clock dom1 -> Clock dom2 -> Signal dom1 a -> Signal dom2 a
unsafeSynchronizer Clock rdom
rclk Clock wdom
wclk Signal rdom Int
rd
    ramI :: Vector a
ramI = Int -> a -> Vector a
forall a. Int -> a -> Vector a
V.replicate
              (SNat n -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum SNat n
sz)
              ((HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (String -> a
forall a. HasCallStack => String -> a
errorX "asyncRam#: initial value undefined"))
    en' :: Signal wdom Bool
en' = 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
enable Enable wdom
en Signal wdom Bool
we)
    dout :: Signal wdom a
dout = Vector a
-> Signal wdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal wdom a
forall a (wdom :: Domain).
Vector a
-> Signal wdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal wdom a
go Vector a
ramI Signal wdom Int
rd' Signal wdom Bool
en' Signal wdom Int
wr Signal wdom a
din

    go :: V.Vector a -> Signal wdom Int -> Signal wdom Bool
       -> Signal wdom Int -> Signal wdom a -> Signal wdom a
    go :: Vector a
-> Signal wdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal wdom a
go !Vector a
ram (r :: Int
r :- rs :: Signal wdom Int
rs) (e :: Bool
e :- es :: Signal wdom Bool
es) (w :: Int
w :- ws :: Signal wdom Int
ws) (d :: a
d :- ds :: Signal wdom a
ds) =
      let ram' :: Vector a
ram' = Vector a -> Bool -> Int -> a -> Vector a
forall a. Vector a -> Bool -> Int -> a -> Vector a
upd Vector a
ram Bool
e (Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
w) a
d
          o :: a
o    = Vector a
ram Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
r
      in  a
o a -> Signal wdom a -> Signal wdom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Vector a
-> Signal wdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal wdom a
forall a (wdom :: Domain).
Vector a
-> Signal wdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal wdom a
go Vector a
ram' Signal wdom Int
rs Signal wdom Bool
es Signal wdom Int
ws Signal wdom a
ds

    upd :: Vector a -> Bool -> Int -> a -> Vector a
upd ram :: Vector a
ram we' :: Bool
we' waddr :: Int
waddr d :: a
d = case Bool -> Maybe Bool
forall a. NFData a => a -> Maybe a
maybeIsX Bool
we' of
      Nothing -> case Int -> Maybe Int
forall a. NFData a => a -> Maybe a
maybeIsX Int
waddr of
        Nothing -> (a -> a) -> Vector a -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
forall a b. a -> b -> b
seq Int
waddr a
d)) Vector a
ram
        Just wa :: Int
wa -> Vector a
ram Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
wa,a
d)]
      Just True -> case Int -> Maybe Int
forall a. NFData a => a -> Maybe a
maybeIsX Int
waddr of
        Nothing -> (a -> a) -> Vector a -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
forall a b. a -> b -> b
seq Int
waddr a
d)) Vector a
ram
        Just wa :: Int
wa -> Vector a
ram Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
wa,a
d)]
      _ -> Vector a
ram
{-# NOINLINE asyncRam# #-}