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

Copyright(C) 2013-2015, University of Twente
LicenseBSD2 (see the file LICENSE)
MaintainerChristiaan Baaij <christiaan.baaij@gmail.com>
Safe HaskellNone
LanguageHaskell2010
Extensions
  • MonoLocalBinds
  • ScopedTypeVariables
  • TypeFamilies
  • GADTs
  • GADTSyntax
  • DataKinds
  • DeriveTraversable
  • MultiParamTypeClasses
  • MagicHash
  • KindSignatures
  • GeneralizedNewtypeDeriving
  • TypeOperators
  • ExplicitNamespaces
  • ExplicitForAll

CLaSH.Signal.Delayed

Contents

Description

 

Synopsis

Delay-annotated synchronous signals

data DSignal delay a Source

A synchronized signal with samples of type a, synchronized to "system" clock (period 1000), that has accumulated delay amount of samples delay along its path.

Instances

Functor (DSignal delay) 
Applicative (DSignal delay) 
Foldable (DSignal delay) 
Traversable (DSignal delay) 
Bounded a => Bounded (DSignal delay a) 
Enum a => Enum (DSignal delay a) 
Eq (DSignal delay a) 
Fractional a => Fractional (DSignal delay a) 
Integral a => Integral (DSignal delay a) 
Num a => Num (DSignal delay a) 
Ord a => Ord (DSignal delay a) 
(Num a, Ord a) => Real (DSignal delay a) 
Show a => Show (DSignal delay a) 
Bits a => Bits (DSignal delay a) 
FiniteBits a => FiniteBits (DSignal delay a) 
Default a => Default (DSignal delay a) 
Lift a => Lift (DSignal delay a) 
SaturatingNum a => SaturatingNum (DSignal delay a) 
ExtendingNum a b => ExtendingNum (DSignal n a) (DSignal n b) 
type AResult (DSignal n a) (DSignal n b) = DSignal n (AResult a b) 
type MResult (DSignal n a) (DSignal n b) = DSignal n (MResult a b) 

delay :: forall a n m. KnownNat m => Vec m a -> DSignal (n - m) a -> DSignal n a Source

Delay a DSignal for m periods.

delay3 :: DSignal (n - 3) Int -> DSignal n Int
delay3 = delay (0 :> 0 :> 0 :> Nil)
>>> sampleN 6 (delay3 (dfromList [1..]))
[0,0,0,1,2,3]

delayI :: (Default a, KnownNat m) => DSignal (n - m) a -> DSignal n a Source

Delay a DSignal for m periods, where m is derived from the context.

delay2 :: DSignal (n - 2) Int -> DSignal n Int
delay2 = delayI
>>> sampleN 6 (delay2 (dfromList [1..])
[0,0,1,2,3,4]

feedback :: (DSignal ((n - m) - 1) a -> (DSignal ((n - m) - 1) a, DSignal n a)) -> DSignal ((n - m) - 1) a Source

Feed the delayed result of a function back to its input:

mac :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int
mac x y = feedback (mac' x y)
  where
    mac' :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int
         -> (DSignal 0 Int, DSignal 1 Int)
    mac' a b acc = let acc' = a * b + acc
                   in  (acc, delay (singleton 0) acc')
>>> sampleN 6 (mac (dfromList [1..]) (dfromList [1..]))
[0,1,5,14,30,55]

Signal <-> DSignal conversion

fromSignal :: Signal a -> DSignal 0 a Source

Signals are not delayed

sample s == dsample (fromSignal s)

toSignal :: DSignal delay a -> Signal a Source

Strip a DSignal from its delay information.

List <-> DSignal conversion (not synthesisable)

dfromList :: [a] -> DSignal 0 a Source

Create a DSignal from a list

Every element in the list will correspond to a value of the signal for one clock cycle.

>>> sampleN 2 (dfromList [1,2,3,4,5])
[1,2]

NB: This function is not synthesisable

Experimental

unsafeFromSignal :: Signal a -> DSignal n a Source

EXPERIMENTAL

Unsafely convert a Signal to any DSignal.

NB: Should only be used to interface with functions specified in terms of Signal.

antiDelay :: SNat d -> DSignal n a -> DSignal (n - d) a Source

EXPERIMENTAL

Access a delayed signal in the present.

mac :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int
mac x y = acc'
  where
    acc' = (x * y) + antiDelay d1 acc
    acc  = delay (singleton 0) acc'