benchmain.hs

Gibbon benchmark example

#!/usr/bin/env stack
-- stack --resolver lts-13.8 --install-ghc runghc --package criterion
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
import Criterion.Main
import GHC.Generics (Generic)
import Control.DeepSeq

data Tree = Leaf Int | Inner Int Int Tree Tree
          deriving (Eq, Generic, NFData)

sum_up :: Tree -> Tree
sum_up tr =
    case tr of
      Leaf n -> Leaf n
      Inner sum x left right ->
          let l = sum_up left
              r = sum_up right
          in Inner ((value l) + (value r)) x l r

set_even :: Tree -> Tree
set_even tr =
    case tr of
      Leaf n -> Leaf n
      Inner sum x left right ->
          let l = set_even left
              r = set_even right
          in Inner sum (sum `mod` 2) l r

value :: Tree -> Int
value tr =
    case tr of
      Leaf n -> n
      Inner sum x left right -> sum

generateTree :: Int -> Tree
generateTree 0 = Leaf 2
generateTree n = Inner 0 0 (generateTree (n - 1)) (generateTree (n - 1))

sumup_seteven :: Tree -> Int
sumup_seteven tr = value $ sum_up $ set_even tr

tree_ident :: Tree -> Tree
tree_ident tr = tr

main = defaultMain [
  let tree = generateTree 20 in 
  bgroup "gibbon" [ bench "sumup_seteven" $ nf sumup_seteven tree
                  , bench "ident" $ nf tree_ident tree ]
  ]