clash-prelude-1.2.5: CAES Language for Synchronous Hardware - Prelude library
Safe HaskellNone
LanguageHaskell2010

Clash.Annotations.TH

Description

This module can automatically generate TopEntity definitions from NamedTypes annotations. Annotations involving data/type families must be inspected for correctness. Not all cases can be handled with automatic generation due to the difficulty of type manipulation in template Haskell. In particular annotations _inside_ the following is unlikely to work:

  • Datatype family referencing other datatype families.
  • Annotations inside recursive data types
  • Clock constraints other than a single HiddenClockResetEnable. (You can still use arbitrary explicit clockresetenables!)

See Clash.Tests.TopEntityGeneration for more examples.

import Clash.Annotations.TH

data Named
  = Named
  { name1 :: "named1" ::: BitVector 3
  , name2 :: "named2" ::: BitVector 5
  }

topEntity :: "tup1" ::: Signal System (Int, Bool)
          -> "tup2" ::: (Signal System Int, Signal System Bool)
          -> "tup3" ::: Signal System ("int":::Int, "bool":::Bool)
          -> "tup4" ::: ("int":::Signal System Int, "bool":::Signal System Bool)
          -> "custom" ::: Signal System Named
          -> "outTup" ::: Signal System ("outint":::Int, "outbool":::Bool)
topEntity = undefined
makeTopEntity 'topEntity
-- ===>
--  
Synopsis

To create a Synthesize annotation pragma

makeTopEntity :: Name -> DecsQ Source #

Automatically create a TopEntity for a given Name. The name of the generated RTL entity will be the name of the function that has been specified; e.g. makeTopEntity 'foobar will generate a foobar module.

The function arguments and return values of the function specified by the given Name must be annotated with (:::). This annotation provides the given name of the port.

makeTopEntityWithName :: Name -> String -> DecsQ Source #

Automatically create a TopEntity for a given Name, using the given String to specify the name of the generated RTL entity.

The function arguments and return values of the function specified by the given Name must be annotated with (:::). This annotation provides the given name of the port.

makeTopEntityWithName' :: Name -> Maybe String -> DecQ Source #

Wrap a TopEntity expression in an annotation pragma

To create a TopEntity value

buildTopEntity :: Maybe String -> (Name, Type) -> TExpQ TopEntity Source #

Return a typed expression for a TopEntity of a given (Name, Type).

maybeBuildTopEntity :: Maybe String -> Name -> Q (TExp (Maybe TopEntity)) Source #

Return a typed 'Maybe TopEntity' expression given a Name. This will return an TExp of Nothing if TopEntity generation failed.

getNameBinding :: Name -> Q (Name, Type) Source #

Turn the Name of a value to a (Name, Type)

Orphan instances

Recursive Type Source # 
Instance details

Methods

project :: Type -> Base Type Type #

cata :: (Base Type a -> a) -> Type -> a #

para :: (Base Type (Type, a) -> a) -> Type -> a #

gpara :: (Corecursive Type, Comonad w) => (forall b. Base Type (w b) -> w (Base Type b)) -> (Base Type (EnvT Type w a) -> a) -> Type -> a #

prepro :: Corecursive Type => (forall b. Base Type b -> Base Type b) -> (Base Type a -> a) -> Type -> a #

gprepro :: (Corecursive Type, Comonad w) => (forall b. Base Type (w b) -> w (Base Type b)) -> (forall c. Base Type c -> Base Type c) -> (Base Type (w a) -> a) -> Type -> a #

Corecursive Type Source # 
Instance details

Methods

embed :: Base Type Type -> Type #

ana :: (a -> Base Type a) -> a -> Type #

apo :: (a -> Base Type (Either Type a)) -> a -> Type #

postpro :: Recursive Type => (forall b. Base Type b -> Base Type b) -> (a -> Base Type a) -> a -> Type #

gpostpro :: (Recursive Type, Monad m) => (forall b. m (Base Type b) -> Base Type (m b)) -> (forall c. Base Type c -> Base Type c) -> (a -> Base Type (m a)) -> a -> Type #