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

    = Efficient bundling of initial RAM content with the compiled code

    Leveraging Template Haskell, the initial content for the block RAM 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.BlockRam.File", "Clash.Explicit.BlockRam.Blob"
    generates practically the same HDL as "Clash.Explicit.BlockRam" and is
    compatible with all tools consuming the generated HDL.
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE TypeApplications #-}

    {-# OPTIONS_HADDOCK show-extensions #-}

    module Clash.Explicit.BlockRam.Blob
      ( -- * Block RAMs initialized with a 'MemBlob'
        blockRamBlob
      , blockRamBlobPow2
        -- * Creating and inspecting 'MemBlob'
      , MemBlob
      , createMemBlob
      , memBlobTH
      , unpackMemBlob
        -- * Internal
      , blockRamBlob#
      ) where

    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.ByteString.Lazy as L
    import Data.Maybe (isJust)
    import GHC.Arr (STArray, unsafeReadSTArray, unsafeWriteSTArray)
    import GHC.Stack (withFrozenCallStack)
    import GHC.TypeLits (KnownNat, type (^))
    import Language.Haskell.TH
      (DecsQ, ExpQ, integerL, litE, litT, mkName, normalB, numTyLit, sigD,
       stringPrimL, valD, varP)

    import Clash.Annotations.Primitive (hasBlackBox)
    import Clash.Class.BitPack.Internal (BitPack, BitSize)
    import Clash.Explicit.BlockRam.Internal
      (MemBlob(..), packBVs, unpackMemBlob, unpackMemBlob0)
    import Clash.Explicit.Signal (KnownDomain, Enable, fromEnable)
    import Clash.Promoted.Nat (natToInteger, natToNum)
    import Clash.Signal.Bundle (unbundle)
    import Clash.Signal.Internal (Clock, Signal(..), (.&&.))
    import Clash.Sized.Internal.BitVector (Bit(..), BitVector(..))
    import Clash.Sized.Internal.Unsigned (Unsigned)
    import Clash.XException
      (maybeIsX, deepErrorX, defaultSeqX, fromJustX, NFDataX, XException (..), seqX)

    -- $setup
    -- >>> :set -XTemplateHaskell
    -- >>> :set -fplugin GHC.TypeLits.Normalise
    -- >>> :set -fplugin GHC.TypeLits.KnownNat.Solver
    -- >>> :m -Prelude
    -- >>> import Clash.Explicit.Prelude

    -- | 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
    -- 'Clash.XException.XException'
    --
    --
    -- === See also:
    --
    -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a
    -- block RAM.
    -- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining
    -- write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew'
    -- clk rst en ('blockRamBlob' clk en content) rd wrM@.
    blockRamBlob
      :: forall dom addr m n
       . ( KnownDomain dom
         , Enum addr
         , NFDataX addr
         )
      => Clock dom
      -- ^ 'Clock' to synchronize to
      -> Enable dom
      -- ^ 'Enable' line
      -> MemBlob n m
      -- ^ 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, BitVector m))
      -- ^ (write address @w@, value to write)
      -> Signal dom (BitVector m)
      -- ^ Value of the BRAM at address @r@ from the previous clock cycle
    blockRamBlob :: forall (dom :: Domain) addr (m :: Nat) (n :: Nat).
    (KnownDomain dom, Enum addr, NFDataX addr) =>
    Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom addr
    -> Signal dom (Maybe (addr, BitVector m))
    -> Signal dom (BitVector m)
    blockRamBlob = \Clock dom
    clk Enable dom
    gen content :: MemBlob n m
    content@MemBlob{} Signal dom addr
    rd Signal dom (Maybe (addr, BitVector m))
    wrM ->
      let en :: Signal dom Bool
    en       = Maybe (addr, BitVector m) -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe (addr, BitVector m) -> Bool)
    -> Signal dom (Maybe (addr, BitVector m)) -> Signal dom Bool
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Signal dom (Maybe (addr, BitVector m))
    wrM
          (Signal dom addr
    wr,Signal dom (BitVector m)
    din) = Signal dom (addr, BitVector m) -> Unbundled dom (addr, BitVector m)
    forall a (dom :: Domain).
    Bundle a =>
    Signal dom a -> Unbundled dom a
    forall (dom :: Domain).
    Signal dom (addr, BitVector m) -> Unbundled dom (addr, BitVector m)
    unbundle (Maybe (addr, BitVector m) -> (addr, BitVector m)
    forall a. (HasCallStack, NFDataX a) => Maybe a -> a
    fromJustX (Maybe (addr, BitVector m) -> (addr, BitVector m))
    -> Signal dom (Maybe (addr, BitVector m))
    -> Signal dom (addr, BitVector m)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Signal dom (Maybe (addr, BitVector m))
    wrM)
      in Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom Int
    -> Signal dom Bool
    -> Signal dom Int
    -> Signal dom (BitVector m)
    -> 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 Bool
    -> Signal dom Int
    -> Signal dom (BitVector m)
    -> Signal dom (BitVector m)
    blockRamBlob# Clock dom
    clk Enable dom
    gen 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) 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 (BitVector m)
    din
    {-# INLINE blockRamBlob #-}

    -- | 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 'Clash.Explicit.BlockRam.readNew' for obtaining
    -- write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew'
    -- clk rst en ('blockRamBlobPow2' clk en content) rd wrM@.
    blockRamBlobPow2
      :: forall dom m n
       . ( KnownDomain dom
         , KnownNat n
         )
      => Clock dom
      -- ^ 'Clock' to synchronize to
      -> Enable dom
      -- ^ 'Enable' line
      -> MemBlob (2^n) m
      -- ^ Initial content of the BRAM, also determines the size, 2^@n@, of the BRAM
      --
      -- __NB__: __MUST__ be a constant
      -> Signal dom (Unsigned n)
      -- ^ Read address @r@
      -> Signal dom (Maybe (Unsigned n, BitVector m))
      -- ^ (write address @w@, value to write)
      -> Signal dom (BitVector m)
      -- ^ Value of the BRAM at address @r@ from the previous clock cycle
    blockRamBlobPow2 :: 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 (Maybe (Unsigned n, BitVector m))
    -> Signal dom (BitVector m)
    blockRamBlobPow2 = Clock dom
    -> Enable dom
    -> MemBlob (2 ^ n) m
    -> Signal dom (Unsigned n)
    -> Signal dom (Maybe (Unsigned n, BitVector m))
    -> Signal dom (BitVector m)
    forall (dom :: Domain) addr (m :: Nat) (n :: Nat).
    (KnownDomain dom, Enum addr, NFDataX addr) =>
    Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom addr
    -> Signal dom (Maybe (addr, BitVector m))
    -> Signal dom (BitVector m)
    blockRamBlob
    {-# INLINE blockRamBlobPow2 #-}

    -- | blockRAMBlob primitive
    blockRamBlob#
      :: forall dom m n
       . KnownDomain dom
      => Clock dom
      -- ^ 'Clock' to synchronize to
      -> Enable dom
      -- ^ 'Enable' line
      -> MemBlob n m
      -- ^ 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 (BitVector m)
      -- ^ Value to write (at address @w@)
      -> Signal dom (BitVector m)
      -- ^ Value of the BRAM at address @r@ from the previous clock cycle
    blockRamBlob# :: forall (dom :: Domain) (m :: Nat) (n :: Nat).
    KnownDomain dom =>
    Clock dom
    -> Enable dom
    -> MemBlob n m
    -> Signal dom Int
    -> Signal dom Bool
    -> Signal dom Int
    -> Signal dom (BitVector m)
    -> Signal dom (BitVector m)
    blockRamBlob# !Clock dom
    _ Enable dom
    gen content :: MemBlob n m
    content@MemBlob{} = \Signal dom Int
    rd Signal dom Bool
    wen Signal dom Int
    waS Signal dom (BitVector m)
    wd -> (forall s. ST s (Signal dom (BitVector m)))
    -> Signal dom (BitVector m)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Signal dom (BitVector m)))
     -> Signal dom (BitVector m))
    -> (forall s. ST s (Signal dom (BitVector m)))
    -> Signal dom (BitVector m)
    forall a b. (a -> b) -> a -> b
    $ do
      bvList <- IO [BitVector m] -> ST s [BitVector m]
    forall a s. IO a -> ST s a
    unsafeIOToST (MemBlob n m -> IO [BitVector m]
    forall (n :: Nat) (m :: Nat). MemBlob n m -> IO [BitVector m]
    unpackMemBlob0 MemBlob n m
    content)
      ramStart <- newListArray (0,szI-1) bvList
      go
        ramStart
        (withFrozenCallStack (deepErrorX "blockRamBlob: intial value undefined"))
        (fromEnable gen)
        rd
        (fromEnable gen .&&. wen)
        waS
        wd
     where
      szI :: Int
    szI = forall (n :: Nat) a. (Num a, KnownNat n) => a
    natToNum @n @Int

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

      upd :: STArray s Int (BitVector m) -> Bool -> Int -> BitVector m -> ST s ()
      upd :: forall s.
    STArray s Int (BitVector m)
    -> Bool -> Int -> BitVector m -> ST s ()
    upd STArray s Int (BitVector m)
    ram Bool
    we Int
    waddr BitVector m
    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 (BitVector m) -> Int -> BitVector m -> ST s ()
    forall s i e. STArray s i e -> Int -> e -> ST s ()
    unsafeWriteSTArray STArray s Int (BitVector m)
    ram Int
    i (Int -> BitVector m -> BitVector m
    forall a b. a -> b -> b
    seq Int
    waddr BitVector m
    d))
          Just Int
    wa -> -- Put the XException from `we` as the value at address
                     -- `waddr`.
                     Int -> BitVector m -> STArray s Int (BitVector m) -> ST s ()
    forall s.
    Int -> BitVector m -> STArray s Int (BitVector m) -> ST s ()
    safeUpdate Int
    wa (Bool -> BitVector m -> BitVector m
    forall a b. a -> b -> b
    seq Bool
    we BitVector m
    d) STArray s Int (BitVector m)
    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 (BitVector m) -> Int -> BitVector m -> ST s ()
    forall s i e. STArray s i e -> Int -> e -> ST s ()
    unsafeWriteSTArray STArray s Int (BitVector m)
    ram Int
    i (Int -> BitVector m -> BitVector m
    forall a b. a -> b -> b
    seq Int
    waddr BitVector m
    d))
          Just Int
    wa -> Int -> BitVector m -> STArray s Int (BitVector m) -> ST s ()
    forall s.
    Int -> BitVector m -> STArray s Int (BitVector m) -> ST s ()
    safeUpdate Int
    wa BitVector m
    d STArray s Int (BitVector m)
    ram
        Maybe Bool
    _ -> () -> ST s ()
    forall a. a -> ST s a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

      safeAt :: STArray s Int (BitVector m) -> Int -> ST s (BitVector m)
      safeAt :: forall s. STArray s Int (BitVector m) -> Int -> ST s (BitVector m)
    safeAt STArray s Int (BitVector m)
    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 (BitVector m) -> Int -> ST s (BitVector m)
    forall s i e. STArray s i e -> Int -> ST s e
    unsafeReadSTArray STArray s Int (BitVector m)
    s Int
    i
        else BitVector m -> ST s (BitVector m)
    forall a. a -> ST s a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (BitVector m -> ST s (BitVector m))
    -> BitVector m -> ST s (BitVector m)
    forall a b. (a -> b) -> a -> b
    $
          (HasCallStack => BitVector m) -> BitVector m
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack
            (String -> BitVector m
    forall a. (NFDataX a, HasCallStack) => String -> a
    deepErrorX (String
    "blockRamBlob: 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 :: Int -> BitVector m -> STArray s Int (BitVector m) -> ST s ()
      safeUpdate :: forall s.
    Int -> BitVector m -> STArray s Int (BitVector m) -> ST s ()
    safeUpdate Int
    i BitVector m
    a STArray s Int (BitVector m)
    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 (BitVector m) -> Int -> BitVector m -> ST s ()
    forall s i e. STArray s i e -> Int -> e -> ST s ()
    unsafeWriteSTArray STArray s Int (BitVector m)
    s Int
    i BitVector m
    a
        else
          let d :: BitVector m
    d = (HasCallStack => BitVector m) -> BitVector m
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack
                    (String -> BitVector m
    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 (BitVector m) -> Int -> BitVector m -> ST s ()
    forall s i e. STArray s i e -> Int -> e -> ST s ()
    unsafeWriteSTArray STArray s Int (BitVector m)
    s Int
    j BitVector m
    d)
      {-# INLINE safeUpdate #-}
    {-# ANN blockRamBlob# hasBlackBox #-}
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE blockRamBlob# #-}

    {- | Create a 'MemBlob' binding from a list of values

    Since this uses Template Haskell, nothing in the arguments given to
    'createMemBlob' can refer to something defined in the same module.

    === __Example__

    @
    'createMemBlob' "content" 'Nothing' [15 :: Unsigned 8 .. 17]

    ram clk en = 'blockRamBlob' clk en content
    @

    The 'Data.Maybe.Maybe' datatype has don't care bits, where the actual value
    does not matter. But the bits need a defined value in the memory. Either 0 or
    1 can be used, and both are valid representations of the data.

    >>> import qualified Prelude as P
    >>> let es = [ Nothing, Just (7 :: Unsigned 8), Just 8 ]
    >>> :{
    createMemBlob "content0" (Just 0) es
    createMemBlob "content1" (Just 1) es
    x = 1
    :}

    >>> let pr = mapM_ (putStrLn . show)
    >>> pr $ P.map pack es
    0b0_...._....
    0b1_0000_0111
    0b1_0000_1000
    >>> pr $ unpackMemBlob content0
    0b0_0000_0000
    0b1_0000_0111
    0b1_0000_1000
    >>> pr $ unpackMemBlob content1
    0b0_1111_1111
    0b1_0000_0111
    0b1_0000_1000

    #if __GLASGOW_HASKELL__ >= 910
    >>> :{
    createMemBlob "contentN" Nothing es
    x = 1
    :}
    <interactive>:...: error:...
        packBVs: cannot convert don't care values. Please specify a mapping to a definite value.
    <BLANKLINE>

    #else
    >>> :{
    createMemBlob "contentN" Nothing es
    x = 1
    :}
    <BLANKLINE>
    <interactive>:...: error:...
        packBVs: cannot convert don't care values. Please specify a mapping to a definite value.

    #endif
    Note how we hinted to @clashi@ that our multi-line command was a list of
    declarations by including a dummy declaration @x = 1@. Without this trick,
    @clashi@ would expect an expression and the Template Haskell would not work.
    -}
    createMemBlob
      :: forall a f
       . ( Foldable f
         , BitPack a
         )
      => String
      -- ^ Name of the binding to generate
      -> Maybe Bit
      -- ^ Value to map don't care bits to. 'Nothing' means throwing an error on
      -- don't care bits.
      -> f a
      -- ^ The content for the 'MemBlob'
      -> DecsQ
    createMemBlob :: forall a (f :: Type -> Type).
    (Foldable f, BitPack a) =>
    String -> Maybe Bit -> f a -> DecsQ
    createMemBlob String
    name Maybe Bit
    care f a
    es =
      case Either String (Int, ByteString, ByteString)
    packed of
        Left String
    err -> String -> DecsQ
    forall a. String -> Q a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    err
        Right (Int, ByteString, ByteString)
    _ -> [Q Dec] -> DecsQ
    forall (t :: Type -> Type) (m :: Type -> Type) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
    sequence
          [ Name -> Q Type -> Q Dec
    forall (m :: Type -> Type). Quote m => Name -> m Type -> m Dec
    sigD Name
    name0 [t| MemBlob $(Q Type
    n) $(Q Type
    m) |]
          , Q Pat -> Q Body -> [Q Dec] -> Q Dec
    forall (m :: Type -> Type).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Dec
    valD (Name -> Q Pat
    forall (m :: Type -> Type). Quote m => Name -> m Pat
    varP Name
    name0) (Q Exp -> Q Body
    forall (m :: Type -> Type). Quote m => m Exp -> m Body
    normalB [| MemBlob { memBlobRunsLen = $(Q Exp
    runsLen)
                                                  , memBlobRuns = $(Q Exp
    runs)
                                                  , memBlobEndsLen = $(Q Exp
    endsLen)
                                                  , memBlobEnds = $(Q Exp
    ends)
                                                  } |]) []
          ]
     where
      name0 :: Name
    name0 = String -> Name
    mkName String
    name
      n :: Q Type
    n = Q TyLit -> Q Type
    forall (m :: Type -> Type). Quote m => m TyLit -> m Type
    litT (Q TyLit -> Q Type) -> (Int -> Q TyLit) -> Int -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Q TyLit
    forall (m :: Type -> Type). Quote m => Integer -> m TyLit
    numTyLit (Integer -> Q TyLit) -> (Int -> Integer) -> Int -> Q TyLit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Q Type) -> Int -> Q Type
    forall a b. (a -> b) -> a -> b
    $ Int
    len
      m :: Q Type
    m = Q TyLit -> Q Type
    forall (m :: Type -> Type). Quote m => m TyLit -> m Type
    litT (Q TyLit -> Q Type) -> (Integer -> Q TyLit) -> Integer -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Q TyLit
    forall (m :: Type -> Type). Quote m => Integer -> m TyLit
    numTyLit (Integer -> Q Type) -> Integer -> Q Type
    forall a b. (a -> b) -> a -> b
    $ forall (n :: Nat). KnownNat n => Integer
    natToInteger @(BitSize a)
      runsLen :: Q Exp
    runsLen = Lit -> Q Exp
    forall (m :: Type -> Type). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> (Int64 -> Lit) -> Int64 -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Lit
    integerL (Integer -> Lit) -> (Int64 -> Integer) -> Int64 -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int64 -> Q Exp) -> Int64 -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    L.length ByteString
    runsB
      runs :: Q Exp
    runs = Lit -> Q Exp
    forall (m :: Type -> Type). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> ([Word8] -> Lit) -> [Word8] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> Lit
    stringPrimL ([Word8] -> Q Exp) -> [Word8] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    L.unpack ByteString
    runsB
      endsLen :: Q Exp
    endsLen = Lit -> Q Exp
    forall (m :: Type -> Type). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> (Int64 -> Lit) -> Int64 -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Lit
    integerL (Integer -> Lit) -> (Int64 -> Integer) -> Int64 -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int64 -> Q Exp) -> Int64 -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    L.length ByteString
    endsB
      ends :: Q Exp
    ends = Lit -> Q Exp
    forall (m :: Type -> Type). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> ([Word8] -> Lit) -> [Word8] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> Lit
    stringPrimL ([Word8] -> Q Exp) -> [Word8] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    L.unpack ByteString
    endsB
      (Int
    len, ByteString
    runsB, ByteString
    endsB) = (String -> (Int, ByteString, ByteString))
    -> ((Int, ByteString, ByteString) -> (Int, ByteString, ByteString))
    -> Either String (Int, ByteString, ByteString)
    -> (Int, ByteString, ByteString)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> (Int, ByteString, ByteString)
    forall a. HasCallStack => String -> a
    error (Int, ByteString, ByteString) -> (Int, ByteString, ByteString)
    forall a. a -> a
    id Either String (Int, ByteString, ByteString)
    packed
      packed :: Either String (Int, ByteString, ByteString)
    packed = Maybe Bit -> f a -> Either String (Int, ByteString, ByteString)
    forall a (f :: Type -> Type).
    (Foldable f, BitPack a) =>
    Maybe Bit -> f a -> Either String (Int, ByteString, ByteString)
    packBVs Maybe Bit
    care f a
    es

    {- | Create a 'MemBlob' from a list of values

    Since this uses Template Haskell, nothing in the arguments given to
    'memBlobTH' can refer to something defined in the same module.

    === __Example__

    @
    ram clk en = 'blockRamBlob' clk en $(memBlobTH Nothing [15 :: Unsigned 8 .. 17])
    @

    The 'Data.Maybe.Maybe' datatype has don't care bits, where the actual value
    does not matter. But the bits need a defined value in the memory. Either 0 or
    1 can be used, and both are valid representations of the data.

    >>> import qualified Prelude as P
    >>> let es = [ Nothing, Just (7 :: Unsigned 8), Just 8 ]
    >>> content0 = $(memBlobTH (Just 0) es)
    >>> content1 = $(memBlobTH (Just 1) es)
    >>> let pr = mapM_ (putStrLn . show)
    >>> pr $ P.map pack es
    0b0_...._....
    0b1_0000_0111
    0b1_0000_1000
    >>> pr $ unpackMemBlob content0
    0b0_0000_0000
    0b1_0000_0111
    0b1_0000_1000
    >>> pr $ unpackMemBlob content1
    0b0_1111_1111
    0b1_0000_0111
    0b1_0000_1000

    #if __GLASGOW_HASKELL__ >= 910
    >>> $(memBlobTH Nothing es)
    <interactive>:...: error:...
        • packBVs: cannot convert don't care values. Please specify a mapping to a definite value.
        • In the untyped splice: $(memBlobTH Nothing es)
    <BLANKLINE>

    #else
    >>> $(memBlobTH Nothing es)
    <BLANKLINE>
    <interactive>:...: error:...
        • packBVs: cannot convert don't care values. Please specify a mapping to a definite value.
        • In the untyped splice: $(memBlobTH Nothing es)

    #endif
    -}
    memBlobTH
      :: forall a f
       . ( Foldable f
         , BitPack a
         )
      => Maybe Bit
      -- ^ Value to map don't care bits to. 'Nothing' means throwing an error on
      -- don't care bits.
      -> f a
      -- ^ The content for the 'MemBlob'
      -> ExpQ
    memBlobTH :: forall a (f :: Type -> Type).
    (Foldable f, BitPack a) =>
    Maybe Bit -> f a -> Q Exp
    memBlobTH Maybe Bit
    care f a
    es =
      case Either String (Int, ByteString, ByteString)
    packed of
        Left String
    err -> String -> Q Exp
    forall a. String -> Q a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    err
        Right (Int, ByteString, ByteString)
    _ -> [| MemBlob { memBlobRunsLen = $(Q Exp
    runsLen)
                              , memBlobRuns = $(Q Exp
    runs)
                              , memBlobEndsLen = $(Q Exp
    endsLen)
                              , memBlobEnds = $(Q Exp
    ends)
                              }
                        :: MemBlob $(Q Type
    n) $(Q Type
    m) |]
     where
      n :: Q Type
    n = Q TyLit -> Q Type
    forall (m :: Type -> Type). Quote m => m TyLit -> m Type
    litT (Q TyLit -> Q Type) -> (Int -> Q TyLit) -> Int -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Q TyLit
    forall (m :: Type -> Type). Quote m => Integer -> m TyLit
    numTyLit (Integer -> Q TyLit) -> (Int -> Integer) -> Int -> Q TyLit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Q Type) -> Int -> Q Type
    forall a b. (a -> b) -> a -> b
    $ Int
    len
      m :: Q Type
    m = Q TyLit -> Q Type
    forall (m :: Type -> Type). Quote m => m TyLit -> m Type
    litT (Q TyLit -> Q Type) -> (Integer -> Q TyLit) -> Integer -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Q TyLit
    forall (m :: Type -> Type). Quote m => Integer -> m TyLit
    numTyLit (Integer -> Q Type) -> Integer -> Q Type
    forall a b. (a -> b) -> a -> b
    $ forall (n :: Nat). KnownNat n => Integer
    natToInteger @(BitSize a)
      runsLen :: Q Exp
    runsLen = Lit -> Q Exp
    forall (m :: Type -> Type). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> (Int64 -> Lit) -> Int64 -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Lit
    integerL (Integer -> Lit) -> (Int64 -> Integer) -> Int64 -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int64 -> Q Exp) -> Int64 -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    L.length ByteString
    runsB
      runs :: Q Exp
    runs = Lit -> Q Exp
    forall (m :: Type -> Type). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> ([Word8] -> Lit) -> [Word8] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> Lit
    stringPrimL ([Word8] -> Q Exp) -> [Word8] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    L.unpack ByteString
    runsB
      endsLen :: Q Exp
    endsLen = Lit -> Q Exp
    forall (m :: Type -> Type). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> (Int64 -> Lit) -> Int64 -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Lit
    integerL (Integer -> Lit) -> (Int64 -> Integer) -> Int64 -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int64 -> Q Exp) -> Int64 -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    L.length ByteString
    endsB
      ends :: Q Exp
    ends = Lit -> Q Exp
    forall (m :: Type -> Type). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> ([Word8] -> Lit) -> [Word8] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> Lit
    stringPrimL ([Word8] -> Q Exp) -> [Word8] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    L.unpack ByteString
    endsB
      (Int
    len, ByteString
    runsB, ByteString
    endsB) = (String -> (Int, ByteString, ByteString))
    -> ((Int, ByteString, ByteString) -> (Int, ByteString, ByteString))
    -> Either String (Int, ByteString, ByteString)
    -> (Int, ByteString, ByteString)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> (Int, ByteString, ByteString)
    forall a. HasCallStack => String -> a
    error (Int, ByteString, ByteString) -> (Int, ByteString, ByteString)
    forall a. a -> a
    id Either String (Int, ByteString, ByteString)
    packed
      packed :: Either String (Int, ByteString, ByteString)
    packed = Maybe Bit -> f a -> Either String (Int, ByteString, ByteString)
    forall a (f :: Type -> Type).
    (Foldable f, BitPack a) =>
    Maybe Bit -> f a -> Either String (Int, ByteString, ByteString)
    packBVs Maybe Bit
    care f a
    es