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 <- newStdGen 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]