Benchmarks

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.

Testsuite

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.

sumMapGenBTree.hs (original)

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))

sumMapGenBTree.hs (fused)

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)

normalizer.hs (original)

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 ()

normalizer.hs (fused)

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)

list_comprehension.hs (original)

main = print (f 14000)

f n = sum [ k*m | k<-[1..n], m<-[1..k], mod k m==0 ]

list_comprehension.hs (fused)

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)

paramorphism.hs (original)

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

paramorphism.hs (fused)

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)

Bibliography

[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.

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%

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%