clash-lib-0.6.13: CAES Language for Synchronous Hardware - As a Library

Copyright(C) 2012-2016, University of Twente
LicenseBSD2 (see the file LICENSE)
MaintainerChristiaan Baaij <christiaan.baaij@gmail.com>
Safe HaskellNone
LanguageHaskell2010

CLaSH.Util

Description

Assortment of utility function used in the CLaSH library

Synopsis

Documentation

class MonadUnique m where Source

A class that can generate unique numbers

Methods

getUniqueM :: m Int Source

Get a new unique

curLoc :: Q Exp Source

Create a TH expression that returns the a formatted string containing the name of the module curLoc is spliced into, and the line where it was spliced.

makeCached Source

Arguments

:: (MonadState s m, Hashable k, Eq k) 
=> k

The key the action is associated with

-> Lens' s (HashMap k v)

The Lens to the HashMap that is the cache

-> m v

The action to cache

-> m v 

Cache the result of a monadic action

makeCachedT3 Source

Arguments

:: (MonadTrans t2, MonadTrans t1, MonadTrans t, Eq k, Hashable k, MonadState s m, Monad (t2 m), Monad (t1 (t2 m)), Monad (t (t1 (t2 m)))) 
=> k

The key the action is associated with

-> Lens' s (HashMap k v)

The Lens to the HashMap that is the cache

-> t (t1 (t2 m)) v

The action to cache

-> t (t1 (t2 m)) v 

Cache the result of a monadic action in a State 3 transformer layers down

makeCachedT3S :: (MonadTrans t2, MonadTrans t1, MonadTrans t, Eq k, Hashable k, MonadState s m, Monad (t2 m), Monad (t1 (t2 m)), Monad (t (t1 (t2 m))), NFData v) => k -> Lens' s (HashMap k v) -> t (t1 (t2 m)) v -> t (t1 (t2 m)) v Source

Spine-strict cache variant of mkCachedT3

liftState Source

Arguments

:: MonadState s m 
=> Lens' s s'

Lens to the State in the higher-layer monad

-> State s' a

The State-action to perform

-> m a 

Run a State-action using the State that is stored in a higher-layer Monad

firstM :: Functor f => (a -> f c) -> (a, b) -> f (c, b) Source

Functorial version of first

secondM :: Functor f => (b -> f c) -> (a, b) -> f (a, c) Source

Functorial version of second

combineM :: Applicative f => (a -> f b) -> (c -> f d) -> (a, c) -> f (b, d) Source

traceIf :: Bool -> String -> a -> a Source

Performs trace when first argument evaluates to True

partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) Source

Monadic version of partition

mapAccumLM :: Monad m => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y]) Source

Monadic version of mapAccumL

dot :: (c -> d) -> (a -> b -> c) -> a -> b -> d Source

Composition of a unary function with a binary function

ifThenElse :: (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b Source

if-then-else as a function on an argument

(<:>) :: Applicative f => f a -> f [a] -> f [a] infixr 5 Source

Applicative version of 'GHC.Types.(:)'

indexMaybe :: [a] -> Int -> Maybe a Source

Safe indexing, returns a Nothing if the index does not exist

indexNote :: String -> [a] -> Int -> a Source

Unsafe indexing, return a custom error message when indexing fails

splitAtList :: [b] -> [a] -> ([a], [a]) Source

Split the second list at the length of the first list

clog2 :: (Integral a, Integral c) => a -> c Source

ceiling (log_2(c))

makeLenses :: Name -> DecsQ

Build lenses (and traversals) with a sensible default configuration.

e.g.

data FooBar
  = Foo { _x, _y :: Int }
  | Bar { _x :: Int }
makeLenses ''FooBar

will create

x :: Lens' FooBar Int
x f (Foo a b) = (\a' -> Foo a' b) <$> f a
x f (Bar a)   = Bar <$> f a
y :: Traversal' FooBar Int
y f (Foo a b) = (\b' -> Foo a  b') <$> f b
y _ c@(Bar _) = pure c
makeLenses = makeLensesWith lensRules