app-lens-0.1.0.0: Bench/Eval.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}

import Control.LensFunction
import Examples.Evaluator hiding (incL)

import Criterion.Main

import Control.DeepSeq
import Control.Lens


instance NFData a => NFData (Env a) where
  rnf (Env xs) = rnf xs

instance NFData a => NFData (Val a) where
  rnf (VNum a)       = rnf a
  rnf (VFun s e env) = rnf s `seq` rnf e `seq` rnf env

instance NFData Exp where
  rnf (ENum i)     = rnf i
  rnf (EInc e)     = rnf e
  rnf (EFun s e)   = rnf s `seq` rnf e
  rnf (EApp e1 e2) = rnf e1 `seq` rnf e2
  rnf (EVar e)     = rnf e


expr1 = twice @@ twice @@ (twice @@ twice @@ twice @@ (twice @@ twice @@ twice @@ twice @@ inc)) @@ x 
    where
      twice = EFun "f" $ EFun "x" $
                EVar "f"@@ (EVar "f" @@ EVar "x")
      inc   = EFun "x" (EInc (EVar "x"))
      x     = EVar "x"

incL :: Lens' Int Int
incL = lens' $ \s -> (s + 1, (\v -> v - 1))

put l s v = set l v s 

main = defaultMain [
  bgroup "evalL" [ bench "E0"    $ nf (put (evalL expr) env0)        (VNum 0)
                 , bench "E1000" $ nf (put (evalL expr) (envn 1000)) (VNum 0)
                 , bench "E2000" $ nf (put (evalL expr) (envn 2000)) (VNum 0)
                 , bench "E3000" $ nf (put (evalL expr) (envn 3000)) (VNum 0)
     ]
  ]