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 Test.QuickCheck.Random
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 <- newQCGen
  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]
