From 62c09580062a9676981455ff5fa79317e00f48f6 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Wed, 18 May 2022 23:59:18 -0400 Subject: [PATCH] Added haskell versions (parameterized by CLI argument) --- koka_bench/CMakeLists.txt | 1 + koka_bench/cfold_table.md | 7 +-- koka_bench/deriv_table.md | 7 +-- koka_bench/haskell/CMakeLists.txt | 33 ++++++++++++ koka_bench/haskell/cfold.hs | 65 +++++++++++++++++++++++ koka_bench/haskell/deriv.hs | 86 +++++++++++++++++++++++++++++++ koka_bench/haskell/nqueens.hs | 44 ++++++++++++++++ koka_bench/haskell/rbtree.hs | 70 +++++++++++++++++++++++++ koka_bench/rbnqueens_table.md | 9 ++-- koka_bench/rbtree_table.md | 7 +-- 10 files changed, 316 insertions(+), 13 deletions(-) create mode 100644 koka_bench/haskell/CMakeLists.txt create mode 100644 koka_bench/haskell/cfold.hs create mode 100644 koka_bench/haskell/deriv.hs create mode 100644 koka_bench/haskell/nqueens.hs create mode 100644 koka_bench/haskell/rbtree.hs diff --git a/koka_bench/CMakeLists.txt b/koka_bench/CMakeLists.txt index 6f31a3a..50618bb 100644 --- a/koka_bench/CMakeLists.txt +++ b/koka_bench/CMakeLists.txt @@ -11,3 +11,4 @@ enable_testing() add_subdirectory(kraken) add_subdirectory(koka) add_subdirectory(cpp) +add_subdirectory(haskell) diff --git a/koka_bench/cfold_table.md b/koka_bench/cfold_table.md index 8073a14..0ea5741 100644 --- a/koka_bench/cfold_table.md +++ b/koka_bench/cfold_table.md @@ -1,5 +1,6 @@ | Command | Mean [ms] | Min [ms] | Max [ms] | Relative | |:---|---:|---:|---:|---:| -| `build/kraken/out/bench/kraken-cfold 5` | 24.6 ± 1.0 | 22.9 | 27.5 | 52.26 ± 36.33 | -| `build/cpp/cpp-cfold 5` | 0.8 ± 0.4 | 0.5 | 2.6 | 1.78 ± 1.45 | -| `build/koka/out/bench/kk-cfold 5` | 0.5 ± 0.3 | 0.2 | 2.9 | 1.00 | +| `build/kraken/out/bench/kraken-cfold 5` | 24.7 ± 0.9 | 23.2 | 28.7 | 47.91 ± 21.85 | +| `build/cpp/cpp-cfold 5` | 0.9 ± 0.3 | 0.6 | 3.0 | 1.75 ± 1.02 | +| `build/haskell/hs-cfold 5` | 0.8 ± 0.3 | 0.6 | 2.5 | 1.60 ± 0.91 | +| `build/koka/out/bench/kk-cfold 5` | 0.5 ± 0.2 | 0.3 | 2.1 | 1.00 | diff --git a/koka_bench/deriv_table.md b/koka_bench/deriv_table.md index 8ad3526..14bd3ee 100644 --- a/koka_bench/deriv_table.md +++ b/koka_bench/deriv_table.md @@ -1,5 +1,6 @@ | Command | Mean [s] | Min [s] | Max [s] | Relative | |:---|---:|---:|---:|---:| -| `build/kraken/out/bench/kraken-deriv 8` | 3.555 ± 0.011 | 3.536 | 3.575 | 212.40 ± 8.29 | -| `build/cpp/cpp-deriv 8` | 0.021 ± 0.001 | 0.020 | 0.023 | 1.24 ± 0.06 | -| `build/koka/out/bench/kk-deriv 8` | 0.017 ± 0.001 | 0.016 | 0.018 | 1.00 | +| `build/kraken/out/bench/kraken-deriv 8` | 3.562 ± 0.012 | 3.545 | 3.581 | 215.89 ± 7.06 | +| `build/cpp/cpp-deriv 8` | 0.020 ± 0.001 | 0.020 | 0.022 | 1.24 ± 0.05 | +| `build/haskell/hs-deriv 8` | 0.036 ± 0.001 | 0.035 | 0.037 | 2.15 ± 0.08 | +| `build/koka/out/bench/kk-deriv 8` | 0.016 ± 0.001 | 0.016 | 0.021 | 1.00 | diff --git a/koka_bench/haskell/CMakeLists.txt b/koka_bench/haskell/CMakeLists.txt new file mode 100644 index 0000000..31e1267 --- /dev/null +++ b/koka_bench/haskell/CMakeLists.txt @@ -0,0 +1,33 @@ +find_program(GHC ghc REQUIRED) + +#find_program(GHC "stack") +#if (GHC) +# list(APPEND GHC ghc --) +#else () +# find_program(GHC ghc REQUIRED) +#endif () + +# run `$ cabal install --lib parallel` to compile binarytrees + +set(sources cfold.hs deriv.hs nqueens.hs rbtree.hs) +foreach (source IN LISTS sources) + get_filename_component(name "${source}" NAME_WE) + set(name "hs-${name}") + + add_custom_command( + OUTPUT ${name} + COMMAND ${GHC} -O2 -o ${name} "$" + DEPENDS ${source} + VERBATIM) + + add_custom_target(update-${name} ALL DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/${name}) + + add_executable(${name}-exe IMPORTED) + set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${CMAKE_CURRENT_BINARY_DIR}/${name}") + + add_test(NAME ${name} COMMAND ${name}-exe) + set_tests_properties(${name} PROPERTIES LABELS haskell) +endforeach () + + + diff --git a/koka_bench/haskell/cfold.hs b/koka_bench/haskell/cfold.hs new file mode 100644 index 0000000..3d4f65d --- /dev/null +++ b/koka_bench/haskell/cfold.hs @@ -0,0 +1,65 @@ +-- Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/const_fold.hs + +import System.Environment + +data Expr = Var Integer + | Val Integer + | Add Expr Expr + | Mul Expr Expr + +mk_expr :: Integer -> Integer -> Expr +mk_expr 0 v = if v == 0 then Var 1 else Val v +mk_expr n v = Add (mk_expr (n-1) (v+1)) (mk_expr (n-1) (max (v-1) 0)) + +append_add :: Expr -> Expr -> Expr +append_add (Add e₁ e₂) e₃ = Add e₁ (append_add e₂ e₃) +append_add e₁ e₂ = Add e₁ e₂ + +append_mul :: Expr -> Expr -> Expr +append_mul (Mul e₁ e₂) e₃ = Mul e₁ (append_mul e₂ e₃) +append_mul e₁ e₂ = Mul e₁ e₂ + +reassoc :: Expr -> Expr +reassoc (Add e₁ e₂) = + let e₁' = reassoc e₁ in + let e₂' = reassoc e₂ in + append_add e₁' e₂' +reassoc (Mul e₁ e₂) = + let e₁' = reassoc e₁ in + let e₂' = reassoc e₂ in + append_mul e₁' e₂' +reassoc e = e + +const_folding :: Expr -> Expr +const_folding (Add e₁ e₂) = + let e₁' = const_folding e₁ in + let e₂' = const_folding e₂ in + (case (e₁', e₂') of + (Val a, Val b ) -> Val (a+b) + (Val a, Add e (Val b)) -> Add (Val (a+b)) e + (Val a, Add (Val b) e) -> Add (Val (a+b)) e + (_, _ ) -> Add e₁' e₂') +const_folding (Mul e₁ e₂) = + let e₁' = const_folding e₁ in + let e₂' = const_folding e₂ in + (case (e₁', e₂') of + (Val a, Val b ) -> Val (a*b) + (Val a, Mul e (Val b)) -> Mul (Val (a*b)) e + (Val a, Mul (Val b) e) -> Mul (Val (a*b)) e + (_, _ ) -> Mul e₁' e₂') +const_folding e = e + +eval :: Expr -> Integer +eval (Var _) = 0 +eval (Val v) = v +eval (Add l r) = eval l + eval r +eval (Mul l r) = eval l * eval r + +main :: IO () +main = do + [arg] <- getArgs + let n = read arg + let e = (mk_expr n 1) + let v₁ = eval e + let v₂ = eval (const_folding (reassoc e)) + putStrLn (show v₁ ++ " " ++ show v₂) diff --git a/koka_bench/haskell/deriv.hs b/koka_bench/haskell/deriv.hs new file mode 100644 index 0000000..af615e4 --- /dev/null +++ b/koka_bench/haskell/deriv.hs @@ -0,0 +1,86 @@ +-- Adapted from: https://raw.githubusercontent.com/leanprover/lean4/IFL19/tests/bench/deriv.hs + +import System.Environment + +data Expr = + Val Int + | Var String + | Add Expr Expr + | Mul Expr Expr + | Pow Expr Expr + | Ln Expr + +pown :: Int -> Int -> Int +pown a 0 = 1 +pown a 1 = a +pown a n = + let b = pown a (n `div` 2) in + b * b * (if n `mod` 2 == 0 then 1 else a) + +add :: Expr -> Expr -> Expr +add (Val n) (Val m) = Val (n + m) +add (Val 0) f = f +add f (Val 0) = f +add f (Val n) = add (Val n) f +add (Val n) (Add (Val m) f) = add (Val (n+m)) f +add f (Add (Val n) g) = add (Val n) (add f g) +add (Add f g) h = add f (add g h) +add f g = Add f g + +mul :: Expr -> Expr -> Expr +mul (Val n) (Val m) = Val (n*m) +mul (Val 0) _ = Val 0 +mul _ (Val 0) = Val 0 +mul (Val 1) f = f +mul f (Val 1) = f +mul f (Val n) = mul (Val n) f +mul (Val n) (Mul (Val m) f) = mul (Val (n*m)) f +mul f (Mul (Val n) g) = mul (Val n) (mul f g) +mul (Mul f g) h = mul f (mul g h) +mul f g = Mul f g + +pow :: Expr -> Expr -> Expr +pow (Val m) (Val n) = Val (pown m n) +pow _ (Val 0) = Val 1 +pow f (Val 1) = f +pow (Val 0) _ = Val 0 +pow f g = Pow f g + +ln :: Expr -> Expr +ln (Val 1) = Val 0 +ln f = Ln f + +d :: String -> Expr -> Expr +d x (Val _) = Val 0 +d x (Var y) = if x == y then Val 1 else Val 0 +d x (Add f g) = add (d x f) (d x g) +d x (Mul f g) = add (mul f (d x g)) (mul g (d x f)) +d x (Pow f g) = mul (pow f g) (add (mul (mul g (d x f)) (pow f (Val (-1)))) (mul (ln f) (d x g))) +d x (Ln f) = mul (d x f) (pow f (Val (-1))) + +count :: Expr -> Integer +count (Val _) = 1 +count (Var _) = 1 +count (Add f g) = count f + count g +count (Mul f g) = count f + count g +count (Pow f g) = count f + count g +count (Ln f) = count f + +nest_aux :: Int -> (Int -> Expr -> IO Expr) -> Int -> Expr -> IO Expr +nest_aux s f 0 x = pure x +nest_aux s f m x = f (s - m) x >>= nest_aux s f (m-1) + +nest f n e = nest_aux n f n e + +deriv :: Int -> Expr -> IO Expr +deriv i f = do + let f' = d "x" f + putStrLn (show (i+1) ++ " count: " ++ (show $ count f')) + pure f' + +main = do + let x = Var "x" + let f = pow x x + [arg] <- getArgs + let n = read arg + nest deriv n f diff --git a/koka_bench/haskell/nqueens.hs b/koka_bench/haskell/nqueens.hs new file mode 100644 index 0000000..13b147c --- /dev/null +++ b/koka_bench/haskell/nqueens.hs @@ -0,0 +1,44 @@ + +import System.Environment + +data List a = Nil | Cons !a !(List a) + +len xs + = len' xs 0 + +len' xs acc + = case xs of + Nil -> acc + Cons _ t -> len' t $! (acc+1) + +safe queen diag xs + = case xs of + Nil -> True + Cons q t -> queen /= q && queen /= q + diag && queen /= q - diag && safe queen (diag + 1) t + +appendSafe k soln solns + = if (k <= 0) + then solns + else if safe k 1 soln + then appendSafe (k-1) soln (Cons (Cons k soln) solns) + else appendSafe (k-1) soln solns + + +extend n acc solns + = case solns of + Nil -> acc + Cons soln rest -> extend n (appendSafe n soln acc) rest + +find_solutions n k + = if k == 0 + then Cons Nil Nil + else extend n Nil (find_solutions n (k-1)) + +-- fst_solution n = head (find_solutions n n) + +queens n + = len (find_solutions n n) + +main = do + [arg] <- getArgs + print (queens (read arg)) diff --git a/koka_bench/haskell/rbtree.hs b/koka_bench/haskell/rbtree.hs new file mode 100644 index 0000000..d6bf1e8 --- /dev/null +++ b/koka_bench/haskell/rbtree.hs @@ -0,0 +1,70 @@ +-- Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/rbmap.hs +-- Modified to be strict in the Tree fields +import System.Environment + +data Color = + Red | Black + +data Tree α β = + Leaf + | Node !Color !(Tree α β) !α !β !(Tree α β) + +fold :: (α -> β -> σ -> σ) -> Tree α β -> σ -> σ +fold _ Leaf b = b +fold f (Node _ l k v r) b = fold f r (f k v (fold f l b)) + +balance1 :: Tree α β -> Tree α β -> Tree α β +balance1 (Node _ _ kv vv t) (Node _ (Node Red l kx vx r₁) ky vy r₂) = Node Red (Node Black l kx vx r₁) ky vy (Node Black r₂ kv vv t) +balance1 (Node _ _ kv vv t) (Node _ l₁ ky vy (Node Red l₂ kx vx r)) = Node Red (Node Black l₁ ky vy l₂) kx vx (Node Black r kv vv t) +balance1 (Node _ _ kv vv t) (Node _ l ky vy r) = Node Black (Node Red l ky vy r) kv vv t +balance1 _ _ = Leaf + +balance2 :: Tree α β -> Tree α β -> Tree α β +balance2 (Node _ t kv vv _) (Node _ (Node Red l kx₁ vx₁ r₁) ky vy r₂) = Node Red (Node Black t kv vv l) kx₁ vx₁ (Node Black r₁ ky vy r₂) +balance2 (Node _ t kv vv _) (Node _ l₁ ky vy (Node Red l₂ kx₂ vx₂ r₂)) = Node Red (Node Black t kv vv l₁) ky vy (Node Black l₂ kx₂ vx₂ r₂) +balance2 (Node _ t kv vv _) (Node _ l ky vy r) = Node Black t kv vv (Node Red l ky vy r) +balance2 _ _ = Leaf + +is_red :: Tree α β -> Bool +is_red (Node Red _ _ _ _) = True +is_red _ = False + +lt x y = x < y + +ins :: Ord α => Tree α β -> α -> β -> Tree α β +ins Leaf kx vx = Node Red Leaf kx vx Leaf +ins (Node Red a ky vy b) kx vx = + (if lt kx ky then Node Red (ins a kx vx) ky vy b + else if lt ky kx then Node Red a ky vy (ins b kx vx) + else Node Red a ky vy (ins b kx vx)) +ins (Node Black a ky vy b) kx vx = + if lt kx ky then + (if is_red a then balance1 (Node Black Leaf ky vy b) (ins a kx vx) + else Node Black (ins a kx vx) ky vy b) + else if lt ky kx then + (if is_red b then balance2 (Node Black a ky vy Leaf) (ins b kx vx) + else Node Black a ky vy (ins b kx vx)) + else Node Black a kx vx b + +set_black :: Tree α β -> Tree α β +set_black (Node _ l k v r) = Node Black l k v r +set_black e = e + +insert t k v = + if is_red t then set_black (ins t k v) + else ins t k v + +type Map = Tree Int Bool + +mk_Map_aux :: Int -> Map -> Map +mk_Map_aux 0 m = m +mk_Map_aux n m = let n' = n-1 in mk_Map_aux n' (insert m n' (n' `mod` 10 == 0)) + +mk_Map n = mk_Map_aux n Leaf + +main = do + [arg] <- getArgs + let n = read arg + let m = mk_Map n + let v = fold (\_ v r -> if v then r + 1 else r) m 0 + print v diff --git a/koka_bench/rbnqueens_table.md b/koka_bench/rbnqueens_table.md index 484ffbb..d511807 100644 --- a/koka_bench/rbnqueens_table.md +++ b/koka_bench/rbnqueens_table.md @@ -1,6 +1,7 @@ | Command | Mean [s] | Min [s] | Max [s] | Relative | |:---|---:|---:|---:|---:| -| `build/kraken/out/bench/kraken-nqueens 10` | 2.280 ± 0.040 | 2.218 | 2.356 | 493.82 ± 56.59 | -| `build/cpp/cpp-nqueens 10` | 0.006 ± 0.001 | 0.006 | 0.008 | 1.32 ± 0.19 | -| `build/koka/out/bench/kk-nqueens 10` | 0.005 ± 0.001 | 0.004 | 0.006 | 1.00 | -| `build/koka/out/bench/kk-nqueens-int 10` | 0.007 ± 0.001 | 0.006 | 0.009 | 1.46 ± 0.20 | +| `build/kraken/out/bench/kraken-nqueens 10` | 2.223 ± 0.009 | 2.202 | 2.231 | 503.18 ± 43.65 | +| `build/cpp/cpp-nqueens 10` | 0.006 ± 0.000 | 0.006 | 0.008 | 1.36 ± 0.14 | +| `build/haskell/hs-nqueens 10` | 0.035 ± 0.000 | 0.035 | 0.037 | 8.02 ± 0.70 | +| `build/koka/out/bench/kk-nqueens 10` | 0.004 ± 0.000 | 0.004 | 0.006 | 1.00 | +| `build/koka/out/bench/kk-nqueens-int 10` | 0.007 ± 0.001 | 0.006 | 0.009 | 1.52 ± 0.19 | diff --git a/koka_bench/rbtree_table.md b/koka_bench/rbtree_table.md index 0cc95e4..726d81b 100644 --- a/koka_bench/rbtree_table.md +++ b/koka_bench/rbtree_table.md @@ -1,6 +1,7 @@ | Command | Mean [s] | Min [s] | Max [s] | Relative | |:---|---:|---:|---:|---:| -| `build/kraken/out/bench/kraken-rbtree-opt 42000` | 3.814 ± 0.021 | 3.775 | 3.850 | 865.95 ± 89.32 | -| `build/kraken/out/bench/kraken-rbtree 42000` | 4.133 ± 0.050 | 4.090 | 4.245 | 938.49 ± 97.33 | -| `build/cpp/cpp-rbtree 42000` | 0.006 ± 0.001 | 0.005 | 0.008 | 1.30 ± 0.20 | +| `build/kraken/out/bench/kraken-rbtree-opt 42000` | 3.822 ± 0.037 | 3.785 | 3.886 | 873.63 ± 91.30 | +| `build/kraken/out/bench/kraken-rbtree 42000` | 4.082 ± 0.015 | 4.063 | 4.103 | 933.07 ± 97.15 | +| `build/cpp/cpp-rbtree 42000` | 0.006 ± 0.001 | 0.005 | 0.008 | 1.27 ± 0.19 | +| `build/haskell/hs-rbtree 42000` | 0.016 ± 0.001 | 0.016 | 0.018 | 3.72 ± 0.41 | | `build/koka/out/bench/kk-rbtree 42000` | 0.004 ± 0.000 | 0.004 | 0.007 | 1.00 |