Copyright | (C) 2012-2016 University of Twente 2017 Myrtle Software Ltd 2017-2018 Google Inc. |
---|---|
License | BSD2 (see the file LICENSE) |
Maintainer | Christiaan Baaij <christiaan.baaij@gmail.com> |
Safe Haskell | None |
Language | Haskell2010 |
Utilities for converting Core Type/Term to Netlist datatypes
Synopsis
- stripFiltered :: FilteredHWType -> HWType
- stripVoid :: HWType -> HWType
- flattenFiltered :: FilteredHWType -> [[Bool]]
- isVoidMaybe :: Bool -> Maybe HWType -> Bool
- isVoid :: HWType -> Bool
- isFilteredVoid :: FilteredHWType -> Bool
- mkIdentifier :: IdType -> Identifier -> NetlistMonad Identifier
- extendIdentifier :: IdType -> Identifier -> Identifier -> NetlistMonad Identifier
- splitNormalized :: TyConMap -> Term -> Either String ([Id], [LetBinding], Id)
- unsafeCoreTypeToHWType' :: SrcSpan -> String -> (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) -> CustomReprs -> TyConMap -> Type -> State HWMap HWType
- unsafeCoreTypeToHWType :: SrcSpan -> String -> (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) -> CustomReprs -> TyConMap -> Type -> State HWMap FilteredHWType
- unsafeCoreTypeToHWTypeM' :: String -> Type -> NetlistMonad HWType
- unsafeCoreTypeToHWTypeM :: String -> Type -> NetlistMonad FilteredHWType
- coreTypeToHWTypeM' :: Type -> NetlistMonad (Maybe HWType)
- coreTypeToHWTypeM :: Type -> NetlistMonad (Maybe FilteredHWType)
- unexpectedProjectionErrorMsg :: DataRepr' -> Int -> Int -> String
- convertToCustomRepr :: HasCallStack => CustomReprs -> DataRepr' -> HWType -> HWType
- maybeConvertToCustomRepr :: CustomReprs -> Type -> HWType -> HWType
- coreTypeToHWType' :: (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) -> CustomReprs -> TyConMap -> Type -> State HWMap (Either String HWType)
- coreTypeToHWType :: (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) -> CustomReprs -> TyConMap -> Type -> State HWMap (Either String FilteredHWType)
- originalIndices :: [Bool] -> [Int]
- mkADT :: (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) -> CustomReprs -> TyConMap -> String -> TyConName -> [Type] -> ExceptT String (State HWMap) FilteredHWType
- isRecursiveTy :: TyConMap -> TyConName -> Bool
- representableType :: (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) -> CustomReprs -> Bool -> TyConMap -> Type -> Bool
- typeSize :: HWType -> Int
- conSize :: HWType -> Int
- typeLength :: HWType -> Int
- termHWType :: String -> Term -> NetlistMonad HWType
- termHWTypeM :: Term -> NetlistMonad (Maybe FilteredHWType)
- isBiSignalIn :: HWType -> Bool
- containsBiSignalIn :: HWType -> Bool
- collectPortNames' :: [String] -> PortName -> [Identifier]
- collectPortNames :: TopEntity -> [Identifier]
- filterVoidPorts :: FilteredHWType -> PortName -> PortName
- mkUniqueNormalized :: HasCallStack => InScopeSet -> Maybe (Maybe TopEntity) -> ([Id], [LetBinding], Id) -> NetlistMonad ([Bool], [(Identifier, HWType)], [Declaration], [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
- setBinderName :: Subst -> Id -> Bool -> (Id, Subst, [(Id, Term)]) -> (Id, Term) -> NetlistMonad ((Id, Subst, [(Id, Term)]), Id)
- mkUniqueArguments :: Subst -> Maybe (Maybe TopEntity) -> [Id] -> NetlistMonad ([Bool], [(Identifier, HWType)], [Declaration], Subst)
- mkUniqueResult :: Subst -> Maybe (Maybe TopEntity) -> Id -> NetlistMonad (Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
- idToInPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
- idToOutPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
- idToPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
- id2type :: Id -> Type
- id2identifier :: Id -> Identifier
- repName :: Text -> Name a -> Name a
- mkUnique :: Subst -> [Id] -> NetlistMonad ([Id], Subst)
- mkUniqueIdentifier :: IdType -> Identifier -> NetlistMonad Identifier
- preserveState :: NetlistMonad a -> NetlistMonad a
- preserveVarEnv :: NetlistMonad a -> NetlistMonad a
- dcToLiteral :: HWType -> Int -> Literal
- extendPorts :: [PortName] -> [Maybe PortName]
- portName :: String -> Identifier -> Identifier
- prefixParent :: String -> PortName -> PortName
- appendIdentifier :: (Identifier, HWType) -> Int -> NetlistMonad (Identifier, HWType)
- uniquePortName :: String -> Identifier -> NetlistMonad Identifier
- mkInput :: Maybe PortName -> (Identifier, HWType) -> NetlistMonad ([(Identifier, HWType)], [Declaration], Expr, Identifier)
- mkVectorChain :: Int -> HWType -> [Expr] -> Expr
- mkRTreeChain :: Int -> HWType -> [Expr] -> Expr
- genComponentName :: Bool -> HashMap Identifier Word -> (IdType -> Identifier -> Identifier) -> ComponentPrefix -> Id -> Identifier
- genTopComponentName :: Bool -> (IdType -> Identifier -> Identifier) -> ComponentPrefix -> Maybe TopEntity -> Id -> Identifier
- stripAttributes :: HWType -> ([Attr'], HWType)
- mkOutput :: Maybe PortName -> (Identifier, HWType) -> NetlistMonad (Maybe ([(Identifier, HWType)], [Declaration], Identifier))
- mkOutput' :: Maybe PortName -> (Identifier, HWType) -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
- mkTopUnWrapper :: Id -> Maybe TopEntity -> Manifest -> (Identifier, HWType) -> [(Expr, HWType)] -> [Declaration] -> NetlistMonad [Declaration]
- argBV :: Maybe Identifier -> Either Identifier (Identifier, HWType) -> Expr -> Declaration
- resBV :: Maybe Identifier -> Either Identifier (Identifier, HWType) -> Expr
- doConv :: HWType -> Maybe (Maybe Identifier) -> Bool -> Expr -> Expr
- mkTopInput :: Maybe Identifier -> [(Identifier, Identifier)] -> Maybe PortName -> (Identifier, HWType) -> NetlistMonad ([(Identifier, Identifier)], ([(Identifier, Identifier, HWType)], [Declaration], Either Identifier (Identifier, HWType)))
- throwAnnotatedSplitError :: String -> String -> NetlistMonad a
- mkTopOutput :: Maybe Identifier -> [(Identifier, Identifier)] -> Maybe PortName -> (Identifier, HWType) -> NetlistMonad (Maybe ([(Identifier, Identifier)], ([(Identifier, Identifier, HWType)], [Declaration], Either Identifier (Identifier, HWType))))
- mkTopOutput' :: Maybe Identifier -> [(Identifier, Identifier)] -> Maybe PortName -> (Identifier, HWType) -> NetlistMonad ([(Identifier, Identifier)], ([(Identifier, Identifier, HWType)], [Declaration], Either Identifier (Identifier, HWType)))
- concatPortDecls3 :: [([(Identifier, Identifier, HWType)], [Declaration], Either Identifier (Identifier, HWType))] -> ([(Identifier, Identifier, HWType)], [Declaration], [Either Identifier (Identifier, HWType)])
- nestM :: Modifier -> Modifier -> Maybe Modifier
- bindsExistentials :: [TyVar] -> [Var a] -> Bool
- iteAlts :: HWType -> [Alt] -> Maybe (Term, Term)
- withTicks :: [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
- affixName :: Identifier -> NetlistMonad Identifier
Documentation
stripFiltered :: FilteredHWType -> HWType Source #
Throw away information indicating which constructor fields were filtered due to being void.
stripVoid :: HWType -> HWType Source #
Strip as many Void layers as possible. Might still return a Void if the void doesn't contain a hwtype.
flattenFiltered :: FilteredHWType -> [[Bool]] Source #
isFilteredVoid :: FilteredHWType -> Bool Source #
Same as isVoid
, but on FilteredHWType
instead of HWType
mkIdentifier :: IdType -> Identifier -> NetlistMonad Identifier Source #
extendIdentifier :: IdType -> Identifier -> Identifier -> NetlistMonad Identifier Source #
splitNormalized :: TyConMap -> Term -> Either String ([Id], [LetBinding], Id) Source #
Split a normalized term into: a list of arguments, a list of let-bindings, and a variable reference that is the body of the let-binding. Returns a String containing the error if the term was not in a normalized form.
unsafeCoreTypeToHWType' Source #
:: SrcSpan | Approximate location in original source file |
-> String | |
-> (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) | |
-> CustomReprs | |
-> TyConMap | |
-> Type | |
-> State HWMap HWType |
Same as unsafeCoreTypeToHWType
, but discards void filter information
unsafeCoreTypeToHWType Source #
:: SrcSpan | Approximate location in original source file |
-> String | |
-> (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) | |
-> CustomReprs | |
-> TyConMap | |
-> Type | |
-> State HWMap FilteredHWType |
Converts a Core type to a HWType given a function that translates certain builtin types. Errors if the Core type is not translatable.
unsafeCoreTypeToHWTypeM' :: String -> Type -> NetlistMonad HWType Source #
Same as unsafeCoreTypeToHWTypeM
, but discards void filter information
unsafeCoreTypeToHWTypeM :: String -> Type -> NetlistMonad FilteredHWType Source #
Converts a Core type to a HWType within the NetlistMonad; errors on failure
:: Type | Type to convert to HWType |
-> NetlistMonad (Maybe HWType) |
Same as coreTypeToHWTypeM
, but discards void filter information
:: Type | Type to convert to HWType |
-> NetlistMonad (Maybe FilteredHWType) |
Converts a Core type to a HWType within the NetlistMonad; Nothing
on failure
unexpectedProjectionErrorMsg Source #
Constructs error message for unexpected projections out of a type annotated with a custom bit representation.
convertToCustomRepr :: HasCallStack => CustomReprs -> DataRepr' -> HWType -> HWType Source #
Helper function of maybeConvertToCustomRepr
maybeConvertToCustomRepr Source #
:: CustomReprs | Map containing all custom representations index on its type |
-> Type | Custom reprs are index on type, so we need the clash core type to look it up. |
-> HWType | Type of previous argument represented as a HWType |
-> HWType |
Given a map containing custom bit representation, a type, and the same type represented as HWType, convert the HWType to a CustomSP/CustomSum if it has a custom bit representation.
:: (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) | |
-> CustomReprs | |
-> TyConMap | |
-> Type | Type to convert to HWType |
-> State HWMap (Either String HWType) |
Same as coreTypeToHWType
, but discards void filter information
:: (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) | |
-> CustomReprs | |
-> TyConMap | |
-> Type | Type to convert to HWType |
-> State HWMap (Either String FilteredHWType) |
Converts a Core type to a HWType given a function that translates certain builtin types. Returns a string containing the error message when the Core type is not translatable.
Generates original indices in list before filtering, given a list of removed indices.
>>>
originalIndices [False, False, True, False]
[0,1,3]
:: (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) | Hardcoded Type -> HWType translator |
-> CustomReprs | |
-> TyConMap | TyCon cache |
-> String | String representation of the Core type for error messages |
-> TyConName | The TyCon |
-> [Type] | Its applied arguments |
-> ExceptT String (State HWMap) FilteredHWType | An error string or a tuple with the type and possibly a list of removed arguments. |
Converts an algebraic Core type (split into a TyCon and its argument) to a HWType.
isRecursiveTy :: TyConMap -> TyConName -> Bool Source #
Simple check if a TyCon is recursively defined.
:: (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) | |
-> CustomReprs | |
-> Bool | String considered representable |
-> TyConMap | |
-> Type | |
-> Bool |
Determines if a Core type is translatable to a HWType given a function that translates certain builtin types.
typeSize :: HWType -> Int Source #
Determines the bitsize of a type. For types that don't get turned into real values in hardware (string, integer) the size is 0.
typeLength :: HWType -> Int Source #
Gives the length of length-indexed types
termHWType :: String -> Term -> NetlistMonad HWType Source #
Gives the HWType corresponding to a term. Returns an error if the term has a Core type that is not translatable to a HWType.
:: Term | Term to convert to HWType |
-> NetlistMonad (Maybe FilteredHWType) |
Gives the HWType corresponding to a term. Returns Nothing
if the term has
a Core type that is not translatable to a HWType.
isBiSignalIn :: HWType -> Bool Source #
containsBiSignalIn :: HWType -> Bool Source #
collectPortNames' :: [String] -> PortName -> [Identifier] Source #
Helper function of collectPortNames
, which operates on a PortName
instead of a TopEntity.
collectPortNames :: TopEntity -> [Identifier] Source #
Recursively get all port names from top entity annotations. The result is a list of user defined port names, which should not be used by routines generating unique function names. Only completely qualified names are returned, as it does not (and cannot) account for any implicitly named ports under a PortProduct.
filterVoidPorts :: FilteredHWType -> PortName -> PortName Source #
Remove ports having a void-type from user supplied PortName annotation
:: HasCallStack | |
=> InScopeSet | |
-> Maybe (Maybe TopEntity) | Top entity annotation where:
|
-> ([Id], [LetBinding], Id) | |
-> NetlistMonad ([Bool], [(Identifier, HWType)], [Declaration], [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id) |
Uniquely rename all the variables and their references in a normalized term
:: Subst | Current substitution |
-> Id | The binder for the result |
-> Bool | Whether the result binder is referenced by another binder |
-> (Id, Subst, [(Id, Term)]) |
|
-> (Id, Term) | The binding |
-> NetlistMonad ((Id, Subst, [(Id, Term)]), Id) |
Set the name of the binder
Normally, it just keeps the existing name, but there are two exceptions:
- It's the binding for the result which is also referenced by another binding;
in this case it's suffixed with
_rec
- The binding binds a primitive that has a name control field
- takes priority over 1. Additionally, we create an additional binder when the return value gets a new name.
:: Subst | |
-> Maybe (Maybe TopEntity) | Top entity annotation where:
|
-> [Id] | |
-> NetlistMonad ([Bool], [(Identifier, HWType)], [Declaration], Subst) |
:: Subst | |
-> Maybe (Maybe TopEntity) | Top entity annotation where:
|
-> Id | |
-> NetlistMonad (Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)) |
idToInPort :: Id -> NetlistMonad (Maybe (Identifier, HWType)) Source #
Same as idToPort, but * Throws an error if the port is a composite type with a BiSignalIn
idToOutPort :: Id -> NetlistMonad (Maybe (Identifier, HWType)) Source #
Same as idToPort, but: * Throws an error if port is of type BiSignalIn
idToPort :: Id -> NetlistMonad (Maybe (Identifier, HWType)) Source #
id2identifier :: Id -> Identifier Source #
:: Subst | Existing substitution |
-> [Id] | IDs to make unique |
-> NetlistMonad ([Id], Subst) | (Unique IDs, update substitution) |
Make a set of IDs unique; also returns a substitution from old ID to new updated unique ID.
preserveState :: NetlistMonad a -> NetlistMonad a Source #
Preserve the complete state before running an action, and restore it afterwards.
preserveVarEnv :: NetlistMonad a -> NetlistMonad a Source #
Preserve the Netlist _varCount
,_curCompNm
,_seenIds
when executing
a monadic action
TopEntity Annotations
extendPorts :: [PortName] -> [Maybe PortName] Source #
portName :: String -> Identifier -> Identifier Source #
prefixParent :: String -> PortName -> PortName Source #
Prefix given string before portnames except when this string is empty.
appendIdentifier :: (Identifier, HWType) -> Int -> NetlistMonad (Identifier, HWType) Source #
uniquePortName :: String -> Identifier -> NetlistMonad Identifier Source #
In addition to the original port name (where the user should assert that it's a valid identifier), we also add the version of the port name that has gone through the 'mkIdentifier Basic' process. Why? so that the provided port name is copied verbatim into the generated HDL, but that in e.g. case-insensitive HDLs, a case-variant of the port name is not used as one of the signal names.
mkInput :: Maybe PortName -> (Identifier, HWType) -> NetlistMonad ([(Identifier, HWType)], [Declaration], Expr, Identifier) Source #
mkVectorChain :: Int -> HWType -> [Expr] -> Expr Source #
Create a Vector chain for a list of Identifier
s
mkRTreeChain :: Int -> HWType -> [Expr] -> Expr Source #
Create a RTree chain for a list of Identifier
s
genComponentName :: Bool -> HashMap Identifier Word -> (IdType -> Identifier -> Identifier) -> ComponentPrefix -> Id -> Identifier Source #
genTopComponentName :: Bool -> (IdType -> Identifier -> Identifier) -> ComponentPrefix -> Maybe TopEntity -> Id -> Identifier Source #
stripAttributes :: HWType -> ([Attr'], HWType) Source #
Strips one or more layers of attributes from a HWType; stops at first non-Annotated. Accumilates all attributes of nested annotations.
mkOutput :: Maybe PortName -> (Identifier, HWType) -> NetlistMonad (Maybe ([(Identifier, HWType)], [Declaration], Identifier)) Source #
Generate output port mappings
mkOutput' :: Maybe PortName -> (Identifier, HWType) -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier) Source #
Generate output port mappings. Will yield Nothing if the only output is Void.
:: Id | Name of the TopEntity component |
-> Maybe TopEntity | (maybe) a corresponding |
-> Manifest | a corresponding |
-> (Identifier, HWType) | The name and type of the signal to which to assign the result |
-> [(Expr, HWType)] | The arguments |
-> [Declaration] | Tick declarations |
-> NetlistMonad [Declaration] |
Instantiate a TopEntity, and add the proper type-conversions where needed
:: Maybe Identifier | (maybe) Name of the _TopEntity_ |
-> Either Identifier (Identifier, HWType) | Either:
* A normal argument
* An argument with a |
-> Expr | |
-> Declaration |
Convert between BitVector for an argument
:: Maybe Identifier | (mabye) Name of the _TopEntity_ |
-> Either Identifier (Identifier, HWType) | Either:
* A normal result
* A result with a |
-> Expr |
Convert between BitVector for the result
:: HWType | We only need it for certain types |
-> Maybe (Maybe Identifier) |
|
-> Bool |
|
-> Expr | The expression on top of which we have to add conversion logic |
-> Expr |
Add to/from-BitVector conversion logic
:: Maybe Identifier | (maybe) Name of the _TopEntity_ |
-> [(Identifier, Identifier)] | Rendered input port names and types |
-> Maybe PortName | (maybe) The |
-> (Identifier, HWType) | |
-> NetlistMonad ([(Identifier, Identifier)], ([(Identifier, Identifier, HWType)], [Declaration], Either Identifier (Identifier, HWType))) |
Generate input port mappings for the TopEntity
throwAnnotatedSplitError :: String -> String -> NetlistMonad a Source #
Consider the following type signature:
f :: Signal dom (Vec 6 A) `Annotate` Attr "keep" -> Signal dom (Vec 6 B)
What does the annotation mean, considering that Clash will split these vectors into multiple in- and output ports? Should we apply the annotation to all individual ports? How would we handle pin mappings? For now, we simply throw an error. This is a helper function to do so.
:: Maybe Identifier | (maybe) Name of the _TopEntity_ |
-> [(Identifier, Identifier)] | Rendered output port names and types |
-> Maybe PortName | (maybe) The |
-> (Identifier, HWType) | |
-> NetlistMonad (Maybe ([(Identifier, Identifier)], ([(Identifier, Identifier, HWType)], [Declaration], Either Identifier (Identifier, HWType)))) |
Generate output port mappings for the TopEntity. Yields Nothing if the output is Void
:: Maybe Identifier | (maybe) Name of the _TopEntity_ |
-> [(Identifier, Identifier)] | Rendered output port names and types |
-> Maybe PortName | (maybe) The |
-> (Identifier, HWType) | |
-> NetlistMonad ([(Identifier, Identifier)], ([(Identifier, Identifier, HWType)], [Declaration], Either Identifier (Identifier, HWType))) |
Generate output port mappings for the TopEntity
concatPortDecls3 :: [([(Identifier, Identifier, HWType)], [Declaration], Either Identifier (Identifier, HWType))] -> ([(Identifier, Identifier, HWType)], [Declaration], [Either Identifier (Identifier, HWType)]) Source #
nestM :: Modifier -> Modifier -> Maybe Modifier Source #
Try to merge nested modifiers into a single modifier, needed by the VHDL and SystemVerilog backend.
bindsExistentials :: [TyVar] -> [Var a] -> Bool Source #
Determines if any type variables (exts) are bound in any of the given type or term variables (tms). It's currently only used to detect bound existentials, hence the name.
:: [TickInfo] | |
-> ([Declaration] -> NetlistMonad a) | The source ticks are turned into |
-> NetlistMonad a |
Run a NetlistMonad computation in the context of the given source ticks and name modifier ticks
affixName :: Identifier -> NetlistMonad Identifier Source #
Add the pre- and suffix names in the current environment to the given identifier