These notes accompany the article *Exploiting algebra/coalgebra dualities for program fusion extensions*. We present a small benchmark comparing time and space performance of a
set of sample programs whose original versions are compared against the fused
versions obtained with HFusion.
A step by step explanation of how the fused
versions are obtained can be found in chapter 8 of [1].
The results were measured by compiling the programs with the Glasgow Haskell
Compiler (GHC) version 6.8.3 feeding it with the -O option which enables various optimizations incluiding the shortcut fusion implementation of GHC for functions in the standard libraries. This implies that the tests presented below always offered a chance to GHC to improve the programs via shortcut fusion, though it would do so only in the case of compositions of functions in the standard libraries which mostly appear in just one of the tests.

The following table presents the time comparisons in seconds. The time ratio is calculated as 100 * F/O where O is the running time of the original program and F is the running time of the fused program.

Program |
O |
F |
time ratio |

sumMapGenBTree | 9.87 | 0.002 | 0.02% |

normalizer | 21.45 | 19.52 | 91% |

list comprehension | 28.11 | 13.55 | 48% |

paramorphism | 9.44 | 0.001 | 0.01% |

When fusion eliminates all of the intermediate data structures the improvements are dramatic. These numbers should be considered with caution since our test programs do not perform any expensive computations like I/O. This makes the relative weight of the intermediate data structures significant to the performance.

In the following table we present the comparisons of total allocated bytes. The space ratio is calculated as 100 * F/O where O is the count of kilobytes allocated by the original program and F is the count of kilobytes allocated by the fused program.

Program |
O |
F |
space ratio |

sumMapGenBTree | 1,597,665 | 35 | 0.002% |

normalizer | 376,035 | 374,384 | 99.6% |

list comprehension | 7,334,792 | 4,615,283 | 62.9% |

paramorphism | 1,589,151 | 44 | 0.003% |

Greater savings in allocated memory seem to imply greater improvements in running times. In practice, the critical computations may not be those suitable for deforestation, therefore, more modest results should be expected when working with real programs.

At present HFusion is not capable of finding compositions inside programs automatically. So to create this tests, we had to find the compositions ourselves and fed them to the tool.

For each of the programs in the testsuite we present the original program followed by the fused program.

data BTree a = Node a (BTree a) (BTree a) | Leaf main :: IO () main = print (sumBTree$ mapBTree (1+)$ genBTree 23) mapBTree :: (a->b) -> BTree a -> BTree b mapBTree f Leaf = Leaf mapBTree f (Node a l r) = Node (f a) (mapBTree f l) (mapBTree f r) sumBTree :: BTree Int -> Int sumBTree Leaf = 0 sumBTree (Node i l r) = i + sumBTree l + sumBTree r genBTree :: Int -> BTree Int genBTree 0 = Leaf genBTree i = Node i (genBTree (i-1)) (genBTree (i-1)) |

main :: IO () main = print (sumBTree_mapBTree_genBTree (1+) 23) sumBTree_mapBTree :: (Int->Int) -> BTree Int -> Int sumBTree_mapBTree f Leaf = 0 sumBTree_mapBTree f (Node a l3 r3) = f a + sumBTree_mapBTree f l3 + sumBTree_mapBTree f r3 sumBTree_mapBTree_genBTree :: (Int->Int) -> Int -> Int sumBTree_mapBTree_genBTree f 0 = 0 sumBTree_mapBTree_genBTree f v2 = f v2 + sumBTree_mapBTree_genBTree f (v2 - 1) + sumBTree_mapBTree_genBTree f (v2 - 1) |

n = 500000 main :: IO () main = print$ eval n (genexp (freshvars 0) "v" n) -- Abstract syntax for lambda expressions type Variable = String data Exp = Eapp Exp Exp -- e e | Elamb Variable Exp -- \v.e | Evar Variable -- v deriving Show -- Substitution of of variables by terms subst :: [(Variable,Exp)] -> Exp -> Exp subst ls e@(Evar var) = case lookup var ls of Just e -> e Nothing -> e subst ls (Elamb v e) = Elamb v (subst (filter ((v/=).fst) ls) e) subst ls (Eapp e0 e1) = Eapp (subst ls e0) (subst ls e1) -- Alpha conversions -- The first parameter indicates the variables in scope (bounded). alphaConv :: [Variable] -> [(Variable,Variable)] -> Exp -> Exp alphaConv bs ls (Evar v) = if elem v bs then case lookup v ls of Just v' -> Evar v' Nothing -> Evar v else Evar v alphaConv bs ls (Elamb v e) = case lookup v ls of Just v' -> Elamb v' (alphaConv (v:bs) ls e) Nothing -> Elamb v (alphaConv bs ls e) alphaConv bs ls (Eapp e0 e1) = Eapp (alphaConv bs ls e0) (alphaConv bs ls e1) -- Free variables of an expression -- The first parameter indicates the variables in scope (bounded). fv :: [Variable] -> Exp -> [Variable] fv bs (Evar v) | elem v bs = [v] | otherwise = [] fv bs (Elamb v e) = fv (ins v bs) e where ins a as | elem a as = as | otherwise = a:as fv bs (Eapp e0 e1) = union (fv bs e0) (fv bs e1) -- a list of fresh variables, the parameter is the seed. freshvars :: Int -> [String] freshvars i = ("u"++show i) : freshvars (i+1) -- normalizing function eval :: Int -> Exp -> Exp eval gen (Eapp e0 e1) = case eval gen e0 of Elamb v e0' -> eval gen$ sust [(v,e1)]$ alphaConv [] (zip (fv [] e1) (freshvars gen)) e0' e0' -> Eapp e0' (eval gen e1) eval gen (Elamb v e) = Elamb v (eval gen e) eval _ e = e -- a generator of expressions genexp :: [Variable] -> Variable -> Int -> Exp genexp us v 0 = Evar v genexp (u:us) v n = Eapp (Elamb u (genexp us u (n-1))) (Evar v)main :: IO () |

n = 500000 main :: IO () main = print$ eval' n (genexp (freshvars 0) "v" n) -- Abstract syntax for lambda expressions type Variable = String data Exp = Eapp Exp Exp -- e e | Elamb Variable Exp -- \v.e | Evar Variable -- v deriving Show -- Substitution of of variables by terms subst :: [(Variable,Exp)] -> Exp -> Exp subst ls e@(Evar var) = case lookup var ls of Just e -> e Nothing -> e subst ls (Elamb v e) = Elamb v (subst (filter ((v/=).fst) ls) e) subst ls (Eapp e0 e1) = Eapp (subst ls e0) (subst ls e1) -- Alpha conversions -- The first parameter indicates the variables in scope (bounded). alphaConv :: [Variable] -> [(Variable,Variable)] -> Exp -> Exp alphaConv bs ls (Evar v) = if elem v bs then case lookup v ls of Just v' -> Evar v' Nothing -> Evar v else Evar v alphaConv bs ls (Elamb v e) = case lookup v ls of Just v' -> Elamb v' (alphaConv (v:bs) ls e) Nothing -> Elamb v (alphaConv bs ls e) alphaConv bs ls (Eapp e0 e1) = Eapp (alphaConv bs ls e0) (alphaConv bs ls e1) -- Free variables of an expression -- The first parameter indicates the variables in scope (bounded). fv :: [Variable] -> Exp -> [Variable] fv bs (Evar v) | elem v bs = [v] | otherwise = [] fv bs (Elamb v e) = fv (ins v bs) e where ins a as | elem a as = as | otherwise = a:as fv bs (Eapp e0 e1) = union (fv bs e0) (fv bs e1) -- a list of fresh variables, the parameter is the seed. freshvars :: Int -> [String] freshvars i = ("u"++show i) : freshvars (i+1) -- a generator of expressions genexp :: [Variable] -> Variable -> Int -> Exp genexp us v 0 = Evar v genexp (u:us) v n = Eapp (Elamb u (genexp us u (n-1))) (Evar v) -- fused normalization function eval' :: Int -> Exp -> Exp eval' gen (Eapp e0 e1) = case eval' gen e0 of Elamb v e0' -> eval' gen$ sust_alphaConv [(v,e1)] [] (zip_freshvars (fv [] e1) gen) e0' e0' -> Eapp e0' (eval' gen e1) eval' gen (Elamb v e) = Elamb v (eval' gen e) eval' _ e = e zip_freshvars (a:as) i4 = (a,"u" ++ show i4) : zip_freshvars as (i4+1) zip_freshvars v0 i4 = [] sust_alphaConv ls bs25 ls45 v65@(Evar v66) = if elem v66 bs25 then case lookup v66 ls45 of Just v' -> case lookup v' ls of Just e -> e Nothing -> alphaConv bs25 ls45 v65 Nothing -> case lookup v66 ls of Just e -> e Nothing -> alphaConv bs25 ls45 v65 else case lookup v66 ls of Just e -> e Nothing -> alphaConv bs25 ls45 v65 sust_alphaConv ls bs25 ls45 (Elamb v67 e32) = case lookup v67 ls45 of Just v' -> Elamb v' (sust_alphaConv (filter ((v'/=) . fst) ls) (v67 : bs25) ls45 e32) Nothing -> Elamb v67 (sust_alphaConv (filter ((v67/=) . fst) ls) bs25 ls45 e32) sust_alphaConv ls bs25 ls45 (Eapp e33 e34) = Eapp (sust_alphaConv ls bs25 ls45 e33) (sust_alphaConv ls bs25 ls45 e34) |

main = print (f 14000) f n = sum [ k*m | k<-[1..n], m<-[1..k], mod k m==0 ] |

main = print (sumConcatMapUpto 14000 0 1) sumConcatMapUpto n acc m12 = if m12 > n then acc else v16MapFilterUpto n (m12+1) (m12*) (\m->mod m12 m==0) m12 acc 1 v16MapUpto n0 f n acc m13 m27 = if m27 > n then sumConcatMapUpto n0 acc m13 else v16MapUpto n0 f n (acc + f m27) m13 (m27 + 1) v16 f n acc m51 [] = sumConcatMapUpto f n acc m51 v16 f n acc m51 (x8:xs17) = v16 f n (acc + x8) m51 xs17 v16MapFilterUpto n2 m51 f p n acc m69 = if m69 > n then sumConcatMapUpto n2 acc m51 else if p m69 then v16MapFilterUpto n2 m51 f p n (acc + f m69) (m69 + 1) else v16MapFilterUpto n2 m51 f p n acc (m69 + 1) |

main = print (countNodes (insert 30 (genBTree 24))) data BTree a = Node a (BTree a) (BTree a) | Leaf genBTree :: Int -> BTree Int genBTree 0 = Leaf genBTree i = Node i (genBTree (i-1)) (genBTree (i-1)) countNodes Leaf = 0 countNodes (Node n t1 t2) = 1 + countNodes t1 + countNodes t2 insert :: Ord a => a -> BTree a -> BTree a insert x Leaf = Node x Leaf Leaf insert x (Node a t1 t2) = case a<x of True -> Node a t1 (insert x t2) False -> Node a (insert x t1) t2 |

main = print (countNodes_insert_genBTree 30 24) data BTree a = Node a (BTree a) (BTree a) | Leaf countNodes Leaf = 0 countNodes (Node n t1 t2) = 1 + countNodes t1 + countNodes t2 countNodes_insert_genBTree x 0 = 1 + countNodes Leaf + countNodes Leaf countNodes_insert_genBTree x v0 = if v0 < x then 1 + countNodes_genBTree (v0 - 1) + countNodes_insert_genBTree x (v0 - 1) else 1 + countNodes_insert_genBTree x (v0 - 1) + countNodes_genBTree (v0 - 1) countNodes_genBTree 0 = 0 countNodes_genBTree v0 = 1 + countNodes_genBTree (v0 - 1) + countNodes_genBTree (v0 - 1) |

[1]. **HFusion: a fusion tool based on Acid Rain plus extensions**

Facundo Domínguez

Master thesis. PEDECIBA, Universidad de la República, Uruguay.

August 2009.