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

      Blackbox implementations for functions in "Clash.Sized.Vector".
    -}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE TemplateHaskell #-}

    module Clash.Primitives.Sized.Vector where

    import           Control.Monad                      (replicateM, zipWithM)
    import           Control.Monad.State                (State)
    import qualified Control.Lens                       as Lens
    import           Data.Either                        (rights)
    import           Data.List.Extra                    (iterateNM)
    import           Data.Maybe                         (fromMaybe, listToMaybe)
    import           Data.Monoid                        (Ap(getAp))
    import           Data.Text.Extra                    (showt)
    import           Data.Text.Prettyprint.Doc.Extra
      (Doc, string, renderLazy, layoutPretty, LayoutOptions(..),
       PageWidth(AvailablePerLine))
    import           Text.Trifecta.Result               (Result(Success))
    import qualified Data.String.Interpolate            as I
    import           GHC.Stack                          (HasCallStack)

    import           Clash.Backend
      (Backend, hdlTypeErrValue, expr, blockDecl)
    import           Clash.Core.TermInfo                (isVar)
    import           Clash.Core.Type
      (Type(LitTy), LitTy(NumTy), coreView)
    import           Clash.Netlist.BlackBox             (isLiteral)
    import           Clash.Netlist.BlackBox.Util        (renderElem)
    import           Clash.Netlist.BlackBox.Parser      (runParse)
    import           Clash.Netlist.BlackBox.Types
      (BlackBoxFunction, BlackBoxMeta(..), TemplateKind(TExpr, TDecl),
       Element(Component, Typ, TypElem, Text), Decl(Decl), emptyBlackBoxMeta)
    import           Clash.Netlist.Types
      (Identifier, TemplateFunction, BlackBoxContext, HWType(Vector), Usage(Cont),
       Declaration(..), Expr(Literal,Identifier,DataCon,BlackBoxE), Literal(NumLit),
       BlackBox(BBTemplate, BBFunction), TemplateFunction(..),
       Modifier(Indexed, Nested, DC), HWType(..), BlackBoxContext(..),
       emptyBBContext, tcCache)
    import qualified Clash.Netlist.Id                   as Id
    import           Clash.Netlist.Util                 (typeSize)
    import qualified Clash.Primitives.DSL               as Prim
    import           Clash.Primitives.DSL
      (declarationReturn, instHO, tInputs, tExprToInteger)

    import           Clash.Util                         (curLoc)

    -- | Blackbox function for 'Clash.Sized.Vector.iterateI'
    iterateBBF :: HasCallStack => BlackBoxFunction
    iterateBBF :: HasCallStack => BlackBoxFunction
    iterateBBF Bool
    _isD Text
    _primName [Either Term Type]
    args [Type]
    _resTy = do
      TyConMap
    tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
      Either String (BlackBoxMeta, BlackBox)
    -> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((BlackBoxMeta, BlackBox) -> Either String (BlackBoxMeta, BlackBox)
    forall a b. b -> Either a b
    Right (TyConMap -> BlackBoxMeta
    meta TyConMap
    tcm, BlackBox
    bb))
     where
      bb :: BlackBox
    bb = String -> BBHash -> TemplateFunction -> BlackBox
    BBFunction String
    "Clash.Primitives.Sized.Vector.iterateBBF" BBHash
    0 TemplateFunction
    iterateTF
      vecLength :: TyConMap -> a
    vecLength TyConMap
    tcm =
        case TyConMap -> Type -> Type
    coreView TyConMap
    tcm (Type -> Type) -> [Type] -> [Type]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Either Term Type] -> [Type]
    forall a b. [Either a b] -> [b]
    rights [Either Term Type]
    args of
          (LitTy (NumTy Integer
    0)):[Type]
    _ -> String -> a
    forall a. HasCallStack => String -> a
    error String
    "Unexpected empty vector in 'iterateBBF'"
          (LitTy (NumTy Integer
    n)):[Type]
    _ -> Integer -> a
    forall a. Num a => Integer -> a
    fromInteger (Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1)
          [Type]
    vl -> String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected vector length: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Maybe Type -> String
    forall a. Show a => a -> String
    show ([Type] -> Maybe Type
    forall a. [a] -> Maybe a
    listToMaybe [Type]
    vl)
      meta :: TyConMap -> BlackBoxMeta
    meta TyConMap
    tcm = BlackBoxMeta
    emptyBlackBoxMeta {
          bbKind=TDecl
        , bbFunctionPlurality=[(1, vecLength tcm)]
        }

    -- | Type signature of function we're generating netlist for:
    --
    --   iterateI :: KnownNat n => (a -> a) -> a -> Vec n a
    --
    iterateTF :: TemplateFunction
    iterateTF :: TemplateFunction
    iterateTF = [BBHash]
    -> (BlackBoxContext -> Bool)
    -> (forall s. Backend s => BlackBoxContext -> State s Doc)
    -> TemplateFunction
    TemplateFunction [] (Bool -> BlackBoxContext -> Bool
    forall a b. a -> b -> a
    const Bool
    True) BlackBoxContext -> State s Doc
    forall s.
    (HasCallStack, Backend s) =>
    BlackBoxContext -> State s Doc
    forall s. Backend s => BlackBoxContext -> State s Doc
    iterateTF'

    iterateTF'
      :: forall s
       . (HasCallStack, Backend s)
      => BlackBoxContext
      -> State s Doc
    iterateTF' :: forall s.
    (HasCallStack, Backend s) =>
    BlackBoxContext -> State s Doc
    iterateTF' BlackBoxContext
    bbCtx
      | [ (Integer -> Maybe Integer -> Integer
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Integer
    forall a. HasCallStack => String -> a
    error String
    "n") (Maybe Integer -> Integer)
    -> (TExpr -> Maybe Integer) -> TExpr -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TExpr -> Maybe Integer
    tExprToInteger -> Integer
    n, HWType
    _)
        , (TExpr, HWType)
    _hoFunction
        , (TExpr
    a, HWType
    aType)
        ] <- BlackBoxContext -> [(TExpr, HWType)]
    tInputs BlackBoxContext
    bbCtx
      , let aTemplateType :: [Element]
    aTemplateType = [Element -> Element
    TypElem (Maybe BBHash -> Element
    Typ (BBHash -> Maybe BBHash
    forall a. a -> Maybe a
    Just BBHash
    2))]
      , let inst :: TExpr -> State (BlockState backend) TExpr
    inst TExpr
    arg = BlackBoxContext
    -> BBHash
    -> (HWType, [Element])
    -> [(TExpr, [Element])]
    -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    BlackBoxContext
    -> BBHash
    -> (HWType, [Element])
    -> [(TExpr, [Element])]
    -> State (BlockState backend) TExpr
    instHO BlackBoxContext
    bbCtx BBHash
    1 (HWType
    aType, [Element]
    aTemplateType) [(TExpr
    arg, [Element]
    aTemplateType)]
      = BlackBoxContext
    -> Text -> State (BlockState s) [TExpr] -> State s Doc
    forall backend.
    Backend backend =>
    BlackBoxContext
    -> Text -> State (BlockState backend) [TExpr] -> State backend Doc
    declarationReturn BlackBoxContext
    bbCtx Text
    "iterateI" ((TExpr -> [TExpr])
    -> StateT (BlockState s) Identity TExpr
    -> State (BlockState s) [TExpr]
    forall a b.
    (a -> b)
    -> StateT (BlockState s) Identity a
    -> StateT (BlockState s) Identity b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap TExpr -> [TExpr]
    forall a. a -> [a]
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (StateT (BlockState s) Identity TExpr
     -> State (BlockState s) [TExpr])
    -> ([TExpr] -> StateT (BlockState s) Identity TExpr)
    -> [TExpr]
    -> State (BlockState s) [TExpr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TExpr] -> StateT (BlockState s) Identity TExpr
    forall backend.
    (HasCallStack, Backend backend) =>
    [TExpr] -> State (BlockState backend) TExpr
    Prim.vec ([TExpr] -> State (BlockState s) [TExpr])
    -> State (BlockState s) [TExpr] -> State (BlockState s) [TExpr]
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Word
    -> (TExpr -> StateT (BlockState s) Identity TExpr)
    -> TExpr
    -> State (BlockState s) [TExpr]
    forall (m :: Type -> Type) a.
    Monad m =>
    Word -> (a -> m a) -> a -> m [a]
    iterateNM (Integer -> Word
    forall a. Num a => Integer -> a
    fromInteger Integer
    n) TExpr -> StateT (BlockState s) Identity TExpr
    forall {backend}.
    Backend backend =>
    TExpr -> State (BlockState backend) TExpr
    inst TExpr
    a)
      | Bool
    otherwise
      =  String -> State s Doc
    forall a. HasCallStack => String -> a
    error (String -> State s Doc) -> String -> State s Doc
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected number of arguments: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ BBHash -> String
    forall a. Show a => a -> String
    show ([(Expr, HWType, Bool)] -> BBHash
    forall a. [a] -> BBHash
    forall (t :: Type -> Type) a. Foldable t => t a -> BBHash
    length (BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs BlackBoxContext
    bbCtx))

    data FCall =
      FCall
        Identifier -- left
        Identifier -- right
        Identifier -- result

    -- | Calculates the number of function calls needed for an evaluation of
    -- 'Clash.Sized.Vector.fold', given the length of the vector given to fold.
    foldFunctionPlurality :: HasCallStack => Int -> Int
    foldFunctionPlurality :: HasCallStack => BBHash -> BBHash
    foldFunctionPlurality BBHash
    1 = BBHash
    0
    foldFunctionPlurality BBHash
    2 = BBHash
    1
    foldFunctionPlurality BBHash
    n
      | BBHash
    n BBHash -> BBHash -> Bool
    forall a. Ord a => a -> a -> Bool
    <= BBHash
    0 = String -> BBHash
    forall a. HasCallStack => String -> a
    error (String -> BBHash) -> String -> BBHash
    forall a b. (a -> b) -> a -> b
    $ String
    "functionPlurality: unexpected n: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ BBHash -> String
    forall a. Show a => a -> String
    show BBHash
    n
      | Bool
    otherwise =
          let (BBHash
    d, BBHash
    r) = BBHash
    n BBHash -> BBHash -> (BBHash, BBHash)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` BBHash
    2 in
          BBHash
    1 BBHash -> BBHash -> BBHash
    forall a. Num a => a -> a -> a
    + HasCallStack => BBHash -> BBHash
    BBHash -> BBHash
    foldFunctionPlurality BBHash
    d BBHash -> BBHash -> BBHash
    forall a. Num a => a -> a -> a
    + HasCallStack => BBHash -> BBHash
    BBHash -> BBHash
    foldFunctionPlurality (BBHash
    dBBHash -> BBHash -> BBHash
    forall a. Num a => a -> a -> a
    +BBHash
    r)

    -- | Blackbox function for 'Clash.Sized.Vector.fold'
    foldBBF :: HasCallStack => BlackBoxFunction
    foldBBF :: HasCallStack => BlackBoxFunction
    foldBBF Bool
    _isD Text
    _primName [Either Term Type]
    args [Type]
    _resTy = do
      TyConMap
    tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
      let
        bb :: BlackBox
    bb = String -> BBHash -> TemplateFunction -> BlackBox
    BBFunction String
    "Clash.Primitives.Sized.Vector.foldTF" BBHash
    0 TemplateFunction
    foldTF
        vecLengthMinusOne :: Type
    vecLengthMinusOne = case [Either Term Type] -> [Type]
    forall a b. [Either a b] -> [b]
    rights [Either Term Type]
    args of
          (Type
    l:[Type]
    _) -> Type
    l
          [Type]
    _ -> String -> Type
    forall a. HasCallStack => String -> a
    error (String
    "foldBBF: bad Vec: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> [Either Term Type] -> String
    forall a. Show a => a -> String
    show [Either Term Type]
    args)
        vecLength :: Integer
    vecLength =
          case TyConMap -> Type -> Type
    coreView TyConMap
    tcm Type
    vecLengthMinusOne of
            (LitTy (NumTy Integer
    n)) -> Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    1
            Type
    vl -> String -> Integer
    forall a. HasCallStack => String -> a
    error (String -> Integer) -> String -> Integer
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected vector length: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    vl
        funcPlural :: BBHash
    funcPlural = HasCallStack => BBHash -> BBHash
    BBHash -> BBHash
    foldFunctionPlurality (Integer -> BBHash
    forall a. Num a => Integer -> a
    fromInteger Integer
    vecLength)
        meta :: BlackBoxMeta
    meta = BlackBoxMeta
    emptyBlackBoxMeta {bbKind=TDecl, bbFunctionPlurality=[(0, funcPlural)]}
      Either String (BlackBoxMeta, BlackBox)
    -> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((BlackBoxMeta, BlackBox) -> Either String (BlackBoxMeta, BlackBox)
    forall a b. b -> Either a b
    Right (BlackBoxMeta
    meta, BlackBox
    bb))

    -- | Type signature of function we're generating netlist for:
    --
    --   fold :: (a -> a -> a) -> Vec (n + 1) a -> a
    --
    -- The implementation promises to create a (balanced) tree structure.
    foldTF :: TemplateFunction
    foldTF :: TemplateFunction
    foldTF = [BBHash]
    -> (BlackBoxContext -> Bool)
    -> (forall s. Backend s => BlackBoxContext -> State s Doc)
    -> TemplateFunction
    TemplateFunction [] (Bool -> BlackBoxContext -> Bool
    forall a b. a -> b -> a
    const Bool
    True) BlackBoxContext -> State s Doc
    forall s.
    (HasCallStack, Backend s) =>
    BlackBoxContext -> State s Doc
    forall s. Backend s => BlackBoxContext -> State s Doc
    foldTF'

    foldTF' :: forall s . (HasCallStack, Backend s) => BlackBoxContext -> State s Doc
    foldTF' :: forall s.
    (HasCallStack, Backend s) =>
    BlackBoxContext -> State s Doc
    foldTF' bbCtx :: BlackBoxContext
    bbCtx@(BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs -> [(Expr, HWType, Bool)
    _f, (Expr
    vec, vecType :: HWType
    vecType@(Vector BBHash
    n HWType
    aTy), Bool
    _isLiteral)]) = do
      -- Create an id for every element in the vector
      Identifier
    baseId <- Text -> StateT s Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.make Text
    "acc_0"
      [Identifier]
    vecIds <- BBHash
    -> StateT s Identity Identifier -> StateT s Identity [Identifier]
    forall (m :: Type -> Type) a.
    Applicative m =>
    BBHash -> m a -> m [a]
    replicateM BBHash
    n (Identifier -> StateT s Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> m Identifier
    Id.next Identifier
    baseId)

      Identifier
    vecId <- Text -> StateT s Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.make Text
    "vec"
      let vecDecl :: Declaration
    vecDecl = HWType -> Identifier -> Declaration
    sigDecl HWType
    vecType Identifier
    vecId
          vecAssign :: Declaration
    vecAssign = Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    vecId Usage
    Cont Expr
    vec
          elemAssigns :: [Declaration]
    elemAssigns = (Identifier -> Usage -> Expr -> Declaration)
    -> [Identifier] -> [Usage] -> [Expr] -> [Declaration]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 Identifier -> Usage -> Expr -> Declaration
    Assignment [Identifier]
    vecIds (Usage -> [Usage]
    forall a. a -> [a]
    repeat Usage
    Cont) ((BBHash -> Expr) -> [BBHash] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Identifier -> BBHash -> Expr
    iIndex Identifier
    vecId) [BBHash
    0..])
          resultId :: Identifier
    resultId =
            case BlackBoxContext -> [(Expr, HWType)]
    bbResults BlackBoxContext
    bbCtx of
              [(Identifier Identifier
    t Maybe Modifier
    _, HWType
    _)] -> Identifier
    t
              [(Expr, HWType)]
    _ -> String -> Identifier
    forall a. HasCallStack => String -> a
    error String
    "Unexpected result identifier"

      -- Create a list of function calls to be made (creates identifiers for
      -- intermediate result signals)
      ([[FCall]] -> [FCall]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat -> [FCall]
    fCalls, Identifier
    result) <- BBHash -> [Identifier] -> State s ([[FCall]], Identifier)
    mkTree BBHash
    1 [Identifier]
    vecIds

      let intermediateResultIds :: [Identifier]
    intermediateResultIds = (FCall -> [Identifier]) -> [FCall] -> [Identifier]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap (\(FCall Identifier
    l Identifier
    r Identifier
    _) -> [Identifier
    l, Identifier
    r]) [FCall]
    fCalls
          sigDecls :: [Declaration]
    sigDecls = (Identifier -> Declaration) -> [Identifier] -> [Declaration]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (HWType -> Identifier -> Declaration
    sigDecl HWType
    aTy) (Identifier
    result Identifier -> [Identifier] -> [Identifier]
    forall a. a -> [a] -> [a]
    : [Identifier]
    intermediateResultIds)
          resultAssign :: Declaration
    resultAssign = Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    resultId Usage
    Cont (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    result Maybe Modifier
    forall a. Maybe a
    Nothing)

      [Declaration]
    callDecls <- (BBHash -> FCall -> StateT s Identity Declaration)
    -> [BBHash] -> [FCall] -> StateT s Identity [Declaration]
    forall (m :: Type -> Type) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM BBHash -> FCall -> StateT s Identity Declaration
    callDecl [BBHash
    0..] [FCall]
    fCalls
      Identifier
    foldNm <- Text -> StateT s Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.make Text
    "fold"

      Ap (StateT s Identity) Doc -> State s Doc
    forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
    getAp (Ap (StateT s Identity) Doc -> State s Doc)
    -> Ap (StateT s Identity) Doc -> State s Doc
    forall a b. (a -> b) -> a -> b
    $ Identifier -> [Declaration] -> Ap (StateT s Identity) Doc
    forall state.
    Backend state =>
    Identifier -> [Declaration] -> Ap (State state) Doc
    blockDecl Identifier
    foldNm ([Declaration] -> Ap (StateT s Identity) Doc)
    -> [Declaration] -> Ap (StateT s Identity) Doc
    forall a b. (a -> b) -> a -> b
    $
        Declaration
    resultAssign Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    :
        Declaration
    vecAssign Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    :
        Declaration
    vecDecl Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    :
        [Declaration]
    elemAssigns [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++
        [Declaration]
    sigDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++
        [Declaration]
    callDecls

     where
      callDecl :: Int -> FCall -> State s Declaration
      callDecl :: BBHash -> FCall -> StateT s Identity Declaration
    callDecl BBHash
    fSubPos (FCall Identifier
    a Identifier
    b Identifier
    r) = do
        Doc
    rendered0 <- Text -> State s Doc
    forall (f :: Type -> Type). Applicative f => Text -> f Doc
    string (Text -> State s Doc) -> StateT s Identity Text -> State s Doc
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (BlackBoxContext -> Element -> State s (BBHash -> Text)
    forall backend.
    (HasCallStack, Backend backend) =>
    BlackBoxContext -> Element -> State backend (BBHash -> Text)
    renderElem BlackBoxContext
    bbCtx Element
    call State s (BBHash -> Text)
    -> StateT s Identity BBHash -> StateT s Identity Text
    forall a b.
    StateT s Identity (a -> b)
    -> StateT s Identity a -> StateT s Identity b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> BBHash -> StateT s Identity BBHash
    forall a. a -> StateT s Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure BBHash
    0)
        let layout :: LayoutOptions
    layout = PageWidth -> LayoutOptions
    LayoutOptions (BBHash -> Double -> PageWidth
    AvailablePerLine BBHash
    120 Double
    0.4)
            rendered1 :: Text
    rendered1 = SimpleDocStream () -> Text
    forall ann. SimpleDocStream ann -> Text
    renderLazy (LayoutOptions -> Doc -> SimpleDocStream ()
    forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
    layoutPretty LayoutOptions
    layout Doc
    rendered0)
        Declaration -> StateT s Identity Declaration
    forall a. a -> StateT s Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (
          Text
    -> [[Element]]
    -> [[Element]]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Declaration
    BlackBoxD
            Text
    "__FOLD_BB_INTERNAL__"
            [] [] []
            ([Element] -> BlackBox
    BBTemplate [Text -> Element
    Text Text
    rendered1])
            (Text -> BlackBoxContext
    emptyBBContext Text
    "__FOLD_BB_INTERNAL__")
            )
       where
        call :: Element
    call  = Decl -> Element
    Component (BBHash -> BBHash -> [([Element], [Element])] -> Decl
    Decl BBHash
    fPos BBHash
    fSubPos (([Element], [Element])
    resEl([Element], [Element])
    -> [([Element], [Element])] -> [([Element], [Element])]
    forall a. a -> [a] -> [a]
    :([Element], [Element])
    aEl([Element], [Element])
    -> [([Element], [Element])] -> [([Element], [Element])]
    forall a. a -> [a] -> [a]
    :[([Element], [Element])
    bEl]))
        elTyp :: [Element]
    elTyp = [Element -> Element
    TypElem (Maybe BBHash -> Element
    Typ (BBHash -> Maybe BBHash
    forall a. a -> Maybe a
    Just BBHash
    vecPos))]
        resEl :: ([Element], [Element])
    resEl = ([Text -> Element
    Text (Identifier -> Text
    Id.toLazyText Identifier
    r)], [Element]
    elTyp)
        aEl :: ([Element], [Element])
    aEl   = ([Text -> Element
    Text (Identifier -> Text
    Id.toLazyText Identifier
    a)], [Element]
    elTyp)
        bEl :: ([Element], [Element])
    bEl   = ([Text -> Element
    Text (Identifier -> Text
    Id.toLazyText Identifier
    b)], [Element]
    elTyp)

      -- Argument no. of function
      fPos :: BBHash
    fPos = BBHash
    0

      -- Argument no. of vector
      vecPos :: BBHash
    vecPos = BBHash
    1

      -- Create the whole tree
      mkTree
        :: Int
        -- ^ Current level
        -> [Identifier]
        -- ^ Elements left to process
        -> State s ( [[FCall]]    -- function calls to be rendered
                   , Identifier -- result signal
                   )
      mkTree :: BBHash -> [Identifier] -> State s ([[FCall]], Identifier)
    mkTree BBHash
    _lvl []  = String -> State s ([[FCall]], Identifier)
    forall a. HasCallStack => String -> a
    error String
    "Unreachable?"
      mkTree BBHash
    _lvl [Identifier
    res] = ([[FCall]], Identifier) -> State s ([[FCall]], Identifier)
    forall a. a -> StateT s Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([], Identifier
    res)
      mkTree BBHash
    lvl [Identifier]
    results0  = do
        ([FCall]
    calls0, [Identifier]
    results1) <- (BBHash, BBHash) -> [Identifier] -> State s ([FCall], [Identifier])
    mkLevel (BBHash
    lvl, BBHash
    0) [Identifier]
    results0
        ([[FCall]]
    calls1, Identifier
    result) <- BBHash -> [Identifier] -> State s ([[FCall]], Identifier)
    mkTree (BBHash
    lvlBBHash -> BBHash -> BBHash
    forall a. Num a => a -> a -> a
    +BBHash
    1) [Identifier]
    results1
        ([[FCall]], Identifier) -> State s ([[FCall]], Identifier)
    forall a. a -> StateT s Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([FCall]
    calls0 [FCall] -> [[FCall]] -> [[FCall]]
    forall a. a -> [a] -> [a]
    : [[FCall]]
    calls1, Identifier
    result)

      -- Create a single layer of a tree
      mkLevel
        :: (Int, Int)
        -- ^ (level, offset)
        -> [Identifier]
        -> State s ([FCall], [Identifier])
      mkLevel :: (BBHash, BBHash) -> [Identifier] -> State s ([FCall], [Identifier])
    mkLevel (!BBHash
    lvl, !BBHash
    offset) (Identifier
    a:Identifier
    b:[Identifier]
    rest) = do
        Identifier
    c <- Text -> StateT s Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic (Text
    "acc_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> BBHash -> Text
    forall a. Show a => a -> Text
    showt BBHash
    lvl Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> BBHash -> Text
    forall a. Show a => a -> Text
    showt BBHash
    offset)
        ([FCall]
    calls, [Identifier]
    results) <- (BBHash, BBHash) -> [Identifier] -> State s ([FCall], [Identifier])
    mkLevel (BBHash
    lvl, BBHash
    offsetBBHash -> BBHash -> BBHash
    forall a. Num a => a -> a -> a
    +BBHash
    1) [Identifier]
    rest
        ([FCall], [Identifier]) -> State s ([FCall], [Identifier])
    forall a. a -> StateT s Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Identifier -> Identifier -> Identifier -> FCall
    FCall Identifier
    a Identifier
    b Identifier
    cFCall -> [FCall] -> [FCall]
    forall a. a -> [a] -> [a]
    :[FCall]
    calls, Identifier
    cIdentifier -> [Identifier] -> [Identifier]
    forall a. a -> [a] -> [a]
    :[Identifier]
    results)
      mkLevel (BBHash, BBHash)
    _lvl [Identifier]
    rest =
        ([FCall], [Identifier]) -> State s ([FCall], [Identifier])
    forall a. a -> StateT s Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([], [Identifier]
    rest)

      -- Simple wire without comment
      sigDecl :: HWType -> Identifier -> Declaration
      sigDecl :: HWType -> Identifier -> Declaration
    sigDecl HWType
    typ Identifier
    nm = Maybe Text -> Identifier -> HWType -> Declaration
    NetDecl Maybe Text
    forall a. Maybe a
    Nothing Identifier
    nm HWType
    typ

      -- Index the intermediate vector. This uses a hack in Clash: the 10th
      -- constructor of Vec doesn't exist; using it will be interpreted by the
      -- HDL backends as vector indexing.
      iIndex :: Identifier -> Int -> Expr
      iIndex :: Identifier -> BBHash -> Expr
    iIndex Identifier
    vecId BBHash
    i = Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    vecId (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, BBHash, BBHash) -> Modifier
    Indexed (HWType
    vecType, BBHash
    10, BBHash
    i)))

    foldTF' BlackBoxContext
    args =
      String -> State s Doc
    forall a. HasCallStack => String -> a
    error (String -> State s Doc) -> String -> State s Doc
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected number of arguments: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ BBHash -> String
    forall a. Show a => a -> String
    show ([(Expr, HWType, Bool)] -> BBHash
    forall a. [a] -> BBHash
    forall (t :: Type -> Type) a. Foldable t => t a -> BBHash
    length (BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs BlackBoxContext
    args))

    indexIntVerilog ::  BlackBoxFunction
    indexIntVerilog :: BlackBoxFunction
    indexIntVerilog Bool
    _isD Text
    _primName [Either Term Type]
    args [Type]
    _ty = Either String (BlackBoxMeta, BlackBox)
    -> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Either String (BlackBoxMeta, BlackBox)
    bb
     where
      meta :: TemplateKind -> BlackBoxMeta
    meta TemplateKind
    bbKi = BlackBoxMeta
    emptyBlackBoxMeta{bbKind=bbKi}

      bb :: Either String (BlackBoxMeta, BlackBox)
    bb = case [Either Term Type]
    args of
        [Either Term Type
    _nTy,Either Term Type
    _aTy,Either Term Type
    _kn,Left Term
    v,Left Term
    ix] | Term -> Bool
    isLiteral Term
    ix Bool -> Bool -> Bool
    && Term -> Bool
    isVar Term
    v ->
          (BlackBoxMeta, BlackBox) -> Either String (BlackBoxMeta, BlackBox)
    forall a b. b -> Either a b
    Right (TemplateKind -> BlackBoxMeta
    meta TemplateKind
    TExpr, String -> BBHash -> TemplateFunction -> BlackBox
    BBFunction String
    "Clash.Primitives.Sized.Vector.indexIntVerilogTF" BBHash
    0 TemplateFunction
    indexIntVerilogTF)
        [Either Term Type
    _nTy,Either Term Type
    _aTy,Either Term Type
    _kn,Either Term Type
    _v,Left Term
    ix] | Term -> Bool
    isLiteral Term
    ix ->
          case Text -> Result [Element]
    runParse Text
    bbTextLitIx of
            Success [Element]
    t -> (BlackBoxMeta, BlackBox) -> Either String (BlackBoxMeta, BlackBox)
    forall a b. b -> Either a b
    Right (TemplateKind -> BlackBoxMeta
    meta TemplateKind
    TDecl, [Element] -> BlackBox
    BBTemplate [Element]
    t)
            Result [Element]
    _         -> String -> Either String (BlackBoxMeta, BlackBox)
    forall a b. a -> Either a b
    Left String
    "internal error: parse fail"

        [Either Term Type]
    _ ->
          case Text -> Result [Element]
    runParse Text
    bbText of
            Success [Element]
    t -> (BlackBoxMeta, BlackBox) -> Either String (BlackBoxMeta, BlackBox)
    forall a b. b -> Either a b
    Right (TemplateKind -> BlackBoxMeta
    meta TemplateKind
    TDecl, [Element] -> BlackBox
    BBTemplate [Element]
    t)
            Result [Element]
    _         -> String -> Either String (BlackBoxMeta, BlackBox)
    forall a b. a -> Either a b
    Left String
    "internal error: parse fail"

      bbText :: Text
    bbText = [I.__i|
        // index begin
        ~IF~SIZE[~TYP[1]]~THENwire ~TYPO ~GENSYM[vecArray][0] [0:~LIT[0]-1];
        genvar ~GENSYM[i][2];
        ~GENERATE
        for (~SYM[2]=0; ~SYM[2] < ~LIT[0]; ~SYM[2]=~SYM[2]+1) begin : ~GENSYM[mk_array][3]
          assign ~SYM[0][(~LIT[0]-1)-~SYM[2]] = ~VAR[vecFlat][1][~SYM[2]*~SIZE[~TYPO]+:~SIZE[~TYPO]];
        end
        ~ENDGENERATE
        assign ~RESULT = ~SYM[0][~ARG[2]];~ELSEassign ~RESULT = ~ERRORO;~FI
        // index end
        |]

      bbTextLitIx :: Text
    bbTextLitIx = [I.__i|
        // index lit begin
        ~IF~SIZE[~TYP[1]]~THENassign ~RESULT = ~VAR[vec][1][~SIZE[~TYP[1]]-1-~LIT[2]*~SIZE[~TYPO] -: ~SIZE[~TYPO]];~ELSEassign ~RESULT = ~ERRORO;~FI
        // index lit end
        |]

    indexIntVerilogTF :: TemplateFunction
    indexIntVerilogTF :: TemplateFunction
    indexIntVerilogTF = [BBHash]
    -> (BlackBoxContext -> Bool)
    -> (forall s. Backend s => BlackBoxContext -> State s Doc)
    -> TemplateFunction
    TemplateFunction [BBHash]
    used BlackBoxContext -> Bool
    forall {b}. b -> Bool
    valid BlackBoxContext -> State s Doc
    forall s. Backend s => BlackBoxContext -> State s Doc
    indexIntVerilogTemplate
     where
      used :: [BBHash]
    used  = [BBHash
    1,BBHash
    2]
      valid :: b -> Bool
    valid = Bool -> b -> Bool
    forall a b. a -> b -> a
    const Bool
    True

    indexIntVerilogTemplate
      :: Backend s
      => BlackBoxContext
      -> State s Doc
    indexIntVerilogTemplate :: forall s. Backend s => BlackBoxContext -> State s Doc
    indexIntVerilogTemplate BlackBoxContext
    bbCtx
      | [  (Expr, HWType, Bool)
    _kn, (Expr
    vec, HWType
    vTy, Bool
    _), (Expr
    ix, HWType
    _, Bool
    _)] <- BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs BlackBoxContext
    bbCtx
      , [(Expr
    _,HWType
    rTy)] <- BlackBoxContext -> [(Expr, HWType)]
    bbResults BlackBoxContext
    bbCtx
      = Ap (StateT s Identity) Doc -> StateT s Identity Doc
    forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
    getAp (Ap (StateT s Identity) Doc -> StateT s Identity Doc)
    -> Ap (StateT s Identity) Doc -> StateT s Identity Doc
    forall a b. (a -> b) -> a -> b
    $ case HWType -> BBHash
    typeSize HWType
    vTy of
      BBHash
    0 -> HWType -> Ap (StateT s Identity) Doc
    forall state. Backend state => HWType -> Ap (State state) Doc
    hdlTypeErrValue HWType
    rTy
      BBHash
    _ -> case Expr
    vec of
        Identifier Identifier
    i Maybe Modifier
    mM -> do
          let
            ixI :: Expr ->  Int
            ixI :: Expr -> BBHash
    ixI Expr
    ix0 = case Expr
    ix0 of
              Literal Maybe (HWType, BBHash)
    _ (NumLit Integer
    j) ->
                Integer -> BBHash
    forall a. Num a => Integer -> a
    fromInteger Integer
    j
              DataCon (Signed BBHash
    _) (DC (Void{},BBHash
    _)) [Literal (Just (Signed BBHash
    _,BBHash
    _)) (NumLit Integer
    j)] ->
                Integer -> BBHash
    forall a. Num a => Integer -> a
    fromInteger Integer
    j
              BlackBoxE Text
    "GHC.Types.I#" [[Element]]
    _lib [[Element]]
    _use [((Text, Text), BlackBox)]
    _incl BlackBox
    _templ Context{bbInputs :: BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs=[(Literal Maybe (HWType, BBHash)
    _ (NumLit Integer
    j),HWType
    _,Bool
    _)]} Bool
    _paren ->
                Integer -> BBHash
    forall a. Num a => Integer -> a
    fromInteger Integer
    j
              Expr
    _ ->
                String -> BBHash
    forall a. HasCallStack => String -> a
    error ($(curLoc) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Unexpected literal: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Expr -> String
    forall a. Show a => a -> String
    show Expr
    ix)
          case Maybe Modifier
    mM of
            Just Modifier
    m ->
                Bool -> Expr -> Ap (StateT s Identity) Doc
    forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
    expr Bool
    False (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    i (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just (Modifier -> Modifier -> Modifier
    Nested Modifier
    m ((HWType, BBHash, BBHash) -> Modifier
    Indexed (HWType
    vTy,BBHash
    10,Expr -> BBHash
    ixI Expr
    ix)))))
            Maybe Modifier
    _ -> Bool -> Expr -> Ap (StateT s Identity) Doc
    forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
    expr Bool
    False (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    i (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, BBHash, BBHash) -> Modifier
    Indexed (HWType
    vTy,BBHash
    10,Expr -> BBHash
    ixI Expr
    ix))))
        Expr
    _ -> String -> Ap (StateT s Identity) Doc
    forall a. HasCallStack => String -> a
    error ($(curLoc) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Expected Identifier: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Expr -> String
    forall a. Show a => a -> String
    show Expr
    vec)
      | Bool
    otherwise
      = String -> StateT s Identity Doc
    forall a. HasCallStack => String -> a
    error (String
    "indexIntVerilogTemplate: bad bbContext: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> BlackBoxContext -> String
    forall a. Show a => a -> String
    show BlackBoxContext
    bbCtx)