{-|
  Copyright   :  (C) 2020 QBayLogic
  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.State                (State, zipWithM)
import qualified Control.Lens                       as Lens
import           Data.Either                        (rights)
import qualified Data.IntMap                        as IntMap
import           Data.Semigroup.Monad               (getMon)
import qualified Data.Text                          as Text
import qualified Data.Text.Lazy                     as LText
import           Data.Text.Lazy                     (pack)
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 qualified Data.String.Interpolate.Util       as I

import           Clash.Backend
  (Backend, hdlTypeErrValue, expr, mkUniqueIdentifier, blockDecl)
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),
   Declaration(..), Expr(BlackBoxE, Literal, Identifier), Literal(NumLit),
   BlackBox(BBTemplate, BBFunction), TemplateFunction(..), WireOrReg(Wire),
   Modifier(Indexed, Nested), bbInputs, bbResult, emptyBBContext, tcCache,
   bbFunctions)
import           Clash.Netlist.Id                   (IdType(Basic))
import           Clash.Netlist.Util                 (typeSize)

import           Clash.Util                         (HasCallStack, curLoc)

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 :: Int -> Int
foldFunctionPlurality Int
1 = Int
0
foldFunctionPlurality Int
2 = Int
1
foldFunctionPlurality Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"functionPlurality: unexpected n: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
  | Bool
otherwise =
      let (Int
d, Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 in
      Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ HasCallStack => Int -> Int
Int -> Int
foldFunctionPlurality Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ HasCallStack => Int -> Int
Int -> Int
foldFunctionPlurality (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
r)

foldBBF :: HasCallStack => BlackBoxFunction
foldBBF :: BlackBoxFunction
foldBBF Bool
_isD Text
_primName [Either Term Type]
args Type
_resTy = do
  TyConMap
tcm <- Getting TyConMap NetlistState TyConMap -> NetlistMonad TyConMap
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
Lens.use Getting TyConMap NetlistState TyConMap
Lens' NetlistState TyConMap
tcCache
  Either [Char] (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((BlackBoxMeta, BlackBox) -> Either [Char] (BlackBoxMeta, BlackBox)
forall a b. b -> Either a b
Right (TyConMap -> BlackBoxMeta
meta TyConMap
tcm, BlackBox
bb))
 where
  bb :: BlackBox
bb = [Char] -> Int -> TemplateFunction -> BlackBox
BBFunction [Char]
"Clash.Primitives.Sized.Vector.foldTF" Int
0 TemplateFunction
foldTF
  [Type
_, Type
vecLengthMinusOne] = [Either Term Type] -> [Type]
forall a b. [Either a b] -> [b]
rights [Either Term Type]
args
  vecLength :: TyConMap -> Integer
vecLength TyConMap
tcm =
    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 -> [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error ([Char] -> Integer) -> [Char] -> Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected vector length: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Type -> [Char]
forall a. Show a => a -> [Char]
show Type
vl
  funcPlural :: TyConMap -> Int
funcPlural TyConMap
tcm = HasCallStack => Int -> Int
Int -> Int
foldFunctionPlurality (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (TyConMap -> Integer
vecLength TyConMap
tcm))
  meta :: TyConMap -> BlackBoxMeta
meta TyConMap
tcm = BlackBoxMeta
emptyBlackBoxMeta {bbKind :: TemplateKind
bbKind=TemplateKind
TDecl, bbFunctionPlurality :: [(Int, Int)]
bbFunctionPlurality=[(Int
0, TyConMap -> Int
funcPlural TyConMap
tcm)]}

-- | 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 = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [] (Bool -> BlackBoxContext -> Bool
forall a b. a -> b -> a
const Bool
True) 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' :: BlackBoxContext -> State s Doc
foldTF' bbCtx :: BlackBoxContext
bbCtx@(BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs -> [(Expr, HWType, Bool)
_f, (Expr
vec, vecType :: HWType
vecType@(Vector Int
n HWType
aTy), Bool
_isLiteral)]) = do
  -- Create an id for every element in the vector
  [Text]
vecIds <- (Int -> StateT s Identity Text)
-> [Int] -> StateT s Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
i -> [Char] -> StateT s Identity Text
mkId ([Char]
"acc_0_" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

  Text
vecId <- [Char] -> StateT s Identity Text
mkId [Char]
"vec"
  let vecDecl :: Declaration
vecDecl = HWType -> WireOrReg -> Text -> Declaration
sigDecl HWType
vecType WireOrReg
Wire Text
vecId
      vecAssign :: Declaration
vecAssign = Text -> Expr -> Declaration
Assignment Text
vecId Expr
vec
      elemAssigns :: [Declaration]
elemAssigns = (Text -> Expr -> Declaration) -> [Text] -> [Expr] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> Expr -> Declaration
Assignment [Text]
vecIds ((Int -> Expr) -> [Int] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int -> Expr
iIndex Text
vecId) [Int
0..])
      resultId :: Text
resultId =
        case BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx of
          (Identifier Text
t Maybe Modifier
_, HWType
_) -> Text
t
          (Expr, HWType)
_ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"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, Text
result) <- Int -> [Text] -> State s ([[FCall]], Text)
mkTree Int
1 [Text]
vecIds

  let intermediateResultIds :: [Text]
intermediateResultIds = (FCall -> [Text]) -> [FCall] -> [Text]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\(FCall Text
l Text
r Text
_) -> [Text
l, Text
r]) [FCall]
fCalls
      wr :: WireOrReg
wr = case Int
-> IntMap
     [(Either BlackBox (Text, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
       BlackBoxContext)]
-> Maybe
     [(Either BlackBox (Text, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
       BlackBoxContext)]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
0 (BlackBoxContext
-> IntMap
     [(Either BlackBox (Text, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
       BlackBoxContext)]
bbFunctions BlackBoxContext
bbCtx) of
             Just ((Either BlackBox (Text, [Declaration])
_,WireOrReg
rw,[BlackBoxTemplate]
_,[BlackBoxTemplate]
_,[((Text, Text), BlackBox)]
_,BlackBoxContext
_):[(Either BlackBox (Text, [Declaration]), WireOrReg,
  [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
  BlackBoxContext)]
_) -> WireOrReg
rw
             Maybe
  [(Either BlackBox (Text, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
    BlackBoxContext)]
_ -> [Char] -> WireOrReg
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error"
      sigDecls :: [Declaration]
sigDecls = (WireOrReg -> Text -> Declaration)
-> [WireOrReg] -> [Text] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (HWType -> WireOrReg -> Text -> Declaration
sigDecl HWType
aTy) (WireOrReg
wrWireOrReg -> [WireOrReg] -> [WireOrReg]
forall a. a -> [a] -> [a]
:Int -> WireOrReg -> [WireOrReg]
forall a. Int -> a -> [a]
replicate Int
n WireOrReg
Wire [WireOrReg] -> [WireOrReg] -> [WireOrReg]
forall a. [a] -> [a] -> [a]
++ WireOrReg -> [WireOrReg]
forall a. a -> [a]
repeat WireOrReg
wr)
                                       (Text
result Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
intermediateResultIds)
      resultAssign :: Declaration
resultAssign = Text -> Expr -> Declaration
Assignment Text
resultId (Text -> Maybe Modifier -> Expr
Identifier Text
result Maybe Modifier
forall a. Maybe a
Nothing)

  [Declaration]
callDecls <- (Int -> FCall -> StateT s Identity Declaration)
-> [Int] -> [FCall] -> StateT s Identity [Declaration]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> FCall -> StateT s Identity Declaration
callDecl [Int
0..] [FCall]
fCalls
  Text
foldNm <- [Char] -> StateT s Identity Text
mkId [Char]
"fold"

  Mon (State s) Doc -> State s Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State s) Doc -> State s Doc)
-> Mon (State s) Doc -> State s Doc
forall a b. (a -> b) -> a -> b
$ Text -> [Declaration] -> Mon (State s) Doc
forall state.
Backend state =>
Text -> [Declaration] -> Mon (State state) Doc
blockDecl Text
foldNm ([Declaration] -> Mon (State s) Doc)
-> [Declaration] -> Mon (State s) 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
  mkId :: String -> State s Identifier
  mkId :: [Char] -> StateT s Identity Text
mkId = IdType -> Text -> StateT s Identity Text
forall s. Backend s => IdType -> Text -> State s Text
mkUniqueIdentifier IdType
Basic (Text -> StateT s Identity Text)
-> ([Char] -> Text) -> [Char] -> StateT s Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack

  callDecl :: Int -> FCall -> State s Declaration
  callDecl :: Int -> FCall -> StateT s Identity Declaration
callDecl Int
fSubPos (FCall Text
a Text
b Text
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 (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
bbCtx Element
call State s (Int -> Text)
-> StateT s Identity Int -> StateT s Identity Text
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Int -> StateT s Identity Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0)
    let layout :: LayoutOptions
layout = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
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 (f :: Type -> Type) a. Applicative f => a -> f a
pure (
      Text
-> [BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> Declaration
BlackBoxD
        Text
"__FOLD_BB_INTERNAL__"
        [] [] []
        (BlackBoxTemplate -> BlackBox
BBTemplate [Text -> Element
Text Text
rendered1])
        (Text -> BlackBoxContext
emptyBBContext Text
"__FOLD_BB_INTERNAL__")
        )
   where
    call :: Element
call  = Decl -> Element
Component (Int -> Int -> [(BlackBoxTemplate, BlackBoxTemplate)] -> Decl
Decl Int
fPos Int
fSubPos ((BlackBoxTemplate, BlackBoxTemplate)
resEl(BlackBoxTemplate, BlackBoxTemplate)
-> [(BlackBoxTemplate, BlackBoxTemplate)]
-> [(BlackBoxTemplate, BlackBoxTemplate)]
forall a. a -> [a] -> [a]
:(BlackBoxTemplate, BlackBoxTemplate)
aEl(BlackBoxTemplate, BlackBoxTemplate)
-> [(BlackBoxTemplate, BlackBoxTemplate)]
-> [(BlackBoxTemplate, BlackBoxTemplate)]
forall a. a -> [a] -> [a]
:[(BlackBoxTemplate, BlackBoxTemplate)
bEl]))
    elTyp :: BlackBoxTemplate
elTyp = [Element -> Element
TypElem (Maybe Int -> Element
Typ (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
vecPos))]
    resEl :: (BlackBoxTemplate, BlackBoxTemplate)
resEl = ([Text -> Element
Text (Text -> Text
LText.fromStrict Text
r)], BlackBoxTemplate
elTyp)
    aEl :: (BlackBoxTemplate, BlackBoxTemplate)
aEl   = ([Text -> Element
Text (Text -> Text
LText.fromStrict Text
a)], BlackBoxTemplate
elTyp)
    bEl :: (BlackBoxTemplate, BlackBoxTemplate)
bEl   = ([Text -> Element
Text (Text -> Text
LText.fromStrict Text
b)], BlackBoxTemplate
elTyp)

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

  -- Argument no. of vector
  vecPos :: Int
vecPos = Int
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 :: Int -> [Text] -> State s ([[FCall]], Text)
mkTree Int
_lvl []  = [Char] -> State s ([[FCall]], Text)
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable?"
  mkTree Int
_lvl [Text
res] = ([[FCall]], Text) -> State s ([[FCall]], Text)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([], Text
res)
  mkTree Int
lvl [Text]
results0  = do
    ([FCall]
calls0, [Text]
results1) <- (Int, Int) -> [Text] -> State s ([FCall], [Text])
mkLevel (Int
lvl, Int
0) [Text]
results0
    ([[FCall]]
calls1, Text
result) <- Int -> [Text] -> State s ([[FCall]], Text)
mkTree (Int
lvlInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Text]
results1
    ([[FCall]], Text) -> State s ([[FCall]], Text)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([FCall]
calls0 [FCall] -> [[FCall]] -> [[FCall]]
forall a. a -> [a] -> [a]
: [[FCall]]
calls1, Text
result)

  -- Create a single layer of a tree
  mkLevel
    :: (Int, Int)
    -- ^ (level, offset)
    -> [Identifier]
    -> State s ([FCall], [Identifier])
  mkLevel :: (Int, Int) -> [Text] -> State s ([FCall], [Text])
mkLevel (!Int
lvl, !Int
offset) (Text
a:Text
b:[Text]
rest) = do
    Text
c <- [Char] -> StateT s Identity Text
mkId ([Char]
"acc_" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lvl [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"_" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
offset)
    ([FCall]
calls, [Text]
results) <- (Int, Int) -> [Text] -> State s ([FCall], [Text])
mkLevel (Int
lvl, Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Text]
rest
    ([FCall], [Text]) -> State s ([FCall], [Text])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text -> Text -> Text -> FCall
FCall Text
a Text
b Text
cFCall -> [FCall] -> [FCall]
forall a. a -> [a] -> [a]
:[FCall]
calls, Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
results)
  mkLevel (Int, Int)
_lvl [Text]
rest =
    ([FCall], [Text]) -> State s ([FCall], [Text])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([], [Text]
rest)

  -- Simple wire without comment
  sigDecl :: HWType -> WireOrReg -> Identifier -> Declaration
  sigDecl :: HWType -> WireOrReg -> Text -> Declaration
sigDecl HWType
typ WireOrReg
rw Text
nm = Maybe Text
-> WireOrReg
-> Text
-> Either Text HWType
-> Maybe Expr
-> Declaration
NetDecl' Maybe Text
forall a. Maybe a
Nothing WireOrReg
rw Text
nm (HWType -> Either Text HWType
forall a b. b -> Either a b
Right HWType
typ) Maybe Expr
forall a. Maybe a
Nothing

  -- 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 :: Text -> Int -> Expr
iIndex Text
vecId Int
i = Text -> Maybe Modifier -> Expr
Identifier Text
vecId (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just ((HWType, Int, Int) -> Modifier
Indexed (HWType
vecType, Int
10, Int
i)))

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

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

  bbKi :: TemplateKind
bbKi = case [Either Term Type]
args of
    [Either Term Type
_nTy,Either Term Type
_aTy,Either Term Type
_kn,Either Term Type
_v,Left Term
ix]
      | Term -> Bool
isLiteral Term
ix -> TemplateKind
TExpr
    [Either Term Type]
_ -> TemplateKind
TDecl

  bb :: Either [Char] BlackBox
bb = case [Either Term Type]
args of
    [Either Term Type
_nTy,Either Term Type
_aTy,Either Term Type
_kn,Either Term Type
_v,Left Term
ix] | Term -> Bool
isLiteral Term
ix ->
      BlackBox -> Either [Char] BlackBox
forall a b. b -> Either a b
Right ([Char] -> Int -> TemplateFunction -> BlackBox
BBFunction [Char]
"Clash.Primitives.Sized.Vector" Int
0 TemplateFunction
indexIntVerilogTF)
    [Either Term Type]
_ ->
      BlackBoxTemplate -> BlackBox
BBTemplate (BlackBoxTemplate -> BlackBox)
-> Either [Char] BlackBoxTemplate -> Either [Char] BlackBox
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text -> Result BlackBoxTemplate
runParse ([Char] -> Text
pack ([Char] -> [Char]
I.unindent [Char]
bbText)) of
        Success BlackBoxTemplate
t -> BlackBoxTemplate -> Either [Char] BlackBoxTemplate
forall a b. b -> Either a b
Right BlackBoxTemplate
t
        Result BlackBoxTemplate
_         -> [Char] -> Either [Char] BlackBoxTemplate
forall a b. a -> Either a b
Left [Char]
"internal error: parse fail"

  bbText :: [Char]
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|]

indexIntVerilogTF :: TemplateFunction
indexIntVerilogTF :: TemplateFunction
indexIntVerilogTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
used BlackBoxContext -> Bool
forall b. b -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
indexIntVerilogTemplate
 where
  used :: [Int]
used  = [Int
1,Int
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 :: BlackBoxContext -> State s Doc
indexIntVerilogTemplate BlackBoxContext
bbCtx = Mon (State s) Doc -> State s Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State s) Doc -> State s Doc)
-> Mon (State s) Doc -> State s Doc
forall a b. (a -> b) -> a -> b
$ case HWType -> Int
typeSize HWType
vTy of
  Int
0 -> HWType -> Mon (State s) Doc
forall state. Backend state => HWType -> Mon (State state) Doc
hdlTypeErrValue HWType
rTy
  Int
_ -> case Expr
vec of
    Identifier Text
i Maybe Modifier
mM -> case Maybe Modifier
mM of
      Just Modifier
m ->
           Bool -> Expr -> Mon (State s) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
False (Text -> Maybe Modifier -> Expr
Identifier Text
i (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just (Modifier -> Modifier -> Modifier
Nested Modifier
m ((HWType, Int, Int) -> Modifier
Indexed (HWType
vTy,Int
10,Expr -> Int
ixI Expr
ix)))))
      Maybe Modifier
_ -> Bool -> Expr -> Mon (State s) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
False (Text -> Maybe Modifier -> Expr
Identifier Text
i (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just ((HWType, Int, Int) -> Modifier
Indexed (HWType
vTy,Int
10,Expr -> Int
ixI Expr
ix))))
    Expr
_ -> [Char] -> Mon (State s) Doc
forall a. HasCallStack => [Char] -> a
error ($([Char]
curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Expected Identifier: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Expr -> [Char]
forall a. Show a => a -> [Char]
show Expr
vec)
 where
  [  (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)
bbResult BlackBoxContext
bbCtx

  ixI :: Expr ->  Int
  ixI :: Expr -> Int
ixI Expr
ix0 = case Expr
ix0 of
    Literal Maybe (HWType, Int)
_ (NumLit Integer
i) ->
      Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
    BlackBoxE Text
"GHC.Types.I#" [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
ixCtx Bool
_ ->
      let (Expr
ix1,HWType
_,Bool
_) = [(Expr, HWType, Bool)] -> (Expr, HWType, Bool)
forall a. [a] -> a
head (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
ixCtx)
      in  Expr -> Int
ixI Expr
ix1
    Expr
_ ->
      [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ($([Char]
curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Unexpected literal: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Expr -> [Char]
forall a. Show a => a -> [Char]
show Expr
ix)