clash-lib-1.7.0: Clash: a functional hardware description language - As a library
Copyright(C) 2019 Myrtle Software Ltd.
2020-2023 QBayLogic B.V.
2021 Myrtle.ai
2022-2023 Google Inc
LicenseBSD2 (see the file LICENSE)
MaintainerQBayLogic B.V. <devops@qbaylogic.com>
Safe HaskellNone
LanguageHaskell2010

Clash.Primitives.DSL

Description

This module contains a mini dsl for creating haskell blackbox instantiations.

Synopsis

Annotations

data BlackBoxHaskellOpts Source #

Options for blackBoxHaskell function. Use def from package 'data-default' for a set of default options.

Constructors

BlackBoxHaskellOpts 

Fields

Instances

Instances details
Default BlackBoxHaskellOpts Source # 
Instance details

Defined in Clash.Primitives.DSL

blackBoxHaskell Source #

Arguments

:: 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.

Constructors

BlockState 

Fields

Instances

Instances details
Backend backend => HasIdentifierSet (BlockState backend) Source # 
Instance details

Defined in Clash.Primitives.DSL

HasUsageMap backend => HasUsageMap (BlockState backend) Source # 
Instance details

Defined in Clash.Primitives.DSL

data TExpr Source #

A typed expression.

Constructors

TExpr 

Fields

Instances

Instances details
Show TExpr Source # 
Instance details

Defined in Clash.Primitives.DSL

Methods

showsPrec :: Int -> TExpr -> ShowS #

show :: TExpr -> String #

showList :: [TExpr] -> ShowS #

addDeclaration :: Declaration -> State (BlockState backend) () Source #

Add a declaration to the state.

assign Source #

Arguments

:: 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.

compInBlock Source #

Arguments

:: 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.

declaration Source #

Arguments

:: Backend backend 
=> Text

block name

-> State (BlockState backend) ()

block builder

-> State backend Doc

pretty printed block

Run a block declaration.

declarationReturn Source #

Arguments

:: 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.

declare Source #

Arguments

:: 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.

declareN Source #

Arguments

:: 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

instDecl Source #

Arguments

:: 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

instHO Source #

Arguments

:: 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.

viaAnnotatedSignal Source #

Arguments

:: (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 TExprs together using a newly declared signal with (exactly) the given name sigNm. The new signal has an annotated type, using the given attributes.

Literals

bvLit Source #

Arguments

:: Int

BitVector size

-> Integer

Literal

-> TExpr 

Construct a fully defined BitVector literal

data LitHDL Source #

A literal that can be used for hdl attributes. It has a Num and IsString instances for convenience.

Constructors

B Bool 
S String 
I Integer 

Instances

Instances details
Num LitHDL Source # 
Instance details

Defined in Clash.Primitives.DSL

Show LitHDL Source # 
Instance details

Defined in Clash.Primitives.DSL

IsString LitHDL Source # 
Instance details

Defined in Clash.Primitives.DSL

Methods

fromString :: String -> LitHDL #

pattern High :: TExpr Source #

The high literal bit.

pattern Low :: TExpr Source #

The low literal bit.

constructProduct :: HWType -> [TExpr] -> TExpr Source #

Construct a product type given its type and fields

tuple :: HasCallStack => [TExpr] -> TExpr Source #

Create an n-tuple of TExpr

vec Source #

Arguments

:: (HasCallStack, Backend backend) 
=> [TExpr]

Elements of vector

-> State (BlockState backend) TExpr

Vector elements

Create a vector of TExprs

Extraction

tInputs :: BlackBoxContext -> [(TExpr, HWType)] Source #

The TExp inputs from a blackbox context.

tResults :: BlackBoxContext -> [TExpr] Source #

The TExp result of a blackbox context.

getStr :: TExpr -> Maybe String Source #

Try to get the literal string value of an expression.

getBool :: TExpr -> Maybe Bool Source #

Try to get the literal bool value of an expression.

getVec :: TExpr -> Maybe [TExpr] Source #

Try to get a Vector of expressions.

tExprToInteger :: TExpr -> Maybe Integer Source #

Try to get the literal nat value of an expression.

deconstructProduct Source #

Arguments

:: (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.

untuple Source #

Arguments

:: (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.

unvec Source #

Arguments

:: (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.

deconstructMaybe Source #

Arguments

:: (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

Deconstruct a Maybe into its constructor Bit and contents of its Just field. Note that the contents might be undefined, if the constructor bit is set to Nothing.

Conversion

bitCoerce Source #

Arguments

:: (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.

toBV Source #

Arguments

:: Backend backend 
=> Text

BitVector name hint

-> TExpr

Expression to convert to BitVector

-> State (BlockState backend) TExpr

BitVector expression

Convert an expression to a BitVector

toBvWithAttrs Source #

Arguments

:: 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

fromBV Source #

Arguments

:: (HasCallStack, Backend backend) 
=> Text

Result name hint

-> HWType

Type to convert to

-> TExpr

BitVector expression

-> State (BlockState backend) TExpr

Converted BitVector expression

Convert an expression from a BitVector into some type. If the expression is Annotated, only convert the expression within.

enableToBit Source #

Arguments

:: (HasCallStack, Backend backend) 
=> Text

Name hint for intermediate signal

-> TExpr 
-> State (BlockState backend) TExpr 

Convert an enable to a bit.

boolToBit Source #

Arguments

:: (HasCallStack, Backend backend) 
=> Text

Name hint for intermediate signal

-> TExpr 
-> State (BlockState backend) TExpr 

Convert a bool to a bit.

boolFromBit Source #

Arguments

:: (HasCallStack, Backend backend) 
=> Text

Name hint for intermediate signal

-> TExpr 
-> State (BlockState backend) TExpr 

Use to create an output Bool from a Bit. The expression given must be the identifier of the bool you wish to get assigned. Returns a reference to a declared Bit that should get assigned by something (usually the output port of an entity).

boolFromBitVector Source #

Arguments

:: Size 
-> Text

Name hint for intermediate signal

-> TExpr 
-> State (BlockState VHDLState) 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 #

Arguments

:: (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 #

Used to create an output Bool from a number of Bits, using conjunction. Similarly to untuple, it returns a list of references to declared values (the inputs to the function) which should get assigned by something---usually output ports of an entity.

TODO: Implement for (System)Verilog

unsafeToActiveHigh Source #

Arguments

:: Backend backend 
=> Text

Name hint

-> TExpr

Reset signal

-> State (BlockState backend) TExpr 

Massage a reset to work as active-high reset.

unsafeToActiveLow Source #

Arguments

:: Backend backend 
=> Text

Name hint

-> TExpr

Reset signal

-> State (BlockState backend) TExpr 

Massage a reset to work as active-low reset.

Operations

andExpr Source #

Arguments

:: Backend backend 
=> Text

name hint

-> TExpr

a

-> TExpr

a

-> State (BlockState backend) TExpr

a && b

And together (&&) two expressions, assigning it to a new identifier.

notExpr Source #

Arguments

:: Backend backend 
=> Text

name hint

-> TExpr

a

-> State (BlockState backend) TExpr

not a

Negate (not) an expression, assigning it to a new identifier.

pureToBV Source #

Arguments

:: Text

name hint

-> Int

Size (n)

-> TExpr

ARG

-> State (BlockState VHDLState) TExpr

(0 to n => ARG)

Creates a BV that produces the following vhdl:

   (0 to n => ARG)

TODO: Implement for (System)Verilog

pureToBVResized Source #

Arguments

:: 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"

Utilities

clog2 :: Num i => Integer -> i Source #

litTExpr :: LitHDL -> TExpr Source #

Convert a LitHDL to a TExpr

N.B.: Clash 1.8 changed instDecl's type signature. Where it would previously accept LitHDL in its generics/parameters argument, it now accepts a TExpr. This function is mostly there to ease this transition.

toIdentifier Source #

Arguments

:: Backend backend 
=> Text

desired new identifier name, will be made unique

-> TExpr

expression to get identifier of

-> State (BlockState backend) TExpr

identifier to expression

Get an identifier to an expression, creating a new assignment if necessary.

tySize :: Num i => HWType -> i Source #