clash-prelude-0.99.1: CAES Language for Synchronous Hardware - Prelude library

Copyright(C) 2017 Myrtle Software QBayLogic
LicenseBSD2 (see the file LICENSE)
MaintainerChristiaan Baaij <christiaan.baaij@gmail.com>
Safe HaskellSafe
LanguageHaskell2010
ExtensionsDeriveDataTypeable

Clash.Annotations.Primitive

Description

Instruct the clash compiler to look for primitive HDL templates in the indicated directory. For distribution of new packages with primitive HDL templates.

Synopsis

Documentation

data HDL Source #

Constructors

SystemVerilog 
Verilog 
VHDL 
Instances
Eq HDL Source # 
Instance details

Methods

(==) :: HDL -> HDL -> Bool #

(/=) :: HDL -> HDL -> Bool #

Data HDL Source # 
Instance details

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> HDL -> c HDL #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c HDL #

toConstr :: HDL -> Constr #

dataTypeOf :: HDL -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c HDL) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HDL) #

gmapT :: (forall b. Data b => b -> b) -> HDL -> HDL #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> HDL -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> HDL -> r #

gmapQ :: (forall d. Data d => d -> u) -> HDL -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> HDL -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> HDL -> m HDL #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> HDL -> m HDL #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> HDL -> m HDL #

Read HDL Source # 
Instance details
Show HDL Source # 
Instance details

Methods

showsPrec :: Int -> HDL -> ShowS #

show :: HDL -> String #

showList :: [HDL] -> ShowS #

data Primitive Source #

The Primitive constructor instructs the clash compiler to look for primitive HDL templates in the indicated directory. InlinePrimitive is equivalent but provides the HDL template inline. They are intended for the distribution of new packages with primitive HDL templates.

Example of Primitive

You have some existing IP written in one of HDLs supported by Clash, and you want to distribute some bindings so that the IP can be easily instantiated from Clash.

You create a package which has a myfancyip.cabal file with the following stanza:

data-files: path/to/MyFancyIP.json
cpp-options: -DCABAL

and a MyFancyIP.hs module with the simulation definition and primitive.

module MyFancyIP where

import Clash.Prelude

myFancyIP :: ...
myFancyIP = ...
{-# NOINLINE myFancyIP #-}

The NOINLINE pragma is needed so that GHC will never inline the definition.

Now you need to add the following imports and ANN pragma:

#ifdef CABAL
import           Clash.Annotations.Primitive
import           System.FilePath
import qualified Paths_myfancyip
import           System.IO.Unsafe

{-# ANN module (Primitive VHDL (unsafePerformIO Paths_myfancyip.getDataDir </> "path" </> "to")) #-}
#endif

Add more files to the data-files stanza in your .cabal files and more ANN pragma's if you want to add more primitive templates for other HDLs

Example of InlinePrimitive

The following example shows off an inline HDL primitive template. It uses the interpolate package for nicer multiline strings.

{-# LANGUAGE DataKinds   #-}
{-# LANGUAGE QuasiQuotes #-}

module InlinePrimitive where

import           Clash.Annotations.Primitive
import           Clash.Prelude
import           Data.String.Interpolate      (i)
import           Data.String.Interpolate.Util (unindent)

{-# ANN example (InlinePrimitive VHDL $ unindent [i|
  [ { "BlackBox" :
      { "name" : "InlinePrimitive.example"
      , "templateD" :
  "-- begin InlinePrimitive example:
  ~GENSYM[example][0] : block
  ~RESULT <= 1 + ~ARG[0];
  end block;
  -- end InlinePrimitive example"
      }
    }
  ]
  |]) #-}
{-# NOINLINE example #-}
example :: Signal System (BitVector 2) -> Signal System (BitVector 2)
example = fmap succ

Constructors

Primitive HDL FilePath

Description of a primitive for a given HDL in a file at FilePath

InlinePrimitive HDL String

Description of a primitive for a given HDL as an inline String

Instances
Data Primitive Source # 
Instance details

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Primitive -> c Primitive #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Primitive #

toConstr :: Primitive -> Constr #

dataTypeOf :: Primitive -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Primitive) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Primitive) #

gmapT :: (forall b. Data b => b -> b) -> Primitive -> Primitive #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Primitive -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Primitive -> r #

gmapQ :: (forall d. Data d => d -> u) -> Primitive -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Primitive -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive #

Read Primitive Source # 
Instance details
Show Primitive Source # 
Instance details