{-|
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 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.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, fromJustX)

-- | 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 = \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) (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 = \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) =>
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#
  :: ( 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# Clock wdom
wclk Clock rdom
rclk Enable wdom
en SNat n
sz Signal rdom Int
rd Signal wdom Bool
we Signal wdom Int
wr 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 :: Seq a
ramI = Int -> a -> Seq a
forall a. Int -> a -> Seq a
Seq.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 String
"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 = Seq a
-> Signal wdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal wdom a
forall a (wdom :: Domain).
Seq a
-> Signal wdom Int
-> Signal wdom Bool
-> Signal wdom Int
-> Signal wdom a
-> Signal wdom a
go Seq a
ramI Signal wdom Int
rd' Signal wdom Bool
en' Signal wdom Int
wr Signal wdom a
din

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

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