From f540a6d7e54ce8807818fe520f7259751fbcedd1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 3 Feb 2022 18:50:32 -0500 Subject: [PATCH 1/6] perf(vector): less aggressive growth for internal resizing --- src/core/CCVector.ml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 8ce99034..5c0017a9 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -79,9 +79,13 @@ let init n f = { } (* is the underlying array empty? *) -let array_is_empty_ v = +let[@inline] array_is_empty_ v = Array.length v.vec = 0 +(* next capacity, if current one is [n] *) +let[@inline] next_grow_ n = + min Sys.max_array_length (n + n lsl 1 + 5) + (* resize the underlying array using x to temporarily fill the array *) let resize_ v newcapacity x = assert (newcapacity >= v.size); @@ -128,7 +132,7 @@ let grow_with_ v ~filler:x = fill_with_junk_ v.vec 0 len; ) else ( let n = Array.length v.vec in - let size = min (2 * n + 3) Sys.max_array_length in + let size = next_grow_ n in if size = n then invalid_arg "vec: can't grow any further"; resize_ v size v.vec.(0) ) @@ -143,8 +147,8 @@ let ensure_assuming_not_empty_ v ~size = ) else if size < Array.length v.vec then ( () (* nothing to do *) ) else ( - let n = ref (max 8 (Array.length v.vec)) in - while !n < size do n := min Sys.max_array_length (2* !n) done; + let n = ref (Array.length v.vec) in + while !n < size do n := next_grow_ !n done; resize_ v !n v.vec.(0) ) From 7ec9e50f7439535be13d795c1fb046dc0d8467ff Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 3 Feb 2022 18:51:09 -0500 Subject: [PATCH 2/6] perf: make sure to use some decent level of inlining even without flambda --- src/mkflags.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mkflags.ml b/src/mkflags.ml index 3c4ffca5..d23ae951 100644 --- a/src/mkflags.ml +++ b/src/mkflags.ml @@ -13,7 +13,7 @@ let () = if after_4_3 then ( ["-O3"; "-unbox-closures"; "-unbox-closures-factor"; "20"; "-color"; "always"] ) else ( - [] + ["-inline"; "100"] ) in C.Flags.write_sexp "flambda.flags" sexp ) From 8c9d7016b88e896478157a615fbf18d26cb84944 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 3 Feb 2022 18:54:59 -0500 Subject: [PATCH 3/6] perf: uniformize ocamlopt_flags we don't need codegen which depends on >= 4.03, it's assumed. Also include a reasonable value for `-inline` when flambda isn't available. --- src/core/dune | 1 - src/data/dune | 1 - src/dune | 15 +++++---------- src/mkflags.ml | 19 ------------------- src/monomorphic/dune | 3 +-- src/threads/dune | 1 - src/top/dune | 1 - src/unix/dune | 4 +--- 8 files changed, 7 insertions(+), 38 deletions(-) delete mode 100644 src/mkflags.ml diff --git a/src/core/dune b/src/core/dune index d65c7d3f..ca13aa78 100644 --- a/src/core/dune +++ b/src/core/dune @@ -19,7 +19,6 @@ (modules :standard \ mkshims) (flags :standard -warn-error -a+8 -w -32 -safe-string -strict-sequence -nolabels -open CCMonomorphic) - (ocamlopt_flags (:include ../flambda.flags)) (libraries seq either containers.monomorphic)) (ocamllex (modules CCSexp_lex)) diff --git a/src/data/dune b/src/data/dune index 9e9ace90..7c5c1868 100644 --- a/src/data/dune +++ b/src/data/dune @@ -4,5 +4,4 @@ (public_name containers-data) (wrapped false) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -open CCShims_) - (ocamlopt_flags :standard (:include ../flambda.flags)) (libraries containers)) diff --git a/src/dune b/src/dune index e7a035b6..21bb22a5 100644 --- a/src/dune +++ b/src/dune @@ -1,15 +1,10 @@ -(executable - (name mkflags) - (modules mkflags) - (libraries dune.configurator)) (env - (_ (flags :standard -warn-error -3))) - -(rule - (targets flambda.flags) - (mode fallback) - (action (run ./mkflags.exe))) + (_ + (flags :standard -warn-error -3 -color always) + (ocamlopt_flags :standard -O3 -unbox-closures -unbox-closures-factor 20 + -inline 100) + )) (executable (name mdx_runner) diff --git a/src/mkflags.ml b/src/mkflags.ml deleted file mode 100644 index d23ae951..00000000 --- a/src/mkflags.ml +++ /dev/null @@ -1,19 +0,0 @@ - -module C = Configurator.V1 - -let () = - C.main ~name:"mkflags" (fun c -> - let version = C.ocaml_config_var_exn c "version" in - let major, minor = - Scanf.sscanf version "%u.%u" - (fun major minor -> major, minor) - in - let after_4_3 = (major, minor) >= (4, 3) in - let sexp = - if after_4_3 then ( - ["-O3"; "-unbox-closures"; "-unbox-closures-factor"; "20"; "-color"; "always"] - ) else ( - ["-inline"; "100"] - ) in - C.Flags.write_sexp "flambda.flags" sexp - ) diff --git a/src/monomorphic/dune b/src/monomorphic/dune index 06b39722..c3a3bdbd 100644 --- a/src/monomorphic/dune +++ b/src/monomorphic/dune @@ -14,5 +14,4 @@ (public_name containers.monomorphic) (modules CCMonomorphic CCMonomorphicShims_) (wrapped false) - (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) - (ocamlopt_flags :standard (:include ../flambda.flags))) + (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string)) diff --git a/src/threads/dune b/src/threads/dune index 55ce29ea..f27b5e65 100644 --- a/src/threads/dune +++ b/src/threads/dune @@ -5,6 +5,5 @@ (wrapped false) (optional) (flags :standard -warn-error -a+8 -w -32 -safe-string -open CCShims_) - (ocamlopt_flags :standard (:include ../flambda.flags)) (libraries containers threads)) diff --git a/src/top/dune b/src/top/dune index a23a99e7..29a6a6b4 100644 --- a/src/top/dune +++ b/src/top/dune @@ -5,5 +5,4 @@ (public_name containers.top) (wrapped false) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) - (ocamlopt_flags :standard (:include ../flambda.flags)) (libraries compiler-libs.common containers containers.unix)) diff --git a/src/unix/dune b/src/unix/dune index bebb4ead..aa387981 100644 --- a/src/unix/dune +++ b/src/unix/dune @@ -5,6 +5,4 @@ (wrapped false) (optional) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) - (ocamlopt_flags :standard (:include ../flambda.flags)) - (libraries unix) - ) + (libraries unix)) From 0baa4fddec8ec1a9f17c1c861c0ebf19eff36922 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 3 Feb 2022 18:55:50 -0500 Subject: [PATCH 4/6] perf(vector): inline some more stuff plz --- src/core/CCVector.ml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 5c0017a9..09734eda 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -165,7 +165,7 @@ let ensure v size = ensure_assuming_not_empty_ v ~size ) -let clear v = +let[@inline] clear v = v.size <- 0 (*$R @@ -192,9 +192,9 @@ let clear_and_reset v = OUnit.assert_equal None (Weak.get a 0); *) -let is_empty v = v.size = 0 +let[@inline] is_empty v = v.size = 0 -let push_unsafe_ v x = +let[@inline] push_unsafe_ v x = Array.unsafe_set v.vec v.size x; v.size <- v.size + 1 @@ -300,11 +300,11 @@ let append a b = OUnit.assert_equal (Iter.to_array Iter.(6 -- 10)) (to_array b); *) -let get v i = +let[@inline] get v i = if i < 0 || i >= v.size then invalid_arg "CCVector.get"; Array.unsafe_get v.vec i -let set v i x = +let[@inline] set v i x = if i < 0 || i >= v.size then invalid_arg "CCVector.set"; Array.unsafe_set v.vec i x @@ -345,7 +345,7 @@ let remove_unordered v i = to_list v1 = (List.sort CCInt.compare (to_list v2))) *) -let append_iter a i = i (fun x -> push a x) +let[@inline] append_iter a i = i (fun x -> push a x) let append_seq a seq = Seq.iter (fun x -> push a x) seq @@ -481,12 +481,12 @@ let pop v = try Some (pop_exn v) with Empty -> None -let top v = - if v.size = 0 then None else Some v.vec.(v.size-1) +let[@inline] top v = + if v.size = 0 then None else Some (Array.unsafe_get v.vec (v.size-1)) -let top_exn v = +let[@inline] top_exn v = if v.size = 0 then raise Empty; - v.vec.(v.size-1) + Array.unsafe_get v.vec (v.size-1) (*$T 1 -- 10 |> top = Some 10 @@ -494,7 +494,7 @@ let top_exn v = 1 -- 10 |> top_exn = 10 *) -let copy v = { +let[@inline] copy v = { size = v.size; vec = Array.sub v.vec 0 v.size; } From 02c09534682ffd6143c0229536c368481ac2753b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 3 Feb 2022 19:13:43 -0500 Subject: [PATCH 5/6] fix stupid typo --- src/core/CCVector.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 09734eda..a4d96201 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -84,7 +84,7 @@ let[@inline] array_is_empty_ v = (* next capacity, if current one is [n] *) let[@inline] next_grow_ n = - min Sys.max_array_length (n + n lsl 1 + 5) + min Sys.max_array_length (n + n lsr 1 + 5) (* resize the underlying array using x to temporarily fill the array *) let resize_ v newcapacity x = From 21c10d2ad4b6eed03ef2bd90da6d092a32055943 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 3 Feb 2022 19:15:13 -0500 Subject: [PATCH 6/6] less aggressive constant. series of sizes should now be: ``` # let next n = n + n lsr 1 + 2;; # CCSeq.unfold (fun x -> Some (x, next x)) 0 |> CCSeq.take 20 |> CCSeq.to_list;; - : int list = [0; 2; 5; 9; 15; 24; 38; 59; 90; 137; 207; 312; 470; 707; 1062; 1595; 2394; 3593; 5391; 8088] ``` --- src/core/CCVector.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index a4d96201..719ea85e 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -84,7 +84,7 @@ let[@inline] array_is_empty_ v = (* next capacity, if current one is [n] *) let[@inline] next_grow_ n = - min Sys.max_array_length (n + n lsr 1 + 5) + min Sys.max_array_length (n + n lsr 1 + 2) (* resize the underlying array using x to temporarily fill the array *) let resize_ v newcapacity x =