adopt benchmark for fairer comparison

Author: thma

benchmark/ReductionBenchmarks.hs

@@ -1,13 +1,13 @@
 module ReductionBenchmarks where
 
 import Criterion.Main ( defaultMain, bench, nf )
-import Parser ( parseEnvironment, Expr(Int) )
+import Parser ( parseEnvironment, Expr(Int, (:@)) )
 import LambdaToSKI ( abstractToSKI, compile )
 import GraphReduction ( allocate, normalForm, toString, Graph )
 import Data.Maybe (fromJust)
 import Data.STRef ( STRef )
 import Control.Monad.ST ( ST, runST )
-import HhiReducer ( primitives, transLink)
+import HhiReducer ( primitives, transLink, CExpr(CInt, CApp) ) 
 import Control.Monad.Fix ( fix )
 
 type SourceCode = String
@@ -43,10 +43,10 @@ reduceGraph graph = do
   normalForm gP
 
 reducerTest :: Expr -> String
-reducerTest expr =
-  let tExp = transLink primitives expr
-  in show tExp
-
+reducerTest (expr :@ (Int x)) =
+  let fun = transLink primitives expr
+  in show (CApp fun (CInt x))
+reducerTest expr = error "invalid input expression " ++ show expr
 
 benchmarks :: IO ()
 benchmarks = do

src/LambdaToSKI.hs

@@ -66,22 +66,22 @@ fv vs (Lam s f) = fv (s : vs) f
 fv vs _ = vs
 
 isComb :: Expr -> Bool
-isComb e = null $ fv [] e \\ ["s", "k", "i", "b", "c", "y"]
+isComb e = null $ fv [] e \\ ["s", "k", "i", "b", "c", "y", "s'", "b'", "c'"]
 
 noLamEq :: Expr -> Expr -> Bool
 noLamEq (Var x) (Var y)   = x == y
 noLamEq (a :@ b) (c :@ d) = a `noLamEq` c && b `noLamEq` d
 noLamEq _ _               = False
 
+-- | optimizations according to Antoni Diller, Compiling Functional Languages, chapter 7
 opt :: Expr -> Expr
 opt (Var "i" :@ n@(Int _n))                           = n
 opt ((Var "s" :@ (Var "k" :@ e1)) :@ (Var "k" :@ e2)) = Var "k" :@ (e1 :@ e2)
 opt ((Var "s" :@ e1) :@ (Var "k" :@ e2))              = (Var "c" :@ e1) :@ e2
 opt ((Var "s" :@ (Var "k" :@ e1)) :@ e2)              = (Var "b" :@ e1) :@ e2
 opt ((Var "s" :@ ((Var "b" :@ p) :@ q)) :@ r)         = ((Var "s'" :@ p) :@ q) :@ r  -- Diller, p.98
-opt ((Var "b" :@ (p :@ q) :@ r))                      = ((Var "b'" :@ p) :@ q) :@ r
-opt ((Var "c" :@ ((Var "b" :@ p) :@ q)) :@ r)         = ((Var "c'" :@ p) :@ q) :@ r
-
+opt ((Var "b" :@ (p :@ q) :@ r))                      = ((Var "b'" :@ p) :@ q) :@ r  -- Diller, p.98
+opt ((Var "c" :@ ((Var "b" :@ p) :@ q)) :@ r)         = ((Var "c'" :@ p) :@ q) :@ r  -- Diller, p.98
 opt (x :@ y)                                          = opt x :@ opt y
 opt x                                                 = x