Building software in haskell is frequently expressing problem in one domain and then transfer it into another. Previous post Remote fpga call was about using type system to use and define circuits in both hardware and software.

Plan for this post is to show how to define circuits (using clash in haskell) for two different and related domains. One domain are circuits using Signal a that represent periodic clock domain where value a (like Bool or Signed 5) changes at each clock edge. Frequency and polarity of clock change are not relevant, but they are same for whole circuitry. This are synchronous digital circuits where whole circuitry operates on same clock.

Other domain is about digital synchronous circuits that at each clock receives and process n values of type a. We call such domain multi data domain or MultiSignal. Type of this data stream is Signal (Vec n a) where Vec n a is homogeneous list of exactly n elements each having type a. Such signals represents for example serialized data received over high speed bus or ADC that in one clock cycle sends more than one sample acquired at higher frequency.

We are on quest to figure out how to express circuits in both Signal and MultiSignal domain.

Whole idea summary

MultiSignal n a is defined as Signal (Vec n a) as explained earlier. After providing instance of Functor and Applicative for such type new type-class Prependable is required that generalize over delay/register with instance for both Signal and Multisignal n. This few type-classes are enough to describe synchronous circuits in both domains (Signal and MultiSignal). Finally there are few examples on how to implement primitive building blocks in Multisignal n as defined with Signal in clash-prelude library. Library

Functor

Note: If you are familiar with Functors and Applicative you can skip to prependable

We will say that Signal has property of a functor. Functor f as used in haskell defines function fmap of type (a -> b) -> f a -> f b. Additionally it requires that law fmap id == id holds.

When using with Signal function fmap has type of.

fmap :: (a -> b) -> Signal a -> Signal b
-- or equivalently
fmap :: (a -> b) -> (Signal a -> Signal b)

fmap converts combinatorial circuit having type a -> b to synchronous circuit Signal a -> Signal b. For example, combinatorial function that tels if value is positive can be naively expressed as.

isPositive x = x >= 0

Type signature of isPositive is deduced automatically by compiler as (Ord a, Num a) => a -> Bool. This tels us that such circuit can be synthesized for any a that is both Ord-erable and can be compared against. a additionally needs to be Num-ber. Only those types that has property of Num can be compared against 0. Function isPositive takes value of type a and returns Boolean.

Additionally we can manually define less generic and more restrictive type signature. To define for input that is Signed 6 for example.

isPositive :: Signed 6 -> Bool

Composing combinatorial circuits with synchronous circuits requires that we change function of type Signed 6 -> Bool to function of type Signal (Signed 6) -> Signal Bool .

isPositiveSig :: Signal (Signed 6) -> Signal Bool
isPositiveSig = fmap isPositive

Functor for Signal with function fmap provide transformation from combinatorial circuit to synchronous. Functor additionally requires that law fmap id == id holds, where id is identity function implemented as id x = x. This law guarantees that Signal behaves well and one can not implement fmap using register without breaking such law. Transformation from combinatorial to synchronous circuit is trivial in hardware level. What happens is that only type signature changes, but transformed circuitry remains same.

Before going with MultiSignal let’s take a look in functor properties of Vec n. Vec n a is homogeneous list of elements with length n and type a. For example Vec 5 (Signed 6) is array of 5 elements each having type of Signed 6. Functor Vec n has function fmap with type

fmap :: (a -> b) -> Vec n a -> Vec n b

Using isPositive :: Signed 6 -> Bool and Vec 5 (Signed 6) we can make Vec 5 Bool using fmap

 isArrayPositve :: Vec 5 (Signed 6) -> Vec 5 Bool
 isArrayPositve arr = fmap isPositive arr

or also

 isArrayPositve :: Vec 5 (Signed 6) -> Vec 5 Bool 
 isArrayPositve = fmap isPositive

Fmap is function that transform function operating over single value Signed 6 -> Bool in function operating over vector Vec 5 (Signed 6) -> Vec 5 Bool. In this case fmap makes 5 instances of function isPositive in hardware to generate isArrayPositve. We trust implementor (or check source) of library that fmap for Vec n obeys law fmap id == id. That is, transforming each element of Vec n a with id is same as Vec n a applied on function id.

Functor for MultiSignal

First we define type

data MultiSignal n a = MultiSignal {unMultiSignal :: Signal (Vec n a) }

MultiSignal is similar to Vec and parametrized over 2 types. First n is type level length, because length has to be known at compile time and a is underlying type. MultiSignal on left side of = is type definition and MultiSignal on right side of = is constructor having type Signal (Vec n a) -> MultiSignal n a . To get Signal (Vec n a) from MultiSignal n a there is unMultiSignal :: MultiSignal n a -> Signal (Vec n a) available.

MultiSignal has property of being Functor. We define MultiSignal being Functor as

instance Functor (MultiSignal n) where
    fmap f s = MultiSignal ( fmap ( fmap f ) ( unMultiSignal s ) )

We first apply unMultiSignal to s so we get Signal (Vec n a) from type MultiSignal n a. There are two fmap used here. Leftmost is over Signal where rightmost fmap is over Vec . Resulting type of fmap ( fmap f ) ( unMultiSignal s ) is Signal (Vec n a) and we finally apply MultiSignal constructor to make result type MultiSignal n a.

Applicative

So far we have functor that enables converting combinatorial circuits of type a -> b to synchronous having type Signal a -> Signal b . What remains is extending such concept to converting functions having more than one arrow. For example transforming a -> b -> c -> d in Signal a -> Signal b -> Signal c -> Signal d. Additionally we need concept of delaying Signal using register or d flip flop. Applicative enables transforming from combinatorial to synchronous circuits for arbitrary number of arrows.

Applicative class requires two functions, to be defined.

class Functor f => Applicative f where
    pure :: a -> f a
    (<*>) :: f (a -> b) -> f a -> f b

For signal we need

-- For Signal
pure :: a -> Signal a

pure changes value a to Signal a. On each clock change we get same value. Example: pure True is Signal Bool having boolean True as value on each clock.

Function (<*>) can be used as either operator or function depending on parenthesis so (<*>) a b used as function is same as a <*> b when used as operator.

-- For Signal
(<*>) :: Signal (a -> b) -> Signal a -> Signal b

First argument has type Signal (a -> b). It represents a function that is changing with clock signal. For any class that is Applicative we have available functions

liftA  :: Applicative f => (a -> b) -> f a -> f b
liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d

Using liftAx with Signal enables converting combinatorial circuits having x inputs in synchronous circuits. For f being Signal function liftA2 becomes

liftA2 ::  (a -> b -> c) -> Signal a -> Signal b -> Signal c

liftA2 can be implemented as

liftA2 f s1 s2 = (pure f) <*> s1 <*> s2

Intermediate types are

f                      :: a -> b -> c
pure f                 :: Signal (a -> b -> c)
(pure f) <*> s1        :: Signal (b -> c)
(pure f) <*> s1 <*> s2 :: Signal c

Signal (a -> b -> c) is same as Signal (a -> (b -> c)) and this is why (pure f) <*> s1 has type Signal (b -> c)

Using this pattern liftA5 is expressed

liftA5 f s1 s2 s3 s4 s5 = (pure f) <*> s1 <*> s2 <*> s3 <*> s4 <*> s5

Function liftAx transform combinatorial circuit having arbitrary number of arrows in synchronous circuit. In hardware level such transformation is trivial and what happens is that just type of function change to make compiler happy.

Vec n is also an Applicative and works similar compared to Signal. For Vec n liftA2 when used with Vec has type.

liftA2 :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c

liftA2 for Vec n works in way that takes values at same index to produce value at same index in resulting vector using passed function. As with Functor there are Applicative functor laws that should hold for every implementation of Applicative.

Applicative functor instance of Signal and Vec are similar to reason about. Both works in way, that each value at some place represent value as a result of other values at that place. For example

liftA2 (+) (1:>2:>3:>Nil) (3:>5:>7:>Nil) == (4:>7:>10:>Nil)

MultiSignal as applicative functor

Implementing instance of Applicative functor for MultiSignal enables all required tools for transforming combinatorial circuits in domain of MultiSignal. For example liftA2 is defined in terms of Applicative for MultiSignal as

liftA2 :: (a->b->c) -> MultiSignal n a -> MultiSignal n b -> MultiSignal n c

We need to define two functions

pure :: a -> MultiSignal n a
(<*>) :: MultiSignal n (a -> b) -> MultiSignal n a -> MultiSignal n a

Implementation for Applicative

instance KnownNat n => Applicative (MultiSignal n) where
   pure x = MultiSignal (pure (pure x))
   f <*> s = MultiSignal  (fmap (<*>) fu <*> su) where
      fu = unMultiSignal f
      su = unMultiSignal s

Prependable

Prependable is typeclass to generalize over register . We would like to use single function that can be used to define delay for both Signal and MultiSignal. Prependable works as something that prepends element to the stream.

class Prependable f where
    prepend :: a -> f a -> f a

Defining prepend for Signal is just register.

instance Prependable Signal where
    prepend = register

for MultiSignal: value from register we shift to vector. What pop out at shift we store in register.

instance (KnownNat n, n ~ (m+1)) => Prependable (MultiSignal n) where
    prepend x (MultiSignal s) = 
        MultiSignal $ liftA2 (+>>) (register x (fmap last s)) s

there are two functions used from CLaSH.Prelude. One is (+>>) :: KnownNat n => a -> Vec n a -> Vec n a and other
last :: Vec (n + 1) a -> a Source

What about Prependable laws, you may ask. Instances of Prependable are like Foldable. Foldable enables function toList.

toList (prep a ax) == a : toList ax

Foldable instance of Signal and MultiSignal hardly has representation in hardware, because it requires iterating whole stream that is infinite. For example, calculating sum as single value of infinitely long stream is not what we can do, but that is what foldr1 (+) express. I am still looking for better way to express Prepenadable and figure out better name.

Isomorphic circuits

Whole idea is that we express circuits using Functor, Applicative and Prependable, than synthesize for both Signal and MultiSignal n domain. We have seen how we can change combinatoric circuits in new domain. In this new domain (for example Signal or MultiSignal) we can use prepend as a function that works as register.

Example of simple circuit is accumulator. This is circuitry that outputs sum of all previously received inputs.

         +-------+
         |       |   +------------+
input ---+  ADD  |   |  prepend   |
         |  (+)  +---+ (register) +----+------ output
      +--+       |   |            |    |
      |  |       |   +------------+    |
      |  +-------+                     |
      +--------------------------------+

And this is how we define such circuit using using new tools.

acc input = output where
    output = prepend 0 (liftA2 (+) input output)

Now we can defer instantiation of such circuitry to the point where we define type signature.

topEntity :: MultiSignal 2 (Signed 6) ->  MultiSignal 2 (Signed 6)
topEntity = acc

                        +----------+
                6 bit   |          |
            ------------+   ADD    |                         
                        | Signed 6 +------------------+             
                   +----+          |                  |     output 
     input         |    |          |                  |   2 * Signed 6         
    2 * Signed 6   |    +----------+                  |    +--------
                   |                                  |    |             
                   +---------------------------+      +----|--------
                        +----------+           |      |    |
                        |          |   +-----+ |      |    |
            ------------+   ADD    |   |     | |      |    |      
                        | Signed 6 +---+ REG +-+-----------+    
                   +----+          |   |6 bit|        |             
                   |    |          |   +-----+        |           
                   |    +----------+                  |
                   |                                  |
                   +----------------------------------+

This is how digital acc circuit is instantiated in MultiSignal 2 (Signed 6). Each wire represent 6 bit bus. At each clock we process two synchronous values.

This looks like free optimization technique, all one need is trade space for speed. Right? Well it is not that easy. As we can see signal needs in worst case propagate trough both adders in single clock cycle to reach register REG. This makes maximal operating frequency approx twice lower compared to circuitry operating in Signal or MultiSignal 1. Improvement can be probably found by exploiting associative properties of addition and is something to look into in future.

mr. Mealy & mr. Moore

Example of mealy :: (s -> i -> (s, o)) -> s -> Signal i -> Signal o as expressed using Prependable.

mealyP f d i = o where
   r = liftA2 f (prepend d s) i
   s = fmap fst r
   o = fmap snd r

Compiler automatically deduce type as

mealyP  :: (Prependable f, Applicative f)
        => (s -> i -> (s, o)) -> s -> f i -> f o

This tells us that we can use mealyP on any type that is Prependable and Applicative. Here we use

We can also in similar terms define moore :: (s -> i -> s) -> (s -> o) -> s -> Signal i -> Signal o

mooreP :: (Prependable f, Applicative f) 
       => (s -> i -> s) -> (s -> o) -> s -> f i -> f o
mooreP fs fo s i = fmap fo r where
     r = liftA2 fs (prepend s r) i

And we can also express fir filter nearly same way as it is on front page of clash-lang.org

fir coeffs x = dotp coeffs (windowP x)
  where
    dotp as bs = sum (zipWith (*) as bs)
    windowP  x = iterateI (prepend def) x

Only difference is that we had to define windowP that works over Prependable instead of Signal. Additionally it requires that MultiSignal is instance of Num. Further details are available in clash-multisignal library.

Conclusion

Using few simple concepts we separate composition and construction of circuits. There is clash-multisignal available and can be used as starting point to play with such structures.