Copyright | (C) 2019 Myrtle Software Ltd. 2020-2023 QBayLogic B.V. 2021 Myrtle.ai 2022-2023 Google Inc |
---|---|
License | BSD2 (see the file LICENSE) |
Maintainer | QBayLogic B.V. <devops@qbaylogic.com> |
Safe Haskell | None |
Language | Haskell2010 |
This module contains a mini dsl for creating haskell blackbox instantiations.
Synopsis
- data BlackBoxHaskellOpts = BlackBoxHaskellOpts {
- bo_ignoredArguments :: [Int]
- bo_supportedHdls :: [HDL]
- bo_multiResult :: Bool
- blackBoxHaskell :: Name -> Name -> BlackBoxHaskellOpts -> Primitive
- data BlockState backend = BlockState {
- _bsDeclarations :: [Declaration]
- _bsHigherOrderCalls :: IntMap Int
- _bsBackend :: backend
- data TExpr = TExpr {}
- addDeclaration :: Declaration -> State (BlockState backend) ()
- assign :: Backend backend => Text -> TExpr -> State (BlockState backend) TExpr
- compInBlock :: forall backend. Backend backend => Text -> [(Text, HWType)] -> [(Text, HWType)] -> State (BlockState backend) ()
- declaration :: Backend backend => Text -> State (BlockState backend) () -> State backend Doc
- declarationReturn :: Backend backend => BlackBoxContext -> Text -> State (BlockState backend) [TExpr] -> State backend Doc
- declare :: Backend backend => Text -> HWType -> State (BlockState backend) TExpr
- declareN :: Backend backend => Text -> [HWType] -> State (BlockState backend) [TExpr]
- instDecl :: forall backend. Backend backend => EntityOrComponent -> Identifier -> Identifier -> [(Text, TExpr)] -> [(Text, TExpr)] -> [(Text, TExpr)] -> State (BlockState backend) ()
- instHO :: Backend backend => BlackBoxContext -> Int -> (HWType, BlackBoxTemplate) -> [(TExpr, BlackBoxTemplate)] -> State (BlockState backend) TExpr
- viaAnnotatedSignal :: (HasCallStack, Backend backend) => Identifier -> TExpr -> TExpr -> [Attr Text] -> State (BlockState backend) ()
- bvLit :: Int -> Integer -> TExpr
- data LitHDL
- pattern High :: TExpr
- pattern Low :: TExpr
- constructProduct :: HWType -> [TExpr] -> TExpr
- tuple :: HasCallStack => [TExpr] -> TExpr
- vec :: (HasCallStack, Backend backend) => [TExpr] -> State (BlockState backend) TExpr
- tInputs :: BlackBoxContext -> [(TExpr, HWType)]
- tResults :: BlackBoxContext -> [TExpr]
- getStr :: TExpr -> Maybe String
- getBool :: TExpr -> Maybe Bool
- getVec :: TExpr -> Maybe [TExpr]
- exprToInteger :: Expr -> Maybe Integer
- tExprToInteger :: TExpr -> Maybe Integer
- deconstructProduct :: (HasCallStack, Backend backend) => TExpr -> [Text] -> State (BlockState backend) [TExpr]
- untuple :: (HasCallStack, Backend backend) => TExpr -> [Text] -> State (BlockState backend) [TExpr]
- unvec :: (HasCallStack, Backend backend) => Text -> TExpr -> State (BlockState backend) [TExpr]
- deconstructMaybe :: (HasCallStack, Backend backend) => TExpr -> (Text, Text) -> State (BlockState backend) (TExpr, TExpr)
- bitCoerce :: (HasCallStack, Backend backend) => Text -> HWType -> TExpr -> State (BlockState backend) TExpr
- toBV :: Backend backend => Text -> TExpr -> State (BlockState backend) TExpr
- toBvWithAttrs :: Backend backend => [Attr Text] -> Text -> TExpr -> State (BlockState backend) TExpr
- fromBV :: (HasCallStack, Backend backend) => Text -> HWType -> TExpr -> State (BlockState backend) TExpr
- enableToBit :: (HasCallStack, Backend backend) => Text -> TExpr -> State (BlockState backend) TExpr
- boolToBit :: (HasCallStack, Backend backend) => Text -> TExpr -> State (BlockState backend) TExpr
- boolFromBit :: (HasCallStack, Backend backend) => Text -> TExpr -> State (BlockState backend) TExpr
- boolFromBitVector :: Size -> Text -> TExpr -> State (BlockState VHDLState) TExpr
- unsignedFromBitVector :: (HasCallStack, Backend backend) => Text -> TExpr -> State (BlockState backend) TExpr
- boolFromBits :: [Text] -> TExpr -> State (BlockState VHDLState) [TExpr]
- unsafeToActiveHigh :: Backend backend => Text -> TExpr -> State (BlockState backend) TExpr
- unsafeToActiveLow :: Backend backend => Text -> TExpr -> State (BlockState backend) TExpr
- andExpr :: Backend backend => Text -> TExpr -> TExpr -> State (BlockState backend) TExpr
- notExpr :: Backend backend => Text -> TExpr -> State (BlockState backend) TExpr
- pureToBV :: Text -> Int -> TExpr -> State (BlockState VHDLState) TExpr
- pureToBVResized :: Text -> Int -> TExpr -> State (BlockState VHDLState) TExpr
- open :: Backend backend => HWType -> State (BlockState backend) TExpr
- clog2 :: Num i => Integer -> i
- litTExpr :: LitHDL -> TExpr
- toIdentifier :: Backend backend => Text -> TExpr -> State (BlockState backend) TExpr
- tySize :: Num i => HWType -> i
Annotations
data BlackBoxHaskellOpts Source #
Options for blackBoxHaskell
function. Use def
from package
'data-default' for a set of default options.
BlackBoxHaskellOpts | |
|
Instances
Default BlackBoxHaskellOpts Source # | |
Defined in Clash.Primitives.DSL |
:: Name | blackbox name |
-> Name | template function name |
-> BlackBoxHaskellOpts | Options, see data structure for more information |
-> Primitive |
Create a blackBoxHaskell primitive. To be used as part of an annotation:
{-# ANN myFunction (blackBoxHaskell 'myFunction 'myBBF def{bo_ignoredArguments=[1,2]}) #-}
[1,2]
would mean this blackbox ignores its second and third argument.
Declarations
data BlockState backend Source #
The state of a block. Contains a list of declarations and a the backend state.
BlockState | |
|
Instances
Backend backend => HasIdentifierSet (BlockState backend) Source # | |
Defined in Clash.Primitives.DSL identifierSet :: Lens' (BlockState backend) IdentifierSet Source # | |
HasUsageMap backend => HasUsageMap (BlockState backend) Source # | |
Defined in Clash.Primitives.DSL |
A typed expression.
addDeclaration :: Declaration -> State (BlockState backend) () Source #
Add a declaration to the state.
:: Backend backend | |
=> Text | Name hint for assignment |
-> TExpr | expression to be assigned to freshly generated identifier |
-> State (BlockState backend) TExpr | the identifier of the expression that actually got assigned |
Assign an expression to an identifier, returns the new typed identifier expression.
:: forall backend. Backend backend | |
=> Text | Component name |
-> [(Text, HWType)] | in ports |
-> [(Text, HWType)] | out ports |
-> State (BlockState backend) () |
This creates a component declaration (for VHDL) given in and out port
names, updating the 'BlockState backend' stored in the State
monad.
A typical result is that a
component fifo port ( rst : in std_logic ... ; full : out std_logic ; empty : out std_logic ); end component;
declaration would be added in the appropriate place.
:: Backend backend | |
=> Text | block name |
-> State (BlockState backend) () | block builder |
-> State backend Doc | pretty printed block |
Run a block declaration.
:: Backend backend | |
=> BlackBoxContext | |
-> Text | block name |
-> State (BlockState backend) [TExpr] | block builder yielding an expression that should be assigned to the result variable in the blackbox context |
-> State backend Doc | pretty printed block |
Run a block declaration. Assign the result of the block builder to the result variable in the given blackbox context.
:: Backend backend | |
=> Text | Name hint |
-> HWType | Type of new signal |
-> State (BlockState backend) TExpr | Expression pointing the the new signal |
Declare a new signal with the given name and type.
:: Backend backend | |
=> Text | Name hint |
-> [HWType] | Types of the signals |
-> State (BlockState backend) [TExpr] | Expressions pointing the the new signals |
Declare n new signals with the given type and based on the given name
:: forall backend. Backend backend | |
=> EntityOrComponent | Type of instantiation |
-> Identifier | Component/entity name |
-> Identifier | Instantiation label |
-> [(Text, TExpr)] | Generics / parameters |
-> [(Text, TExpr)] | In ports |
-> [(Text, TExpr)] | Out ports |
-> State (BlockState backend) () |
Instantiate a component/entity in a block state
:: Backend backend | |
=> BlackBoxContext | BlackBoxContext, used for rendering higher-order function and error reporting |
-> Int | Position of HO-argument. For example: fold :: forall n a . (a -> a -> a) -> Vec (n + 1) a -> a would have its HO-argument at position 0, while iterateI :: forall n a. KnownNat n => (a -> a) -> a -> Vec n a would have it at position 1. |
-> (HWType, BlackBoxTemplate) | Result type of HO function |
-> [(TExpr, BlackBoxTemplate)] | Arguments and their types |
-> State (BlockState backend) TExpr | Result of the function |
Instantiate/call a higher-order function.
:: (HasCallStack, Backend backend) | |
=> Identifier | Name given to signal |
-> TExpr | expression the signal is assigned to |
-> TExpr | expression (must be identifier) to which the signal is assigned |
-> [Attr Text] | the attributes to annotate the signal with |
-> State (BlockState backend) () |
Wires the two given TExpr
s together using a newly declared
signal with (exactly) the given name sigNm
. The new signal has an
annotated type, using the given attributes.
Literals
Construct a fully defined BitVector literal
constructProduct :: HWType -> [TExpr] -> TExpr Source #
Construct a product type given its type and fields
:: (HasCallStack, Backend backend) | |
=> [TExpr] | Elements of vector |
-> State (BlockState backend) TExpr | Vector elements |
Create a vector of TExpr
s
Extraction
tResults :: BlackBoxContext -> [TExpr] Source #
The TExp result of a blackbox context.
:: (HasCallStack, Backend backend) | |
=> TExpr | Product expression |
-> [Text] | Name hints for element assignments |
-> State (BlockState backend) [TExpr] |
Extract the fields of a product type and return expressions to them. These new expressions are given unique names and get declared in the block scope.
:: (HasCallStack, Backend backend) | |
=> TExpr | Tuple expression |
-> [Text] | Name hints for element assignments |
-> State (BlockState backend) [TExpr] |
Extract the elements of a tuple expression and return expressions to them. These new expressions are given unique names and get declared in the block scope.
:: (HasCallStack, Backend backend) | |
=> Text | Name hint for intermediate signal |
-> TExpr | Vector expression |
-> State (BlockState backend) [TExpr] | Vector elements |
Extract the elements of a vector expression and return expressions to them. If given expression is not an identifier, an intermediate variable will be used to assign the given expression to which is subsequently indexed.
:: (HasCallStack, Backend backend) | |
=> TExpr | Maybe expression |
-> (Text, Text) | Name hint for constructor bit, data |
-> State (BlockState backend) (TExpr, TExpr) | Constructor represented as a Bit, contents of Just |
Conversion
:: (HasCallStack, Backend backend) | |
=> Text | Name hints for intermediate variables |
-> HWType | Type to convert to |
-> TExpr | Expression to convert |
-> State (BlockState backend) TExpr | Converted expression |
Convert an expression from one type to another. Errors if result type and given expression are sized differently.
:: Backend backend | |
=> Text | BitVector name hint |
-> TExpr | Expression to convert to BitVector |
-> State (BlockState backend) TExpr | BitVector expression |
Convert an expression to a BitVector
:: Backend backend | |
=> [Attr Text] | |
-> Text | BitVector name hint |
-> TExpr | Expression to convert to BitVector |
-> State (BlockState backend) TExpr | BitVector expression |
Convert an expression to a BitVector and add the given HDL attributes
:: (HasCallStack, Backend backend) | |
=> Text | Result name hint |
-> HWType | Type to convert to |
-> TExpr |
|
-> State (BlockState backend) TExpr | Converted |
:: (HasCallStack, Backend backend) | |
=> Text | Name hint for intermediate signal |
-> TExpr | |
-> State (BlockState backend) TExpr |
Convert an enable to a bit.
:: (HasCallStack, Backend backend) | |
=> Text | Name hint for intermediate signal |
-> TExpr | |
-> State (BlockState backend) TExpr |
Convert a bool to a bit.
:: (HasCallStack, Backend backend) | |
=> Text | Name hint for intermediate signal |
-> TExpr | |
-> State (BlockState backend) TExpr |
Used to create an output Bool
from a BitVector
of given size.
Works in a similar way to boolFromBit
above.
TODO: Implement for (System)Verilog
unsignedFromBitVector Source #
:: (HasCallStack, Backend backend) | |
=> Text | Name hint for intermediate signal |
-> TExpr | BitVector expression |
-> State (BlockState backend) TExpr | Unsigned expression |
Used to create an output Unsigned
from a BitVector
of given
size. Works in a similar way to boolFromBit
above.
boolFromBits :: [Text] -> TExpr -> State (BlockState VHDLState) [TExpr] Source #
Massage a reset to work as active-high reset.
Massage a reset to work as active-low reset.
Operations
And together (&&)
two expressions, assigning it to a new identifier.
Negate (not)
an expression, assigning it to a new identifier.
Creates a BV that produces the following vhdl:
(0 to n => ARG)
TODO: Implement for (System)Verilog
:: Text | name hint |
-> Int | Size (n) |
-> TExpr | ARG |
-> State (BlockState VHDLState) TExpr | std_logic_vector(resize(ARG, Size)) |
Creates a BV that produces the following vhdl:
std_logic_vector(resize(ARG, Size))
TODO: Implement for (System)Verilog
open :: Backend backend => HWType -> State (BlockState backend) TExpr Source #
Allows assignment of a port to be "open"