Merge pull request #6130 from kit-ty-kate/0install-cudf-0.5.0

Add support for opam-0install-cudf 0.5.0

.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/");

.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:

.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

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])

doc/index.html

@@ -198,6 +198,8 @@ <h1>opam %{OPAMVERSION}% API and libraries documentation</h1>
   <td>Configuration options for this lib (record, global reference, setter, initialisation)</td></tr>
 <tr><th><a href="opam-solver/OpamActionGraph">opamActionGraph.ml</a></th>
   <td>Handles graphs of actions (package changes), based on ocamlgraph</td></tr>
+<tr><th><a href="opam-solver/OpamCudfCriteria">opamCudfCriteria.ml</a></th>
+  <td>Cudf criteria helper functions (string conversion, etc.)</td></tr>
 <tr><th><a href="opam-solver/OpamCudfSolver">opamCudfSolver.ml</a></th>
   <td>Bindings to implementation of CUDF solvers, either built-in or external</td></tr>
 <tr><th><a href="opam-solver/OpamCudf">opamCudf.ml</a></th>

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
 
@@ -211,6 +218,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]

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"

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

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 =

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