The library implements a framework for computing with small, fixed-size vectors such as complex numbers or coordinates. My goal was to be as generic and efficient as possible. In particular, it should be easy to generically define common functions such as dot product or magnitude for vectors of arbitrary arity and to add new vector types and operations. Equally importantly, there shouldn’t be any run-time overhead – all operations should be as fast as if they were written by hand.

There are a number of nice libraries on Hackage which provide all this to varying degrees. However, I thought it would be fun to write my own and perhaps I could come up with a design that is minimal in some sense. In the end, I’m not sure about minimal but I sure did have quite a bit of fun.

So what is a small, fixed-size vector? Essentially, it should be completely defined by two operations:

construct :: a -> ... -> a -> v a
inspect :: v a -> (a -> ... -> a -> b) -> b

That is, we can construct a vector from a bunch of coordinates and inspect it with a function that takes a bunch of coordinates and produces some result. The number of coordinates is the arity of the vector and is known at compile time. Ideally, the framework should work for all types that define these two operations and nothing else. The question is: can we just put them in a type class and implement everything else on top of it?

The two signatures suggest (unsurprisingly) that functions of type a -> ... -> a -> b play a rather central role here: construct is such a function and inspect takes such a function as an argument. Nowadays, it is fairly straightforward to encode them in the type system. First, we define type-level natural numbers which represent the arity:

data Z     -- zero
data S n   -- successor of n

Now, we can define such functions as a type family parametrised by the arity n, the type of arguments a and the result type b:

type family Fn n a b
type instance Fn Z a b = b
type instance Fn (S n) a b = a -> Fn n a b

For example, functions or arity 2 are represented by Fn (S (S n)) a b = a -> a -> b.

To define a generic vector class, we also have to associate vectors with their arity. This is easy:

type family Dim (v :: * -> *)

One design decision here is that vectors are type constructors such as Complex which must be applied to an element type. This makes certain things easier but means that tuples like (Int,Int,Int) aren’t vectors. An alternative design in the style of the vector-space package is also possible and easily supported by the framework. But that’s a topic for another post.

Anyway, a generic vector class should be easy now:

class Vector v a where
  construct :: Fn (Dim v) a (v a)
  inspect :: v a -> Fn (Dim v) a b -> b

Alas, this fails quite miserably. The problem is that a and v are not fixed in construct. Fn is a non-injective type family and so there is no way to find outwhat v and a are from Fn (Dim v) a (v a).

To fix that, it is enough to introduce an injective type constructor which captures Fn:

newtype Fun n a b = Fun (Fn n a b)

Now, Fn is a type function which captures functions from n as to b and Fun is a type constructor which does the same but is injective.

As an aside, it is well possible to make Fun an injective data type family or even a GADT and forgo Fn altogether:

data family Fun n a b
newtype instance Fun Z a b = FunZ b
newtype instance Fun (S n) a b = FunS (a -> Fun n a b)

However, this really messes up GHC’s optimiser and leads to very inefficient code. The slightly more complex setup with Fn and Fun is much better in this respect and not that hard to understand. Just keep in mind that Fn n a b doesn’t fix the types n, a and b and Fun does.

The final definition of Vector looks like this:

class Arity (Dim n) => Vector v a where
  construct :: Fun (Dim v) a (v a)
  inspect :: v a -> Fun (Dim v) a b -> b

Here is a simple instance:

type instance Dim Complex = S (S Z)
instance RealFloat a => Vector Complex a where
  construct = Fun Complex
  inspect (Complex x y) (Fun f) = f x y

This is nice but rather pointless unless we can do something useful with these vectors. And we can! All necessary functionality is folded into the Arity type class which is a superclass of Vector. Here is its definition and instances for Z and S:

class Arity n where
  accum :: (forall m. t (S m) -> a -> t m) -> (t Z -> b) -> t n -> Fn n a b
  apply :: (forall m. t (S m) -> (a, t m)) -> t n -> Fn n a b -> b

instance Arity Z where
  accum f g t = g t
  apply f t h = h

instance Arity n => Arity (S n) where
  accum f g t = \a -> accum f g (f t a)
  apply f t h = case f t of (a,u) -> apply f u (h a)

This might look a bit scary but really isn’t. At least not very. The two methods allow us to define (accum) and apply n-ary functions generically. Let’s look at the latter first. In apply f t h, t is a seed which can generate n values of type a, where n is statically encoded in its type. From this seed, the function f produces one a value and a new seed which now embeds n-1 values. It can do this for any n which means that we can apply it repeatedly to obtain all values stored in the seed. These values are then passed to h, which ultimately yields a result of type b. Here is an example of how to use apply:

data T_replicate n = T_replicate

replicateF :: forall n a b. Arity n => a -> Fun n a b -> b
replicateF x (Fun h) = apply (\T_replicate -> (x, T_replicate))
                             (T_replicate :: T_replicate n)
                             h

This function applies an n-ary Fun to n copies of x. The seed T_replicate doesn’t carry any useful information, it just fixes n. When asked to produce a new a, we simply return x; the new seed is T_replicate with a different n.

Now, it is easy to define a generic replicate for arbitrary vectors:

replicate :: Vector v a => a -> v a
replicate x = replicateF x
            $ construct

To understand how it all works, Let’s see how the term replicate 0 :: Complex Double is evaluated:

  replicate 0 :: Complex Double
= replicateF x (construct :: Fun (S (S Z)) Double (Complex Double))
= let f :: forall m. T_replicate (S m) -> (Double, T_replicate m)
      f T_replicate = (x, T_replicate)
  in
  apply f
        (T_replicate :: T_replicate (S (S Z)))
        Complex
= let f = ...
  in
  case f (T_replicate :: T_replicate (S (S Z))) of
    (x,u) -> apply f u (Complex x)
= let f = ...
  in
  apply f (T_replicate :: T_replicate (S Z)) (Complex x)
= let f = ...
  in
  case f (T_replicate :: T_replicate (S Z)) of
    (x,u) -> apply f u (Complex x)
= let f = ...
  in
  apply f (T_replicate :: Z) (Complex x x)
= Complex x x

The interesting part is, of course, that replicate works for vectors of arbitrary arities. Equally importantly, everything is evaluated at compile time – GHC really compiles the term to (0 :+ 0).

The other method of Arity, accum, is slightly more involved. The call accum f g t produces a function which accumulates its arguments (of type a) by repeatedly applying f to an accumulator value (starting with t) and an a argument. The number of values that can be accumulated into t is, again, determined by its type and decreases with each application of f. After accumulating all arguments in this way, we end up with a value of type t Z from which g produces the final result.

Here are two examples of how to use accumulate:

newtype T_foldl b n = T_foldl b

foldlF :: forall n a b. Arity n => (b -> a -> b) -> b -> Fun n a b
foldlF f b = Fun $ accum (\(T_foldl b) a -> T_foldl (f b a))
                         (\(T_foldl b) -> b)
                         (T_foldl b :: T_foldl b n)

newtype T_map b c n = T_map (Fn n b c)

mapF :: forall n a b c. Arity n => (a -> b) -> Fun n b c -> Fun n a c
mapF f (Fun h) = Fun $ accum (\(T_map h) a -> T_map (h (f a)))
                             (\(T_map h) -> h)
                             (T_map h :: T_map b c n)

Their semantics shouldn’t be surprising:

foldlF f z = \a1 ... an -> z `f` a1 `f` ... `f` an
mapF f h   = \a1 ... an -> h (f a1) ... (f an)

There are, of course, more useful functions which can be defined in this way. Of these, the most important is probably zipWithF. I’ll leave its implementation as an exercise for the interested reader (should there be any) for now. It is a bit elaborate but not that difficult to come up with. Took me only a few hours or so.

Now that we have all these nice functions, it is quite easy to implement a lot of useful stuff for our vectors. Here are a few examples:

map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b
map f v = inspect v
        $ mapF f
        $ construct

zipWith :: (Vector v a, Vector v b, Vector v c)
        => (a -> b -> c) -> v a -> v b -> v c
zipWith f v w = inspect w
              $ inspect v
              $ zipWithF f
              $ construct

fold :: Vector v a => (b -> a -> b) -> b -> v a -> b
fold f z v = inspect v
           $ foldF f z

eq :: (Vector v a, Eq a) => v a -> v a -> Bool
eq v w = inspect w
       $ inspect v
       $ zipWithF (==)
       $ foldF (&&) True

The structure of these functions reflects the fact that we are essentially programming in continuation-passing style.

All this is nicely generic but what about efficiency? With appropriate INLINE pragmas, GHC’s mighty simplifier is perfectly capable of eliminating all intermediate data and functions and produce code that is equivalent to what we would write by hand. For example, here is a small function:

isZero :: Complex Double -> Bool
isZero x = V.eq x (V.replicate 0)

The code generated by GHC is perfect:

\ (x_agj :: Complex Double) ->
  case x_agj of _ { :+ x1_XxL y_XxO ->
  case x1_XxL of _ { D# x2_awT ->
  case ==## x2_awT 0.0 of _ {
    False -> False;
    True -> case y_XxO of _ { D# x3_Xy6 -> ==## x3_Xy6 0.0 }
  } } }

There is a fairly obvious connection between accum and apply and well-known list operations. Consider that Fun n a b is, in a sense, equivalent to a partial function of type [a] -> b. The Arity methods then correspond to the following functions:

accumList :: (t -> a -> t) -> (t -> b) -> [a] -> b
applyList :: (t -> (a,t)) -> t -> ([a] -> b) -> b

Of course, accumList is just a disguised foldl and applyList is almost exactly unfoldr. It would be nicer if accum corresponded to foldr instead of foldl but that would lead to much uglier code.

Anyway, this is it for now. I’m still cleaning up the library (which doesn’t have any comments whatsoever at the moment) but a first version should appear on Hackage in the next week or so.

let x = expensive computation 1
    y = expensive computation 2
in
(x `par` y) `pseq` (x+y)

The pseq is necessary because we have to tell the compiler to evaluate x `par` y before x+y. This is all explained in Algorithm + Strategy = Parallelism.

Internally, when x `par` y is evaluated the runtime system creates a spark for x. A spark is a bit like a thread but cheaper. The RTS maintains a queue of sparks and evaluates them whenever it has a spare CPU or core. The scheduling algorithm is based on work stealing and is really quite sophisticated. A detailed description of the RTS is given in Runtime Support for Multicore Haskell.

Let’s try to abuse this mechanism a bit by sparking ST computations rather than pure ones. Here is how:

parST :: ST s a -> ST s a
parST m = x `par` return x
  where
    x = runST (unsafeIOToST noDuplicate >> unsafeCoerce m)

First, we create a thunk x which, when evaluated, runs the ST computation m. The parallel RTS will sometimes evaluate thunks twice which is fine for pure computations (it just duplicates work) but could be disastrous for stateful ones since it could duplicate side effects. The call to noDuplicate (from GHC.IO) ensures that this doesn’t happen. Then, we spark x and return it. Note that return is lazy and doesn’t evaluate x. This is absolutely crucial.

It is quite possible to implement parST in terms of forkIO. However, sparks are much cheaper than threads (yes, even than GHC threads) which means that this implementation ought to support much more fine-grained parallelism.

So how do we use parST? The basic idea is to spark computations, do something else for a while and then synchronise by demanding the results:

do
  x <- parST $ foo
  bar
  x `seq` return ()

The last line ensures that foo is executed one way or another: either in parallel to bar or after bar when its result is demanded by seq. We can capture an instance of this pattern in a combinator:

(|||) :: ST s () -> ST s () -> ST s ()
p ||| q = do
            u <- runST p
            q
            u `seq` return ()

This is quite straightforward to use. Here is a rather simple-minded version of in-place Quicksort:

qsort :: (MVector v a, Ord a) => v s a -> ST s ()
qsort v
  | n < 2 = return ()
  | otherwise = do
                  x <- unsafeRead v (n `div` 2)
                  i <- unstablePartition (<x) v
                  qsort (unsafeSlice 0 i v)
                    ||| qsort (unsafeSlice (max i 1) (n-i) v)
  where
    n = length v

This looks just like sequential Quicksort except that the two recursive calls are potentially executed in parallel.

Interestingly, the programming model that parST gives us is very well known (e.g., as lazy threads). In particular, Cilk, which I rather like, is based on a very similar approach. It is quite amazing that we can get this with basically 2 lines of Haskell code.

This leaves two questions. Firstly: is it safe? I think (but I’m not sure) that the answer is yes for IO (we can define parIO similarly to parST) but it is definitely not safe for ST. Here is an example that produces different results depending on scheduling and compiler optimisations:

let x = runST (do { r <- newSTRef 0; writeSTRef r 1 ||| writeSTRef r 2; readSTRef r })
    y = runST (do { r <- newSTRef 0; writeSTRef r 1 ||| writeSTRef r 2; readSTRef r })
in x == y

It ought to be possible to build a safe library on top of it, though.

So what about performance? Alas, I don’t have time to pursue this at the moment so I have absolutely no idea. The only real benchmark I tried is Introsort from Dan Doel’s vector-algorithms which I parallelised like Quicksort above (that is, I changed exactly one line). The chart below shows the running times for sorting 10M random elements (in seconds) vs. the number of cores on an 8-core XServe. Clearly, it does things in parallel but it doesn’t really scale. I have my suspicions as to why this is the case (I blame noDuplicate) but I need to investigate more. It is quite encouraging, however, that the very naive parallel algorithm is barely slower than the sequential one on 1 core (1.98s vs. 2.08s).

• DPH-style unboxed vectors (in Data.Vector.Unboxed) which use associated types to select the appropriate unboxed representation depending on the type of the elements.
• Redesigned interface between mutable and immutable vectors. In particular, the popular unsafeFreeze primitive is now supported for all vector types.
• Many new operations on both immutable and mutable vectors.
• Significant performance improvements.

The release is accompanied by a new version of the NoSlow array benchmark suite which has been cleaned up and significantly extended. In particular, it now includes a couple of small array algorithms which probably provide a much better indication of overall performance than just loop kernels. Alas, I didn’t have enough time to do a lot of benchmarking but here is a graph which shows how much faster NoSlow algorithms run when using vector compared to dph-prim-seq with the current development version of GHC. Note that this shows both safe (bounds checking) and unsafe (no bounds checks) versions of the algorithms. In general, bounds checking doesn’t seem to cost much because we mostly use collective operations which don’t require any checks. However, it is rather weird that for list_rank and hyb_cc, bounds checking actually makes things faster. This probably points to a problem somewhere in the simplifier.

• standard lists
• primitive arrays from the DPH project (package dph-prim-seq)
• uvector (a fork of the above)
• vector (primitive, storable and boxed arrays)
• storablevector

The actual benchmarking is done by Brian O’Sullivan’s wonderful criterion.

NoSlow is a very young project so the output isn’t particularly pretty but it does the job. It is also not very thoroughly tested and only includes a very restricted set of benchmarks so saying “library x is better than library y because it produces better numbers in NoSlow” would be completely and utterly wrong. However, it is quite useful for identifying cases where taking a closer look at the code generated for a particular loop might be a good idea. It already helped me spot one tricky performance regression in the standard list library.

Here is an example of the data it produces.

Benchmarks

At the moment, NoSlow only benchmarks a bunch of very small and fairly random loop kernels as I was more concerned with getting the infrastructure in place. Here is an example (called $a+$b in the table):

dotp as bs = sum (zipWith (*) as bs)

When it is built, NoSlow compiles several different versions of this loop. For instance, for the storablevector backend it will generate these two functions:

dotp :: (Storable a, Num a) => StorableVector a -> StorableVector a -> a
dotp :: StorableVector Double -> StorableVector Double -> Double

The first one is overloaded on the element type whereas the second one is specialised to Double. NoSlow does this for all its backends and then runs all generated versions of the benchmark with the same test data. With more testing and more benchmarks, this will give us a rough estimate of the relative performance of the different array libraries. It also shows how much faster specialised loops are compared to their polymorphic versions

Here is the output of a full run. *Double and Double are overloaded and specialised loops, respectively. At the moment, NoSlow only does Double benchmarks but adding more types is easy.

NoSlow can also be used to see how well different GHC versions optimise array loops. Here is a comparison of the current HEAD to GHC 6.10.4 (2 means 6.13 is 2x slower, 0.5 means it is 2x faster).

Usage

The current interface is rather minimalistic. After building NoSlow, you get two binaries: noslow and noslow-table. The first one runs the actual benchmarks and produces a log file:

noslow -u log

The log can then be fed to noslow-table to generate HTML tables:

noslow-table log > table.html

We can also restrict the output to a particular data type:

noslow-table log --type=Double > table.html

or compare two logs:

noslow-table --diff log1 log2 > table.html

In this case, the table will contain ratios of corresponding values from the two logs, just like in the table above.

Compiling

NoSlow should work out of the box with GHC 6.10. I haven’t tried it with 6.12 because I didn’t have time to install the release candidate and the required packages. Getting it to build with the HEAD (which is what I’m interested in) is a rather annoying process, though, because uvector is missing a DPH patch which would make it work with the new IO system. Fortunately, I could simply transplant some code from the DPH library (the module is dph-base/Data/Array/Parallel/Data/Array/Parallel/Arr/BUArr.hs) and everything worked.

Also, storablevector depends on QuickCheck 1 which doesn’t seem to compile with the HEAD. I just removed all references to QuickCheck from the code but it might be easier to simply not build the storablevector backend (there is a flag for that).

How it works

Benchmarking itself is rather straighforward – all the exciting bits are in criterion. The heart of NoSlow is the specialiser – a Template Haskell function that takes a bunch of abstract loop kernels and specialises them for a particular backend and data type. Here is how it works. The kernels themselves are implemented in a TH quote:

kernels = [d| ...
    dotp :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a -> a
    dotp _ as bs = named "sum($a*$b)" $ I.sum (I.zipWith (*) as bs)
    ... |]

They refer to functions from module I (short for NoName.Backend.Interface) which are just stubs and do not provide any real functionality. The specialiser traverses the ASTs of the kernels (which it has access to since they are quoted) and replaces references to those stubs with calls to functions from the backend that it is specialising for. For instance, it replaces I.sum by NoSlow.Backend.List.sum (which is just a reexport of the Prelude function) when specialising for lists. It also adjusts signatures and looks for tags like named in the example above which defines the kernel’s name in the HTML output.

This scheme has one big advantage: it allows backends to mark some kernels as unsupported. An example is storablevector which does not support arrays of pairs. The corresponding backend defines zip like this:

zip :: Undefined
zip = Undefined

When replacing I.zip with NoSlow.Backend.StorableVector.zip, the specialiser reifies the latter, notices that its type is Unsupported and omits the kernel that contains the call to zip altogether.

data T a where
  TInt  :: Int -> T Int
  TPair :: T a -> T b -> T (a,b)

and a function which does something with it:

sumT :: T a -> Int
sumT (TInt n) = n
sumT (TPair l r) = sumT l + sumT r

Now, let’s use the two:

term = TPair (TPair (TInt 1) (TInt 2)) (TInt 3)
foo = sumT term

Since foo is constant, we would expect GHC to evaluate it at compile time and just bind it to 6 in the compiled code, right?

Wrong! For this to happen, GHC would have to inline sumT. But sumT is a recursive function and GHC never inlines those because it might get into an infinite loop otherwise. This means that it won’t optimise foo at all which was absolutely unacceptable in my program. I spent about two days fiddling with inline pragmas, rewrite rules and other unpleasant things until I found a satisfactory solution.

My first attempt was to only inline sumT if it is applied to a constructor. We could try adding a couple of rewrite rules.

"sumT/TInt"  forall n. sumT (TInt n) = n
"sumT/TPair" forall l r. sumT (TPair l r) = sumT l + sumT r

Alas, this doesn’t work most of time. Basically, trying to match on non-trivial constructors in rewrite rules is never a good idea. We could introduce “virtual” constructors, use them everywhere instead of the real ones and match on them.

tInt :: Int -> T Int
{-# NOINLINE CONLIKE tInt #-}
tInt = TInt

tPair :: T a -> T b -> T (a,b)
{-# NOINLINE CONLIKE tPair #-}
tPair = TPair

"sumT/tInt" forall n. sumT (tInt n) = n
"sumT/tPair" forall l r. sumT (tPair l r) = sumT l + sumT r

This works much better but, unfortunately, still fails in my program. There, I make extensive use of type families so the Core generated by GHC has casts all over the place. Casts make rule matching highly unreliable because rules don’t ignore them (a particularly ugly wart that I keep running into). So what to do?

The solution I came up with requires adding a unit component to every recursive constructor.

data T a where
  TInt  :: Int -> T Int
  TPair :: () -> T a -> T b -> T (a,b)

Where we previously wrote TPair, we will now write TPair (). In fact, let’s provide a convenience function for that:

tPair :: T a -> T b -> T (a,b)
tPair = TPair ()

Now, we define a non-recursive version of sumT which is parametrised with a function it is supposed to apply to the pair components.

sumT_cont :: (forall a. () -> T a -> Int) -> T a -> Int
{-# INLINE sumT_cont #-}
sumT_cont cont (TInt  n) = n
sumT_cont cont (TPair u l r) = cont u l + cont u r

Note that since sumT_cont isn’t recursive it can be freely inlined. Note also that we pass the unit value from the constructor to cont. This is absolutely essential.

The actual recursive sum is defined via sumT_cont. Of course, it has to be parametrised with () (which it ignores).

sumT' :: () -> T a -> Int
sumT' _ = sumT_cont sumT'

sumT :: T a -> Int
{-# INLINE sumT #-}
sumT = sumT' ()

The final missing piece that makes the whole thing work is this simple rewrite rule:

"sumT'"  sumT' () = sumT_cont sumT'

It “inlines” sumT' but only if it is applied to (). Why is this useful? Let’s see what happens if we apply sumT to a term which GHC knows nothing about:

   sumT x
= {inline sumT}
   sumT' () x
= {apply rule "sumT'"}
   sumT_cont sumT' x
= {inline sumT_cont}
    case x of TInt n -> n
              TPair u l r -> sumT' u l + sumT' u r

Rewriting sumT' to sumT_cont sumT’ again would be a disaster as it would put us into an infinite rewriting loop. This is precisely the reason why GHC won't inline recursive functions. But our rule doesn't match here because u is not guaranteed to be ()!

So what happens if we apply sumT to a term that is at least partially static?

   sumT (tPair (tInt 1) y)
= {inline sumT and tPair}
   sumT' () (TPair () (TInt 1) y)
= {apply rule "sumT'"}
   sumT_cont sumT' (TPair () (TInt 1) y)
= {inline sumT_cont}
    case TPair () (TInt 1) y of TInt n -> n
                                TPair u l r -> sumT' u l + sumT' u r
= {eliminate case}
   sumT' () (TInt 1) + sumT' () y
= {apply rule "sumT'" twice}
    sumT_cont sumT' (TInt 1) + sumT_cont sumT' y
= {inline sumT_cont, eliminate case}
    1 + case y of TInt n -> n
                  TPair u l r -> sumT' u l + sumT' u r

This looks good! In effect, GHC executed sumT for the statically known portion of the term at compile time and deferred the rest to run time. This worked because when it eliminated the case on TPair it bound u in the case alternative to (). This allowed it to apply the "sumT'" rule again and thus to get rid of the TInt constructor in the left component. The right component is unknown, though, so rewriting stops there. In general, after "inlining" (via the rewrite rule) sumT' once, GHC will only apply the rule again if it eliminates the case, thus binding u to (). This, in turn, is only possible if the head of the term is a known constructor so GHC will continue rewriting and inlining until it consumes all known constructors but will not get into an infinite loop. For foo from my first example, which is fully constant, it will perform the entire computation at compile time and reduce it to 6.

A word of warning: it is possible to get GHC into an infinite loop with this approach by constructing infinite but statically known terms. For instance, we could apply the same technique to this type.

data U = UInt Int | UPair U U

But now, this term gets us into trouble:

x = UPair (UInt 1) x

This technique works best with GADTs like T that do not admit infinite terms.

With a bit of thought, this turns out to be surprisingly easy. Since DPH uses stream fusion, (almost) all those loops operate on streams. Now, the basic idea is to annotate all streams with a string which tells us how the stream has been produced.

data Stream a = forall s. Stream ... String

replicateS :: Int -> a -> Stream a
replicateS n x = Stream ... "replicateS"

mapS :: (a -> b) -> Stream a -> Stream b
mapS f (Stream ... c) = Stream ... ("mapS <- " ++ c)

and so on. Now, when a real loop consumes a stream it simply logs its running time together with the stream’s producer:

unstreamU :: Stream a -> UArr a
unstreamU (Stream ... c) = runST (traceLoopST ("unstreamU <- " ++ c) $ fill)
  where
    fill =

Since streams are purely compile-time structures and no streams should be left in the program if the simplifier is doing its job properly, all those strings simply go away if we compile our library without tracing (i.e., make traceLoopST a noop). With tracing on, however, our rather fancy implementation actually produces dtrace events at the beginning and at the end of a loop. This is a very flexible mechanism. In particular, it allows us to produce profiles like this (pardon my formatting):

  ...
  unstreamMU <- zipWithS <- (zipWithS <- (zipWithS <- (replicateEachS <- zipWithS <- (streamU, streamU), streamU), zipWithS <- (replicateEachS <- zipWithS <- (streamU, streamU), streamU)), zipWithS <- (zipWithS <- (replicateEachS <- zipWithS <- (streamU, st         12115903
  unstreamMU <- mapS <- mapS <- streamU                      21787693
  foldS <- streamU                                           27096786
  unstreamMU <- zipWithS <- (streamU, mapS <- fold1SS <- (streamU, zipWithS <- (enumFromToEachS <- zipWithS <- (replicateS, mapS <- streamU), streamU)))         60756439
  unstreamMU <- toStream                                    817568512

This shows the raw running time for each kind of stream loop in the program. Of course, it doesn’t distinguish between different instantiations of the same loop structure (for instance, foldS <- streamU occurs rather frequently) but it’s still very helpful and doesn’t require any compiler support whatsoever. Ignoring toStream which is only called during test data generation, the loop with fold1SS takes by far the most time. Indeed, it turns out that fold1SS is the problem; optimising its implementation speeds up the program almost by a factor of 2.

Implementing all this took less than one day. I guess this shows yet again: don’t mess with the compiler if you can mess with the library instead. Also, use Haskell.

As we know, recursive data types are fixpoints of non-recursive ones. So, for instance, the standard list data type:

data [a] = [] | a : [a]

is just the fixpoint of this guy:

data PreList a s = Nil | Cons a s

with these simple injection/projection functions:

inject :: PreList a [a] -> [a]
inject Nil         = []
inject (Cons x xs) = x : xs

project :: [a] -> PreList a [a]
project []     = Nil
project (x:xs) = Cons x xs

Of course, PreList is also a functor:

instance Functor (PreList a) where
  fmap f Nil        = Nil
  fmap f (Cons x s) = Cons x (f s)

Now, our goal is to mutilate the standard short cut fusion rules by using PreList as much as possible. Let’s do destroy/unfoldr first:

destroy :: (forall s. (s -> PreList a s) -> s -> t) -> [a] -> t
destroy g = g project

unfoldr :: (s -> PreList a s) -> s -> [a]
unfoldr f = inject . fmap (unfoldr f) . f

The fusion rule is

destroy g (unfoldr f s) = g f s

Of course, unfoldr is just the list anamorphism but what’s so special about destroy? If we squint hard enough at its type we might realise that

forall t. (forall s. (s -> PreList a s) -> s -> t) -> t

is, in fact, isomorphic to

exists s. (s -> PreList a s, s)

This being Haskell, we have to introduce a separate data type for the existential:

data Unfolding a = forall s. Unfolding (s -> PreList a s) s

This makes the signatures of our two functions a lot simpler:

destroy :: [a] -> Unfolding a
destroy xs = Unfolding project xs

unfoldr :: Unfolding a -> [a]
unfoldr (Unfolding f s) = ana s
  where
     ana = inject . fmap ana . f

And the fusion rule is a bit nicer, too:

destroy (unfoldr s) = s

In fact, what we have here is almost but not quite stream fusion: destroy is equivalent to stream, unfoldr to unstream and Unfolding to Stream. The only difference is that PreList (which corresponds to the Step data type in the paper) is missing the Skip constructor which, unfortunately, is crucial for making the whole thing work.

This part was clear to me back when we were doing stream fusion but the next bit I didn’t understand until recently. The question is: can we do something similar with foldr/build? Again, let’s get rid of as many funny types as possible and use PreList instead:

foldr :: (PreList a s -> s) -> [a] -> s
foldr f = f . fmap (foldr f) . project

build :: (forall s. (PreList a s -> s) -> s) -> [a]
build g = g inject

If you are wondering where these signatures come from, here is a little hint:

(a -> s -> s) -> s -> t   ~   ((a,s) -> s) -> (() -> s) -> t    ~   ((a,s)+() -> s) -> t   ~   (PreList a s -> s) -> t

Now, by squinting at the types we might just see that it makes sense to introduce an abstraction:

data Folding a = Folding (forall s. (PreList a s -> s) -> s)

and use it:

foldr :: [a] -> Folding a
foldr xs = Folding (\f -> let cata = f . fmap cata . project in cata xs)

build :: Folding a -> [a]
build (Folding g) = g inject

Voilà! We now have a shiny new foldr/build fusion rule:

foldr (build s) = s

It’s probably worth pointing out that Folding does, in fact, support many useful list operations. Here is an example:

instance Functor Folding where
  fmap f (Folding g) = Folding (\h -> g (h . emap))
    where
      emap Nil        = Nil
      emap (Cons x s) = Cons (f x) s

So is there a point to all this? Well, I find it quite interesting that foldr/build fusion can be rewritten in this way. I’m even more intrigued by what we get if we squint at the list hylomorphism:

refold :: Unfolding a -> Folding a
refold (Unfolding g s) = Folding (\f -> let hylo = f . fmap hylo . g in  hylo s)

Could we have both stream fusion and foldr/build in one framework? Would that be useful? Is there a way of working on fusion without irreparably damaging my eyes?