    {-|
    Copyright  :  (C) 2021-2022, QBayLogic B.V.
    License    :  BSD2 (see the file LICENSE)
    Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

    = Efficient bundling of ROM content with the compiled code

    Leveraging Template Haskell, the content for the ROM components in this module
    is stored alongside the compiled Haskell code. It covers use cases where passing
    the initial content as a 'Clash.Sized.Vector.Vec' turns out to be
    problematically slow.

    The data is stored efficiently, with very little overhead (worst-case 7%, often
    no overhead at all).

    Unlike "Clash.Explicit.ROM.File", "Clash.Explicit.ROM.Blob" generates
    practically the same HDL as "Clash.Explicit.ROM" and is compatible with all
    tools consuming the generated HDL.
    -}

    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE Trustworthy #-}

    {-# OPTIONS_HADDOCK show-extensions #-}

    module Clash.Explicit.ROM.Blob
      ( -- * ROMs defined by a 'MemBlob'
        romBlob
      , romBlobPow2
        -- * Creating and inspecting 'MemBlob'
      , MemBlob
      , createMemBlob
      , memBlobTH
      , unpackMemBlob
        -- * Internal
      , romBlob#
      ) where

    import Data.Array (listArray)
    import Data.Array.Base (unsafeAt)
    import GHC.Stack (withFrozenCallStack)
    import GHC.TypeLits (KnownNat, type (^))

    import Clash.Annotations.Primitive (hasBlackBox)
    import Clash.Explicit.BlockRam.Blob (createMemBlob, memBlobTH)
    import Clash.Explicit.BlockRam.Internal (MemBlob(..), unpackMemBlob)
    import Clash.Promoted.Nat (natToNum)
    import Clash.Signal.Internal
      (Clock (..), KnownDomain, Signal (..), Enable, fromEnable)
    import Clash.Sized.Internal.BitVector (BitVector)
    import Clash.Sized.Internal.Unsigned (Unsigned)
    import Clash.XException (deepErrorX, seqX)

    -- | A ROM with a synchronous read port, with space for @n@ elements
    --
    -- * __NB__: Read value is delayed by 1 cycle
    -- * __NB__: Initial output value is /undefined/, reading it will throw an
    -- 'Clash.XException.XException'
    --
    -- === See also:
    --
    -- * See "Clash.Sized.Fixed#creatingdatafiles" and
    -- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs.
    romBlob
      :: forall dom addr m n
       . ( KnownDomain dom
         , Enum addr
         )
      => Clock dom
      -- ^ 'Clock' to synchronize to
      -> Enable dom
      -- ^ 'Enable' line
      -> MemBlob n m
      -- ^ ROM content, also determines the size, @n@, of the ROM
      --
      -- __NB__: __MUST__ be a constant
      -> Signal dom addr
      -- ^ Read address @r@
      -> Signal dom (BitVector m)
      -- ^ The value of the ROM at address @r@ from the previous clock cycle
    romBlob :: forall (dom :: Domain) addr (m :: Nat) (n :: Nat).
    (KnownDomain dom, Enum addr) =>
    Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom addr
    -> Signal dom (BitVector m)
    romBlob = \Clock dom
    clk Enable dom
    en MemBlob n m
    content Signal dom addr
    rd -> Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom Int
    -> Signal dom (BitVector m)
    forall (dom :: Domain) (m :: Nat) (n :: Nat).
    KnownDomain dom =>
    Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom Int
    -> Signal dom (BitVector m)
    romBlob# Clock dom
    clk Enable dom
    en MemBlob n m
    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)
    {-# INLINE romBlob #-}

    -- | A ROM with a synchronous read port, 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
    -- 'Clash.XException.XException'
    --
    -- === See also:
    --
    -- * See "Clash.Sized.Fixed#creatingdatafiles" and
    -- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs.
    romBlobPow2
      :: forall dom m n
       . ( KnownDomain dom
         , KnownNat n
         )
      => Clock dom
      -- ^ 'Clock' to synchronize to
      -> Enable dom
      -- ^ 'Enable' line
      -> MemBlob (2^n) m
      -- ^ ROM content, also determines the size, 2^@n@, of the ROM
      --
      -- __NB__: __MUST__ be a constant
      -> Signal dom (Unsigned n)
      -- ^ Read address @r@
      -> Signal dom (BitVector m)
      -- ^ The value of the ROM at address @r@ from the previous clock cycle
    romBlobPow2 :: forall (dom :: Domain) (m :: Nat) (n :: Nat).
    (KnownDomain dom, KnownNat n) =>
    Clock dom
    -> Enable dom
    -> MemBlob (2 ^ n) m
    -> Signal dom (Unsigned n)
    -> Signal dom (BitVector m)
    romBlobPow2 = Clock dom
    -> Enable dom
    -> MemBlob (2 ^ n) m
    -> Signal dom (Unsigned n)
    -> Signal dom (BitVector m)
    forall (dom :: Domain) addr (m :: Nat) (n :: Nat).
    (KnownDomain dom, Enum addr) =>
    Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom addr
    -> Signal dom (BitVector m)
    romBlob
    {-# INLINE romBlobPow2 #-}

    -- | ROM primitive
    romBlob#
      :: forall dom m n
       . KnownDomain dom
      => Clock dom
      -- ^ 'Clock' to synchronize to
      -> Enable dom
      -- ^ 'Enable' line
      -> MemBlob n m
      -- ^ ROM content, also determines the size, @n@, of the ROM
      --
      -- __NB__: __MUST__ be a constant
      -> Signal dom Int
      -- ^ Read address @r@
      -> Signal dom (BitVector m)
      -- ^ The value of the ROM at address @r@ from the previous clock cycle
    romBlob# :: forall (dom :: Domain) (m :: Nat) (n :: Nat).
    KnownDomain dom =>
    Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom Int
    -> Signal dom (BitVector m)
    romBlob# !Clock dom
    _ Enable dom
    en content :: MemBlob n m
    content@MemBlob{} =
      BitVector m
    -> Signal dom Bool -> Signal dom Int -> Signal dom (BitVector m)
    forall {dom :: Domain} {dom :: Domain} {dom :: Domain}.
    BitVector m
    -> Signal dom Bool -> Signal dom Int -> Signal dom (BitVector m)
    go
        ((HasCallStack => BitVector m) -> BitVector m
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack (String -> BitVector m
    forall a. (NFDataX a, HasCallStack) => String -> a
    deepErrorX String
    "romBlob: initial value undefined"))
        (Enable dom -> Signal dom Bool
    forall (dom :: Domain). Enable dom -> Signal dom Bool
    fromEnable Enable dom
    en)
     where
      szI :: Int
    szI = forall (n :: Nat) a. (Num a, KnownNat n) => a
    natToNum @n @Int
      arr :: Array Int (BitVector m)
    arr = (Int, Int) -> [BitVector m] -> Array Int (BitVector m)
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0,Int
    szIInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) ([BitVector m] -> Array Int (BitVector m))
    -> [BitVector m] -> Array Int (BitVector m)
    forall a b. (a -> b) -> a -> b
    $ MemBlob n m -> [BitVector m]
    forall (n :: Nat) (m :: Nat). MemBlob n m -> [BitVector m]
    unpackMemBlob MemBlob n m
    content

      go :: BitVector m
    -> Signal dom Bool -> Signal dom Int -> Signal dom (BitVector m)
    go BitVector m
    o (Bool
    e :- Signal dom Bool
    es) rd :: Signal dom Int
    rd@(~(Int
    r :- Signal dom Int
    rs)) =
        let o1 :: BitVector m
    o1 = if Bool
    e then Int -> BitVector m
    safeAt Int
    r else BitVector m
    o
        -- See [Note: register strictness annotations]
        in  BitVector m
    o BitVector m -> Signal dom (BitVector m) -> Signal dom (BitVector m)
    forall a b. a -> b -> b
    `seqX` BitVector m
    o BitVector m -> Signal dom (BitVector m) -> Signal dom (BitVector m)
    forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
    :- (Signal dom Int
    rd Signal dom Int
    -> Signal dom (BitVector m) -> Signal dom (BitVector m)
    forall a b. a -> b -> b
    `seq` BitVector m
    -> Signal dom Bool -> Signal dom Int -> Signal dom (BitVector m)
    go BitVector m
    o1 Signal dom Bool
    es Signal dom Int
    rs)

      safeAt :: Int -> BitVector m
      safeAt :: Int -> BitVector m
    safeAt 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
          Array Int (BitVector m) -> Int -> BitVector m
    forall i. Ix i => Array i (BitVector m) -> Int -> BitVector m
    forall (a :: Type -> Type -> Type) e i.
    (IArray a e, Ix i) =>
    a i e -> Int -> e
    unsafeAt Array Int (BitVector m)
    arr Int
    i
        else
          (HasCallStack => BitVector m) -> BitVector m
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack
            (String -> BitVector m
    forall a. (NFDataX a, HasCallStack) => String -> a
    deepErrorX (String
    "romBlob: 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 #-}
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE romBlob# #-}
    {-# ANN romBlob# hasBlackBox #-}