Note: This is part 3 of small tutorial on Template Haskell I wrote on my blog; the tutorial is composed of part1, part 2 and part 3.

In the previous part of this tutorial, we introduced an FIR filter generator in Template Haskell. The filter generator produces a syntactic representation of FIR Filters in the Haskell Language. An example application is the following:

myfilter = [ | \ x -> $ ( Filt . flt0 [ 0 , 1 ] [ | x | ]) | ]

which produces the following Haskell AST:

\ x_0 -> (( 0 % 1 ) GHC . Num .* ( x_0 GHC . List .!! 0 )) GHC . Num .+ (( 1 % 1 ) GHC . Num .* ( x_0 GHC . List .!! 1 ))

which corresponds to the following mathematical filter:

\begin{equation} f(x) = 0 \times x[0] + 1 \times x[1] \end{equation}

Now this is all cool but we’d really like to optimize the above as:

\begin{equation} f(x) = x[1] \end{equation}

Besides, we want to be able to make more advanced optimizations. In fact, wouldn’t it be even more cool if we could optimize the concatenation of more filters? For example:

Filt . flt0 [ 0 , 1 ] $ Filt . flt0 [ 0 , 1 ] [ | x | ]

produces the concatenation of two trivial 2-tap filters; the resulting Haskell program, without optimization, is:

\ x -> 0 * 0 * x !! 0 + 1 * x !! 1 !! 0 + 1 * ( 0 * x !! 0 + 1 * x !! 1 ) !! 1

However, one can easily see that the two filters above produce simply x delayed by two:

\begin{equation} f(x) = x[2] \end{equation}

because each of the two filters delays the input by one.

How can we achieve this by manipulating the symbolic representation of the filter in Haskell? Let’s see.

Constant propagation

First of all, we need to propagate away trivial constants such as multiplication by 0 and 1 and additions with 0.

To do this, we need to parse the AST looking for the above patterns. We thus write a recursive function that munches the final expression to produce an optimized one:

constProp :: Exp -> Exp

The function is defined as:

constProp ( InfixE ( Just e1 ) op ( Just e2 )) | ( justZero e1 ) && ( isPlus op ) = e2 | ( justZero e2 ) && ( isPlus op ) = e1 | (( justZero e1 ) || ( justZero e2 )) && ( isTimes op ) = zero | (( justOne e1 )) && ( isTimes op ) = e2 | (( justOne e2 )) && ( isTimes op ) = e1 | otherwise = ( InfixE ( Just ( constProp e1 )) op ( Just ( constProp e2 ))) constProp e = e

where (InfixE (Just e1) op (Just e2)) matches an infix operator op and two expressions e1 and e2 .

By pattern matching we evaluate all the optimizable cases; we use some helper functions such as justZero :

justZero :: Exp -> Bool justZero (( LitE ( RationalL ( 0 )))) = True justZero (( LitE ( IntegerL ( 0 )))) = True justZero _ = False

and justOne :

justOne :: Exp -> Bool justOne (( LitE ( RationalL ( 1 )))) = True justOne (( LitE ( IntegerL ( 1 )))) = True justOne _ = False

to make the match against literals 0 and 1 more readable. Similarly, we use isPlus :

isPlus :: Exp -> Bool isPlus op | op == ( VarE '( N .+ )) = True | otherwise = False

and isTimes to match against plus and times operators:

isTimes :: Exp -> Bool isTimes op | op == ( VarE '( N .* )) = True | otherwise = False

The pattern matches in constProp are easily defined with the above helpers; for example:

| (( justZero e1 ) || ( justZero e2 )) && ( isTimes op ) = zero

tells that if either e1 and e2 are 0 and the operator is * , the expression can be optimized to literal 0 :

zero :: Exp zero = ( LitE ( RationalL ( 0 )))

Obviously, each time we change the AST, we have to check whether new opportunities for optimization arise. Thus we have to iterate until we reach a fixed point with until :

iterateConstProp :: Exp -> Exp iterateConstProp = until ( \ x -> constProp x == x ) constProp

To apply iterateConstProp within the Q monad, we need to bind the input expression and return the result within the monad:

simplify :: ExpQ -> ExpQ simplify eq = do e <- eq return ( iterateConstProp e )

Now let’s see how the concatenation of the two filters presented above is optimized:

pipe = [ | \ x -> $ ( simplify $ Filt . flt0 [ 0 , 1 ] $ Filt . flt0 [ 0 , 1 ] [ | x | ]) | ] main = printCode $ wrappedPipe

Which gives as result:

\x_0 -> (x_0 GHC.List.!! 1) GHC.List.!! 1

</img>

Domain specific optimization

To simplify further, we have to apply a domain specific optimization; in particular, we are going to look for a concatenation of delay operators !! , so that:

(exp !! a) !! b => exp !! (a + b)

where a+b is evaluated at compile time. To achieve this, we define:

delayOpt :: Exp -> Exp delayOpt ( InfixE ( Just e1 ) op ( Just e2 )) | isDelay ( op ) && isDelayedSignal ( e1 ) && isNum ( e2 ) = fuseDelays e1 op e2 | otherwise = ( InfixE ( Just ( delayOpt e1 )) op ( Just ( delayOpt e2 )))

This function needs to be iteratively applied together with iterateConstProp . The nature of this function is very similar to iterateConstProp in that it visits the AST tree looking for opportunities to simplify delay expressions.

As usual, we use some helper predicates; isDelay checks whether the top operator is a delay operator ( !! ):

isDelay :: Exp -> Bool isDelay op | op == ( VarE '( L .!! )) = True | otherwise = False

isDelayedSignal checks whether we have a nested delay:

isDelayedSignal :: Exp -> Bool isDelayedSignal ( InfixE ( Just e1 ) op ( Just e2 )) | isDelay ( op ) && isNum ( e2 ) = True | otherwise = False isDelayedSignal e = False

Finally, we can apply this optimization only to literal values of the coefficients so we need to define:

isNum :: Exp -> Bool isNum (( LitE ( RationalL ( a )))) = True isNum (( LitE ( IntegerL ( a )))) = True isNum _ = False

fuseDelays constructs a new infix AST node by collapsing the delays as described above:

fuseDelays :: Exp -> Exp -> Exp -> Exp fuseDelays e1 op e2 = let d = getDelayValue e1 s = getDelayedSignal e1 c = getNum e2 in ( InfixE ( Just s ) op ( Just ( LitE ( RationalL ( d + c )))))

where getDelayedSignal , getDelayValue and getNum are some helper accessors.

To use delayOpt we need create a simplifyPass that consists of the concatenation of both iterateConstProp and delayOpt :

simplifyPass :: Exp -> Exp simplifyPass eq = do delayOpt $ iterateConstProp eq

finally, we need to iterate simplifyPass until we reach a fixed point :

simplifyAll = until ( \ x -> simplifyPass x == x ) simplifyPass

and modify simplify as follows:

simplify :: ExpQ -> ExpQ simplify eq = do e <- eq return ( simplifyAll e )

If we optimize again our pipeline:

pipe = [ | \ x -> $ ( simplify $ Filt . flt0 [ 0 , 1 ] $ Filt . flt0 [ 0 , 1 ] [ | x | ]) | ] main = printCode $ wrappedPipe

Which gives as result:

\ x_0 -> x_0 GHC . List .!! ( 2 % 1 )

I.e., the input signal delayed by two.

</img>