compdata-0.6.1: benchmark/Benchmark.hs
module Main where
import Criterion.Main
import qualified Functions.Comp as A
import qualified Functions.Standard as S
import DataTypes.Comp as DC
import DataTypes.Standard as DS
import DataTypes.Transform
import Data.Comp
import Data.Comp.DeepSeq ()
import Control.DeepSeq
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen
import System.Random
aExpr :: SugarExpr
aExpr = iIf ((iVInt 1 `iGt` (iVInt 2 `iMinus` iVInt 1))
`iOr` ((iVInt 1 `iGt` (iVInt 2 `iMinus` iVInt 1))))
((iVInt 2 `iMinus` iVInt 1))
(iVInt 3)
sExpr :: PExpr
sExpr = transSugar aExpr
sfCoalg :: Coalg SugarSig Int
sfCoalg 0 = inj $ VInt 1
sfCoalg n = let n' = n-1 in inj $ Plus n' n'
sfGen' :: Int -> SugarExpr
sfGen' = ana' sfCoalg
sfGen :: Int -> SugarExpr
sfGen = ana sfCoalg
shortcutFusion :: Benchmark
shortcutFusion = bgroup "shortcut-fusion" [
bench "eval without fusion" (nf (A.evalSugar2 . sfGen) depth),
bench "eval with fusion" (nf (A.evalSugar2 . sfGen') depth)
]
where depth = 15
standardBenchmarks :: (PExpr, SugarExpr, String) -> Benchmark
standardBenchmarks (sExpr,aExpr,n) = rnf aExpr `seq` rnf sExpr `seq` getBench (sExpr, aExpr,n)
where getBench (sExpr, aExpr,n) = bgroup n paperBenchmarks
-- these are the benchmarks for evaluation
evalBenchmarks = [
bench "evalDesug" (nf A.desugEval2 aExpr),
bench "evalDesug (fusion)" (nf A.desugEval2' aExpr),
bench "evalDesug (comparison)" (nf S.desugEval2 sExpr),
bench "evalDesugM" (nf A.desugEval aExpr),
bench "evalDesugT" (nf A.desugEvalT aExpr),
bench "evalDesugM (fusion)" (nf A.desugEval' aExpr),
bench "evalDesugT (fusion)" (nf A.desugEvalT' aExpr),
bench "evalDesugM (comparison)" (nf S.desugEval sExpr),
bench "eval" (nf A.evalSugar2 aExpr),
bench "evalDirect" (nf A.evalDirectE2 aExpr),
bench "eval[Direct] (comparison)" (nf S.evalSugar2 sExpr),
bench "evalM" (nf A.evalSugar aExpr),
bench "evalT" (nf A.evalSugarT aExpr),
bench "evalDirectM" (nf A.evalDirectE aExpr),
bench "eval[Direct]M (comparison)" (nf S.evalSugar sExpr)]
-- these are the benchmarks from the WGP '11 paper
paperBenchmarks = [
bench "desugHom" (nf A.desugExpr aExpr),
bench "desugCata" (nf A.desugExpr2 aExpr),
bench "desug[Hom,Cata] (comparison)" (nf S.desug sExpr),
bench "inferDesug" (nf A.desugType2 aExpr),
bench "inferDesug (fusion)" (nf A.desugType2' aExpr),
bench "inferDesug (comparison)" (nf S.desugType2 sExpr),
bench "inferDesugM" (nf A.desugType aExpr),
bench "inferDesugM (fusion)" (nf A.desugType' aExpr),
bench "inferDesugM (comparison)" (nf S.desugType sExpr),
bench "infer" (nf A.typeSugar2 aExpr),
bench "infer (comparison)" (nf S.typeSugar2 sExpr),
bench "inferM" (nf A.typeSugar aExpr),
bench "inferM (comparison)" (nf S.typeSugar sExpr),
bench "evalDesug" (nf A.desugEval2 aExpr),
bench "evalDesug (fusion)" (nf A.desugEval2' aExpr),
bench "evalDesug (comparison)" (nf S.desugEval2 sExpr),
bench "evalDesugM" (nf A.desugEval aExpr),
bench "evalDesugM (fusion)" (nf A.desugEval' aExpr),
bench "evalDesugM (comparison)" (nf S.desugEval sExpr),
bench "eval" (nf A.evalSugar2 aExpr),
bench "evalDirect" (nf A.evalDirectE2 aExpr),
bench "eval[Direct] (comparison)" (nf S.evalSugar2 sExpr),
bench "evalM" (nf A.evalSugar aExpr),
bench "evalDirectM" (nf A.evalDirectE aExpr),
bench "eval[Direct]M (comparison)" (nf S.evalSugar sExpr),
bench "contVar" (nf (A.contVar' 10) aExpr),
bench "contVarG" (nf (A.contVarGen 10) aExpr),
bench "contVarU" (nf (S.contVarGen 10) sExpr),
bench "contVar (comparison)" (nf (S.contVar 10) sExpr),
bench "freeVars" (nf A.freeVars' aExpr),
bench "freeVarsG" (nf A.freeVarsGen aExpr),
bench "freeVarsU" (nf S.freeVarsGen sExpr),
bench "freeVars (comparison)" (nf S.freeVars sExpr)]
-- these are all the benchmarks
allBenchmarks = [
bench "Comp.desug" (nf A.desugExpr aExpr),
bench "Comp.desug'" (nf A.desugExpr' aExpr),
bench "Comp.desugAlg" (nf A.desugExpr2 aExpr),
bench "Standard.desug" (nf S.desug sExpr),
bench "Standard.desug'" (nf S.desug' sExpr),
bench "Comp.desugType" (nf A.desugType aExpr),
bench "Comp.desugType'" (nf A.desugType' aExpr),
bench "Standard.desugType" (nf S.desugType sExpr),
bench "Comp.typeSugar" (nf A.typeSugar aExpr),
bench "Standard.typeSugar" (nf S.typeSugar sExpr),
bench "Comp.desugType2" (nf A.desugType2 aExpr),
bench "Comp.desugType2'" (nf A.desugType2' aExpr),
bench "Standard.desugType2" (nf S.desugType2 sExpr),
bench "Comp.typeSugar2" (nf A.typeSugar2 aExpr),
bench "Standard.typeSugar2" (nf S.typeSugar2 sExpr),
bench "Comp.desugEval" (nf A.desugEval aExpr),
bench "Comp.desugEval'" (nf A.desugEval' aExpr),
bench "Standard.desugEval" (nf S.desugEval sExpr),
bench "Comp.evalSugar" (nf A.evalSugar aExpr),
bench "Comp.evalDirect" (nf A.evalDirectE aExpr),
bench "Standard.evalSugar" (nf S.evalSugar sExpr),
bench "Comp.desugEval2" (nf A.desugEval2 aExpr),
bench "Comp.desugEval2'" (nf A.desugEval2' aExpr),
bench "Standard.desugEval2" (nf S.desugEval2 sExpr),
bench "Comp.evalSugar2" (nf A.evalSugar2 aExpr),
bench "Comp.evalDirect2" (nf A.evalDirectE2 aExpr),
bench "Standard.evalSugar2" (nf S.evalSugar2 sExpr),
bench "Comp.contVar" (nf (A.contVar 10) aExpr),
bench "Comp.contVar'" (nf (A.contVar' 10) aExpr),
bench "Comp.contVarGen" (nf (A.contVarGen 10) aExpr),
bench "Standard.contVar" (nf (S.contVar 10) sExpr),
bench "Standard.contVarGen" (nf (S.contVarGen 10) sExpr),
bench "Comp.freeVars" (nf A.freeVars aExpr),
bench "Comp.freeVars'" (nf A.freeVars' aExpr),
bench "Comp.freeVarsGen" (nf A.freeVarsGen aExpr),
bench "Standard.freeVars" (nf S.freeVars sExpr),
bench "Standard.freeVarsGen" (nf S.freeVarsGen sExpr)
]
randStdBenchmarks :: Int -> IO Benchmark
randStdBenchmarks s = do
rand <- getStdGen
let ty = unGen arbitrary rand s
putStr "size of the type term: "
print $ size ty
print $ ty
let aExpr = unGen (genTyped ty) rand s
sExpr = transSugar aExpr
putStr "size of the input term: "
print $ size aExpr
putStr "does it type check: "
print (A.desugType aExpr == Right ty)
return $ standardBenchmarks (sExpr,aExpr, "random (depth: " ++ show s ++ ", size: "++ show (size aExpr) ++ ")")
main = do b1 <- randStdBenchmarks 5
b2 <- randStdBenchmarks 10
b3 <- randStdBenchmarks 20
let b0 = standardBenchmarks (sExpr, aExpr, "hand-written")
defaultMain $ [b0,b1,b2,b3]