From c750e5b4645e32bf9b94401100e995fe26ec2861 Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Mon, 6 Jan 2025 16:41:13 +1100 Subject: [PATCH 1/6] pkg: version comparison fastpath Solving dependencies requires performing many package version comparisons. Opam's logic for comparing versions is complicated in the worst case, however in practice most package versions follow an approximation of semantic versioning. In such cases the components of the version can be packed into a single integer value which can be efficiently compared. This change introduces a pre-processing step for package versions that packs them into an int of possible and uses int comparison when comparing package versions when possible. This is based on an optimization in python's uv package manager. Signed-off-by: Stephen Sherratt --- vendor/opam/src/format/opamPackage.ml | 108 ++++++++++++++++++++++--- vendor/opam/src/format/opamPackage.mli | 8 +- 2 files changed, 106 insertions(+), 10 deletions(-) diff --git a/vendor/opam/src/format/opamPackage.ml b/vendor/opam/src/format/opamPackage.ml index 35a57235ad5..34b4c752f66 100644 --- a/vendor/opam/src/format/opamPackage.ml +++ b/vendor/opam/src/format/opamPackage.ml @@ -16,11 +16,76 @@ let slog = OpamConsole.slog module Version = struct - type version = string + type version_style = + | Triple (* E.g "1.2.3" *) + | V_triple (* E.g "v1.2.3" *) + + let version_style_equal a b = match (a, b) with + | Triple, Triple | V_triple, V_triple -> true + | _ -> false + + (* Alternative reprentation for some common patterns of version number that + can be efficiently compared. This is micro-optimized because solving + dependencies requires comparing a large number of package versions. *) + type version_small = + { int : Int64.t + ; style : version_style + ; has_suffix : bool + } + + type version = + { raw : string + ; small : version_small option + } type t = version - let to_string x = x + let to_string x = x.raw + + let small_of_string s = + let parts = + String.split_on_char '+' s + |> List.concat_map (String.split_on_char '~') + |> List.concat_map (String.split_on_char '-') + in + let has_suffix = List.length parts > 1 in + match String.split_on_char '.' (List.nth parts 0) with + | [] -> None + | major :: rest -> + let style, major = + if String.starts_with major ~prefix:"v" + then V_triple, String.sub major 1 (String.length major - 1) + else Triple, major + in + let major_opt = int_of_string_opt major in + let minor_opt, patch_opt = match rest with + | [] -> Some 0, Some 0 + | minor :: rest -> + let minor_opt = int_of_string_opt minor in + let patch_opt = match rest with + | [] -> Some 0 + | [ patch ] -> int_of_string_opt patch + | _ -> + None + in + minor_opt, patch_opt + in + match major_opt, minor_opt, patch_opt with + | Some major, Some minor, Some patch -> + let max = 65535 in + if major <= max && minor <= max && patch <= max + then + (* If each part of the version number can fit in a 16-bit + integer pack them into a single 64-bit int so they can be + efficiently compared. *) + let int = + (Int64.shift_left (Int64.of_int major) 32) + |> Int64.logor (Int64.shift_left (Int64.of_int minor) 16) + |> Int64.logor (Int64.of_int patch) + in + Some { style; int; has_suffix } + else None + | _ -> None let of_string x = if String.length x = 0 then failwith "Package version can't be empty"; @@ -30,11 +95,36 @@ module Version = struct failwith (Printf.sprintf "Invalid character '%c' in package version %S" c x)) x; - x - - let default = "dev" - - let compare = OpamVersionCompare.compare + { raw = x + ; small = small_of_string x + } + + let default = of_string "dev" + + let small_compare a b = + if version_style_equal a.style b.style then + let c = Int64.compare a.int b.int in + if c == 0 then + (* Only consider the suffix if the numeric part of both versions is the same. *) + match a.has_suffix, b.has_suffix with + | false, false -> Some 0 + | false, true -> Some (-1) + | true, false -> Some 1 + | true, true -> + (* If both versions have suffixes then run the full comparison. *) + None + else + Some c + else + None + + let compare a b = + match a.small, b.small with + | Some small_a, Some small_b -> ( + match small_compare small_a small_b with + | Some c -> c + | None -> OpamVersionCompare.compare a.raw b.raw) + | _ -> OpamVersionCompare.compare a.raw b.raw let equal v1 v2 = compare v1 v2 = 0 @@ -277,8 +367,8 @@ let names_of_packages nvset = let package_of_name_aux empty split filter nv n = if n = "" then empty else - let inf = {name = String.sub n 0 (String.length n - 1); version= ""} in - let sup = {name = n^"\000"; version = ""} in + let inf = {name = String.sub n 0 (String.length n - 1); version= Version.of_string ""} in + let sup = {name = n^"\000"; version = Version.of_string ""} in let _, _, nv = split inf nv in let nv, _, _ = split sup nv in filter nv diff --git a/vendor/opam/src/format/opamPackage.mli b/vendor/opam/src/format/opamPackage.mli index bcf152b5f7c..07739cd6b97 100644 --- a/vendor/opam/src/format/opamPackage.mli +++ b/vendor/opam/src/format/opamPackage.mli @@ -17,7 +17,10 @@ (** Versions *) module Version: sig - include OpamStd.ABSTRACT + type t + + module Set : OpamStd.SET with type elt = t + module Map : OpamStd.MAP with type key = t (** Compare two versions using the Debian version scheme *) val compare: t -> t -> int @@ -27,6 +30,9 @@ module Version: sig (** Default version used when no version is given *) val default : t + + val to_string : t -> string + val of_string : string -> t end (** Names *) From 82825b88f0c289a284fd31423d19fec7e3355ddd Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 18 Jan 2025 21:54:12 +0000 Subject: [PATCH 2/6] pkg: remove polymorphic comparison Signed-off-by: Rudi Grinberg Signed-off-by: Rudi Grinberg --- vendor/opam/src/format/opamPackage.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vendor/opam/src/format/opamPackage.ml b/vendor/opam/src/format/opamPackage.ml index 34b4c752f66..04b66af0904 100644 --- a/vendor/opam/src/format/opamPackage.ml +++ b/vendor/opam/src/format/opamPackage.ml @@ -104,7 +104,7 @@ module Version = struct let small_compare a b = if version_style_equal a.style b.style then let c = Int64.compare a.int b.int in - if c == 0 then + if c = 0 then (* Only consider the suffix if the numeric part of both versions is the same. *) match a.has_suffix, b.has_suffix with | false, false -> Some 0 From d0191485dc5698821b04876c4da7b9799be3df85 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 18 Jan 2025 22:20:37 +0000 Subject: [PATCH 3/6] pkg: remove magic number Signed-off-by: Rudi Grinberg Signed-off-by: Rudi Grinberg --- vendor/opam/src/format/opamPackage.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vendor/opam/src/format/opamPackage.ml b/vendor/opam/src/format/opamPackage.ml index 04b66af0904..4a696fcc628 100644 --- a/vendor/opam/src/format/opamPackage.ml +++ b/vendor/opam/src/format/opamPackage.ml @@ -72,7 +72,7 @@ module Version = struct in match major_opt, minor_opt, patch_opt with | Some major, Some minor, Some patch -> - let max = 65535 in + let max = 2 lsl 15 - 1 in if major <= max && minor <= max && patch <= max then (* If each part of the version number can fit in a 16-bit From 54d7ceed81cb2f99134a4ba9399809aee64480cf Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 18 Jan 2025 23:10:12 +0000 Subject: [PATCH 4/6] fix(pkg): tilde handling bug Signed-off-by: Rudi Grinberg --- vendor/opam/src/format/opamPackage.ml | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/vendor/opam/src/format/opamPackage.ml b/vendor/opam/src/format/opamPackage.ml index 4a696fcc628..5ed7cecb153 100644 --- a/vendor/opam/src/format/opamPackage.ml +++ b/vendor/opam/src/format/opamPackage.ml @@ -30,7 +30,7 @@ module Version = struct type version_small = { int : Int64.t ; style : version_style - ; has_suffix : bool + ; has_suffix : [`None | `Tilde | `Some ] } type version = @@ -48,7 +48,12 @@ module Version = struct |> List.concat_map (String.split_on_char '~') |> List.concat_map (String.split_on_char '-') in - let has_suffix = List.length parts > 1 in + let has_suffix = + match parts with + | [] -> `None + | ["~"] -> `Tilde + | _ :: _ -> `Some + in match String.split_on_char '.' (List.nth parts 0) with | [] -> None | major :: rest -> @@ -107,10 +112,11 @@ module Version = struct if c = 0 then (* Only consider the suffix if the numeric part of both versions is the same. *) match a.has_suffix, b.has_suffix with - | false, false -> Some 0 - | false, true -> Some (-1) - | true, false -> Some 1 - | true, true -> + | `Tilde, `Tilde + | `None, `None -> Some 0 + | `Tilde, `None -> Some (-1) + | `None, `Tilde -> Some 1 + | _ , _ -> (* If both versions have suffixes then run the full comparison. *) None else From e7e30469334e5302cce3935a5d90ba8f8c1553e9 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 19 Jan 2025 11:16:24 +0000 Subject: [PATCH 5/6] fix: 4.08 shim Signed-off-by: Rudi Grinberg --- vendor/opam/src/format/opamPackage.ml | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/vendor/opam/src/format/opamPackage.ml b/vendor/opam/src/format/opamPackage.ml index 5ed7cecb153..75b6f7dcfab 100644 --- a/vendor/opam/src/format/opamPackage.ml +++ b/vendor/opam/src/format/opamPackage.ml @@ -42,11 +42,24 @@ module Version = struct let to_string x = x.raw + (* CR rgrinberg: get rid of this once we drop 4.08 support *) + let rev_concat_map t ~f = + let rec aux f acc = function + | [] -> acc + | x :: l -> + let xs = f x in + aux f (List.rev_append xs acc) l + in + aux f [] t + ;; + + let concat_map t ~f = List.rev (rev_concat_map t ~f) + let small_of_string s = let parts = String.split_on_char '+' s - |> List.concat_map (String.split_on_char '~') - |> List.concat_map (String.split_on_char '-') + |> concat_map ~f:(String.split_on_char '~') + |> concat_map ~f:(String.split_on_char '-') in let has_suffix = match parts with From d8ea64cdd08f4ee387ec72e3660c4091eeddf9d2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 19 Jan 2025 21:21:20 +0000 Subject: [PATCH 6/6] fix: more compatability craziness starts_with requires 4.13 Signed-off-by: Rudi Grinberg --- vendor/opam/src/format/opamPackage.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vendor/opam/src/format/opamPackage.ml b/vendor/opam/src/format/opamPackage.ml index 75b6f7dcfab..603294fe29f 100644 --- a/vendor/opam/src/format/opamPackage.ml +++ b/vendor/opam/src/format/opamPackage.ml @@ -70,8 +70,8 @@ module Version = struct match String.split_on_char '.' (List.nth parts 0) with | [] -> None | major :: rest -> - let style, major = - if String.starts_with major ~prefix:"v" + let style, major = + if String.length major > 0 && major.[0] = 'v' then V_triple, String.sub major 1 (String.length major - 1) else Triple, major in