{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Clash.Primitives.DSL
(
blackBoxHaskell
, BlockState (..)
, TExpr
, declaration
, declarationReturn
, instDecl
, instHO
, viaAnnotatedSignal
, bvLit
, LitHDL (..)
, pattern High
, pattern Low
, tuple
, vec
, tInputs
, tResult
, getStr
, getBool
, exprToInteger
, tExprToInteger
, untuple
, unvec
, toBV
, fromBV
, boolToBit
, boolFromBit
, boolFromBitVector
, unsignedFromBitVector
, boolFromBits
, andExpr
, notExpr
, pureToBV
, pureToBVResized
, open
, toIdentifier
, tySize
, clog2
) where
import Clash.Util (HasCallStack, clogBase)
import Control.Lens hiding (Indexed, assign)
import Control.Monad.State
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Semigroup hiding (Product)
import Data.Semigroup.Monad
import Data.String
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import Data.Text.Prettyprint.Doc.Extra
import TextShow (showt)
import Clash.Annotations.Primitive (HDL (..), Primitive (..))
import Clash.Backend hiding (fromBV, toBV)
import Clash.Backend.VHDL (VHDLState)
import Clash.Core.Var (Attr')
import Clash.Netlist.BlackBox.Util (exprToString, renderElem)
import Clash.Netlist.BlackBox.Types
(BlackBoxTemplate, Element(Component, Text), Decl(..))
import Clash.Netlist.Id
import Clash.Netlist.Types hiding (Component, toBit)
import Clash.Netlist.Util hiding (mkUniqueIdentifier)
import qualified Data.String.Interpolate as I
import Data.String.Interpolate.Util (unindent)
import Language.Haskell.TH (Name)
import Prelude
blackBoxHaskell
:: [Int]
-> HDL
-> Name
-> Name
-> Primitive
blackBoxHaskell :: [Int] -> HDL -> Name -> Name -> Primitive
blackBoxHaskell ([Int] -> String
forall a. Show a => a -> String
show -> String
ign) HDL
hdl Name
bb Name
tf =
[HDL] -> String -> Primitive
InlinePrimitive [HDL
hdl] (String -> Primitive) -> String -> Primitive
forall a b. (a -> b) -> a -> b
$ String -> String
unindent [I.i|
[ { "BlackBoxHaskell" :
{ "name" : "#{bb}"
, "templateFunction" : "#{tf}"
, "ignoredArguments" : #{ign}
}
}
]
|]
data BlockState backend = BlockState
{ BlockState backend -> [Declaration]
_bsDeclarations :: [Declaration]
, BlockState backend -> IntMap Int
_bsHigherOrderCalls :: IntMap Int
, BlockState backend -> backend
_bsBackend :: backend
}
makeLenses ''BlockState
data TExpr = TExpr
{ TExpr -> HWType
ety :: HWType
, TExpr -> Expr
eex :: Expr
} deriving Int -> TExpr -> String -> String
[TExpr] -> String -> String
TExpr -> String
(Int -> TExpr -> String -> String)
-> (TExpr -> String) -> ([TExpr] -> String -> String) -> Show TExpr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TExpr] -> String -> String
$cshowList :: [TExpr] -> String -> String
show :: TExpr -> String
$cshow :: TExpr -> String
showsPrec :: Int -> TExpr -> String -> String
$cshowsPrec :: Int -> TExpr -> String -> String
Show
makeLenses ''TExpr
declarationReturn
:: Backend backend
=> BlackBoxContext
-> Text.Text
-> State (BlockState backend) TExpr
-> State backend Doc
declarationReturn :: BlackBoxContext
-> Text -> State (BlockState backend) TExpr -> State backend Doc
declarationReturn BlackBoxContext
bbCtx Text
blockName State (BlockState backend) TExpr
blockBuilder =
Text -> State (BlockState backend) () -> State backend Doc
forall backend.
Backend backend =>
Text -> State (BlockState backend) () -> State backend Doc
declaration Text
blockName (State (BlockState backend) () -> State backend Doc)
-> State (BlockState backend) () -> State backend Doc
forall a b. (a -> b) -> a -> b
$ do
TExpr
res <- State (BlockState backend) TExpr
blockBuilder
let (Identifier Text
resultNm Maybe Modifier
Nothing, HWType
_) = BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Text -> Expr -> Declaration
Assignment Text
resultNm (TExpr -> Expr
eex TExpr
res))
() -> State (BlockState backend) ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
declaration
:: Backend backend
=> Text.Text
-> State (BlockState backend) ()
-> State backend Doc
declaration :: Text -> State (BlockState backend) () -> State backend Doc
declaration Text
blockName State (BlockState backend) ()
s = do
backend
backend0 <- StateT backend Identity backend
forall s (m :: Type -> Type). MonadState s m => m s
get
let initState :: BlockState backend
initState = [Declaration] -> IntMap Int -> backend -> BlockState backend
forall backend.
[Declaration] -> IntMap Int -> backend -> BlockState backend
BlockState [] IntMap Int
forall a. IntMap a
IntMap.empty backend
backend0
BlockState [Declaration]
decs IntMap Int
_hoCalls backend
backend1 = State (BlockState backend) ()
-> BlockState backend -> BlockState backend
forall s a. State s a -> s -> s
execState State (BlockState backend) ()
s BlockState backend
initState
backend -> StateT backend Identity ()
forall s (m :: Type -> Type). MonadState s m => s -> m ()
put backend
backend1
Text
blockNameUnique <- IdType -> Text -> State backend Text
forall s. Backend s => IdType -> Text -> State s Text
mkUniqueIdentifier IdType
Basic Text
blockName
Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State backend) Doc -> State backend Doc)
-> Mon (State backend) Doc -> State backend Doc
forall a b. (a -> b) -> a -> b
$ Text -> [Declaration] -> Mon (State backend) Doc
forall state.
Backend state =>
Text -> [Declaration] -> Mon (State state) Doc
blockDecl Text
blockNameUnique ([Declaration] -> [Declaration]
forall a. [a] -> [a]
reverse [Declaration]
decs)
addDeclaration :: Declaration -> State (BlockState backend) ()
addDeclaration :: Declaration -> State (BlockState backend) ()
addDeclaration Declaration
dec = ([Declaration] -> Identity [Declaration])
-> BlockState backend -> Identity (BlockState backend)
forall backend. Lens' (BlockState backend) [Declaration]
bsDeclarations (([Declaration] -> Identity [Declaration])
-> BlockState backend -> Identity (BlockState backend))
-> ([Declaration] -> [Declaration])
-> State (BlockState backend) ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Declaration -> [Declaration] -> [Declaration]
forall s a. Cons s s a a => a -> s -> s
cons Declaration
dec
newName :: Backend backend => Text -> State (BlockState backend) Identifier
newName :: Text -> State (BlockState backend) Text
newName Text
nm = LensLike'
(Zoomed (StateT backend Identity) Text)
(BlockState backend)
backend
-> StateT backend Identity Text -> State (BlockState backend) Text
forall (m :: Type -> Type) (n :: Type -> Type) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
(Zoomed (StateT backend Identity) Text)
(BlockState backend)
backend
forall backend backend.
Lens (BlockState backend) (BlockState backend) backend backend
bsBackend (StateT backend Identity Text -> State (BlockState backend) Text)
-> StateT backend Identity Text -> State (BlockState backend) Text
forall a b. (a -> b) -> a -> b
$ IdType -> Text -> StateT backend Identity Text
forall s. Backend s => IdType -> Text -> State s Text
mkUniqueIdentifier IdType
Basic Text
nm
declare'
:: Backend backend
=> Identifier
-> WireOrReg
-> HWType
-> State (BlockState backend) Identifier
declare' :: Text -> WireOrReg -> HWType -> State (BlockState backend) Text
declare' Text
decName WireOrReg
wireOrReg HWType
ty = do
Text
uniqueName <- Text -> State (BlockState backend) Text
forall backend.
Backend backend =>
Text -> State (BlockState backend) Text
newName Text
decName
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Maybe Text
-> WireOrReg
-> Text
-> Either Text HWType
-> Maybe Expr
-> Declaration
NetDecl' Maybe Text
forall a. Maybe a
Nothing WireOrReg
wireOrReg Text
uniqueName (HWType -> Either Text HWType
forall a b. b -> Either a b
Right HWType
ty) Maybe Expr
forall a. Maybe a
Nothing)
Text -> State (BlockState backend) Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
uniqueName
declare
:: Backend backend
=> Identifier
-> WireOrReg
-> HWType
-> State (BlockState backend) TExpr
declare :: Text -> WireOrReg -> HWType -> State (BlockState backend) TExpr
declare Text
decName WireOrReg
wireOrReg HWType
ty = do
Text
uniqueName <- Text -> WireOrReg -> HWType -> State (BlockState backend) Text
forall backend.
Backend backend =>
Text -> WireOrReg -> HWType -> State (BlockState backend) Text
declare' Text
decName WireOrReg
wireOrReg HWType
ty
TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (HWType -> Expr -> TExpr
TExpr HWType
ty (Text -> Maybe Modifier -> Expr
Identifier Text
uniqueName Maybe Modifier
forall a. Maybe a
Nothing))
assign
:: Backend backend
=> Text
-> TExpr
-> State (BlockState backend) TExpr
assign :: Text -> TExpr -> State (BlockState backend) TExpr
assign Text
aName (TExpr HWType
ty Expr
aExpr) = do
texp :: TExpr
texp@(~(TExpr HWType
_ (Identifier Text
uniqueName Maybe Modifier
Nothing))) <- Text -> WireOrReg -> HWType -> State (BlockState backend) TExpr
forall backend.
Backend backend =>
Text -> WireOrReg -> HWType -> State (BlockState backend) TExpr
declare Text
aName WireOrReg
Wire HWType
ty
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Text -> Expr -> Declaration
Assignment Text
uniqueName Expr
aExpr)
TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
texp
unvec
:: Backend backend
=> Identifier
-> TExpr
-> State (BlockState backend) [TExpr]
unvec :: Text -> TExpr -> State (BlockState backend) [TExpr]
unvec Text
vName v :: TExpr
v@(TExpr -> HWType
ety -> Vector Int
vSize HWType
eType) = do
~(TExpr HWType
_ (Identifier Text
vUniqueName Maybe Modifier
Nothing)) <- Text -> TExpr -> State (BlockState backend) TExpr
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) TExpr
toIdentifier Text
vName TExpr
v
let vIndex :: Int -> Expr
vIndex Int
i = Text -> Maybe Modifier -> Expr
Identifier Text
vUniqueName (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just ((HWType, Int, Int) -> Modifier
Indexed (TExpr -> HWType
ety TExpr
v, Int
10, Int
i)))
[TExpr] -> State (BlockState backend) [TExpr]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Int -> TExpr) -> [Int] -> [TExpr]
forall a b. (a -> b) -> [a] -> [b]
map (HWType -> Expr -> TExpr
TExpr HWType
eType (Expr -> TExpr) -> (Int -> Expr) -> Int -> TExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr
vIndex) [Int
0..Int
vSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
unvec Text
_ TExpr
e = String -> State (BlockState backend) [TExpr]
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) [TExpr])
-> String -> State (BlockState backend) [TExpr]
forall a b. (a -> b) -> a -> b
$ String
"unvec: cannot be called on non-vector: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HWType -> String
forall a. Show a => a -> String
show (TExpr -> HWType
ety TExpr
e)
untuple
:: (HasCallStack, Backend backend)
=> TExpr
-> [Identifier]
-> State (BlockState backend) [TExpr]
untuple :: TExpr -> [Text] -> State (BlockState backend) [TExpr]
untuple (TExpr ty :: HWType
ty@(Product Text
_ Maybe [Text]
_ [HWType]
tys) (Identifier Text
resName Maybe Modifier
_)) [Text]
vals = do
[TExpr]
newNames <- (Text -> HWType -> StateT (BlockState backend) Identity TExpr)
-> [Text] -> [HWType] -> State (BlockState backend) [TExpr]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ((Text
-> WireOrReg
-> HWType
-> StateT (BlockState backend) Identity TExpr)
-> WireOrReg
-> Text
-> HWType
-> StateT (BlockState backend) Identity TExpr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text
-> WireOrReg
-> HWType
-> StateT (BlockState backend) Identity TExpr
forall backend.
Backend backend =>
Text -> WireOrReg -> HWType -> State (BlockState backend) TExpr
declare WireOrReg
Wire) [Text]
vals [HWType]
tys
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Declaration -> State (BlockState backend) ())
-> Declaration -> State (BlockState backend) ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Declaration
Assignment Text
resName (Expr -> Declaration) -> Expr -> Declaration
forall a b. (a -> b) -> a -> b
$ HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
ty ((HWType, Int) -> Modifier
DC (HWType
ty, Int
0)) ((TExpr -> Expr) -> [TExpr] -> [Expr]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap TExpr -> Expr
eex [TExpr]
newNames)
[TExpr] -> State (BlockState backend) [TExpr]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [TExpr]
newNames
untuple TExpr
e [Text]
i = String -> State (BlockState backend) [TExpr]
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) [TExpr])
-> String -> State (BlockState backend) [TExpr]
forall a b. (a -> b) -> a -> b
$ String
"untuple: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TExpr -> String
forall a. Show a => a -> String
show TExpr
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show [Text]
i
pattern High :: TExpr
pattern $bHigh :: TExpr
$mHigh :: forall r. TExpr -> (Void# -> r) -> (Void# -> r) -> r
High <- TExpr Bit (Literal _ (BitLit H))
where High = HWType -> Expr -> TExpr
TExpr HWType
Bit (Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
Bit,Int
1)) (Bit -> Literal
BitLit Bit
H))
pattern Low :: TExpr
pattern $bLow :: TExpr
$mLow :: forall r. TExpr -> (Void# -> r) -> (Void# -> r) -> r
Low <- TExpr Bit (Literal _ (BitLit L))
where Low = HWType -> Expr -> TExpr
TExpr HWType
Bit (Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
Bit,Int
1)) (Bit -> Literal
BitLit Bit
L))
pattern T :: TExpr
pattern $bT :: TExpr
$mT :: forall r. TExpr -> (Void# -> r) -> (Void# -> r) -> r
T <- TExpr Bool (Literal _ (BoolLit True))
where T = HWType -> Expr -> TExpr
TExpr HWType
Bool (Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
Bool,Int
1)) (Bool -> Literal
BoolLit Bool
True))
pattern F :: TExpr
pattern $bF :: TExpr
$mF :: forall r. TExpr -> (Void# -> r) -> (Void# -> r) -> r
F <- TExpr Bool (Literal _ (BoolLit False))
where F = HWType -> Expr -> TExpr
TExpr HWType
Bool (Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
Bool,Int
1)) (Bool -> Literal
BoolLit Bool
False))
bvLit
:: Int
-> Integer
-> TExpr
bvLit :: Int -> Integer -> TExpr
bvLit Int
sz Integer
n =
HWType -> Expr -> TExpr
TExpr
(Int -> HWType
BitVector Int
sz)
(Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector Int
sz, Int
sz)) (Integer -> Integer -> Literal
BitVecLit Integer
0 Integer
n))
boolToBit
:: (HasCallStack, Backend backend)
=> Identifier
-> TExpr
-> State (BlockState backend) TExpr
boolToBit :: Text -> TExpr -> State (BlockState backend) TExpr
boolToBit Text
bitName = \case
TExpr
T -> TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
High
TExpr
F -> TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
Low
TExpr HWType
Bool Expr
boolExpr -> do
texp :: TExpr
texp@(~(TExpr HWType
_ (Identifier Text
uniqueBitName Maybe Modifier
Nothing))) <- Text -> WireOrReg -> HWType -> State (BlockState backend) TExpr
forall backend.
Backend backend =>
Text -> WireOrReg -> HWType -> State (BlockState backend) TExpr
declare Text
bitName WireOrReg
Wire HWType
Bit
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Declaration -> State (BlockState backend) ())
-> Declaration -> State (BlockState backend) ()
forall a b. (a -> b) -> a -> b
$
Text
-> HWType
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Declaration
CondAssignment Text
uniqueBitName HWType
Bit Expr
boolExpr HWType
Bool
[ (Literal -> Maybe Literal
forall a. a -> Maybe a
Just (Bool -> Literal
BoolLit Bool
True), Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bit -> Literal
BitLit Bit
H))
, (Maybe Literal
forall a. Maybe a
Nothing , Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bit -> Literal
BitLit Bit
L))
]
TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
texp
TExpr
tExpr -> String -> State (BlockState backend) TExpr
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) TExpr)
-> String -> State (BlockState backend) TExpr
forall a b. (a -> b) -> a -> b
$ String
"boolToBit: Got \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TExpr -> String
forall a. Show a => a -> String
show TExpr
tExpr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" expected Bool"
boolFromBit
:: Backend backend
=> Identifier
-> TExpr
-> State (BlockState backend) TExpr
boolFromBit :: Text -> TExpr -> State (BlockState backend) TExpr
boolFromBit = HWType
-> HWType
-> (Text -> Text)
-> Text
-> TExpr
-> State (BlockState backend) TExpr
forall backend.
(HasCallStack, Backend backend) =>
HWType
-> HWType
-> (Text -> Text)
-> Text
-> TExpr
-> State (BlockState backend) TExpr
outputCoerce HWType
Bit HWType
Bool (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = '1'")
boolFromBitVector
:: Backend backend
=> Size
-> Identifier
-> TExpr
-> State (BlockState backend) TExpr
boolFromBitVector :: Int -> Text -> TExpr -> State (BlockState backend) TExpr
boolFromBitVector Int
n =
HWType
-> HWType
-> (Text -> Text)
-> Text
-> TExpr
-> State (BlockState backend) TExpr
forall backend.
(HasCallStack, Backend backend) =>
HWType
-> HWType
-> (Text -> Text)
-> Text
-> TExpr
-> State (BlockState backend) TExpr
outputCoerce (Int -> HWType
BitVector Int
n) HWType
Bool (\Text
i -> Text
"unsigned(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") > 0")
unsignedFromBitVector
:: Size
-> Identifier
-> TExpr
-> State (BlockState VHDLState) TExpr
unsignedFromBitVector :: Int -> Text -> TExpr -> State (BlockState VHDLState) TExpr
unsignedFromBitVector Int
n =
HWType
-> HWType
-> (Text -> Text)
-> Text
-> TExpr
-> State (BlockState VHDLState) TExpr
forall backend.
(HasCallStack, Backend backend) =>
HWType
-> HWType
-> (Text -> Text)
-> Text
-> TExpr
-> State (BlockState backend) TExpr
outputCoerce (Int -> HWType
BitVector Int
n) (Int -> HWType
Unsigned Int
n) (\Text
i -> Text
"unsigned(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
boolFromBits
:: [Identifier]
-> TExpr
-> State (BlockState VHDLState) [TExpr]
boolFromBits :: [Text] -> TExpr -> State (BlockState VHDLState) [TExpr]
boolFromBits [Text]
inNames = [HWType]
-> HWType
-> ([Text] -> Text)
-> [Text]
-> TExpr
-> State (BlockState VHDLState) [TExpr]
forall backend.
(HasCallStack, Backend backend) =>
[HWType]
-> HWType
-> ([Text] -> Text)
-> [Text]
-> TExpr
-> State (BlockState backend) [TExpr]
outputFn ((Text -> HWType) -> [Text] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (HWType -> Text -> HWType
forall a b. a -> b -> a
const HWType
Bit) [Text]
inNames) HWType
Bool
((Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
" and " ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
i -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = '1')")) [Text]
inNames
outputCoerce
:: (HasCallStack, Backend backend)
=> HWType
-> HWType
-> (Identifier -> Identifier)
-> Identifier
-> TExpr
-> State (BlockState backend) TExpr
outputCoerce :: HWType
-> HWType
-> (Text -> Text)
-> Text
-> TExpr
-> State (BlockState backend) TExpr
outputCoerce HWType
fromType HWType
toType Text -> Text
exprStringFn Text
inName TExpr
expr_
| TExpr HWType
outType (Identifier Text
outName Maybe Modifier
Nothing) <- TExpr
expr_
, HWType
outType HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
toType = do
Text
inName' <- Text -> State (BlockState backend) Text
forall backend.
Backend backend =>
Text -> State (BlockState backend) Text
newName Text
inName
let exprIdent :: Expr
exprIdent = Text -> Maybe Modifier -> Expr
Identifier (Text -> Text
exprStringFn Text
inName') Maybe Modifier
forall a. Maybe a
Nothing
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Maybe Text -> Text -> HWType -> Declaration
NetDecl Maybe Text
forall a. Maybe a
Nothing Text
inName' HWType
fromType)
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Text -> Expr -> Declaration
Assignment Text
outName Expr
exprIdent)
TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (HWType -> Expr -> TExpr
TExpr HWType
fromType (Text -> Maybe Modifier -> Expr
Identifier Text
inName' Maybe Modifier
forall a. Maybe a
Nothing))
outputCoerce HWType
_ HWType
toType Text -> Text
_ Text
_ TExpr
texpr = String -> State (BlockState backend) TExpr
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) TExpr)
-> String -> State (BlockState backend) TExpr
forall a b. (a -> b) -> a -> b
$ String
"outputCoerce: the expression " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TExpr -> String
forall a. Show a => a -> String
show TExpr
texpr
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must be an Identifier with type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HWType -> String
forall a. Show a => a -> String
show HWType
toType
outputFn
:: (HasCallStack, Backend backend)
=> [HWType]
-> HWType
-> ([Identifier] -> Identifier)
-> [Identifier]
-> TExpr
-> State (BlockState backend) [TExpr]
outputFn :: [HWType]
-> HWType
-> ([Text] -> Text)
-> [Text]
-> TExpr
-> State (BlockState backend) [TExpr]
outputFn [HWType]
fromTypes HWType
toType [Text] -> Text
exprFn [Text]
inNames (TExpr HWType
outType (Identifier Text
outName Maybe Modifier
Nothing))
| HWType
outType HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
toType = do
[Text]
inNames' <- (Text -> StateT (BlockState backend) Identity Text)
-> [Text] -> StateT (BlockState backend) Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> StateT (BlockState backend) Identity Text
forall backend.
Backend backend =>
Text -> State (BlockState backend) Text
newName [Text]
inNames
let exprIdent :: Expr
exprIdent = Text -> Maybe Modifier -> Expr
Identifier ([Text] -> Text
exprFn [Text]
inNames') Maybe Modifier
forall a. Maybe a
Nothing
Getting
(Sequenced () (StateT (BlockState backend) Identity))
[State (BlockState backend) ()]
(State (BlockState backend) ())
-> [State (BlockState backend) ()] -> State (BlockState backend) ()
forall (m :: Type -> Type) a s.
Monad m =>
Getting (Sequenced a m) s (m a) -> s -> m ()
sequenceOf_ Getting
(Sequenced () (StateT (BlockState backend) Identity))
[State (BlockState backend) ()]
(State (BlockState backend) ())
forall s t a b. Each s t a b => Traversal s t a b
each [ Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Maybe Text -> Text -> HWType -> Declaration
NetDecl Maybe Text
forall a. Maybe a
Nothing Text
nm HWType
t)
| (Text
nm,HWType
t) <- [Text] -> [HWType] -> [(Text, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
inNames' [HWType]
fromTypes ]
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Text -> Expr -> Declaration
Assignment Text
outName Expr
exprIdent)
[TExpr] -> State (BlockState backend) [TExpr]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [ HWType -> Expr -> TExpr
TExpr HWType
t (Text -> Maybe Modifier -> Expr
Identifier Text
nm Maybe Modifier
forall a. Maybe a
Nothing)
| (Text
nm,HWType
t) <- [Text] -> [HWType] -> [(Text, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
inNames' [HWType]
fromTypes ]
outputFn [HWType]
_ HWType
outType [Text] -> Text
_ [Text]
_ TExpr
texpr =
String -> State (BlockState backend) [TExpr]
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) [TExpr])
-> String -> State (BlockState backend) [TExpr]
forall a b. (a -> b) -> a -> b
$ String
"outputFn: the expression " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TExpr -> String
forall a. Show a => a -> String
show TExpr
texpr
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must be an Identifier with type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HWType -> String
forall a. Show a => a -> String
show HWType
outType
vec
:: (HasCallStack, Backend backend)
=> [TExpr]
-> State (BlockState backend) TExpr
vec :: [TExpr] -> State (BlockState backend) TExpr
vec els :: [TExpr]
els@(TExpr
el:[TExpr]
_)
| (TExpr -> Bool) -> [TExpr] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (\TExpr
e -> TExpr -> HWType
ety TExpr
e HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== TExpr -> HWType
ety TExpr
el) [TExpr]
els
= TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (HWType -> Expr -> TExpr
TExpr (Int -> HWType -> HWType
Vector ([TExpr] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [TExpr]
els) (TExpr -> HWType
ety TExpr
el)) Expr
theVec)
| Bool
otherwise
= String -> State (BlockState backend) TExpr
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) TExpr)
-> String -> State (BlockState backend) TExpr
forall a b. (a -> b) -> a -> b
$ String
"vec: elements not of same type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TExpr] -> String
forall a. Show a => a -> String
show [TExpr]
els
where
theVec :: Expr
theVec = Int -> HWType -> [Expr] -> Expr
mkVectorChain ([TExpr] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [TExpr]
els) (TExpr -> HWType
ety TExpr
el) ((TExpr -> Expr) -> [TExpr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map TExpr -> Expr
eex [TExpr]
els)
vec [] = String -> State (BlockState backend) TExpr
forall a. HasCallStack => String -> a
error String
"vec: can't be used on empty lists"
tuple :: [TExpr] -> TExpr
tuple :: [TExpr] -> TExpr
tuple [] = String -> TExpr
forall a. HasCallStack => String -> a
error (String -> TExpr) -> String -> TExpr
forall a b. (a -> b) -> a -> b
$ String
"nTuple: Cannot create empty tuple"
tuple [TExpr
_] =
String -> TExpr
forall a. HasCallStack => String -> a
error (String -> TExpr) -> String -> TExpr
forall a b. (a -> b) -> a -> b
$ String
"nTuple: Cannot create 1-tuple"
tuple [TExpr]
els =
HWType -> Expr -> TExpr
TExpr HWType
tupTy (HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
tupTy ((HWType, Int) -> Modifier
DC (HWType
tupTy,Int
0)) ((TExpr -> Expr) -> [TExpr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map TExpr -> Expr
eex [TExpr]
els))
where
commas :: Text
commas = Int -> Text -> Text
Text.replicate ([TExpr] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [TExpr]
els Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
","
tupTy :: HWType
tupTy = Text -> Maybe [Text] -> [HWType] -> HWType
Product (Text
"GHC.Tuple.(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commas Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") Maybe [Text]
forall a. Maybe a
Nothing ((TExpr -> HWType) -> [TExpr] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map TExpr -> HWType
ety [TExpr]
els)
getStr :: TExpr -> Maybe String
getStr :: TExpr -> Maybe String
getStr (TExpr HWType
_ Expr
e) = Expr -> Maybe String
exprToString Expr
e
getBool :: TExpr -> Maybe Bool
getBool :: TExpr -> Maybe Bool
getBool (TExpr HWType
_ (Literal Maybe (HWType, Int)
_ (BoolLit Bool
b))) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
getBool TExpr
_ = Maybe Bool
forall a. Maybe a
Nothing
tExprToInteger :: TExpr -> Maybe Integer
tExprToInteger :: TExpr -> Maybe Integer
tExprToInteger (TExpr HWType
_ Expr
e) = Expr -> Maybe Integer
exprToInteger Expr
e
exprToInteger :: Expr -> Maybe Integer
exprToInteger :: Expr -> Maybe Integer
exprToInteger (DataCon HWType
_ Modifier
_ [Expr
n]) = Expr -> Maybe Integer
exprToInteger Expr
n
exprToInteger (Literal Maybe (HWType, Int)
_ (NumLit Integer
n)) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
exprToInteger Expr
_ = Maybe Integer
forall a. Maybe a
Nothing
toBV
:: Backend backend
=> Identifier
-> TExpr
-> State (BlockState backend) TExpr
toBV :: Text -> TExpr -> State (BlockState backend) TExpr
toBV Text
bvName TExpr
a = case TExpr
a of
TExpr BitVector{} Expr
_ -> TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
a
TExpr HWType
aTy Expr
aExpr -> Text -> TExpr -> State (BlockState backend) TExpr
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) TExpr
assign Text
bvName (TExpr -> State (BlockState backend) TExpr)
-> TExpr -> State (BlockState backend) TExpr
forall a b. (a -> b) -> a -> b
$
HWType -> Expr -> TExpr
TExpr (Int -> HWType
BitVector (HWType -> Int
typeSize HWType
aTy)) (Maybe Text -> HWType -> Bool -> Expr -> Expr
ConvBV Maybe Text
forall a. Maybe a
Nothing HWType
aTy Bool
True Expr
aExpr)
fromBV
:: (HasCallStack, Backend backend)
=> Identifier
-> TExpr
-> State (BlockState backend) TExpr
fromBV :: Text -> TExpr -> State (BlockState backend) TExpr
fromBV Text
_ a :: TExpr
a@(TExpr BitVector{} Expr
_) = TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
a
fromBV Text
bvName (TExpr HWType
aTy (Identifier Text
aName Maybe Modifier
Nothing)) = do
Text
bvName' <- Text -> State (BlockState backend) Text
forall backend.
Backend backend =>
Text -> State (BlockState backend) Text
newName Text
bvName
let bvExpr :: Expr
bvExpr = Maybe Text -> HWType -> Bool -> Expr -> Expr
ConvBV Maybe Text
forall a. Maybe a
Nothing HWType
aTy Bool
False (Text -> Maybe Modifier -> Expr
Identifier Text
bvName' Maybe Modifier
forall a. Maybe a
Nothing)
bvTy :: HWType
bvTy = Int -> HWType
BitVector (HWType -> Int
typeSize HWType
aTy)
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Maybe Text -> Text -> HWType -> Declaration
NetDecl Maybe Text
forall a. Maybe a
Nothing Text
bvName' HWType
bvTy)
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Text -> Expr -> Declaration
Assignment Text
aName Expr
bvExpr)
TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (HWType -> Expr -> TExpr
TExpr HWType
bvTy (Text -> Maybe Modifier -> Expr
Identifier Text
bvName' Maybe Modifier
forall a. Maybe a
Nothing))
fromBV Text
_ TExpr
texpr = String -> State (BlockState backend) TExpr
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) TExpr)
-> String -> State (BlockState backend) TExpr
forall a b. (a -> b) -> a -> b
$
String
"fromBV: the expression " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TExpr -> String
forall a. Show a => a -> String
show TExpr
texpr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"must be an Indentifier"
clog2 :: Num i => Integer -> i
clog2 :: Integer -> i
clog2 = Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> i) -> (Integer -> Int) -> Integer -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> (Integer -> Maybe Int) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Maybe Int
clogBase Integer
2
tySize :: Num i => HWType -> i
tySize :: HWType -> i
tySize = Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> i) -> (HWType -> Int) -> HWType -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
typeSize
data LitHDL
= B Bool
| S String
| I Integer
deriving Int -> LitHDL -> String -> String
[LitHDL] -> String -> String
LitHDL -> String
(Int -> LitHDL -> String -> String)
-> (LitHDL -> String)
-> ([LitHDL] -> String -> String)
-> Show LitHDL
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LitHDL] -> String -> String
$cshowList :: [LitHDL] -> String -> String
show :: LitHDL -> String
$cshow :: LitHDL -> String
showsPrec :: Int -> LitHDL -> String -> String
$cshowsPrec :: Int -> LitHDL -> String -> String
Show
instance Num LitHDL where
+ :: LitHDL -> LitHDL -> LitHDL
(+) = LitHDL -> LitHDL -> LitHDL
forall a. HasCallStack => a
undefined
* :: LitHDL -> LitHDL -> LitHDL
(*) = LitHDL -> LitHDL -> LitHDL
forall a. HasCallStack => a
undefined
abs :: LitHDL -> LitHDL
abs = LitHDL -> LitHDL
forall a. HasCallStack => a
undefined
signum :: LitHDL -> LitHDL
signum = LitHDL -> LitHDL
forall a. HasCallStack => a
undefined
negate :: LitHDL -> LitHDL
negate = LitHDL -> LitHDL
forall a. HasCallStack => a
undefined
fromInteger :: Integer -> LitHDL
fromInteger = Integer -> LitHDL
I
instance IsString LitHDL where
fromString :: String -> LitHDL
fromString = String -> LitHDL
S
instHO
:: Backend backend
=> BlackBoxContext
-> Int
-> (HWType, BlackBoxTemplate)
-> [(TExpr, BlackBoxTemplate)]
-> State (BlockState backend) TExpr
instHO :: BlackBoxContext
-> Int
-> (HWType, BlackBoxTemplate)
-> [(TExpr, BlackBoxTemplate)]
-> State (BlockState backend) TExpr
instHO BlackBoxContext
bbCtx Int
fPos (HWType
resTy, BlackBoxTemplate
bbResTy) [(TExpr, BlackBoxTemplate)]
argsWithTypes = do
let ([TExpr]
args0, [BlackBoxTemplate]
argTypes) = [(TExpr, BlackBoxTemplate)] -> ([TExpr], [BlackBoxTemplate])
forall a b. [(a, b)] -> ([a], [b])
unzip [(TExpr, BlackBoxTemplate)]
argsWithTypes
Int
fSubPos <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int)
-> (IntMap Int -> Maybe Int) -> IntMap Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
fPos (IntMap Int -> Int)
-> StateT (BlockState backend) Identity (IntMap Int)
-> StateT (BlockState backend) Identity Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (IntMap Int) (BlockState backend) (IntMap Int)
-> StateT (BlockState backend) Identity (IntMap Int)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (IntMap Int) (BlockState backend) (IntMap Int)
forall backend. Lens' (BlockState backend) (IntMap Int)
bsHigherOrderCalls
(IntMap Int -> Identity (IntMap Int))
-> BlockState backend -> Identity (BlockState backend)
forall backend. Lens' (BlockState backend) (IntMap Int)
bsHigherOrderCalls ((IntMap Int -> Identity (IntMap Int))
-> BlockState backend -> Identity (BlockState backend))
-> (IntMap Int -> IntMap Int)
-> StateT (BlockState backend) Identity ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fPos (Int -> Int
forall a. Enum a => a -> a
succ Int
fSubPos)
let
ctxName :: Text
ctxName = [Text] -> Text
forall a. [a] -> a
last ((Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') (BlackBoxContext -> Text
bbName BlackBoxContext
bbCtx))
baseArgName :: Text
baseArgName = Text
ctxName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ho" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. TextShow a => a -> Text
showt Int
fPos Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. TextShow a => a -> Text
showt Int
fSubPos
argName :: a -> Text
argName a
n = Text
baseArgName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_arg" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. TextShow a => a -> Text
showt a
n
[Text]
args1 <- (Int -> TExpr -> StateT (BlockState backend) Identity Text)
-> [Int] -> [TExpr] -> StateT (BlockState backend) Identity [Text]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
argN -> Text -> TExpr -> StateT (BlockState backend) Identity Text
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) Text
toIdentifier' (Int -> Text
forall a. TextShow a => a -> Text
argName Int
argN)) [(Int
0 :: Int)..] [TExpr]
args0
let
args2 :: [BlackBoxTemplate]
args2 = (Text -> BlackBoxTemplate) -> [Text] -> [BlackBoxTemplate]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> BlackBoxTemplate
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Element -> BlackBoxTemplate)
-> (Text -> Element) -> Text -> BlackBoxTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Element
Text (Text -> Element) -> (Text -> Text) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.fromStrict) [Text]
args1
args3 :: [(BlackBoxTemplate, BlackBoxTemplate)]
args3 = [BlackBoxTemplate]
-> [BlackBoxTemplate] -> [(BlackBoxTemplate, BlackBoxTemplate)]
forall a b. [a] -> [b] -> [(a, b)]
zip [BlackBoxTemplate]
args2 [BlackBoxTemplate]
argTypes
resWireOrReg :: WireOrReg
resWireOrReg =
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
fPos (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)]
_ -> String -> WireOrReg
forall a. HasCallStack => String -> a
error String
"internal error"
Text
resName <- Text
-> WireOrReg -> HWType -> StateT (BlockState backend) Identity Text
forall backend.
Backend backend =>
Text -> WireOrReg -> HWType -> State (BlockState backend) Text
declare' (Text
ctxName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ho" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. TextShow a => a -> Text
showt Int
fPos Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. TextShow a => a -> Text
showt Int
fSubPos Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_res") WireOrReg
resWireOrReg HWType
resTy
let res :: (BlackBoxTemplate, BlackBoxTemplate)
res = ([Text -> Element
Text (Text -> Text
LText.fromStrict Text
resName)], BlackBoxTemplate
bbResTy)
let component :: Element
component = Decl -> Element
Component (Int -> Int -> [(BlackBoxTemplate, BlackBoxTemplate)] -> Decl
Decl Int
fPos Int
fSubPos ((BlackBoxTemplate, BlackBoxTemplate)
res(BlackBoxTemplate, BlackBoxTemplate)
-> [(BlackBoxTemplate, BlackBoxTemplate)]
-> [(BlackBoxTemplate, BlackBoxTemplate)]
forall a. a -> [a] -> [a]
:[(BlackBoxTemplate, BlackBoxTemplate)]
args3))
Doc
rendered0 <-
LensLike'
(Zoomed (StateT backend Identity) Doc) (BlockState backend) backend
-> StateT backend Identity Doc
-> StateT (BlockState backend) Identity Doc
forall (m :: Type -> Type) (n :: Type -> Type) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
(Zoomed (StateT backend Identity) Doc) (BlockState backend) backend
forall backend backend.
Lens (BlockState backend) (BlockState backend) backend backend
bsBackend (Text -> StateT backend Identity Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> StateT backend Identity Doc)
-> StateT backend Identity Text -> StateT backend Identity Doc
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (BlackBoxContext -> Element -> State backend (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
bbCtx Element
component State backend (Int -> Text)
-> StateT backend Identity Int -> StateT backend Identity Text
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Int -> StateT backend 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 (BlockState backend) Identity ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Declaration -> StateT (BlockState backend) Identity ())
-> Declaration -> StateT (BlockState backend) Identity ()
forall a b. (a -> b) -> a -> b
$
Text
-> [BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> Declaration
BlackBoxD
(Text
"__INST_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlackBoxContext -> Text
bbName BlackBoxContext
bbCtx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_BB_INTERNAL__") [] [] []
(BlackBoxTemplate -> BlackBox
BBTemplate [Text -> Element
Text Text
rendered1])
(Text -> BlackBoxContext
emptyBBContext (Text
"__INST_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlackBoxContext -> Text
bbName BlackBoxContext
bbCtx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_BB_INTERNAL__"))
TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (HWType -> Expr -> TExpr
TExpr HWType
resTy (Text -> Maybe Modifier -> Expr
Identifier Text
resName Maybe Modifier
forall a. Maybe a
Nothing))
instDecl
:: Backend backend
=> EntityOrComponent
-> Identifier
-> Identifier
-> [(Text, LitHDL)]
-> [(Text, TExpr)]
-> [(Text, TExpr)]
-> State (BlockState backend) ()
instDecl :: EntityOrComponent
-> Text
-> Text
-> [(Text, LitHDL)]
-> [(Text, TExpr)]
-> [(Text, TExpr)]
-> State (BlockState backend) ()
instDecl EntityOrComponent
entOrComp Text
compName Text
instLbl [(Text, LitHDL)]
attrs [(Text, TExpr)]
inPorts [(Text, TExpr)]
outPorts = do
[(Expr, PortDirection, HWType, Expr)]
inPorts' <- ((Text, TExpr)
-> StateT
(BlockState backend) Identity (Expr, PortDirection, HWType, Expr))
-> [(Text, TExpr)]
-> StateT
(BlockState backend) Identity [(Expr, PortDirection, HWType, Expr)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PortDirection
-> (Text, TExpr)
-> StateT
(BlockState backend) Identity (Expr, PortDirection, HWType, Expr)
forall backend b.
Backend backend =>
b
-> (Text, TExpr)
-> StateT (BlockState backend) Identity (Expr, b, HWType, Expr)
mkPort PortDirection
In) [(Text, TExpr)]
inPorts
[(Expr, PortDirection, HWType, Expr)]
outPorts' <- ((Text, TExpr)
-> StateT
(BlockState backend) Identity (Expr, PortDirection, HWType, Expr))
-> [(Text, TExpr)]
-> StateT
(BlockState backend) Identity [(Expr, PortDirection, HWType, Expr)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PortDirection
-> (Text, TExpr)
-> StateT
(BlockState backend) Identity (Expr, PortDirection, HWType, Expr)
forall backend b.
Backend backend =>
b
-> (Text, TExpr)
-> StateT (BlockState backend) Identity (Expr, b, HWType, Expr)
mkPort PortDirection
Out) [(Text, TExpr)]
outPorts
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Declaration -> State (BlockState backend) ())
-> Declaration -> State (BlockState backend) ()
forall a b. (a -> b) -> a -> b
$ EntityOrComponent
-> Maybe Text
-> Text
-> Text
-> [(Expr, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
-> Declaration
InstDecl EntityOrComponent
entOrComp Maybe Text
forall a. Maybe a
Nothing Text
compName Text
instLbl ([(Text, LitHDL)] -> [(Expr, HWType, Expr)]
mkAttrs [(Text, LitHDL)]
attrs) ([(Expr, PortDirection, HWType, Expr)]
inPorts' [(Expr, PortDirection, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
forall a. [a] -> [a] -> [a]
++ [(Expr, PortDirection, HWType, Expr)]
outPorts')
where
mkPort :: b
-> (Text, TExpr)
-> StateT (BlockState backend) Identity (Expr, b, HWType, Expr)
mkPort b
inOrOut (Text
nm, TExpr
pExpr) = do
TExpr HWType
ty Expr
pExpr' <- Text -> TExpr -> State (BlockState backend) TExpr
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) TExpr
toIdentifier (Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_port") TExpr
pExpr
(Expr, b, HWType, Expr)
-> StateT (BlockState backend) Identity (Expr, b, HWType, Expr)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text -> Maybe Modifier -> Expr
Identifier Text
nm Maybe Modifier
forall a. Maybe a
Nothing, b
inOrOut, HWType
ty, Expr
pExpr')
mkAttrs :: [(Text.Text, LitHDL)] -> [(Expr, HWType, Expr)]
mkAttrs :: [(Text, LitHDL)] -> [(Expr, HWType, Expr)]
mkAttrs = ((Text, LitHDL) -> (Expr, HWType, Expr))
-> [(Text, LitHDL)] -> [(Expr, HWType, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
s, LitHDL
ty) -> (Text -> Maybe Modifier -> Expr
Identifier Text
s Maybe Modifier
forall a. Maybe a
Nothing, LitHDL -> HWType
hdlTy LitHDL
ty, LitHDL -> Expr
litExpr LitHDL
ty))
litExpr :: LitHDL -> Expr
litExpr :: LitHDL -> Expr
litExpr (B Bool
b) = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
b)
litExpr (S String
s) = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (String -> Literal
StringLit String
s)
litExpr (I Integer
i) = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Integer -> Literal
NumLit Integer
i)
hdlTy :: LitHDL -> HWType
hdlTy :: LitHDL -> HWType
hdlTy = \case
B{} -> HWType
Bool
S{} -> HWType
String
I{} -> HWType
Integer
viaAnnotatedSignal
:: (HasCallStack, Backend backend)
=> Text
-> TExpr
-> TExpr
-> [Attr']
-> State (BlockState backend) ()
viaAnnotatedSignal :: Text -> TExpr -> TExpr -> [Attr'] -> State (BlockState backend) ()
viaAnnotatedSignal Text
sigNm (TExpr HWType
fromTy Expr
fromExpr) (TExpr HWType
toTy (Identifier Text
outNm Maybe Modifier
Nothing)) [Attr']
attrs
| HWType
fromTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
toTy = do
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Maybe Text -> Text -> HWType -> Declaration
NetDecl Maybe Text
forall a. Maybe a
Nothing Text
sigNm ([Attr'] -> HWType -> HWType
Annotated [Attr']
attrs HWType
fromTy))
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Text -> Expr -> Declaration
Assignment Text
sigNm Expr
fromExpr)
Declaration -> State (BlockState backend) ()
forall backend. Declaration -> State (BlockState backend) ()
addDeclaration (Text -> Expr -> Declaration
Assignment Text
outNm (Text -> Maybe Modifier -> Expr
Identifier Text
sigNm Maybe Modifier
forall a. Maybe a
Nothing))
viaAnnotatedSignal Text
_ TExpr
inTExpr outTExpr :: TExpr
outTExpr@(TExpr HWType
_ (Identifier Text
_ Maybe Modifier
_)) [Attr']
_ =
String -> State (BlockState backend) ()
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) ())
-> String -> State (BlockState backend) ()
forall a b. (a -> b) -> a -> b
$ String
"viaAnnotatedSignal: The in and out expressions \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TExpr -> String
forall a. Show a => a -> String
show TExpr
inTExpr String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"\" and \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TExpr -> String
forall a. Show a => a -> String
show TExpr
outTExpr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" have non-matching types."
viaAnnotatedSignal Text
_ TExpr
_ TExpr
outTExpr [Attr']
_ =
String -> State (BlockState backend) ()
forall a. HasCallStack => String -> a
error (String -> State (BlockState backend) ())
-> String -> State (BlockState backend) ()
forall a b. (a -> b) -> a -> b
$ String
"viaAnnotatedSignal: The out expression \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TExpr -> String
forall a. Show a => a -> String
show TExpr
outTExpr String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"\" must be an Identifier."
tInputs :: BlackBoxContext -> [(TExpr, HWType)]
tInputs :: BlackBoxContext -> [(TExpr, HWType)]
tInputs = ((Expr, HWType, Bool) -> (TExpr, HWType))
-> [(Expr, HWType, Bool)] -> [(TExpr, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Expr
x, HWType
t, Bool
_) -> (HWType -> Expr -> TExpr
TExpr HWType
t Expr
x, HWType
t)) ([(Expr, HWType, Bool)] -> [(TExpr, HWType)])
-> (BlackBoxContext -> [(Expr, HWType, Bool)])
-> BlackBoxContext
-> [(TExpr, HWType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs
tResult :: BlackBoxContext -> TExpr
tResult :: BlackBoxContext -> TExpr
tResult = (\(Expr
x,HWType
t) -> HWType -> Expr -> TExpr
TExpr HWType
t Expr
x) ((Expr, HWType) -> TExpr)
-> (BlackBoxContext -> (Expr, HWType)) -> BlackBoxContext -> TExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> (Expr, HWType)
bbResult
toIdentifier'
:: Backend backend
=> Identifier
-> TExpr
-> State (BlockState backend) Identifier
toIdentifier' :: Text -> TExpr -> State (BlockState backend) Text
toIdentifier' Text
_ (TExpr HWType
_ (Identifier Text
aExpr Maybe Modifier
Nothing)) = Text -> State (BlockState backend) Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
aExpr
toIdentifier' Text
nm TExpr
texp = do
~(TExpr HWType
_ (Identifier Text
nm' Maybe Modifier
Nothing)) <- Text -> TExpr -> State (BlockState backend) TExpr
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) TExpr
assign Text
nm TExpr
texp
Text -> State (BlockState backend) Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
nm'
toIdentifier
:: Backend backend
=> Identifier
-> TExpr
-> State (BlockState backend) TExpr
toIdentifier :: Text -> TExpr -> State (BlockState backend) TExpr
toIdentifier Text
nm TExpr
texp = do
Text
id' <- Text -> TExpr -> State (BlockState backend) Text
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) Text
toIdentifier' Text
nm TExpr
texp
TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (HWType -> Expr -> TExpr
TExpr (TExpr -> HWType
ety TExpr
texp) (Text -> Maybe Modifier -> Expr
Identifier Text
id' Maybe Modifier
forall a. Maybe a
Nothing))
andExpr
:: Backend backend
=> Identifier
-> TExpr
-> TExpr
-> State (BlockState backend) TExpr
andExpr :: Text -> TExpr -> TExpr -> State (BlockState backend) TExpr
andExpr Text
_ TExpr
T TExpr
bExpr = TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
bExpr
andExpr Text
_ TExpr
F TExpr
_ = TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
F
andExpr Text
_ TExpr
aExpr TExpr
T = TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
aExpr
andExpr Text
_ TExpr
_ TExpr
F = TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
F
andExpr Text
nm TExpr
a TExpr
b = do
Text
aIdent <- Text -> TExpr -> State (BlockState backend) Text
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) Text
toIdentifier' (Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_a") TExpr
a
Text
bIdent <- Text -> TExpr -> State (BlockState backend) Text
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) Text
toIdentifier' (Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_b") TExpr
b
Text
andTxt <-
LensLike' (Const HDL) (BlockState backend) backend
-> (backend -> HDL) -> StateT (BlockState backend) Identity HDL
forall s (m :: Type -> Type) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const HDL) (BlockState backend) backend
forall backend backend.
Lens (BlockState backend) (BlockState backend) backend backend
bsBackend backend -> HDL
forall state. Backend state => state -> HDL
hdlKind StateT (BlockState backend) Identity HDL
-> (HDL -> Text) -> State (BlockState backend) Text
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
HDL
VHDL -> Text
aIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bIdent
HDL
Verilog -> Text
aIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" && " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bIdent
HDL
SystemVerilog -> Text
aIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" && " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bIdent
Text -> TExpr -> State (BlockState backend) TExpr
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) TExpr
assign Text
nm (TExpr -> State (BlockState backend) TExpr)
-> TExpr -> State (BlockState backend) TExpr
forall a b. (a -> b) -> a -> b
$ HWType -> Expr -> TExpr
TExpr HWType
Bool (Text -> Maybe Modifier -> Expr
Identifier Text
andTxt Maybe Modifier
forall a. Maybe a
Nothing)
notExpr
:: Backend backend
=> Identifier
-> TExpr
-> State (BlockState backend) TExpr
notExpr :: Text -> TExpr -> State (BlockState backend) TExpr
notExpr Text
_ TExpr
T = TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
F
notExpr Text
_ TExpr
F = TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TExpr
T
notExpr Text
nm TExpr
aExpr = do
Text
aIdent <- Text -> TExpr -> State (BlockState backend) Text
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) Text
toIdentifier' (Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_a") TExpr
aExpr
Text
notTxt <- LensLike' (Const HDL) (BlockState backend) backend
-> (backend -> HDL) -> StateT (BlockState backend) Identity HDL
forall s (m :: Type -> Type) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const HDL) (BlockState backend) backend
forall backend backend.
Lens (BlockState backend) (BlockState backend) backend backend
bsBackend backend -> HDL
forall state. Backend state => state -> HDL
hdlKind StateT (BlockState backend) Identity HDL
-> (HDL -> Text) -> State (BlockState backend) Text
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
HDL
VHDL -> Text
"not " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aIdent
HDL
Verilog -> Text
"! " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aIdent
HDL
SystemVerilog -> Text
"! " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aIdent
Text -> TExpr -> State (BlockState backend) TExpr
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) TExpr
assign Text
nm (TExpr -> State (BlockState backend) TExpr)
-> TExpr -> State (BlockState backend) TExpr
forall a b. (a -> b) -> a -> b
$ HWType -> Expr -> TExpr
TExpr HWType
Bit (Text -> Maybe Modifier -> Expr
Identifier Text
notTxt Maybe Modifier
forall a. Maybe a
Nothing)
pureToBV
:: Identifier
-> Int
-> TExpr
-> State (BlockState VHDLState) TExpr
pureToBV :: Text -> Int -> TExpr -> State (BlockState VHDLState) TExpr
pureToBV Text
nm Int
n TExpr
arg = do
Text
arg' <- Text -> TExpr -> State (BlockState VHDLState) Text
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) Text
toIdentifier' Text
nm TExpr
arg
let text :: Text
text = Text
"(0 to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. TextShow a => a -> Text
showt Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
arg' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
Text -> TExpr -> State (BlockState VHDLState) TExpr
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) TExpr
assign Text
nm (TExpr -> State (BlockState VHDLState) TExpr)
-> TExpr -> State (BlockState VHDLState) TExpr
forall a b. (a -> b) -> a -> b
$ HWType -> Expr -> TExpr
TExpr (Int -> HWType
BitVector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) (Text -> Maybe Modifier -> Expr
Identifier Text
text Maybe Modifier
forall a. Maybe a
Nothing)
pureToBVResized
:: Identifier
-> Int
-> TExpr
-> State (BlockState VHDLState) TExpr
pureToBVResized :: Text -> Int -> TExpr -> State (BlockState VHDLState) TExpr
pureToBVResized Text
nm Int
n TExpr
arg = do
Text
arg' <- Text -> TExpr -> State (BlockState VHDLState) Text
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) Text
toIdentifier' Text
nm TExpr
arg
let text :: Text
text = Text
"std_logic_vector(resize(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
arg' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. TextShow a => a -> Text
showt Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"))"
Text -> TExpr -> State (BlockState VHDLState) TExpr
forall backend.
Backend backend =>
Text -> TExpr -> State (BlockState backend) TExpr
assign Text
nm (TExpr -> State (BlockState VHDLState) TExpr)
-> TExpr -> State (BlockState VHDLState) TExpr
forall a b. (a -> b) -> a -> b
$ HWType -> Expr -> TExpr
TExpr (Int -> HWType
BitVector Int
n) (Text -> Maybe Modifier -> Expr
Identifier Text
text Maybe Modifier
forall a. Maybe a
Nothing)
open
:: Backend backend
=> HWType
-> State (BlockState backend) TExpr
open :: HWType -> State (BlockState backend) TExpr
open HWType
hwType = TExpr -> State (BlockState backend) TExpr
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TExpr -> State (BlockState backend) TExpr)
-> TExpr -> State (BlockState backend) TExpr
forall a b. (a -> b) -> a -> b
$ HWType -> Expr -> TExpr
TExpr HWType
hwType (Text -> Maybe Modifier -> Expr
Identifier Text
"open" Maybe Modifier
forall a. Maybe a
Nothing)