miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added haskell versions (parameterized by CLI argument)

Browse Source
This commit is contained in:
Nathan Braswell
2022-05-18 23:59:18 -04:00
parent 4481784666
commit 62c0958006
10 changed files with 316 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
koka_bench/CMakeLists.txt
View File

@@ -11,3 +11,4 @@ enable_testing()
add_subdirectory(kraken)
add_subdirectory(koka)
add_subdirectory(cpp)
add_subdirectory(haskell)

7
koka_bench/cfold_table.md
View File

@@ -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 |

7
koka_bench/deriv_table.md
View File

@@ -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 |

33
koka_bench/haskell/CMakeLists.txt Normal file
View File

@@ -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} "$<SHELL_PATH:${CMAKE_CURRENT_SOURCE_DIR}/${source}>"
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 ()

65
koka_bench/haskell/cfold.hs Normal file
View File

@@ -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₂)

86
koka_bench/haskell/deriv.hs Normal file
View File

@@ -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

44
koka_bench/haskell/nqueens.hs Normal file
View File

@@ -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))

70
koka_bench/haskell/rbtree.hs Normal file
View File

@@ -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

9
koka_bench/rbnqueens_table.md
View File

@@ -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 |

7
koka_bench/rbtree_table.md
View File

@@ -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 |