From d8683eca2e5b5ba3cc3385ecb57a0edbab5b12f0 Mon Sep 17 00:00:00 2001 From: Kate Date: Tue, 20 Aug 2024 16:42:27 +0100 Subject: [PATCH 1/2] solver: Move OpamBuiltinZ3.Syntax to a new OpamCudfCriteria module --- doc/index.html | 2 + master_changes.md | 1 + src/solver/opamBuiltinZ3.real.ml | 89 +--------------------------- src/solver/opamCudfCriteria.ml | 99 ++++++++++++++++++++++++++++++++ src/solver/opamCudfCriteria.mli | 37 ++++++++++++ 5 files changed, 142 insertions(+), 86 deletions(-) create mode 100644 src/solver/opamCudfCriteria.ml create mode 100644 src/solver/opamCudfCriteria.mli diff --git a/doc/index.html b/doc/index.html index 399432c6761..f27e6e37661 100644 --- a/doc/index.html +++ b/doc/index.html @@ -198,6 +198,8 @@

opam %{OPAMVERSION}% API and libraries documentation

Configuration options for this lib (record, global reference, setter, initialisation) opamActionGraph.ml Handles graphs of actions (package changes), based on ocamlgraph +opamCudfCriteria.ml + Cudf criteria helper functions (string conversion, etc.) opamCudfSolver.ml Bindings to implementation of CUDF solvers, either built-in or external opamCudf.ml diff --git a/master_changes.md b/master_changes.md index e9bc7d044a7..73bb678f71d 100644 --- a/master_changes.md +++ b/master_changes.md @@ -211,6 +211,7 @@ users) * `OpamStateConfig.opamroot_with_provenance`: restore previous behaviour to `OpamStateConfig.opamroot` for compatibility with third party code [#6047 @dra27] ## opam-solver + * `OpamCudfCriteria`, `OpamBuiltinZ3.Syntax`: Move `OpamBuiltinZ3.Syntax` into a dedicated module `OpamCudfCriteria` [#6130 @kit-ty-kate] ## opam-format * Add `OpamTypesBase.switch_selections_{compare,equal}`: proper comparison functions for `OpamTypes.switch_selections` [#6102 @kit-ty-kate] diff --git a/src/solver/opamBuiltinZ3.real.ml b/src/solver/opamBuiltinZ3.real.ml index 24eada8bb34..3ffa167d6d1 100644 --- a/src/solver/opamBuiltinZ3.real.ml +++ b/src/solver/opamBuiltinZ3.real.ml @@ -273,17 +273,10 @@ let sum ctx (_, universe, _) filter value = [] universe -type filter = Installed | Changed | Removed | New | - Upgraded | Downgraded | Requested -type property = string option -type sign = Plus | Minus - -type criterion = sign * filter * property - let def_criterion ctx opt (preamble, universe, request as cudf) - (sign, filter, property : criterion) = + (sign, filter, property : OpamCudfCriteria.criterion) = let filter_f = match filter with - | Installed -> fun p -> psym ctx p + | Installed | Solution -> fun p -> psym ctx p | Changed -> fun p -> if p.Cudf.installed then @@ -367,82 +360,6 @@ let def_criterion ctx opt (preamble, universe, request as cudf) let def_criteria ctx opt cudf crits = List.iter (def_criterion ctx opt cudf) crits -module Syntax = struct - - let criterion_of_string (s,params) = - let sign = match s.[0] with - | '+' -> Plus - | '-' -> Minus - | c -> failwith (Printf.sprintf "criteria_of_string sign=%c" c) - | exception Invalid_argument _ -> - failwith "criteria_of_string sign=EOF" - in - let s = String.sub s 1 (String.length s - 1) in - let subset_of_string = function - | "new" -> New - | "removed" -> Removed - | "changed" -> Changed - | "up" -> Upgraded - | "down" -> Downgraded - | "installed" | "solution" -> Installed - | "request" -> Requested - | s -> failwith ("criteria_of_string subset="^s) - in - match s, params with - | "count", [field; subset] -> - sign, subset_of_string subset, Some field - | s, [] -> sign, subset_of_string s, None - | s, _ -> failwith ("criteria_of_string s="^s) -(* - let string_of_criterion (sign, filter, property: criterion) = - Printf.sprintf "%c%s%s" - (match sign with Plus -> '+' | Minus -> '-') - (match filter with - | Installed -> "installed" - | Changed -> "changed" - | Removed -> "removed" - | New -> "new" - | Upgraded -> "up" - | Downgraded -> "down" - | Requested -> "request") - (match property with None -> "" | Some p -> "["^p^"]") -*) - let criteria_of_string s = - let start = ref 0 in - let crits = ref [] in - let params = ref None in - for i = 0 to String.length s - 1 do - match s.[i] with - | ',' -> - let sub = String.sub s !start (i - !start) in - start := i + 1; - if sub <> "" then - (match !params with - | None -> crits := (sub, []) :: !crits - | Some (name, ps) -> params := Some (name, sub :: ps)) - | '[' -> - let sub = String.sub s !start (i - !start) in - start := i + 1; - if !params <> None then failwith "criteria_of_string"; - params := Some (sub, []) - | ']' -> - let sub = String.sub s !start (i - !start) in - start := i + 1; - (match !params with - | None -> failwith "criteria_of_string" - | Some (name, ps) -> - params := None; - crits := (name, List.rev (sub::ps)) :: !crits) - | _ -> () - done; - if !start < String.length s then - crits := (String.sub s !start (String.length s - !start), []) :: !crits; - if !params <> None then failwith "criteria_of_string"; - let r = List.rev_map criterion_of_string !crits in - r - -end - let extract_solution_packages universe opt = match Z3.Optimize.get_model opt with | Some model -> @@ -485,7 +402,7 @@ let call ~criteria ?timeout (preamble, universe, _ as cudf) = log "Generating optimization criteria"; let opt = Z3.Optimize.mk_opt ctx.z3 in let _criteria_def_handles = - def_criteria ctx opt cudf (Syntax.criteria_of_string criteria) + def_criteria ctx opt cudf (OpamCudfCriteria.of_string criteria) in log "Sending the problem to Z3"; let params = diff --git a/src/solver/opamCudfCriteria.ml b/src/solver/opamCudfCriteria.ml new file mode 100644 index 00000000000..b4b601e76e6 --- /dev/null +++ b/src/solver/opamCudfCriteria.ml @@ -0,0 +1,99 @@ +(**************************************************************************) +(* *) +(* Copyright 2017-2019 OCamlPro *) +(* *) +(* All rights reserved. This file is distributed under the terms of the *) +(* GNU Lesser General Public License version 2.1, with the special *) +(* exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type filter = + | Installed + | Solution + | Changed + | Removed + | New + | Upgraded + | Downgraded + | Requested + +type property = string option + +type sign = Plus | Minus + +type criterion = sign * filter * property + +let criterion_of_string (s,params) = + let sign = match s.[0] with + | '+' -> Plus + | '-' -> Minus + | c -> failwith (Printf.sprintf "criteria_of_string sign=%c" c) + | exception Invalid_argument _ -> + failwith "criteria_of_string sign=EOF" + in + let s = String.sub s 1 (String.length s - 1) in + let subset_of_string = function + | "new" -> New + | "removed" -> Removed + | "changed" -> Changed + | "up" -> Upgraded + | "down" -> Downgraded + | "installed" -> Installed + | "solution" -> Solution + | "request" -> Requested + | s -> failwith ("criteria_of_string subset="^s) + in + match s, params with + | "count", [field; subset] -> + sign, subset_of_string subset, Some field + | s, [] -> sign, subset_of_string s, None + | s, _ -> failwith ("criteria_of_string s="^s) + +let criterion_to_string (sign, filter, property: criterion) = + Printf.sprintf "%c%s%s" + (match sign with Plus -> '+' | Minus -> '-') + (match filter with + | Installed -> "installed" + | Solution -> "solution" + | Changed -> "changed" + | Removed -> "removed" + | New -> "new" + | Upgraded -> "up" + | Downgraded -> "down" + | Requested -> "request") + (match property with None -> "" | Some p -> "["^p^"]") + +let of_string s = + let start = ref 0 in + let crits = ref [] in + let params = ref None in + for i = 0 to String.length s - 1 do + match s.[i] with + | ',' -> + let sub = String.sub s !start (i - !start) in + start := i + 1; + if sub <> "" then + (match !params with + | None -> crits := (sub, []) :: !crits + | Some (name, ps) -> params := Some (name, sub :: ps)) + | '[' -> + let sub = String.sub s !start (i - !start) in + start := i + 1; + if !params <> None then failwith "criteria_of_string"; + params := Some (sub, []) + | ']' -> + let sub = String.sub s !start (i - !start) in + start := i + 1; + (match !params with + | None -> failwith "criteria_of_string" + | Some (name, ps) -> + params := None; + crits := (name, List.rev (sub::ps)) :: !crits) + | _ -> () + done; + if !start < String.length s then + crits := (String.sub s !start (String.length s - !start), []) :: !crits; + if !params <> None then failwith "criteria_of_string"; + let r = List.rev_map criterion_of_string !crits in + r diff --git a/src/solver/opamCudfCriteria.mli b/src/solver/opamCudfCriteria.mli new file mode 100644 index 00000000000..c9d6ec08376 --- /dev/null +++ b/src/solver/opamCudfCriteria.mli @@ -0,0 +1,37 @@ +(**************************************************************************) +(* *) +(* Copyright 2017-2019 OCamlPro *) +(* *) +(* All rights reserved. This file is distributed under the terms of the *) +(* GNU Lesser General Public License version 2.1, with the special *) +(* exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Cudf criteria helpers *) + +(* {2 Criterion types} *) +type filter = + | Installed + | Solution + | Changed + | Removed + | New + | Upgraded + | Downgraded + | Requested + +type property = string option + +type sign = Plus | Minus + +type criterion = sign * filter * property + +(* {2 String conversion} *) + +val criterion_to_string : criterion -> string + +(** [of_string s] Parses the string [s] as a CUDF optimization criteria. + + @raise {!Stdlib.Failure} if the string is invalid *) +val of_string : string -> criterion list From 94e7f9ac6c7703fa0932a400104ee97f1ebf9026 Mon Sep 17 00:00:00 2001 From: Kate Date: Tue, 30 Jul 2024 22:38:08 +0100 Subject: [PATCH 2/2] solver: Add support for opam-0install-cudf 0.5.0 and bump dependency version --- .github/workflows/ci.ml | 2 +- .github/workflows/depexts.yml | 2 +- .github/workflows/main.yml | 2 +- configure | 6 ++-- configure.ac | 2 +- master_changes.md | 7 ++++ opam-solver.opam | 2 +- src/solver/opamBuiltin0install.ml | 60 +++++++++++++++++++++++-------- src_ext/Makefile.sources | 4 +-- 9 files changed, 62 insertions(+), 25 deletions(-) diff --git a/.github/workflows/ci.ml b/.github/workflows/ci.ml index 55808f635b1..e628ac7999e 100644 --- a/.github/workflows/ci.ml +++ b/.github/workflows/ci.ml @@ -472,7 +472,7 @@ let main oc : unit = (* These should be identical to the values in appveyor.yml *) ("OPAM_REPO", "https://github.com/ocaml/opam-repository.git"); ("OPAM_TEST_REPO_SHA", "dff745994c64d083a6ba3ddc5a9c28ed0ad0f40a"); - ("OPAM_REPO_SHA", "dff745994c64d083a6ba3ddc5a9c28ed0ad0f40a"); + ("OPAM_REPO_SHA", "6eee105e52e098e36949a584c053a18bcb9b2f6b"); ("SOLVER", ""); (* Cygwin configuration *) ("CYGWIN_MIRROR", "http://mirrors.kernel.org/sourceware/cygwin/"); diff --git a/.github/workflows/depexts.yml b/.github/workflows/depexts.yml index 7dcbcc1d9c5..88355bd2f5b 100644 --- a/.github/workflows/depexts.yml +++ b/.github/workflows/depexts.yml @@ -18,7 +18,7 @@ defaults: env: OPAMVERSION: 2.1.6 OPAM_REPO: https://github.com/ocaml/opam-repository.git - OPAM_REPO_SHA: dff745994c64d083a6ba3ddc5a9c28ed0ad0f40a + OPAM_REPO_SHA: 6eee105e52e098e36949a584c053a18bcb9b2f6b jobs: opam-cache: diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 4d7d9624140..87567fa4a5e 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -27,7 +27,7 @@ env: OPAM12CACHE: ~/.cache/opam1.2/cache OPAM_REPO: https://github.com/ocaml/opam-repository.git OPAM_TEST_REPO_SHA: dff745994c64d083a6ba3ddc5a9c28ed0ad0f40a - OPAM_REPO_SHA: dff745994c64d083a6ba3ddc5a9c28ed0ad0f40a + OPAM_REPO_SHA: 6eee105e52e098e36949a584c053a18bcb9b2f6b SOLVER: CYGWIN_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/ CYGWIN_ROOT: D:\cygwin diff --git a/configure b/configure index 6a916830055..b4f27953b88 100755 --- a/configure +++ b/configure @@ -6594,8 +6594,8 @@ printf "%s\n" "not found" >&6; } - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package opam-0install-cudf 0.4 or later" >&5 -printf %s "checking for OCaml findlib package opam-0install-cudf 0.4 or later... " >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package opam-0install-cudf 0.5.0 or later" >&5 +printf %s "checking for OCaml findlib package opam-0install-cudf 0.5.0 or later... " >&6; } if version=`$OCAMLFIND query opam-0install-cudf -format '%v' 2>/dev/null` then : @@ -6619,7 +6619,7 @@ then : -e 's/[^0-9]//g'` - ax_compare_version_B=`echo "0.4" | sed -e 's/\([0-9]*\)/Z\1Z/g' \ + ax_compare_version_B=`echo "0.5.0" | sed -e 's/\([0-9]*\)/Z\1Z/g' \ -e 's/Z\([0-9]\)Z/Z0\1Z/g' \ -e 's/Z\([0-9][0-9]\)Z/Z0\1Z/g' \ -e 's/Z\([0-9][0-9][0-9]\)Z/Z0\1Z/g' \ diff --git a/configure.ac b/configure.ac index 1dd909807d4..b8eee9723cc 100644 --- a/configure.ac +++ b/configure.ac @@ -376,7 +376,7 @@ AC_CHECK_OCAML_PKG_AT_LEAST([dose3.common], [6.1]) AC_CHECK_OCAML_PKG_AT_LEAST([dose3.algo], [6.1]) AC_CHECK_OCAML_PKG_AT_LEAST([opam-file-format], [2.1.4]) AC_CHECK_OCAML_PKG([spdx_licenses]) -AC_CHECK_OCAML_PKG_AT_LEAST([opam-0install-cudf],[0.4]) +AC_CHECK_OCAML_PKG_AT_LEAST([opam-0install-cudf],[0.5.0]) AC_CHECK_OCAML_PKG([jsonm]) AC_CHECK_OCAML_PKG([uutf]) AC_CHECK_OCAML_PKG([sha]) diff --git a/master_changes.md b/master_changes.md index 73bb678f71d..90369d5c2f7 100644 --- a/master_changes.md +++ b/master_changes.md @@ -94,6 +94,8 @@ users) ## Build * Synchronise opam-core.opam with opam-repository changes [#6043 @dra27] * Unset OPAM_SWITCH_PREFIX when using make cold [#5534 @kit-ty-kate] + * Bump the vendored opam-0install-cudf to 0.5.0 [#6130 @kit-ty-kate] + * Require opam-0install-cudf >= 0.5.0 [#6130 @kit-ty-kate] ## Infrastructure @@ -121,6 +123,11 @@ users) ## Opam file format ## Solver + * Add support for unordered criteria with the `builtin-0install` solver [#6130 @kit-ty-kate] + * Add support for the `-changed` criteria with the `builtin-0install` solver, to make the solver prefer to keep packages installed at their current version [#6130 @kit-ty-kate] + * Add support for the `-count[avoid-version,solution]` criteria with the `builtin-0install` solver, to avoid packages marked with `avoid-version` flag [#6130 @kit-ty-kate] + * The default criteria for the `builtin-0install` solver changed from empty to `-changed,-count[avoid-version,solution]` [#6130 @kit-ty-kate] + * The upgrade and fixup criteria for the `builtin-0install` solver changed from empty to `-count[avoid-version,solution]` [#6130 @kit-ty-kate] ## Client diff --git a/opam-solver.opam b/opam-solver.opam index 7a15dbef61c..40ead91ed5c 100644 --- a/opam-solver.opam +++ b/opam-solver.opam @@ -35,7 +35,7 @@ depends: [ "cudf" {>= "0.7"} "re" {>= "1.9.0"} "dune" {>= "2.0.0"} - "opam-0install-cudf" {>= "0.4"} + "opam-0install-cudf" {>= "0.5.0"} ] depopts: [ "z3" diff --git a/src/solver/opamBuiltin0install.ml b/src/solver/opamBuiltin0install.ml index bc5c9c3fa37..3c672a760a0 100644 --- a/src/solver/opamBuiltin0install.ml +++ b/src/solver/opamBuiltin0install.ml @@ -23,9 +23,10 @@ let command_name = None let preemptive_check = false let default_criteria = { - crit_default = ""; - crit_upgrade = ""; - crit_fixup = ""; + crit_default = "-changed,\ + -count[avoid-version,solution]"; + crit_upgrade = "-count[avoid-version,solution]"; + crit_fixup = "-count[avoid-version,solution]"; crit_best_effort_prefix = None; } @@ -90,25 +91,54 @@ let reconstruct_universe universe selections = type options = { drop_installed_packages : bool; prefer_oldest : bool; + handle_avoid_version : bool; + prefer_installed : bool; } let parse_criteria criteria = - let default = {drop_installed_packages = false; prefer_oldest = false} in - match criteria with - | "" -> default - | "+removed" -> {drop_installed_packages = true; prefer_oldest = false} - | "+count[version-lag,solution]" -> {drop_installed_packages = false; prefer_oldest = true} - | "+removed,+count[version-lag,solution]" -> - {drop_installed_packages = true; prefer_oldest = true} - | _ -> - OpamConsole.warning "Criteria '%s' is not supported by the 0install solver" criteria; - default + let default = + { + drop_installed_packages = false; + prefer_oldest = false; + handle_avoid_version = false; + prefer_installed = false; + } + in + let rec parse default (criteria : OpamCudfCriteria.criterion list) = + match criteria with + | [] -> default + | (Plus, Removed, None)::xs -> + parse {default with drop_installed_packages = true} xs + | (Plus, Solution, Some "version-lag")::xs -> + parse {default with prefer_oldest = true} xs + | (Minus, Solution, Some "avoid-version")::xs -> + parse {default with handle_avoid_version = true} xs + | (Minus, Changed, None)::xs -> + parse {default with prefer_installed = true} xs + | criterion::xs -> + OpamConsole.warning + "Criteria '%s' is not supported by the 0install solver" + (OpamCudfCriteria.criterion_to_string criterion); + parse default xs + in + parse default (OpamCudfCriteria.of_string criteria) let call ~criteria ?timeout:_ (preamble, universe, request) = - let {drop_installed_packages; prefer_oldest} = parse_criteria criteria in + let { + drop_installed_packages; + prefer_oldest; + handle_avoid_version; + prefer_installed; + } = + parse_criteria criteria + in let timer = OpamConsole.timer () in let pkgs, constraints = create_spec ~drop_installed_packages universe request in - let context = Opam_0install_cudf.create ~prefer_oldest ~constraints universe in + let context = + Opam_0install_cudf.create + ~prefer_oldest ~handle_avoid_version ~prefer_installed + ~constraints universe + in match Opam_0install_cudf.solve context pkgs with | Ok selections -> let universe = reconstruct_universe universe selections in diff --git a/src_ext/Makefile.sources b/src_ext/Makefile.sources index b8079bbedb3..0bd663c1324 100644 --- a/src_ext/Makefile.sources +++ b/src_ext/Makefile.sources @@ -25,8 +25,8 @@ MD5_dose3 = bc99cbcea8fca29dca3ebbee54be45e1 URL_mccs = https://github.com/ocaml-opam/ocaml-mccs/archive/refs/tags/1.1+17.tar.gz MD5_mccs = 844d99bc531e0713238fe4b6b8511ed1 -URL_opam-0install-cudf = https://github.com/ocaml-opam/opam-0install-solver/releases/download/v0.4.3/opam-0install-cudf-0.4.3.tbz -MD5_opam-0install-cudf = ae0c197deace373ad87737468a04f76b +URL_opam-0install-cudf = https://github.com/ocaml-opam/opam-0install-cudf/releases/download/v0.5.0/opam-0install-cudf-0.5.0.tar.gz +MD5_opam-0install-cudf = 75419722aa839f518a25cae1b3c6efd4 URL_0install-solver = https://github.com/0install/0install/releases/download/v2.18/0install-2.18.tbz MD5_0install-solver = 030edc9b1d3676c06d51397ffb5a737d