From 3a84a7ca4f0a8da60a0d5665e88764a8fd9e08e4 Mon Sep 17 00:00:00 2001 From: zapashcanon Date: Thu, 17 Oct 2024 20:38:31 +0200 Subject: [PATCH] improve benchmarks and reduce noise by making them longer --- wasm/test/bdd.ml | 13 +- wasm/test/boyer.ml | 1 - wasm/test/boyer_no_exc.ml | 1 - wasm/test/fannkuch2.ml | 36 +++-- wasm/test/fib.ml | 14 +- wasm/test/kb.ml | 4 +- wasm/test/kb_no_exc.ml | 286 +++++++++++++++++++------------------- wasm/test/loop.ml | 6 +- wasm/test/main_node.mjs | 81 ++++++----- wasm/test/quicksort.ml | 8 +- wasm/test/takc.ml | 6 +- wasm/test/taku.ml | 2 +- wasm/test/test_node.sh | 92 +++++++----- 13 files changed, 278 insertions(+), 272 deletions(-) diff --git a/wasm/test/bdd.ml b/wasm/test/bdd.ml index 7b70eb368..6b5797283 100644 --- a/wasm/test/bdd.ml +++ b/wasm/test/bdd.ml @@ -243,21 +243,16 @@ let test_hwb bdd vars = eval bdd vars = if !ntrue > 0 then vars.(!ntrue - 1) else false let main () = - let n = 22 in + let n = 25 in let ntests = 100 in let bdd = hwb n in let succeeded = ref true in for _ = 1 to ntests do succeeded := !succeeded && test_hwb bdd (random_vars n) done; - assert !succeeded - -(* + assert !succeeded; if !succeeded then print_string "OK\n" - else print_string "FAILED\n"; -Format.eprintf "%d@." !nodeC; - exit 0 -*) + else print_string "FAILED\n" -let _ = main () +let () = main () diff --git a/wasm/test/boyer.ml b/wasm/test/boyer.ml index 1a9ae5f52..c4e4b4271 100644 --- a/wasm/test/boyer.ml +++ b/wasm/test/boyer.ml @@ -1206,7 +1206,6 @@ let _ = print_string "Proved!\n" else print_string "Cannot prove!\n"; - exit 0 *) (********* diff --git a/wasm/test/boyer_no_exc.ml b/wasm/test/boyer_no_exc.ml index f34575dec..fce3dce46 100644 --- a/wasm/test/boyer_no_exc.ml +++ b/wasm/test/boyer_no_exc.ml @@ -1215,7 +1215,6 @@ let _ = print_string "Proved!\n" else print_string "Cannot prove!\n"; - exit 0 *) (********* diff --git a/wasm/test/fannkuch2.ml b/wasm/test/fannkuch2.ml index 563580167..0137c7af3 100644 --- a/wasm/test/fannkuch2.ml +++ b/wasm/test/fannkuch2.ml @@ -4,6 +4,8 @@ contributed by Isaac Gouy, transliterated from Mike Pall's Lua program *) +exception Done + let fannkuch n = let p = Array.make n 0 in let q = Array.make n 0 in @@ -36,19 +38,19 @@ let fannkuch n = let qq = q.(!q0) in q.(!q0) <- !q0; (if !q0 >= 3 - then - let i = ref 1 in - let j = ref (!q0 - 1) in - while - let t = q.(!i) in - q.(!i) <- q.(!j); - q.(!j) <- t; - incr i; - decr j; - !i < !j - do - () - done); + then + let i = ref 1 in + let j = ref (!q0 - 1) in + while + let t = q.(!i) in + q.(!i) <- q.(!j); + q.(!j) <- t; + incr i; + decr j; + !i < !j + do + () + done); q0 := qq; incr flips done); @@ -73,7 +75,7 @@ let fannkuch n = if i = n - 1 then ( if false then Format.eprintf "%d %d@." !sum !maxflips; - exit 0); + raise Done); s.(i) <- i; let t = p.(0) in for j = 0 to i do @@ -86,8 +88,4 @@ let fannkuch n = let n = 10 -let pf = fannkuch n - -(* -//print(pf[0] + "\n" + "Pfannkuchen(" + n + ") = " + pf[1]); -*) +let () = try fannkuch n with Done -> () diff --git a/wasm/test/fib.ml b/wasm/test/fib.ml index 903d9850e..629a8083c 100644 --- a/wasm/test/fib.ml +++ b/wasm/test/fib.ml @@ -3,14 +3,6 @@ let rec fib n = else fib (n - 1) + fib (n - 2) let () = - let n = 40 in - assert (fib n = 102334155) - (* - for i = 0 to 40 do - print_string "fib ("; - print_int i; - print_string ") = "; - print_int (fib i); - print_string "\n" - done - *) + let n = 43 in + let res = fib n in + print_int res diff --git a/wasm/test/kb.ml b/wasm/test/kb.ml index ea8fdd3cc..aeb22a163 100644 --- a/wasm/test/kb.ml +++ b/wasm/test/kb.ml @@ -584,5 +584,5 @@ let group_order = rpo group_precedence lex_ext let greater pair = match group_order pair with Greater -> true | _ -> false -let _ = - for i = 1 to 20 do kb_complete greater [] geom_rules done +let () = + for i = 1 to 55 do kb_complete greater [] geom_rules done diff --git a/wasm/test/kb_no_exc.ml b/wasm/test/kb_no_exc.ml index 700bfaa42..63b5be00e 100644 --- a/wasm/test/kb_no_exc.ml +++ b/wasm/test/kb_no_exc.ml @@ -68,11 +68,11 @@ let rec fold_left2_opt f accu l1 l2 = let rec match_rec subst t1 t2 = match t1, t2 with | Var v, _ -> - if List.mem_assoc v subst - then if t2 = List.assoc v subst then Some subst else None - else Some ((v, t2) :: subst) + if List.mem_assoc v subst + then if t2 = List.assoc v subst then Some subst else None + else Some ((v, t2) :: subst) | Term (op1, sons1), Term (op2, sons2) -> - if op1 = op2 then fold_left2_opt match_rec subst sons1 sons2 else None + if op1 = op2 then fold_left2_opt match_rec subst sons1 sons2 else None | _ -> None let matching term1 term2 = match_rec [] term1 term2 @@ -89,21 +89,21 @@ let rec occurs n = function let rec unify term1 term2 = match term1, term2 with | Var n1, _ -> - if term1 = term2 - then [] - else if occurs n1 term2 - then failwith "unify" - else [ n1, term2 ] + if term1 = term2 + then [] + else if occurs n1 term2 + then failwith "unify" + else [ n1, term2 ] | term1, Var n2 -> if occurs n2 term1 then failwith "unify" else [ n2, term1 ] | Term (op1, sons1), Term (op2, sons2) -> - if op1 = op2 - then - List.fold_left2 - (fun s t1 t2 -> compsubst (unify (substitute s t1) (substitute s t2)) s) - [] - sons1 - sons2 - else failwith "unify" + if op1 = op2 + then + List.fold_left2 + (fun s t1 t2 -> compsubst (unify (substitute s t1) (substitute s t2)) s) + [] + sons1 + sons2 + else failwith "unify" (* We need to print terms with variables independently from input terms obtained by parsing. We give arbitrary names v1,v2,... to their variables. @@ -113,39 +113,39 @@ let infixes = [ "+"; "*" ] let rec pretty_term = function | Var n -> - print_string "v"; - print_int n + print_string "v"; + print_int n | Term (oper, sons) -> - if List.mem oper infixes - then - match sons with - | [ s1; s2 ] -> - pretty_close s1; - print_string oper; - pretty_close s2 - | _ -> failwith "pretty_term : infix arity <> 2" - else ( + if List.mem oper infixes + then + match sons with + | [ s1; s2 ] -> + pretty_close s1; print_string oper; - match sons with - | [] -> () - | t :: lt -> - print_string "("; - pretty_term t; - List.iter - (fun t -> - print_string ","; - pretty_term t) - lt; - print_string ")") + pretty_close s2 + | _ -> failwith "pretty_term : infix arity <> 2" + else ( + print_string oper; + match sons with + | [] -> () + | t :: lt -> + print_string "("; + pretty_term t; + List.iter + (fun t -> + print_string ","; + pretty_term t) + lt; + print_string ")") and pretty_close = function | Term (oper, _) as m -> - if List.mem oper infixes - then ( - print_string "("; - pretty_term m; - print_string ")") - else pretty_term m + if List.mem oper infixes + then ( + print_string "("; + pretty_term m; + print_string ")") + else pretty_term m | m -> pretty_term m (***********************************************************************) @@ -179,8 +179,8 @@ let mk_rule num m n = let subst = List.map (fun v -> - incr counter; - v, Var !counter) + incr counter; + v, Var !counter) (List.rev all_vars) in { number = num; numvars = !counter; lhs = substitute subst m; rhs = substitute subst n } @@ -191,8 +191,8 @@ let check_rules rules = let counter = ref 0 in List.iter (fun r -> - incr counter; - if r.number <> !counter then failwith "Rule numbers not in sequence") + incr counter; + if r.number <> !counter then failwith "Rule numbers not in sequence") rules; !counter @@ -318,31 +318,31 @@ let mult_ext order = function match diff_eq (eq_ord order) (sons1, sons2) with | [], [] -> Equal | l1, l2 -> - if List.for_all (fun n -> List.exists (fun m -> gt_ord order (m, n)) l1) l2 - then Greater - else NotGE) + if List.for_all (fun n -> List.exists (fun m -> gt_ord order (m, n)) l1) l2 + then Greater + else NotGE) | _ -> failwith "mult_ext" (* Lexicographic extension of order *) let lex_ext order = function | (Term (_, sons1) as m), (Term (_, sons2) as n) -> - let rec lexrec = function - | [], [] -> Equal - | [], _ -> NotGE - | _, [] -> Greater - | x1 :: l1, x2 :: l2 -> ( - match order (x1, x2) with - | Greater -> - if List.for_all (fun n' -> gt_ord order (m, n')) l2 - then Greater - else NotGE - | Equal -> lexrec (l1, l2) - | NotGE -> - if List.exists (fun m' -> ge_ord order (m', n)) l1 then Greater else NotGE - ) - in - lexrec (sons1, sons2) + let rec lexrec = function + | [], [] -> Equal + | [], _ -> NotGE + | _, [] -> Greater + | x1 :: l1, x2 :: l2 -> ( + match order (x1, x2) with + | Greater -> + if List.for_all (fun n' -> gt_ord order (m, n')) l2 + then Greater + else NotGE + | Equal -> lexrec (l1, l2) + | NotGE -> + if List.exists (fun m' -> ge_ord order (m', n)) l1 then Greater else NotGE + ) + in + lexrec (sons1, sons2) | _ -> failwith "lex_ext" (* Recursive path ordering *) @@ -360,14 +360,14 @@ let rpo op_order ext = | Term (op2, sons2) -> ( match op_order op1 op2 with | Greater -> - if List.for_all (fun n' -> gt_ord rporec (m, n')) sons2 - then Greater - else NotGE + if List.for_all (fun n' -> gt_ord rporec (m, n')) sons2 + then Greater + else NotGE | Equal -> ext rporec (m, n) | NotGE -> - if List.exists (fun m' -> ge_ord rporec (m', n)) sons1 - then Greater - else NotGE)) + if List.exists (fun m' -> ge_ord rporec (m', n)) sons1 + then Greater + else NotGE)) in rporec @@ -395,8 +395,8 @@ let rec super m = function let rec collate n = function | [] -> [] | son :: rest -> - List.map (fun (u, subst) -> n :: u, subst) (super m son) - @ collate (n + 1) rest + List.map (fun (u, subst) -> n :: u, subst) (super m son) + @ collate (n + 1) rest in let insides = collate 1 sons in try ([], unify m n) :: insides with Failure _ -> insides) @@ -413,13 +413,13 @@ let rec super m = function let super_strict m = function | Term (_, sons) -> - let rec collate n = function - | [] -> [] - | son :: rest -> - List.map (fun (u, subst) -> n :: u, subst) (super m son) - @ collate (n + 1) rest - in - collate 1 sons + let rec collate n = function + | [] -> [] + | son :: rest -> + List.map (fun (u, subst) -> n :: u, subst) (super m son) + @ collate (n + 1) rest + in + collate 1 sons | _ -> [] (* Critical pairs of l1=r1 with l2=r2 *) @@ -464,8 +464,8 @@ let non_orientable (m, n) = let rec partition p = function | [] -> [], [] | x :: l -> - let l1, l2 = partition p l in - if p x then x :: l1, l2 else l1, x :: l2 + let l1, l2 = partition p l in + if p x then x :: l1, l2 else l1, x :: l2 let rec get_rule n = function | [] -> raise Not_found @@ -477,11 +477,11 @@ let kb_completion greater = let rec kbrec j rules = let rec process failures (k, l) eqs = (* {[ - print_string "***kb_completion "; print_int j; print_newline(); - pretty_rules rules; - List.iter non_orientable failures; - print_int k; print_string " "; print_int l; print_newline(); - List.iter non_orientable eqs; + print_string "***kb_completion "; print_int j; print_newline(); + pretty_rules rules; + List.iter non_orientable failures; + print_int k; print_string " "; print_int l; print_newline(); + List.iter non_orientable eqs; ]} *) match eqs with @@ -494,44 +494,44 @@ let kb_completion greater = match failures with | [] -> rules (* successful completion *) | _ -> - print_string "Non-orientable equations :"; - print_newline (); - List.iter non_orientable failures; - failwith "kb_completion") + print_string "Non-orientable equations :"; + print_newline (); + List.iter non_orientable failures; + failwith "kb_completion") | (m, n) :: eqs -> - let m' = mrewrite_all rules m - and n' = mrewrite_all rules n - and enter_rule (left, right) = - let new_rule = mk_rule (j + 1) left right in - pretty_rule new_rule; - let left_reducible rule = reducible left rule.lhs in - let redl, irredl = partition left_reducible rules in - List.iter deletion_message redl; - let right_reduce rule = - mk_rule rule.number rule.lhs (mrewrite_all (new_rule :: rules) rule.rhs) - in - let irreds = List.map right_reduce irredl in - let eqs' = List.map (fun rule -> rule.lhs, rule.rhs) redl in - kbrec (j + 1) (new_rule :: irreds) [] (k, l) (eqs @ eqs' @ failures) + let m' = mrewrite_all rules m + and n' = mrewrite_all rules n + and enter_rule (left, right) = + let new_rule = mk_rule (j + 1) left right in + pretty_rule new_rule; + let left_reducible rule = reducible left rule.lhs in + let redl, irredl = partition left_reducible rules in + List.iter deletion_message redl; + let right_reduce rule = + mk_rule rule.number rule.lhs (mrewrite_all (new_rule :: rules) rule.rhs) in - (* {[ - print_string "--- Considering "; non_orientable (m', n'); - ]} - *) - if m' = n' - then process failures (k, l) eqs - else if greater (m', n') - then enter_rule (m', n') - else if greater (n', m') - then enter_rule (n', m') - else process ((m', n') :: failures) (k, l) eqs + let irreds = List.map right_reduce irredl in + let eqs' = List.map (fun rule -> rule.lhs, rule.rhs) redl in + kbrec (j + 1) (new_rule :: irreds) [] (k, l) (eqs @ eqs' @ failures) + in + (* {[ + print_string "--- Considering "; non_orientable (m', n'); + ]} + *) + if m' = n' + then process failures (k, l) eqs + else if greater (m', n') + then enter_rule (m', n') + else if greater (n', m') + then enter_rule (n', m') + else process ((m', n') :: failures) (k, l) eqs and next_criticals failures (k, l) = (* {[ - print_string "***next_criticals "; - print_int k; print_string " "; print_int l ; print_newline(); + print_string "***next_criticals "; + print_int k; print_string " "; print_int l ; print_newline(); ]} - *) + *) try let rl = get_rule l rules in let el = rl.lhs, rl.rhs in @@ -575,17 +575,17 @@ let kb_complete greater complete_rules rules = (* $Id: kbmain.ml 7017 2005-08-12 09:22:04Z xleroy $ *) (* - {[ - let group_rules = [ - { number = 1; numvars = 1; - lhs = Term("*", [Term("U",[]); Var 1]); rhs = Var 1 }; - { number = 2; numvars = 1; - lhs = Term("*", [Term("I",[Var 1]); Var 1]); rhs = Term("U",[]) }; - { number = 3; numvars = 3; - lhs = Term("*", [Term("*", [Var 1; Var 2]); Var 3]); - rhs = Term("*", [Var 1; Term("*", [Var 2; Var 3])]) } - ] - ]} + {[ + let group_rules = [ + { number = 1; numvars = 1; + lhs = Term("*", [Term("U",[]); Var 1]); rhs = Var 1 }; + { number = 2; numvars = 1; + lhs = Term("*", [Term("I",[Var 1]); Var 1]); rhs = Term("U",[]) }; + { number = 3; numvars = 3; + lhs = Term("*", [Term("*", [Var 1; Var 2]); Var 3]); + rhs = Term("*", [Var 1; Term("*", [Var 2; Var 3])]) } + ] + ]} *) let geom_rules = @@ -594,22 +594,22 @@ let geom_rules = ; numvars = 1 ; lhs = Term ("*", [ Term ("I", [ Var 1 ]); Var 1 ]) ; rhs = Term ("U", []) - } + } ; { number = 3 ; numvars = 3 ; lhs = Term ("*", [ Term ("*", [ Var 1; Var 2 ]); Var 3 ]) ; rhs = Term ("*", [ Var 1; Term ("*", [ Var 2; Var 3 ]) ]) - } + } ; { number = 4 ; numvars = 0 ; lhs = Term ("*", [ Term ("A", []); Term ("B", []) ]) ; rhs = Term ("*", [ Term ("B", []); Term ("A", []) ]) - } + } ; { number = 5 ; numvars = 0 ; lhs = Term ("*", [ Term ("C", []); Term ("C", []) ]) ; rhs = Term ("U", []) - } + } ; { number = 6 ; numvars = 0 ; lhs = @@ -617,9 +617,9 @@ let geom_rules = ( "*" , [ Term ("C", []) ; Term ("*", [ Term ("A", []); Term ("I", [ Term ("C", []) ]) ]) - ] ) + ] ) ; rhs = Term ("I", [ Term ("A", []) ]) - } + } ; { number = 7 ; numvars = 0 ; lhs = @@ -627,9 +627,9 @@ let geom_rules = ( "*" , [ Term ("C", []) ; Term ("*", [ Term ("B", []); Term ("I", [ Term ("C", []) ]) ]) - ] ) + ] ) ; rhs = Term ("B", []) - } + } ] let group_rank = function @@ -652,7 +652,7 @@ let greater pair = | Greater -> true | _ -> false -let _ = - for _ = 1 to 20 do +let () = + for _ = 1 to 85 do kb_complete greater [] geom_rules done diff --git a/wasm/test/loop.ml b/wasm/test/loop.ml index 2df20f77d..7d3d85c65 100644 --- a/wasm/test/loop.ml +++ b/wasm/test/loop.ml @@ -1,3 +1,5 @@ -for _ = 1 to 1000000000 do - () +for _ = 1 to 3 do + for _ = 1 to 1_000_000_000 do + () + done done diff --git a/wasm/test/main_node.mjs b/wasm/test/main_node.mjs index f56507ef7..04bfaa704 100644 --- a/wasm/test/main_node.mjs +++ b/wasm/test/main_node.mjs @@ -6,59 +6,58 @@ const memory = new WebAssembly.Memory({ }); function print_string(str) { - console.log('print_string'); - var res = ""; - for (i = 0; i < get_length(str); i++) { - res = res + String.fromCharCode(get_char(str, i)); - } - console.log(res); - }; -var str_buff = ""; + let res = ""; + for (let i = 0; i < get_length(str); i++) { + res = res + String.fromCharCode(get_char(str, i)); + } + process.stdout.write(res); +}; + +let str_buff = ""; + function print_string_mem(off, len) { - // console.log('print_string_mem'); - const buff = new Uint8Array(memory.buffer); - // console.log(buff); - var i = 0; - for (i = 0; i < len; i++) { - var char = String.fromCharCode(buff[i+off]); - str_buff = str_buff + char; - } - }; + const buff = new Uint8Array(memory.buffer); + for (let i = off; i < len + off; i++) { + let char = String.fromCharCode(buff[i]); + str_buff = str_buff + char; + } +}; function print_i32(arg) { - str_buff = str_buff + arg.toString(); - }; + str_buff = str_buff + arg.toString(); +}; + function print_f64(arg) { - console.log(arg); - }; + process.stdout.write(arg); +}; function print_endline() { - console.log(str_buff); - str_buff = ""; + process.stdout.write(str_buff); + str_buff = ""; } function putchar(i_char) { - var char = String.fromCharCode(i_char); - str_buff = str_buff + char; + let char = String.fromCharCode(i_char); + str_buff = str_buff + char; }; function flush() { - console.log(str_buff); - str_buff = ""; + process.stdout.write(str_buff); + str_buff = ""; } const bindings = { - "print_i32": print_i32, - "print_f64": print_f64, - "print_string": print_string, - "print_string_mem": print_string_mem, - "print_endline": print_endline, - "putchar": putchar, - "flush": flush, - "memory": memory, - "atan2": Math.atan2, - "sin": Math.sin, - "cos": Math.cos, + "print_i32": print_i32, + "print_f64": print_f64, + "print_string": print_string, + "print_string_mem": print_string_mem, + "print_endline": print_endline, + "putchar": putchar, + "flush": flush, + "memory": memory, + "atan2": Math.atan2, + "sin": Math.sin, + "cos": Math.cos, } const src = "./a.out.wasm" @@ -70,11 +69,11 @@ const imports = {"js_runtime":bindings} async function f() { const wasmModule = await WebAssembly.instantiate(code, imports).then(module => { - console.log("module loaded!"); + //process.stdout.write("module loaded!"); //for (let key in module.instance.exports) { - // console.log(key); + // process.stdout.write(key); //} - //console.log("done!"); + //process.stdout.write("done!"); }); } diff --git a/wasm/test/quicksort.ml b/wasm/test/quicksort.ml index c8f935c62..51cd16412 100644 --- a/wasm/test/quicksort.ml +++ b/wasm/test/quicksort.ml @@ -102,9 +102,7 @@ let test_sort sort_fun size = (*print_string "failed"; print_newline()*) let main () = - test_sort qsort 500000; - test_sort qsort2 500000 + test_sort qsort 2500000; + test_sort qsort2 2500000 -let _ = main () - -(*exit 0*) +let () = main () diff --git a/wasm/test/takc.ml b/wasm/test/takc.ml index 332807588..90079504f 100644 --- a/wasm/test/takc.ml +++ b/wasm/test/takc.ml @@ -17,8 +17,4 @@ let rec tak x y z = let rec repeat n accu = if n <= 0 then accu else repeat (n - 1) (tak 18 12 6 + accu) -let _ = assert (repeat 2000 0 = 14000) - -(* - print_int (repeat 2000); print_newline(); exit 0 -*) +let () = print_int (repeat 20000 0); print_newline () diff --git a/wasm/test/taku.ml b/wasm/test/taku.ml index 3266521ff..316429beb 100644 --- a/wasm/test/taku.ml +++ b/wasm/test/taku.ml @@ -17,4 +17,4 @@ let rec tak (x, y, z) = let rec repeat n accu = if n <= 0 then accu else repeat (n - 1) (tak (18, 12, 6) + accu) -let _ = assert (repeat 2000 0 = 14000) +let () = print_int (repeat 20000 0) diff --git a/wasm/test/test_node.sh b/wasm/test/test_node.sh index defff9d98..2563d40cb 100755 --- a/wasm/test/test_node.sh +++ b/wasm/test/test_node.sh @@ -10,61 +10,89 @@ NODE="node-canary --stack-size=${STACK_SIZE}" ulimit -s $ULIMIT_STACK_SIZE -bench() { - echo "*** Running ${1}:" - - echo "" +#UNSAFE="-unsafe" +UNSAFE="" +bench_native() { echo -n " OCaml native: " - ocamlopt -O3 ./${2}.ml > /dev/null - time ./a.out > /dev/null + ocamlopt $UNSAFE -O3 ./${2}.ml > /dev/null + time ./a.out > output_${2}_ocaml_native.txt +} +bench_wasocaml_opt() { echo -n " Wasocaml + wasm-opt (node): " - ../../ocamlopt -O3 ./${2}.ml > /dev/null - wasm-opt --enable-gc --enable-reference-types --enable-multivalue --enable-tail-call a.out.wasm -o a.out.wasm -O3 - time $NODE ./main_node.mjs > /dev/null + ../../ocamlopt $UNSAFE -O3 ./${2}.ml > /dev/null + wasm-opt --enable-gc --enable-reference-types --enable-multivalue --enable-tail-call --enable-nontrapping-float-to-int --traps-never-happen --skip-pass=inlining-optimizing a.out.wasm -o a.out.wasm -O3 + time $NODE ./main_node.mjs > output_${2}_wasocaml_opt.txt + diff output_${2}_ocaml_native.txt output_${2}_wasocaml_opt.txt +} - #echo -n " Wasocaml (node): " - #../../ocamlopt -O3 ./${2}.ml > /dev/null - #time $NODE ./main_node.mjs > /dev/null +bench_wasocaml() { + echo -n " Wasocaml (node): " + ../../ocamlopt $UNSAFE -O3 ./${2}.ml > /dev/null + time $NODE ./main_node.mjs > output_${2}_wasocaml.txt + diff output_${2}_ocaml_native.txt output_${2}_wasocaml.txt +} +bench_wsoo() { echo -n " wasm_of_ocaml (node): " - ocamlc ./${2}.ml > /dev/null - rm -f a.js a.wat || true 2> /dev/null + ocamlc $UNSAFE ./${2}.ml > /dev/null + rm -rf a.assets* a.js a.wat || true 2> /dev/null wasm_of_ocaml compile --opt=3 ./a.out > /dev/null - time $NODE ./a.js > /dev/null - rm -rf a.assets* + time $NODE ./a.js > output_${2}_wsoo.txt + diff output_${2}_ocaml_native.txt output_${2}_wsoo.txt +} +bench_jsoo() { echo -n " js_of_ocaml (node): " - ocamlc ./${2}.ml > /dev/null + ocamlc $UNSAFE ./${2}.ml > /dev/null rm -f a.js a.wat || true 2> /dev/null js_of_ocaml compile --target-env=nodejs --opt=3 ./a.out - time $NODE ./a.js > /dev/null + time $NODE ./a.js > output_${2}_jsoo.txt + diff output_${2}_ocaml_native.txt output_${2}_jsoo.txt +} +bench_bytecode() { echo -n " OCaml bytecode: " - ocamlc ./${2}.ml > /dev/null - time ocamlrun ./a.out > /dev/null + ocamlc $UNSAFE ./${2}.ml > /dev/null + time ocamlrun ./a.out > output_${2}_bytecode.txt + diff output_${2}_ocaml_native.txt output_${2}_bytecode.txt +} + +bench() { + echo "*** Running ${1}:" + + echo "" + + bench_native "${1}" "${2}" + bench_wasocaml_opt "${1}" "${2}" + #bench_wasocaml "${1}" "${2}" + bench_wsoo "${1}" "${2}" + #bench_jsoo "${1}" "${2}" + #bench_bytecode "${1}" "${2}" echo "" } -bench "Knuth-Bendix" "kb" -bench "Knuth-Bendix (no exception)" "kb_no_exc" -bench "Soli" "soli" -bench "Fibonacci" "fib" + #bench "Almabench" "almabench" # global init must have correct type -bench "Binary Decision Diagram" "bdd" #bench "Binary Trees" "binary_trees" # unreachable #bench "Boyer" "boyer" # unreachable #bench "Boyer no exceptions" "boyer_no_exc" # unreachable #bench "Pfannkuchen" "fannkuch" # unreachable -#bench "Pfannkuchen 2" "fannkuch2" # unreachable -#bench "Fast Fourier Transform" "fft" -#bench "Hamming" "hamming" -bench "Loop" "loop" +#bench "Pfannkuchen 2" "fannkuch2" # missing "caml_string_notequal" and "caml_lessthan" +#bench "Fast Fourier Transform" "fft" # unreachable +#bench "Hamming" "hamming" # missing value let-rec #bench "Nucleic" "nucleic" # unreachable -#bench "Quicksort" "quicksort" -#bench "Ray-Trace" "raytrace" -#bench "Splay Tree" "splay" +#bench "Ray-Trace" "raytrace" # global init must have correct type +#bench "Splay Tree" "splay" # unreachable + +bench "Knuth-Bendix" "kb" +bench "Knuth-Bendix (no exception)" "kb_no_exc" +bench "Soli" "soli" +bench "Fibonacci" "fib" +bench "Binary Decision Diagram" "bdd" +bench "Loop" "loop" bench "Takc" "takc" bench "Taku" "taku" +bench "Quicksort" "quicksort"