{-|
  Copyright   :  (C) 2021 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 (fromIntegerTF) 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 (..))

fromIntegerTF :: TemplateFunction
fromIntegerTF :: TemplateFunction
fromIntegerTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
used BlackBoxContext -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
fromIntegerTFTemplate
 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

fromIntegerTFTemplate
  :: Backend s
  => BlackBoxContext
  -> State s Doc
fromIntegerTFTemplate :: BlackBoxContext -> State s Doc
fromIntegerTFTemplate BlackBoxContext
bbCtx = Ap (State s) Doc -> State s Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Ap (State s) Doc -> State s Doc)
-> Ap (State s) Doc -> State s Doc
forall a b. (a -> b) -> a -> b
$ do
  let [(Literal Maybe (HWType, Int)
_ (NumLit Integer
sz),HWType
_,Bool
_), (i :: Expr
i@(Identifier Identifier
iV Maybe Modifier
m), Signed Int
szI, Bool
_)] = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
  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 -> 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 (State s) Doc
forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
expr Bool
False (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
iV Maybe Modifier
m1)
    Ordering
EQ -> Bool -> Expr -> Ap (State s) Doc
forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
expr Bool
False Expr
i
    Ordering
GT -> Ap (State s) Doc
"resize" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State s) [Doc] -> Ap (State s) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([Ap (State s) Doc] -> Ap (State s) [Doc]
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Bool -> Expr -> Ap (State s) Doc
forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
expr Bool
False Expr
i
                                        ,Bool -> Expr -> Ap (State s) 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))])