[Haskell-cafe] strange performance of expression evaluators

[Alexander Vodomerov]

On Sat, Jan 13, 2007 at 11:44:38AM +1000, Matthew Brecknell wrote:

> So my advice here would be: always try the optimiser before you worry
> too much about strange performance!
Thanks for help!

I've done some more experiments. The following program defines simple
arithmetic expression with indexed variables. I've written four
different ways to evaluate them:
 - eval1 is simple monadic evaluator
 - eval2 is the obvious straight-forward implentation
 - compile1 is attempt to perform compilation
 - compile2 is refined compile1 with sub-expressions explicitely
     separated via "let" binding.

Test evaluates the same expression in 1000000 different environments.
The results are:
  - eval1 - 17.47 sec
  - eval2 - 3.71 sec
  - compile1 - 3.79 sec
  - compile2 - 3.74 sec

This figures are completely mysterious for me.
   1) I expected eval1 and eval2 to perform equally. In fact, eval1 is
       4.7 times slower for eval2.
   2) I expected compile{1,2} to perform much faster then eval{1,2}.
      However, the "compilation" attempt does not give any speed up at
      all.

Can anyone explain these results?

Program was compiled with "ghc -O3 -fexcess-precision" command.

For comparison, I wrote simple straight-forward implementation of
compile2 in C++. It runs approximately 1.04 sec (3.57 better than
Haskell).
 
import Data.Array.Unboxed
import Data.Array.Base
import Control.Monad.Reader
import Data.Int

foldl' f z []     =  z
foldl' f z (x:xs) =  (foldl' f $! f z x) xs

type Value = Int32
data Expr = Const !Value | Var !Int | Add !Expr !Expr | Sub !Expr !Expr | Mul !Expr !Expr
type Env = UArray Int Value

eval1 :: Expr -> Reader Env Value
eval1 e =
    case e of
      Const c -> return c
      Var n -> do { env <- ask; return $ env ! n }
      Add e1 e2 -> do
             v1 <- eval1 e1
             v2 <- eval1 e2
             return $ v1 + v2
      Sub e1 e2 -> do
             v1 <- eval1 e1
             v2 <- eval1 e2
             return $ v1 - v2
      Mul e1 e2 -> do
             v1 <- eval1 e1
             v2 <- eval1 e2
             return $ v1 * v2

eval2 :: Expr -> Env -> Value
eval2 e env =
    case e of
      Const c -> c
      Var n -> env ! n
      Add e1 e2 -> eval2 e1 env + eval2 e2 env
      Sub e1 e2 -> eval2 e1 env - eval2 e2 env
      Mul e1 e2 -> eval2 e1 env * eval2 e2 env

compile1 :: Expr -> (Env -> Value)
compile1 e =
    case e of
      Const c -> \env -> c
      Var n -> \env -> env ! n
      Add e1 e2 -> \env -> (compile1 e1) env + (compile1 e2) env
      Sub e1 e2 -> \env -> (compile1 e1) env - (compile1 e2) env
      Mul e1 e2 -> \env -> (compile1 e1) env * (compile1 e2) env

compile2 :: Expr -> (Env -> Value)
compile2 e =
    case e of
      Const c -> \env -> c
      Var n -> \env -> env ! n
      Add e1 e2 -> let c1 = compile2 e1 in
                   let c2 = compile2 e2 in
                   \env -> c1 env + c2 env
      Sub e1 e2 -> let c1 = compile2 e1 in
                   let c2 = compile2 e2 in
                   \env -> c1 env - c2 env
      Mul e1 e2 -> let c1 = compile2 e1 in
                   let c2 = compile2 e2 in
                   \env -> c1 env * c2 env

test1 :: Expr
test1 = Add (Mul (Add (Var 0) (Var 1)) (Add (Var 0) (Var 1))) (Mul (Sub (Var 0) (Var 1)) (Sub (Var 0) (Var 1)))

test :: Expr
test = Add (Mul test1 test1) (Add test1 test1)

do_test :: (Env -> Value) -> Value
do_test e =
    foldl' (+) 0 (map (\n -> e (array (0, 1) [(0, n), (1, n)])) [0..1000000])

main = do
  putStrLn "testing empty expr"
  let res0 = do_test (\env -> 0)
  putStrLn $ "result is " ++ show res0
  putStrLn "testing compile 1"
  let res1 = do_test (compile1 test)
  putStrLn $ "result is " ++ show res1
  putStrLn "testing compile 2"
  let res2 = do_test (compile2 test)
  putStrLn $ "result is " ++ show res2
  putStrLn "testing eval 1"
  let res3 = do_test (runReader (eval1 test))
  putStrLn $ "result is " ++ show res3
  putStrLn "testing eval 2"
  let res4 = do_test (eval2 test)
  putStrLn $ "result is " ++ show res4
  return ()