using sourcecode from static file to have more control

benchmark/BenchmarkSources.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE QuasiQuotes #-}
+module BenchmarkSources where
+
+import Text.RawString.QQ  
+
+type SourceCode = String
+
+ackermann :: SourceCode 
+ackermann = [r|
+  expected = 7
+  ack  = y(λf n m -> if (is0 n) (+ m 1) (if (is0 m) (f (sub1 n) 1) (f (sub1 n) (f n (sub1 m)))))
+  main = ack 2 2
+|]
+
+factorial :: SourceCode
+factorial = [r| 
+  expected = 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
+  fact = y(λf n -> if (is0 n) 1 (* n (f (sub1 n))))
+  main = fact 100
+|]
+
+fibonacci :: SourceCode
+fibonacci = [r| 
+  expected = 89
+  fib  = y(λf n -> if (is0 n) 1 (if (eql n 1) 1 (+ (f (sub1 n)) (f (sub n 2)))))
+  main = fib 10
+|]
+
+gaussian :: SourceCode
+gaussian = [r| 
+  expected = 5050
+  gaussianSum  = y(λf n -> (if (is0 n) 0 (+ n (f (sub1 n)))))
+  main = gaussianSum 100
+|]
+
+tak :: SourceCode
+tak = [r| 
+  expected = 4
+  tak  = y(λf x y z -> (if (geq y x) z (f (f (sub1 x) y z) (f (sub1 y) z x) (f (sub1 z) x y ))))
+  main = tak 18 6 3
+|]

benchmark/ReductionBenchmarks.hs

@@ -12,19 +12,16 @@ import Control.Monad.ST ( ST, runST )
 import HhiReducer ( primitives, transLink, CExpr(CInt, CApp) ) 
 import Control.Monad.Fix ( fix )
 import Kiselyov (compileKi)
+import BenchmarkSources
 
-type SourceCode = String
-
-loadTestCase :: String -> IO CL
-loadTestCase name = do
-  src <- readFile $ "test/" ++ name ++ ".ths"
+loadTestCase :: SourceCode -> IO CL
+loadTestCase src = do
   let pEnv = parseEnvironment src
       expr = compile pEnv abstractToSKI
   return expr
 
-loadTestCaseKiselyov :: String -> IO CL
-loadTestCaseKiselyov name = do
-  src <- readFile $ "test/" ++ name ++ ".ths"
+loadTestCaseKiselyov :: SourceCode -> IO CL
+loadTestCaseKiselyov src = do
   let pEnv = parseEnvironment src
       expr = compileBulk pEnv 
   return expr  
@@ -60,16 +57,16 @@ reducerTest expr = error "invalid input expression " ++ show expr
 
 benchmarks :: IO ()
 benchmarks = do
-  fac <- loadTestCase "factorial"
-  fib <- loadTestCase "fibonacci"
-  akk <- loadTestCase "ackermann"
-  gau <- loadTestCase "gaussian"
-  tak <- loadTestCase "tak"
-  facKi <- loadTestCaseKiselyov "factorial"
-  fibKi <- loadTestCaseKiselyov "fibonacci"
-  akkKi <- loadTestCaseKiselyov "ackermann"
-  gauKi <- loadTestCaseKiselyov "gaussian"
-  takKi <- loadTestCaseKiselyov "tak"
+  fac <- loadTestCase factorial
+  fib <- loadTestCase fibonacci
+  akk <- loadTestCase ackermann
+  gau <- loadTestCase gaussian
+  tak <- loadTestCase tak
+  facKi <- loadTestCaseKiselyov factorial
+  fibKi <- loadTestCaseKiselyov fibonacci
+  akkKi <- loadTestCaseKiselyov ackermann
+  gauKi <- loadTestCaseKiselyov gaussian
+  takKi <- loadTestCaseKiselyov BenchmarkSources.tak
 
 
   defaultMain [
@@ -97,7 +94,6 @@ benchmarks = do
   return ()
 
 
-
 fact :: Integer -> Integer
 fact = fix (\f n -> if n == 0 then 1 else n * f (n-1))
 
@@ -120,12 +116,12 @@ gaussianSum  = fix (\f n -> if n == 0 then 0 else n + f (n-1))
 
 
 tak_18_6 :: Integer -> Integer
-tak_18_6 = tak 18 6
+tak_18_6 = takN 18 6
 
-tak :: Integer -> Integer -> Integer -> Integer
-tak  = fix (\f x y z -> (if y >= x then z else f (f (x-1) y z) (f (y-1) z x) (f (z-1) x y )))
+takN :: Integer -> Integer -> Integer -> Integer
+takN  = fix (\f x y z -> (if y >= x then z else f (f (x-1) y z) (f (y-1) z x) (f (z-1) x y )))
 
-tak1 (x,y,z) = tak x y z
+tak1 (x,y,z) = takN x y z
 
 tak2 :: (Integer, Integer, Integer) -> Integer
 tak2 (x,y,z) = takInt x y z

lambda-ski.cabal

@@ -47,6 +47,7 @@ library
 executable benchmark
   main-is: Main.hs
   other-modules:
+      BenchmarkSources
       ReductionBenchmarks
       Paths_lambda_ski
   hs-source-dirs:

stack.yaml

@@ -18,7 +18,7 @@
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
 resolver:
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/11.yaml
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/12.yaml
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.