From 306e8eafaab613d053667a5224116b12c01b162f Mon Sep 17 00:00:00 2001 From: Magnus Myreen Date: Thu, 24 Jan 2019 18:40:07 +0100 Subject: [PATCH] Update CakeML code in benchmarks --- .../cakeml_benchmarks/cakeml/bst_contain.sml | 14 ++---- .../cakeml/sptree_contain.sml | 10 ++-- .../mlton_benchmarks/cakeml/even-odd.sml | 4 +- .../mlton_benchmarks/cakeml/imp-for.sml | 4 +- .../mlton_benchmarks/cakeml/knuth-bendix.sml | 28 +++++------ .../mlton_benchmarks/cakeml/life.sml | 8 ++-- .../mlton_benchmarks/cakeml/logic.sml | 24 +++++----- .../mlton_benchmarks/cakeml/mpuz.sml | 6 +-- .../mlton_benchmarks/cakeml/pidigits.sml | 18 +++---- .../mlton_benchmarks/cakeml/ratio-regions.sml | 48 +++++++++---------- 10 files changed, 78 insertions(+), 86 deletions(-) diff --git a/compiler/benchmarks/cakeml_benchmarks/cakeml/bst_contain.sml b/compiler/benchmarks/cakeml_benchmarks/cakeml/bst_contain.sml index 6ed6e4cc71..38d8389a51 100644 --- a/compiler/benchmarks/cakeml_benchmarks/cakeml/bst_contain.sml +++ b/compiler/benchmarks/cakeml_benchmarks/cakeml/bst_contain.sml @@ -1,19 +1,11 @@ val with_inserts = True - fun num_compare v1 = - (fn v2 => - if (v1 = v2) - then Equal - else (if (v1 < v2) - then Less - else Greater)); - (* NB, 6561 (3^8) and 40000 (2^7 * 5^5) are chosen to be relatively prime so * that all element of the array are hit *) fun insert1 a n l = if n < l then - (a := Map.insert num_compare n 1 (!a); + (a := Map.insert (!a) n 1; insert1 a (n + 6561) l) else if n > l then insert1 a (n - l) l @@ -22,7 +14,7 @@ fun insert1 a n l = fun lookup1 a n l = if n < l then - (Map.lookup num_compare n (!a); + (Map.lookup (!a) n; lookup1 a (n + 6561) l) else if n > l then lookup1 a (n - l) l @@ -36,7 +28,7 @@ fun ins_look a n len = ((if with_inserts then insert1 a 0 len else ()); lookup1 a 0 len; ins_look a (n - 1) len); fun harness () = -let val a = Ref Tip in +let val a = Ref (Map.empty Int.compare) in (insert1 a 0 40000; ins_look a 1000 40000) end; diff --git a/compiler/benchmarks/cakeml_benchmarks/cakeml/sptree_contain.sml b/compiler/benchmarks/cakeml_benchmarks/cakeml/sptree_contain.sml index 6f35033f2b..2c59d67a03 100644 --- a/compiler/benchmarks/cakeml_benchmarks/cakeml/sptree_contain.sml +++ b/compiler/benchmarks/cakeml_benchmarks/cakeml/sptree_contain.sml @@ -10,12 +10,12 @@ val with_inserts = True fun lookup v7 v8 = case v8 - of Ln => NONE + of Ln => None | Ls(v1) => (if (v7 <= 0) - then (SOME(v1)) - else NONE) + then (Some(v1)) + else None) | Bn v3 v2 => (if (v7 <= 0) - then NONE + then None else (lookup ((let val k = v7 - 1 in if (k < 0) @@ -25,7 +25,7 @@ val with_inserts = True then v3 else v2))) | Bs v6 v5 v4 => (if (v7 <= 0) - then (SOME(v5)) + then (Some(v5)) else (lookup ((let val k = v7 - 1 in if (k < 0) diff --git a/compiler/benchmarks/mlton_benchmarks/cakeml/even-odd.sml b/compiler/benchmarks/mlton_benchmarks/cakeml/even-odd.sml index d117ae9f72..f726e3363f 100644 --- a/compiler/benchmarks/mlton_benchmarks/cakeml/even-odd.sml +++ b/compiler/benchmarks/mlton_benchmarks/cakeml/even-odd.sml @@ -2,10 +2,10 @@ fun abs i = if i < 0 then ~i else i exception Fail of string fun even' i = case i of - 0 => true + 0 => True | _ => odd' (i-1) and odd' i = case i of - 0 => false + 0 => False | _ => even' (i-1) fun even i = even' (abs i) diff --git a/compiler/benchmarks/mlton_benchmarks/cakeml/imp-for.sml b/compiler/benchmarks/mlton_benchmarks/cakeml/imp-for.sml index d9f676dc33..ef41f55c05 100644 --- a/compiler/benchmarks/mlton_benchmarks/cakeml/imp-for.sml +++ b/compiler/benchmarks/mlton_benchmarks/cakeml/imp-for.sml @@ -2,7 +2,7 @@ exception Fail of string; fun for start stop f = let - val i = ref start + val i = Ref start fun loop () = if !i >= stop then () else (f (!i) ; i := !i + 1 ; loop ()) @@ -14,7 +14,7 @@ structure Main = struct fun doit () = let - val x = ref 0 + val x = Ref 0 val u = for 0 10 (fn _ => for 0 10 (fn _ => diff --git a/compiler/benchmarks/mlton_benchmarks/cakeml/knuth-bendix.sml b/compiler/benchmarks/mlton_benchmarks/cakeml/knuth-bendix.sml index 9c4ed78a9b..5fa15eff83 100644 --- a/compiler/benchmarks/mlton_benchmarks/cakeml/knuth-bendix.sml +++ b/compiler/benchmarks/mlton_benchmarks/cakeml/knuth-bendix.sml @@ -9,22 +9,22 @@ structure Main = fun length l = let fun j p = case p of - (k, nil) => k + (k, []) => k | (k, a::x) => j(k+1,x) in j(0,l) end fun append p = case p of - (nil, l) => l + ([], l) => l | (a::r, l) => a :: (append (r,l)) fun rev l = let fun f p = case p of - (nil, h) => h + ([], h) => h | (a::r, h) => f(r, a::h) in - f(l,nil) + f(l,[]) end fun app f = let @@ -70,14 +70,14 @@ fun it_list2 f = fun exists p = let fun exists_rec ls = case ls of - [] => false + [] => False | (a::l) => (p a) orelse (exists_rec l) in exists_rec end fun for_all p = let fun for_all_rec ls = case ls of - [] => true + [] => True | (a::l) => (p a) andalso (for_all_rec l) in for_all_rec end @@ -106,7 +106,7 @@ fun partition p = fun mem a = let fun mem_rec ls = case ls of - [] => false + [] => False | (b::l) => (a=b) orelse mem_rec l in mem_rec end @@ -121,7 +121,7 @@ fun union l1 l2 = fun mem_assoc a = let fun mem_rec ls = case ls of - [] => false + [] => False | ((b,_)::l) => (a=b) orelse mem_rec l in mem_rec end @@ -296,10 +296,10 @@ fun reduce l m = (* A more efficient version of can (rewrite1 (l,r)) for r arbitrary *) fun reducible l = let fun redrec m = - (matching l m; true) + (matching l m; True) handle Failure _ => case m of Term _ sons => exists redrec sons - | _ => false + | _ => False in redrec end @@ -341,9 +341,9 @@ pretty_term (mrewrite_all Group_rules m where m,_=<>);; datatype ordering = Greater | Equal | NotGE; -fun ge_ord order pair = case order pair of NotGE => false | _ => true -and gt_ord order pair = case order pair of Greater => true | _ => false -and eq_ord order pair = case order pair of Equal => true | _ => false +fun ge_ord order pair = case order pair of NotGE => False | _ => True +and gt_ord order pair = case order pair of Greater => True | _ => False +and eq_ord order pair = case order pair of Equal => True | _ => False fun rem_eq equiv = let fun remrec x ls = case ls of @@ -603,7 +603,7 @@ fun group_precedence op1 op2 = val group_order = rpo group_precedence lex_ext - fun greater pair = (case group_order pair of Greater => true | _ => false) + fun greater pair = (case group_order pair of Greater => True | _ => False) fun doit() = kb_complete greater [] geom_rules diff --git a/compiler/benchmarks/mlton_benchmarks/cakeml/life.sml b/compiler/benchmarks/mlton_benchmarks/cakeml/life.sml index 57ea7d32d5..4f29507d49 100644 --- a/compiler/benchmarks/mlton_benchmarks/cakeml/life.sml +++ b/compiler/benchmarks/mlton_benchmarks/cakeml/life.sml @@ -24,8 +24,8 @@ structure Main = fun exists p = let fun existsp ls = case ls of - [] => false - | (a::x) => if p a then true else existsp x + [] => False + | (a::x) => if p a then True else existsp x in existsp end fun equal a b = (a = b) @@ -53,7 +53,7 @@ structure Main = | (a::x) => append (lexordset (filter (lexless a) x)) (append [a] (lexordset (filter (lexgreater a) x))) and lexless(a1:int,b1:int)(a2,b2) = - if a2 tr - | (n, r::tr) => ( r := NONE ; unwind_trail (n-1, tr) ) + | (n, r::tr) => ( r := None ; unwind_trail (n-1, tr) ) | (_, []) => raise Term.BadArg "unwind_trail" - fun reset_trail () = ( global_trail := nil ) + fun reset_trail () = ( global_trail := [] ) fun trail func = let @@ -38,7 +38,7 @@ struct end fun bind (r, t) = - ( r := SOME t ; + ( r := Some t ; global_trail := r::(!global_trail) ; trail_counter := !trail_counter+1 ) @@ -51,7 +51,7 @@ struct fun same_ref p = case p of (r, Term.REF(r')) => (r = r') - | _ => false + | _ => False fun occurs_check r t = let @@ -59,12 +59,12 @@ struct (Term.STR _ ts) => ocs ts | (Term.REF(r')) => (case !r' of - SOME(s) => oc s + Some(s) => oc s | _ => r <> r') - | (Term.CON _) => true - | (Term.INT _) => true + | (Term.CON _) => True + | (Term.INT _) => True and ocs ls = case ls of - [] => true + [] => True | (t::ts) => oc t andalso ocs ts in oc t @@ -74,7 +74,7 @@ struct case t of (Term.REF(x)) => (case !x of - SOME(s) => deref s + Some(s) => deref s | _ => t) | t => t @@ -126,7 +126,7 @@ struct val cON_nil_s = Term.CON(nil_s) val cON_x_s = Term.CON(x_s) - fun exists sc = sc (Term.REF(ref(NONE))) + fun exists sc = sc (Term.REF(Ref(None))) fun move_horiz (t_1, t_2) sc = ( diff --git a/compiler/benchmarks/mlton_benchmarks/cakeml/mpuz.sml b/compiler/benchmarks/mlton_benchmarks/cakeml/mpuz.sml index 99c0de31f6..4aac47fbf7 100644 --- a/compiler/benchmarks/mlton_benchmarks/cakeml/mpuz.sml +++ b/compiler/benchmarks/mlton_benchmarks/cakeml/mpuz.sml @@ -83,7 +83,7 @@ structure Mpuz = else () end - val values = List.map (fn v =>(v, ref false)) [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] + val values = List.map (fn v =>(v, Ref False)) [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] (* Try all assignments of values to letters. *) fun loop(letters) = @@ -94,10 +94,10 @@ structure Mpuz = (values, fn (v, r) => if !r then () - else (r := true + else (r := True ; setLetterValue(c, v) ; loop(letters) - ; r := false)) + ; r := False)) in loop(letters) end diff --git a/compiler/benchmarks/mlton_benchmarks/cakeml/pidigits.sml b/compiler/benchmarks/mlton_benchmarks/cakeml/pidigits.sml index 1317d4496f..989d916ce4 100644 --- a/compiler/benchmarks/mlton_benchmarks/cakeml/pidigits.sml +++ b/compiler/benchmarks/mlton_benchmarks/cakeml/pidigits.sml @@ -9,8 +9,8 @@ struct let fun loop b () = case f b of - NONE => Nil - | SOME p => case p of (x,b) => (Cons x (loop b)) + None => Nil + | Some p => case p of (x,b) => (Cons x (loop b)) in loop end @@ -18,8 +18,8 @@ struct fun map f = unfold (fn s => case s () of - Nil => NONE - | Cons x xs => SOME (f x, xs)) + Nil => None + | Cons x xs => Some (f x, xs)) end @@ -53,7 +53,7 @@ struct val pi = let val init = unit - val lfts = Stream.map (fn k => (k, 4*k+2, 0, 2*k+1)) (Stream.unfold (fn i => SOME(i, i+1)) 1) + val lfts = Stream.map (fn k => (k, 4*k+2, 0, 2*k+1)) (Stream.unfold (fn i => Some(i, i+1)) 1) fun floor_extr (q,r,s,t) x = (q * x + r) div (s * x + t) fun next z = floor_extr z 3 fun safe z n = n = floor_extr z 4 @@ -98,10 +98,10 @@ struct fun main (name, arguments) = case arguments of [n] => (case Int.fromString n of - SOME n => if n >= 1 + Some n => if n >= 1 then (display n; OS.Process.success) else usage name - | NONE => usage name) + | None => usage name) | _ => usage name*) end @@ -132,10 +132,10 @@ struct fun main (name, arguments) = case arguments of [n] => (case IntInf.fromString n of - SOME n => if n >= 1 + Some n => if n >= 1 then (display n; OS.Process.success) else usage name - | NONE => usage name) + | None => usage name) | _ => usage name*) val doit = display diff --git a/compiler/benchmarks/mlton_benchmarks/cakeml/ratio-regions.sml b/compiler/benchmarks/mlton_benchmarks/cakeml/ratio-regions.sml index 1b9fe3c786..c662a32055 100644 --- a/compiler/benchmarks/mlton_benchmarks/cakeml/ratio-regions.sml +++ b/compiler/benchmarks/mlton_benchmarks/cakeml/ratio-regions.sml @@ -144,15 +144,15 @@ fun pormat(control_string: string, values: pormatValue list) = * (CF_T y x) is the residual capacity from (y,x) to t. * We do not compute the residual capacity from t to (y,x) because it will * be used. - * (EF_RIGHT? y x) is true if there is an edge from (y,x) to (y,x+1) in the + * (EF_RIGHT? y x) is True if there is an edge from (y,x) to (y,x+1) in the * residual network. - * (EF_LEFT? y x) is true if there is an edge from (y,x) to (y,x_1) in the + * (EF_LEFT? y x) is True if there is an edge from (y,x) to (y,x_1) in the * residual network. - * (EF_DOWN? y x) is true if there is an edge from (y,x) to (y+1,x) in the + * (EF_DOWN? y x) is True if there is an edge from (y,x) to (y+1,x) in the * residual network. - * (EF_UP? y x) is true if there is an edge from (y,x) to (y_1,x) in the + * (EF_UP? y x) is True if there is an edge from (y,x) to (y_1,x) in the * residual network. - * (EF_T? y x) is true if there is an edge from (y,x) to t in the + * (EF_T? y x) is True if there is an edge from (y,x) to t in the * residual network. * There are always edges in the residual network from s to (y,X_1), (y,0), * (Y_1,x), and (0,x). @@ -180,7 +180,7 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = val f_t = make_matrix(height, width, 0) val h = make_matrix(height, width, 0) val e = make_matrix(height, width, 0) - val marked = make_matrix(height, width, false) + val marked = make_matrix(height, width, False) val m1 = height * width + 2 val m2 = 2 * height * width + 2 val q = make_vector(2 * height * width + 3, []) @@ -205,7 +205,7 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = matrix_ref(h, y, x), (cons((x, y), vector_ref(q, matrix_ref(h, y, x))))) - ; matrix_set(marked, y, x, true)) + ; matrix_set(marked, y, x, True)) else () fun cf_t(y, x) = v * matrix_ref(w, y, x) - matrix_ref(f_t, y, x) fun ef_t(y, x) = positive(cf_t(y, x)) @@ -335,21 +335,21 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = let fun null(q) = case !q of - Nil => true - | _ => false - val q= ref Nil : (int * int) queue ref - val tail = ref Nil : (int * int) queue ref + Nil => True + | _ => False + val q= Ref Nil : (int * int) queue ref + val tail = Ref Nil : (int * int) queue ref fun enqueue(y, x, value) = if value < matrix_ref(h, y, x) then (matrix_set(h, y, x, value) ; if not(matrix_ref(marked, y, x)) - then (matrix_set(marked, y, x, true) + then (matrix_set(marked, y, x, True) ; (case !tail of Nil => - (tail := Cons (x, y) (ref Nil) + (tail := Cons (x, y) (Ref Nil) ; q := !tail) | Cons _ cdr => - (cdr := Cons (x, y) (ref Nil) + (cdr := Cons (x, y) (Ref Nil) ; tail := !cdr))) else ()) else () @@ -357,14 +357,14 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = case !q of Nil => raise Fail "dequeue" | Cons p rest => - (matrix_set(marked, y p, x p, false) + (matrix_set(marked, y p, x p, False) ; q := !rest ; if null q then tail := Nil else () ; p) in doo(height, fn y => doo(width, fn x => (matrix_set(h, y, x, m1) - ; matrix_set(marked, y, x, false)))) + ; matrix_set(marked, y, x, False)))) ; doo(height, fn y => doo(width, fn x => if ef_t(y, x) @@ -413,9 +413,9 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = ; doo(width - 1, fn x => (matrix_set(e, height - 1, x, ~1) ; matrix_set(e, 0, x, ~1))) - ; let val pushes = ref 0 - val lifts = ref 0 - val relabels = ref 0 + ; let val pushes = Ref 0 + val lifts = Ref 0 + val relabels = Ref 0 fun loop(i, p) = if zero(modulo(i, 6)) andalso not p then (relabel() @@ -464,13 +464,13 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = vector_set(q, k, [])) ; doo(height, fn y => doo(width, fn x => - matrix_set(marked, y, x, false))) + matrix_set(marked, y, x, False))) ; doo(height, fn y => doo(width, fn x => if not(zero(matrix_ref(e, y, x))) then enqueue(y, x) else ())) - ; loop(i, true))) + ; loop(i, True))) else if some_vector(q, fn ps => some(ps, fn p => let val x = x p @@ -493,7 +493,7 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = ; (for_each (ps, fn p => matrix_set(marked, y p, x p, - false))) + False))) ; (for_each (ps, fn p => let val x = x p @@ -531,7 +531,7 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = else () in loop(vector_length q - 1) end - ; loop(i + 1, false)) + ; loop(i + 1, False)) else (* This is so MIN_CUT and MIN_CUT_INCLUDES_EVERY_EDGE_TO_T work. *) (relabel() @@ -545,7 +545,7 @@ fun rao_ratio_region(c_right, c_down, w, lg_max_v) = String(if !relabels = 1 then "" else "s"), Int i, String(if i = 1 then "" else "s")]))) - in loop(0, false) + in loop(0, False) end end fun min_cut_includes_every_edge_to_t() =