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

      VHDL Blackbox implementations for "Clash.Sized.Internal.Signed.toInteger#".
    -}

    {-# LANGUAGE OverloadedStrings #-}
    module Clash.Primitives.Sized.Signed (fromIntegerTFvhdl) where

    import Control.Monad.State (State)
    import Data.Monoid (Ap(getAp))
    import Data.Text.Prettyprint.Doc.Extra (Doc, tupled)

    import Clash.Backend (Backend, expr)
    import Clash.Netlist.Types
      (BlackBoxContext (..), Expr (..), HWType (..), Literal (..), Modifier (..),
       TemplateFunction (..))

    fromIntegerTFvhdl :: TemplateFunction
    fromIntegerTFvhdl :: TemplateFunction
    fromIntegerTFvhdl = [Int]
    -> (BlackBoxContext -> Bool)
    -> (forall s. Backend s => BlackBoxContext -> State s Doc)
    -> TemplateFunction
    TemplateFunction [Int]
    used BlackBoxContext -> Bool
    valid BlackBoxContext -> State s Doc
    forall s. Backend s => BlackBoxContext -> State s Doc
    fromIntegerTFTemplateVhdl
     where
      used :: [Int]
    used = [Int
    0,Int
    1]
      valid :: BlackBoxContext -> Bool
    valid BlackBoxContext
    bbCtx = case BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs BlackBoxContext
    bbCtx of
        [(Expr, HWType, Bool)
    kn,(Expr, HWType, Bool)
    _] -> case (Expr, HWType, Bool)
    kn of
          (Literal Maybe (HWType, Int)
    _ (NumLit Integer
    _),HWType
    _,Bool
    True) -> Bool
    True
          (Expr, HWType, Bool)
    _ -> Bool
    False
        [(Expr, HWType, Bool)]
    _ -> Bool
    False

    fromIntegerTFTemplateVhdl
      :: Backend s
      => BlackBoxContext
      -> State s Doc
    fromIntegerTFTemplateVhdl :: forall s. Backend s => BlackBoxContext -> State s Doc
    fromIntegerTFTemplateVhdl BlackBoxContext
    bbCtx
      | [(Literal Maybe (HWType, Int)
    _ (NumLit Integer
    sz),HWType
    _,Bool
    _), (Expr
    i, Signed Int
    szI, Bool
    _)] <- BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs 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 Integer -> Integer -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Integer
    sz (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    szI) of
        Ordering
    LT -> case Expr
    i of
               Identifier Identifier
    iV Maybe Modifier
    m ->
                let sl :: Modifier
    sl = (HWType, Int, Int) -> Modifier
    Sliced (Int -> HWType
    Signed Int
    szI,Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1,Int
    0)
                    m1 :: Maybe Modifier
    m1 = Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just (Modifier -> (Modifier -> Modifier) -> Maybe Modifier -> Modifier
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Modifier
    sl (Modifier -> Modifier -> Modifier
    `Nested` Modifier
    sl) Maybe Modifier
    m)
                in 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
    iV Maybe Modifier
    m1)
               Expr
    _ -> Ap (StateT s Identity) Doc
    "signed(std_logic_vector(resize(unsigned(std_logic_vector(" Ap (StateT s Identity) Doc
    -> Ap (StateT s Identity) Doc -> Ap (StateT s Identity) Doc
    forall a. Semigroup a => a -> a -> a
    <> Bool -> Expr -> Ap (StateT s Identity) Doc
    forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
    expr Bool
    False Expr
    i Ap (StateT s Identity) Doc
    -> Ap (StateT s Identity) Doc -> Ap (StateT s Identity) Doc
    forall a. Semigroup a => a -> a -> a
    <> Ap (StateT s Identity) Doc
    "))," Ap (StateT s Identity) Doc
    -> Ap (StateT s Identity) Doc -> Ap (StateT s Identity) Doc
    forall a. Semigroup a => a -> a -> a
    <> Bool -> Expr -> Ap (StateT s Identity) Doc
    forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
    expr Bool
    False (Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Integer -> Literal
    NumLit Integer
    sz)) Ap (StateT s Identity) Doc
    -> Ap (StateT s Identity) Doc -> Ap (StateT s Identity) Doc
    forall a. Semigroup a => a -> a -> a
    <> Ap (StateT s Identity) Doc
    ")))"
        Ordering
    EQ -> Bool -> Expr -> Ap (StateT s Identity) Doc
    forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
    expr Bool
    False Expr
    i
        Ordering
    GT -> Ap (StateT s Identity) Doc
    "resize" Ap (StateT s Identity) Doc
    -> Ap (StateT s Identity) Doc -> Ap (StateT s Identity) Doc
    forall a. Semigroup a => a -> a -> a
    <> Ap (StateT s Identity) [Doc] -> Ap (StateT s Identity) Doc
    forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
    tupled ([Ap (StateT s Identity) Doc] -> Ap (StateT s Identity) [Doc]
    forall (t :: Type -> Type) (f :: Type -> Type) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: Type -> Type) a. Applicative f => [f a] -> f [a]
    sequenceA [Bool -> Expr -> Ap (StateT s Identity) Doc
    forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
    expr Bool
    False Expr
    i
                                            ,Bool -> Expr -> Ap (StateT s Identity) Doc
    forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
    expr Bool
    False (Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Integer -> Literal
    NumLit Integer
    sz))])
      | Bool
    otherwise
      = [Char] -> StateT s Identity Doc
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "fromIntegerTFTemplateVhdl: bad bInputs: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [(Expr, HWType, Bool)] -> [Char]
    forall a. Show a => a -> [Char]
    show (BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs BlackBoxContext
    bbCtx))