From 61cfeba9a6c0dfad261c238dde9d7e7e777cce55 Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Thu, 17 Sep 2020 18:10:49 +0200
Subject: [PATCH 01/19] Experimental CUDF request preprocessing

---
 src/solver/opamCudf.ml | 46 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 45 insertions(+), 1 deletion(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 076f4b92307..5f582d1e969 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1068,6 +1068,49 @@ let dump_cudf_error ~version_map univ req =
   | Some f -> f
   | None -> assert false
 
+let preprocess_cudf_request (props, univ, creq) =
+  let chrono = OpamConsole.timer () in
+  let univ0 = univ in
+  let univ =
+    let open Set.Op in
+    let vpkg2set vp = Set.of_list (Common.CudfAdd.resolve_deps univ vp) in
+    let deps p =
+      List.fold_left (fun acc dep -> Set.union acc (vpkg2set dep)) Set.empty p.Cudf.depends
+    in
+    let installed =
+      Set.of_list (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) univ)
+    in
+    let to_install = vpkg2set creq.Cudf.install in
+    let packages =
+      to_install ++
+      vpkg2set creq.Cudf.remove ++
+      vpkg2set creq.Cudf.upgrade
+    in
+    let packages =
+      Set.fixpoint deps packages
+    in
+    let conflicts =
+      (* Lookup deps of level 1 of [to_install], and gather all mandatory
+         conflicts *)
+      Set.fold (fun p acc ->
+          List.fold_left (fun acc disj ->
+              Set.map_reduce ~default:Set.empty (fun d ->
+                  Set.filter (fun e -> e.Cudf.package <> d.Cudf.package)
+                    (vpkg2set d.Cudf.conflicts))
+                Set.inter (vpkg2set disj)
+              ++ acc)
+            acc p.depends)
+        to_install Set.empty
+    in
+    log "Conflicts: %d pkgs to remove" (Set.cardinal conflicts);
+    Cudf.load_universe (Set.elements (packages -- conflicts ++ installed))
+  in
+  log "Preprocess cudf request: from %d to %d packages in %.2fs"
+    (Cudf.universe_size univ0)
+    (Cudf.universe_size univ)
+    (chrono ());
+  props, univ, creq
+
 exception Timeout of Algo.Depsolver.solver_result option
 
 let call_external_solver ~version_map univ req =
@@ -1091,6 +1134,7 @@ let call_external_solver ~version_map univ req =
       if !timed_out then raise (Timeout (Some r)) else r
     in
     try
+      let cudf_request = preprocess_cudf_request cudf_request in
       let r =
         check_request_using
           ~call_solver:(OpamSolverConfig.call_solver ~criteria)
@@ -1412,7 +1456,7 @@ let compute_root_causes g requested reinstall =
    required reinstallations and computing the graph of dependency of required
    actions *)
 let atomic_actions ~simple_universe ~complete_universe root_actions =
-  log "graph_of_actions root_actions=%a"
+  log ~level:2 "graph_of_actions root_actions=%a"
     (slog string_of_actions) root_actions;
 
   let to_remove, to_install =

From 372ef86b6b305111f1e7268fe8c32da72e35bacc Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Fri, 18 Sep 2020 13:39:30 +0200
Subject: [PATCH 02/19] rec-conflicts preprocess (wip)

---
 src/solver/opamCudf.ml | 35 +++++++++++++++++++++++++----------
 1 file changed, 25 insertions(+), 10 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 5f582d1e969..dc22a785cdb 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1089,17 +1089,32 @@ let preprocess_cudf_request (props, univ, creq) =
     let packages =
       Set.fixpoint deps packages
     in
+    let direct_conflicts p =
+      Set.filter (fun q -> q.Cudf.package <> p.Cudf.package)
+        (vpkg2set p.Cudf.conflicts)
+    in
+    let cache = Hashtbl.create 513 in
+    let rec transitive_conflicts seen acc p =
+      (* OpamConsole.msg "%s\n" (Package.to_string p); *)
+      try Hashtbl.find cache p ++ acc with Not_found ->
+      if Set.mem p seen then acc else
+      let seen = Set.add p seen in
+      let conflicts =
+        direct_conflicts p ++
+        List.fold_left (fun acc disj ->
+            acc ++
+            Set.map_reduce ~default:Set.empty
+              (transitive_conflicts seen Set.empty)
+              Set.inter
+              (vpkg2set disj))
+          acc
+          p.Cudf.depends
+      in
+      Hashtbl.add cache p conflicts;
+      conflicts
+    in
     let conflicts =
-      (* Lookup deps of level 1 of [to_install], and gather all mandatory
-         conflicts *)
-      Set.fold (fun p acc ->
-          List.fold_left (fun acc disj ->
-              Set.map_reduce ~default:Set.empty (fun d ->
-                  Set.filter (fun e -> e.Cudf.package <> d.Cudf.package)
-                    (vpkg2set d.Cudf.conflicts))
-                Set.inter (vpkg2set disj)
-              ++ acc)
-            acc p.depends)
+      Set.fold (fun p acc -> transitive_conflicts Set.empty acc p)
         to_install Set.empty
     in
     log "Conflicts: %d pkgs to remove" (Set.cardinal conflicts);

From d4f640d0cd501fac28d68bf20fa3d8144763a070 Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Mon, 21 Sep 2020 11:43:52 +0200
Subject: [PATCH 03/19] Cudf preprocessing: remove transitive conflicts

This appears to give huge solver speedups with MCCS on some tests
---
 src/solver/opamCudf.ml | 122 ++++++++++++++++++++++++++---------------
 1 file changed, 78 insertions(+), 44 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index dc22a785cdb..3a7a5f2a2c0 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -421,6 +421,53 @@ type conflict =
 
 module Map = OpamStd.Map.Make(Package)
 module Set = OpamStd.Set.Make(Package)
+
+(* From a CUDF dependency CNF, extract the set of packages that can possibly
+   part of a solution.
+
+   This is much finer than [Common.CudfAdd.resolve_deps] which doesn't handle
+   conjunctions of versions (see [Graph.of_universe] below) *)
+let dependency_set u deps =
+  let strong_deps, weak_deps =
+    (* strong deps are mandatory (constraint appearing in the top
+       conjunction)
+       weak deps correspond to optional occurrences of a package, as part of
+       a disjunction: e.g. in (A>=4 & (B | A<5)), A>=4 is strong, and the
+       other two are weak. In the end we want to retain B and A>=4. *)
+    List.fold_left (fun (strong_deps, weak_deps) l ->
+        let names =
+          List.fold_left (fun acc (n, _) ->
+              OpamStd.String.Map.add n Set.empty acc)
+            OpamStd.String.Map.empty l
+        in
+        let set =
+          List.fold_left (fun acc (n, cstr) ->
+              List.fold_left (fun s x -> Set.add x s)
+                acc (Cudf.lookup_packages ~filter:cstr u n))
+            Set.empty l
+        in
+        let by_name =
+          Set.fold (fun p ->
+              OpamStd.String.Map.update
+                p.Cudf.package (Set.add p) Set.empty)
+            set names
+        in
+        if OpamStd.String.Map.is_singleton by_name then
+          let name, versions = OpamStd.String.Map.choose by_name in
+          OpamStd.String.Map.update name (Set.inter versions) versions
+            strong_deps,
+          OpamStd.String.Map.remove name weak_deps
+        else
+          strong_deps, OpamStd.String.Map.union Set.union weak_deps by_name)
+      (OpamStd.String.Map.empty, OpamStd.String.Map.empty) deps
+  in
+  OpamStd.String.Map.fold (fun _ -> Set.union) strong_deps @@
+  OpamStd.String.Map.fold (fun name ps acc ->
+      if not (OpamStd.String.Map.mem name strong_deps)
+      then Set.union ps acc else acc)
+    weak_deps
+    Set.empty
+
 module Graph = struct
 
   module PG = struct
@@ -445,44 +492,7 @@ module Graph = struct
     let g = PG.create ~size:(Cudf.universe_size u) () in
     let iter_deps f deps =
       (* List.iter (fun d -> List.iter f (Common.CudfAdd.resolve_deps u d)) deps *)
-      let strong_deps, weak_deps =
-        (* strong deps are mandatory (constraint appearing in the top
-           conjunction)
-           weak deps correspond to optional occurrences of a package, as part of
-           a disjunction: e.g. in (A>=4 & (B | A<5)), A>=4 is strong, and the
-           other two are weak. In the end we want to retain B and A>=4. *)
-        List.fold_left (fun (strong_deps, weak_deps) l ->
-            let names =
-              List.fold_left (fun acc (n, _) ->
-                  OpamStd.String.Map.add n Set.empty acc)
-                OpamStd.String.Map.empty l
-            in
-            let set =
-              List.fold_left (fun acc (n, cstr) ->
-                  List.fold_left (fun s x -> Set.add x s)
-                    acc (Cudf.lookup_packages ~filter:cstr u n))
-                Set.empty l
-            in
-            let by_name =
-              Set.fold (fun p ->
-                  OpamStd.String.Map.update
-                    p.Cudf.package (Set.add p) Set.empty)
-                set names
-            in
-            if OpamStd.String.Map.is_singleton by_name then
-              let name, versions = OpamStd.String.Map.choose by_name in
-              OpamStd.String.Map.update name (Set.inter versions) versions
-                strong_deps,
-              OpamStd.String.Map.remove name weak_deps
-            else
-              strong_deps, OpamStd.String.Map.union Set.union weak_deps by_name)
-          (OpamStd.String.Map.empty, OpamStd.String.Map.empty) deps
-      in
-      OpamStd.String.Map.iter (fun _ p -> Set.iter f p) strong_deps;
-      OpamStd.String.Map.iter (fun name p ->
-          if not (OpamStd.String.Map.mem name strong_deps)
-          then Set.iter f p)
-        weak_deps
+      Set.iter f (dependency_set u deps)
     in
     Cudf.iter_packages
       (fun p ->
@@ -1074,9 +1084,7 @@ let preprocess_cudf_request (props, univ, creq) =
   let univ =
     let open Set.Op in
     let vpkg2set vp = Set.of_list (Common.CudfAdd.resolve_deps univ vp) in
-    let deps p =
-      List.fold_left (fun acc dep -> Set.union acc (vpkg2set dep)) Set.empty p.Cudf.depends
-    in
+    let deps p = dependency_set univ p.Cudf.depends in
     let installed =
       Set.of_list (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) univ)
     in
@@ -1089,15 +1097,34 @@ let preprocess_cudf_request (props, univ, creq) =
     let packages =
       Set.fixpoint deps packages
     in
+    let to_map set =
+      Set.fold (fun p ->
+          OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty)
+        set OpamStd.String.Map.empty
+    in
+    let to_set map =
+      OpamStd.String.Map.fold (fun _ -> Set.union) map Set.empty
+    in
+    let packages_map = to_map packages in
     let direct_conflicts p =
       Set.filter (fun q -> q.Cudf.package <> p.Cudf.package)
         (vpkg2set p.Cudf.conflicts)
+      ++
+      (* Dependencies not matching constraints are also conflicts *)
+      (to_set @@
+       OpamStd.String.Map.mapi (fun name set ->
+           try OpamStd.String.Map.find name packages_map -- set
+           with Not_found -> Set.empty)
+         @@
+         to_map (deps p))
     in
     let cache = Hashtbl.create 513 in
+    (* Don't explore deeper than that for transitive conflicts *)
+    let max_dig_depth = 2 in
     let rec transitive_conflicts seen acc p =
       (* OpamConsole.msg "%s\n" (Package.to_string p); *)
       try Hashtbl.find cache p ++ acc with Not_found ->
-      if Set.mem p seen then acc else
+      if Set.mem p seen || Set.cardinal seen >= max_dig_depth then acc else
       let seen = Set.add p seen in
       let conflicts =
         direct_conflicts p ++
@@ -1118,7 +1145,10 @@ let preprocess_cudf_request (props, univ, creq) =
         to_install Set.empty
     in
     log "Conflicts: %d pkgs to remove" (Set.cardinal conflicts);
-    Cudf.load_universe (Set.elements (packages -- conflicts ++ installed))
+    let final_packages = packages -- conflicts ++ installed in
+    let ocamls = Set.filter (fun p -> p.Cudf.package = "ocaml") final_packages in
+    log "OCamls (%d): %s" (Set.cardinal ocamls) (Set.to_string ocamls);
+    Cudf.load_universe (Set.elements (final_packages -- conflicts))
   in
   log "Preprocess cudf request: from %d to %d packages in %.2fs"
     (Cudf.universe_size univ0)
@@ -1149,7 +1179,11 @@ let call_external_solver ~version_map univ req =
       if !timed_out then raise (Timeout (Some r)) else r
     in
     try
-      let cudf_request = preprocess_cudf_request cudf_request in
+      let cudf_request =
+        if OpamStd.Config.env_bool "PREPRO" = Some true then
+          preprocess_cudf_request cudf_request
+        else  cudf_request
+      in
       let r =
         check_request_using
           ~call_solver:(OpamSolverConfig.call_solver ~criteria)

From 923bf152010d95d18fe22f4e45c8af2ccd4274dc Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Mon, 21 Sep 2020 11:44:35 +0200
Subject: [PATCH 04/19] CUDF preprocessing: turn on by default

---
 src/solver/opamCudf.ml | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 3a7a5f2a2c0..a421e5b52d7 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1180,9 +1180,8 @@ let call_external_solver ~version_map univ req =
     in
     try
       let cudf_request =
-        if OpamStd.Config.env_bool "PREPRO" = Some true then
-          preprocess_cudf_request cudf_request
-        else  cudf_request
+        if OpamStd.Config.env_bool "PREPRO" = Some false then cudf_request
+        else preprocess_cudf_request cudf_request
       in
       let r =
         check_request_using

From b63e65066c932360155235efcc5bbc6c3e0ca02d Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Mon, 21 Sep 2020 12:22:26 +0200
Subject: [PATCH 05/19] CUDF preprocessing: make the trimming optional

It's not what gives the most speedup, and it could be harmful for
maximisation / best-effort requests.
---
 src/solver/opamCudf.ml | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index a421e5b52d7..3e5dcc1f4ec 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1090,12 +1090,13 @@ let preprocess_cudf_request (props, univ, creq) =
     in
     let to_install = vpkg2set creq.Cudf.install in
     let packages =
-      to_install ++
-      vpkg2set creq.Cudf.remove ++
-      vpkg2set creq.Cudf.upgrade
-    in
-    let packages =
-      Set.fixpoint deps packages
+      if OpamStd.Config.env_bool "CUDFTRIM" = Some true then
+        Set.fixpoint deps
+          (to_install ++
+           vpkg2set creq.Cudf.remove ++
+           vpkg2set creq.Cudf.upgrade)
+      else
+        Set.of_list (Cudf.get_packages univ)
     in
     let to_map set =
       Set.fold (fun p ->
@@ -1144,10 +1145,9 @@ let preprocess_cudf_request (props, univ, creq) =
       Set.fold (fun p acc -> transitive_conflicts Set.empty acc p)
         to_install Set.empty
     in
-    log "Conflicts: %d pkgs to remove" (Set.cardinal conflicts);
+    log "Conflicts: %a pkgs to remove"
+      (slog OpamStd.Op.(string_of_int @* Set.cardinal)) conflicts;
     let final_packages = packages -- conflicts ++ installed in
-    let ocamls = Set.filter (fun p -> p.Cudf.package = "ocaml") final_packages in
-    log "OCamls (%d): %s" (Set.cardinal ocamls) (Set.to_string ocamls);
     Cudf.load_universe (Set.elements (final_packages -- conflicts))
   in
   log "Preprocess cudf request: from %d to %d packages in %.2fs"

From 5c1c2b8a04133c279f072ba35246ae265f6d2ef5 Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Mon, 21 Sep 2020 17:13:21 +0200
Subject: [PATCH 06/19] CUDF preprocessing: fix handling of top-level version
 choices

---
 src/solver/opamCudf.ml | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 3e5dcc1f4ec..98f0d2e55ff 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1142,8 +1142,14 @@ let preprocess_cudf_request (props, univ, creq) =
       conflicts
     in
     let conflicts =
-      Set.fold (fun p acc -> transitive_conflicts Set.empty acc p)
-        to_install Set.empty
+      OpamStd.String.Map.fold (fun _ ps acc ->
+          acc ++
+          Set.map_reduce ~default:Set.empty
+            (transitive_conflicts Set.empty Set.empty)
+            Set.inter
+            ps)
+        (to_map to_install)
+        Set.empty
     in
     log "Conflicts: %a pkgs to remove"
       (slog OpamStd.Op.(string_of_int @* Set.cardinal)) conflicts;

From 151b9b8b391ef0b25d5c32be151ce5c70fd6691c Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Wed, 23 Sep 2020 12:40:01 +0200
Subject: [PATCH 07/19] CUDF preprocessing: small code simplification

---
 src/solver/opamCudf.ml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 98f0d2e55ff..f7067c6d937 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1122,20 +1122,20 @@ let preprocess_cudf_request (props, univ, creq) =
     let cache = Hashtbl.create 513 in
     (* Don't explore deeper than that for transitive conflicts *)
     let max_dig_depth = 2 in
-    let rec transitive_conflicts seen acc p =
+    let rec transitive_conflicts seen p =
       (* OpamConsole.msg "%s\n" (Package.to_string p); *)
-      try Hashtbl.find cache p ++ acc with Not_found ->
-      if Set.mem p seen || Set.cardinal seen >= max_dig_depth then acc else
+      try Hashtbl.find cache p with Not_found ->
+      if Set.mem p seen || Set.cardinal seen >= max_dig_depth then Set.empty else
       let seen = Set.add p seen in
       let conflicts =
         direct_conflicts p ++
         List.fold_left (fun acc disj ->
             acc ++
             Set.map_reduce ~default:Set.empty
-              (transitive_conflicts seen Set.empty)
+              (transitive_conflicts seen)
               Set.inter
               (vpkg2set disj))
-          acc
+          Set.empty
           p.Cudf.depends
       in
       Hashtbl.add cache p conflicts;
@@ -1145,7 +1145,7 @@ let preprocess_cudf_request (props, univ, creq) =
       OpamStd.String.Map.fold (fun _ ps acc ->
           acc ++
           Set.map_reduce ~default:Set.empty
-            (transitive_conflicts Set.empty Set.empty)
+            (transitive_conflicts Set.empty)
             Set.inter
             ps)
         (to_map to_install)

From e05a141617a6979600e1b8ba107911e3d478e8a2 Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Wed, 23 Sep 2020 12:40:30 +0200
Subject: [PATCH 08/19] CUDF preprocessing: fix another bug with overzealous
 conflict trimming

---
 src/solver/opamCudf.ml | 29 ++++++++++++++++-------------
 1 file changed, 16 insertions(+), 13 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index f7067c6d937..e2125b845c2 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1103,21 +1103,24 @@ let preprocess_cudf_request (props, univ, creq) =
           OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty)
         set OpamStd.String.Map.empty
     in
-    let to_set map =
-      OpamStd.String.Map.fold (fun _ -> Set.union) map Set.empty
-    in
-    let packages_map = to_map packages in
     let direct_conflicts p =
-      Set.filter (fun q -> q.Cudf.package <> p.Cudf.package)
-        (vpkg2set p.Cudf.conflicts)
-      ++
+      let base_conflicts =
+        Set.filter (fun q -> q.Cudf.package <> p.Cudf.package)
+          (vpkg2set p.Cudf.conflicts)
+      in
       (* Dependencies not matching constraints are also conflicts *)
-      (to_set @@
-       OpamStd.String.Map.mapi (fun name set ->
-           try OpamStd.String.Map.find name packages_map -- set
-           with Not_found -> Set.empty)
-         @@
-         to_map (deps p))
+      List.fold_left (fun acc -> function
+          | (n, c) :: disj when List.for_all (fun (m, _) -> m = n) disj ->
+            let coset = function
+              | Some (op, v) ->
+                let filter = Some (OpamFormula.neg_relop op, v) in
+                Set.of_list (Cudf.lookup_packages ~filter univ n)
+              | None -> Set.empty
+            in
+            acc ++
+            List.fold_left (fun acc (_, c) -> acc %% coset c) (coset c) disj
+          | _ -> acc)
+        base_conflicts p.Cudf.depends
     in
     let cache = Hashtbl.create 513 in
     (* Don't explore deeper than that for transitive conflicts *)

From 233b35e398b11ec2dfd9e283d2eb29cac4fa2a6a Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Thu, 24 Sep 2020 10:02:18 +0200
Subject: [PATCH 09/19] Make 'make libinstall' install docs to the same prefix

---
 Makefile | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Makefile b/Makefile
index 6581f9de2c4..08dad68e177 100644
--- a/Makefile
+++ b/Makefile
@@ -107,7 +107,7 @@ endif
 endif
 
 ifneq ($(LIBINSTALL_DIR),)
-    OPAMINSTALLER_FLAGS += --libdir "$(LIBINSTALL_DIR)"
+    OPAMINSTALLER_FLAGS += --libdir "$(LIBINSTALL_DIR)" --docdir "$(LIBINSTALL_DIR)/../doc"
 endif
 
 opam-devel.install: $(DUNE_DEP)

From 9bd924bc032350870c82243777649ad715e3a747 Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Thu, 24 Sep 2020 11:53:35 +0200
Subject: [PATCH 10/19] CUDF preprocessing: add an `OPAMDIGDEPTH` debug
 variable

Determines how far we go through the dependencies of the specified packages to
extract conflicts. Defaults to 2, 0 disables conflict detection, more than 5 is
probably meaningless.

Higher values make the preprocessing take around 2s, but that could probably be
optimised.
---
 src/solver/opamCudf.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index e2125b845c2..b64db67c491 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1124,7 +1124,11 @@ let preprocess_cudf_request (props, univ, creq) =
     in
     let cache = Hashtbl.create 513 in
     (* Don't explore deeper than that for transitive conflicts *)
-    let max_dig_depth = 2 in
+    let max_dig_depth =
+      match OpamStd.Config.env_int "DIGDEPTH" with
+      | None -> 2
+      | Some i -> i
+    in
     let rec transitive_conflicts seen p =
       (* OpamConsole.msg "%s\n" (Package.to_string p); *)
       try Hashtbl.find cache p with Not_found ->

From d626e729756bdbaa004c1bff66ef8aae5bf7fb8c Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Fri, 25 Sep 2020 11:49:14 +0200
Subject: [PATCH 11/19] Add warning for invalid cudf version constraint leading
 to inaccurate error message

---
 src/solver/opamSolver.ml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/solver/opamSolver.ml b/src/solver/opamSolver.ml
index c08f74f3992..be43b4036fa 100644
--- a/src/solver/opamSolver.ml
+++ b/src/solver/opamSolver.ml
@@ -102,6 +102,8 @@ let constraint_to_cudf version_map name (op,v) =
        (this shouldn't happen for any constraint in the universe, now that we
        compute a full version map, but may still happen for user-provided
        constraints) *)
+    log "Warn: fallback constraint for %s"
+      (OpamFormula.string_of_atom (name, Some (op,v)));
     let all_versions =
       OpamPackage.Map.filter (fun nv _ -> nv.name = name)
         version_map in

From 0309d0e504ef406e45aa2da0edb8cc00328c3ff9 Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Wed, 7 Oct 2020 16:28:26 +0200
Subject: [PATCH 12/19] Fix subtle bug with disappearing dependencies

Computation of dependencies was based on `OpamCudf.Graph.close_and_linearize`,
which is using a topological traversal of the dependency graph. Unfortunately,
when cycles appear (which is now allowed with `post` dependencies, but could
also happen before with malformed opam repos), this can cause dependencies to be
missed.

I believe this could manifest mysteriously in several bugs, but I dug it up on
an issue about `opam remove -a` no longer working, reporting a conflict while
attempting to remove `ocaml-config`.

Note 1: there are small changes in the API for simplicity's sake: the dependency
functions now return sets, and there is a separate sort function. We didn't use
the order anyway and always converted to sets, except in one `opam list` case
where we actually needed only the sort and not the dependency computing.

Note 2: I used a conservative approach (fix the bug first), but it would make
much sense to compute the cone directly from `OpamSolver` without going through
`OpamCudf` and back, which is quite coslty.
---
 src/client/opamClient.ml      | 23 ++++++++++------------
 src/client/opamListCommand.ml | 11 ++---------
 src/client/opamLockCommand.ml | 30 ++++++++++++++--------------
 src/solver/opamCudf.ml        | 37 ++++++++++++-----------------------
 src/solver/opamCudf.mli       | 18 ++++++++---------
 src/solver/opamSolver.ml      | 26 +++++++++++++++++++-----
 src/solver/opamSolver.mli     | 12 ++++++++++--
 7 files changed, 78 insertions(+), 79 deletions(-)

diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml
index 9c1d1f77064..c7825b32b00 100644
--- a/src/client/opamClient.ml
+++ b/src/client/opamClient.ml
@@ -63,7 +63,6 @@ let orphans ?changes ?(transitive=false) t =
     | Some ch ->
       if OpamPackage.Set.is_empty orphans then orphans else
       let recompile_cone =
-        OpamPackage.Set.of_list @@
         OpamSolver.reverse_dependencies
           ~depopts:true ~installed:true ~unavailable:true
           ~build:true ~post:false
@@ -93,7 +92,6 @@ let orphans ?changes ?(transitive=false) t =
     let rec add_trans full_orphans orphan_versions =
       (* fixpoint to check all packages with no available version *)
       let new_orphans =
-        OpamPackage.Set.of_list @@
         OpamSolver.reverse_dependencies
           ~depopts:false ~installed:false ~unavailable:true
           ~build:true ~post:false
@@ -1057,7 +1055,7 @@ let assume_built_restrictions ?available_packages t atoms =
     (OpamPackage.Map.values missing
      |> List.fold_left OpamPackage.Name.Set.union OpamPackage.Name.Set.empty
      |> OpamPackage.packages_of_names available_packages)
-    -- OpamPackage.Set.of_list installed_dependencies
+    -- installed_dependencies
   in
   let available_packages = lazy (
     (available_packages -- uninstalled_dependencies) ++ t.installed ++ pinned
@@ -1065,7 +1063,8 @@ let assume_built_restrictions ?available_packages t atoms =
   let fixed_atoms =
     List.map (fun nv ->
         (OpamPackage.name nv , Some (`Eq, OpamPackage.version nv)))
-      ((OpamPackage.Set.elements pinned) @ installed_dependencies)
+      (OpamPackage.Set.elements pinned @
+       OpamPackage.Set.elements installed_dependencies)
   in
   { t with available_packages }, fixed_atoms
 
@@ -1300,18 +1299,17 @@ let remove_t ?ask ~autoremove ~force atoms t =
         Remove
     in
     let to_remove =
-      OpamPackage.Set.of_list
-        (OpamSolver.reverse_dependencies ~build:true ~post:true
-           ~depopts:false ~installed:true universe packages) in
+      OpamSolver.reverse_dependencies ~build:true ~post:true
+        ~depopts:false ~installed:true universe packages
+    in
     let to_keep =
       (if autoremove then t.installed_roots %% t.installed else t.installed)
       ++ universe.u_base
       -- to_remove -- full_orphans -- orphan_versions
     in
     let to_keep =
-      OpamPackage.Set.of_list
-        (OpamSolver.dependencies ~build:true ~post:true
-           ~depopts:true ~installed:true universe to_keep) in
+      OpamSolver.dependencies ~build:true ~post:true
+        ~depopts:true ~installed:true universe to_keep in
     (* to_keep includes the depopts, because we don't want to autoremove
        them. But that may re-include packages that we wanted removed, so we
        need to remove them again *)
@@ -1323,9 +1321,8 @@ let remove_t ?ask ~autoremove ~force atoms t =
         if atoms = [] then to_remove
         else (* restrict to the dependency cone of removed pkgs *)
           to_remove %%
-          (OpamPackage.Set.of_list
-             (OpamSolver.dependencies ~build:true ~post:true
-                ~depopts:true ~installed:true universe to_remove))
+          (OpamSolver.dependencies ~build:true ~post:true
+             ~depopts:true ~installed:true universe to_remove)
       else to_remove in
     let t, solution =
       OpamSolution.resolve_and_apply ?ask t Remove
diff --git a/src/client/opamListCommand.ml b/src/client/opamListCommand.ml
index 8c6718307d3..852ee93e0d0 100644
--- a/src/client/opamListCommand.ml
+++ b/src/client/opamListCommand.ml
@@ -232,7 +232,6 @@ let apply_selector ~base st = function
       ~installed:false ~unavailable:true
       (get_universe st tog)
       (packages_of_atoms st atoms)
-    |> OpamPackage.Set.of_list
   | Required_by (tog, atoms) ->
     atom_dependencies st tog atoms |>
     OpamFormula.packages base
@@ -664,14 +663,8 @@ let display st format packages =
           ~requested:(OpamPackage.names_of_packages packages)
           Query
       in
-      let deps_packages =
-        OpamSolver.dependencies
-          ~depopts:true ~installed:false ~unavailable:true
-          ~build:true ~post:false
-          universe packages
-      in
-      List.filter (fun nv -> OpamPackage.Set.mem nv packages) deps_packages |>
-      List.rev
+      OpamSolver.dependency_sort ~depopts:true ~build:true ~post:false
+        universe packages
     else match format.order with
       | `Custom o -> List.sort o (OpamPackage.Set.elements packages)
       | _ -> OpamPackage.Set.elements packages
diff --git a/src/client/opamLockCommand.ml b/src/client/opamLockCommand.ml
index 1c3aca35964..253c4697c68 100644
--- a/src/client/opamLockCommand.ml
+++ b/src/client/opamLockCommand.ml
@@ -113,7 +113,7 @@ let lock_opam ?(only_direct=false) st opam =
     OpamSolver.dependencies
       ~depopts:true ~build:true ~post:true ~installed:true
       univ (OpamPackage.Set.singleton nv) |>
-    List.filter (fun nv1 -> nv1 <> nv)
+    OpamPackage.Set.remove nv
   in
   let depends =
     if only_direct then
@@ -123,14 +123,14 @@ let lock_opam ?(only_direct=false) st opam =
         OpamFormula.fold_left (fun acc (n,_) -> OpamPackage.Name.Set.add n acc)
           OpamPackage.Name.Set.empty
       in
-      List.filter (fun nv -> OpamPackage.Name.Set.mem nv.name names) all_depends
+      OpamPackage.packages_of_names all_depends names
     else all_depends
   in
   let map_of_set x set =
     OpamPackage.Map.of_list (List.map (fun nv -> nv, x)
                                (OpamPackage.Set.elements set))
   in
-  let depends_map = map_of_set `version (OpamPackage.Set.of_list depends) in
+  let depends_map = map_of_set `version depends in
   (* others: dev, test, doc *)
   let open OpamPackage.Set.Op in
   let select ?(build=false) ?(test=false) ?(doc=false) ?(dev=false)
@@ -153,11 +153,10 @@ let lock_opam ?(only_direct=false) st opam =
       let depends_map = map_of_set `other installed in
       if only_direct then depends_map
       else
-        ((OpamPackage.Set.of_list
-            (OpamSolver.dependencies
-               ~depopts:false ~build:true ~post:true ~installed:true
-               univ installed))
-         -- (OpamPackage.Set.of_list all_depends))
+        (OpamSolver.dependencies
+           ~depopts:false ~build:true ~post:true ~installed:true
+           univ installed
+         -- all_depends)
         |> map_of_set (`other_dep typ)
         |> OpamPackage.Map.union (fun _v _o -> `other_dep typ) depends_map
     else
@@ -245,17 +244,17 @@ let lock_opam ?(only_direct=false) st opam =
          (OpamPackage.Name.Set.elements uninstalled_depopts))
   in
   let pin_depends =
-    OpamStd.List.filter_map (fun nv ->
-        if not (OpamSwitchState.is_pinned st nv.name) then None else
+    OpamPackage.Set.fold (fun nv acc ->
+        if not (OpamSwitchState.is_pinned st nv.name) then acc else
         match OpamSwitchState.primary_url st nv with
-        | None -> None
+        | None -> acc
         | Some u ->
           match OpamUrl.local_dir u with
           | Some d ->
             let local_warn () =
               OpamConsole.warning "Dependency %s is pinned to local target %s"
                 (OpamPackage.to_string nv) (OpamUrl.to_string u);
-              None
+              acc
             in
             (match u.OpamUrl.backend with
              | #OpamUrl.version_control ->
@@ -263,11 +262,12 @@ let lock_opam ?(only_direct=false) st opam =
                 | Some resolved_u ->
                   OpamConsole.note "Local pin %s resolved to %s"
                     (OpamUrl.to_string u) (OpamUrl.to_string resolved_u);
-                  Some (nv, resolved_u)
+                  (nv, resolved_u) :: acc
                 | None -> local_warn ())
              | _ -> local_warn ())
-          | None -> Some (nv, u))
-      all_depends
+          | None -> (nv, u) :: acc)
+      all_depends []
+    |> List.rev
   in
   opam |>
   OpamFile.OPAM.with_depopts OpamFormula.Empty |>
diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index b64db67c491..66d920c3f84 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -422,7 +422,7 @@ type conflict =
 module Map = OpamStd.Map.Make(Package)
 module Set = OpamStd.Set.Make(Package)
 
-(* From a CUDF dependency CNF, extract the set of packages that can possibly
+(* From a CUDF dependency CNF, extract the set of packages that can possibly be
    part of a solution.
 
    This is much finer than [Common.CudfAdd.resolve_deps] which doesn't handle
@@ -510,19 +510,8 @@ module Graph = struct
   let transitive_closure g =
     PO.O.add_transitive_closure g
 
-  let close_and_linearize g pkgs =
-    let _, l =
-      Topo.fold
-        (fun pkg (closure, topo) ->
-           if Set.mem pkg closure then
-             closure, pkg :: topo
-           else if List.exists (fun p -> Set.mem p closure) (PG.pred g pkg) then
-             Set.add pkg closure, pkg :: topo
-           else
-             closure, topo)
-        g
-        (pkgs, []) in
-    l
+  let linearize g pkgs =
+    Topo.fold (fun p acc -> if Set.mem p pkgs then p::acc else acc) g []
 
   let mirror = PO.O.mirror
 
@@ -535,22 +524,20 @@ let is_artefact cpkg =
   is_opam_invariant cpkg ||
   cpkg.Cudf.package = dose_dummy_request
 
-let filter_dependencies f_direction universe packages =
-  log ~level:3 "filter deps: build graph";
-  let graph = f_direction (Graph.of_universe universe) in
-  let packages = Set.of_list packages in
-  log ~level:3 "filter deps: close_and_linearize";
-  let r = Graph.close_and_linearize graph packages in
-  log ~level:3 "filter deps: done";
-  r
-
-let dependencies = filter_dependencies (fun x -> x)
+let dependencies universe packages =
+  Set.fixpoint (fun p -> dependency_set universe p.Cudf.depends) packages
 (* similar to Algo.Depsolver.dependency_closure but with finer results on
    version sets *)
 
-let reverse_dependencies = filter_dependencies Graph.mirror
+let reverse_dependencies universe packages =
+  let graph = Graph.of_universe universe in
+  Set.fixpoint (fun p -> Set.of_list (Graph.pred graph p)) packages
 (* similar to Algo.Depsolver.reverse_dependency_closure but more reliable *)
 
+let dependency_sort universe packages =
+  let graph = Graph.of_universe universe in
+  Graph.linearize graph packages |> List.rev
+
 let string_of_atom (p, c) =
   let const = function
     | None       -> ""
diff --git a/src/solver/opamCudf.mli b/src/solver/opamCudf.mli
index 18a28542681..1a40955b1eb 100644
--- a/src/solver/opamCudf.mli
+++ b/src/solver/opamCudf.mli
@@ -42,10 +42,6 @@ module Graph: sig
   (** Return the transitive closure of [g] *)
   val transitive_closure: t -> t
 
-  (** Return the transitive closure of dependencies of [set],
-      sorted in topological order. *)
-  val close_and_linearize: t -> Set.t -> Cudf.package list
-
   (** Reverse the direction of all edges *)
   val mirror: t -> t
 end
@@ -62,13 +58,15 @@ module ActionGraph: OpamActionGraph.SIG with type package = Package.t
 (** Abstract type that may be returned in case of conflicts *)
 type conflict
 
-(** Return the transitive closure of dependencies of [set],
-    sorted in topological order *)
-val dependencies: Cudf.universe -> Cudf.package list -> Cudf.package list
+(** Return the transitive closure of dependencies of [set] *)
+val dependencies: Cudf.universe -> Set.t -> Set.t
+
+(** Return the transitive closure of reverse dependencies of [set] *)
+val reverse_dependencies: Cudf.universe -> Set.t -> Set.t
 
-(** Return the transitive closure of dependencies of [set],
-    sorted in topological order *)
-val reverse_dependencies: Cudf.universe -> Cudf.package list -> Cudf.package list
+(** Sorts the given packages topolgically (be careful if there are cycles, e.g.
+   if the universe was loaded with [post] dependencies enabled) *)
+val dependency_sort: Cudf.universe -> Set.t -> Cudf.package list
 
 (** Check if a request is satisfiable and return the reasons why not unless
     [explain] is set to [false] *)
diff --git a/src/solver/opamSolver.ml b/src/solver/opamSolver.ml
index be43b4036fa..f1c11ddf918 100644
--- a/src/solver/opamSolver.ml
+++ b/src/solver/opamSolver.ml
@@ -570,7 +570,7 @@ let dependency_graph
 let filter_dependencies
     f_direction ~depopts ~build ~post ~installed
     ?(unavailable=false) universe packages =
-  if OpamPackage.Set.is_empty packages then [] else
+  if OpamPackage.Set.is_empty packages then OpamPackage.Set.empty else
   let u_packages =
     packages ++
     if installed then universe.u_installed else
@@ -583,19 +583,35 @@ let filter_dependencies
     load_cudf_universe ~depopts ~build ~post universe ~version_map
       u_packages () in
   let cudf_packages =
-    opam2cudf universe ~depopts ~build ~post version_map packages
+    OpamCudf.Set.of_list
+      (opam2cudf universe ~depopts ~build ~post version_map packages)
   in
   log ~level:3 "filter_dependencies: dependency";
-  let topo_packages = f_direction cudf_universe cudf_packages in
-  let result = List.rev_map OpamCudf.cudf2opam topo_packages in
+  let clos_packages = f_direction cudf_universe cudf_packages in
+  let result =
+    OpamCudf.Set.fold (fun cp -> OpamPackage.Set.add (OpamCudf.cudf2opam cp))
+      clos_packages OpamPackage.Set.empty
+  in
   log "filter_dependencies result=%a"
-    (slog (OpamStd.List.to_string OpamPackage.to_string)) result;
+    (slog OpamPackage.Set.to_string) result;
   result
 
 let dependencies = filter_dependencies OpamCudf.dependencies
 
 let reverse_dependencies = filter_dependencies OpamCudf.reverse_dependencies
 
+let dependency_sort ~depopts ~build ~post universe packages =
+  let version_map = cudf_versions_map universe universe.u_packages in
+  let cudf_universe =
+    load_cudf_universe ~depopts ~build ~post universe ~version_map
+      universe.u_packages () in
+  let cudf_packages =
+    OpamCudf.Set.of_list
+      (opam2cudf universe ~depopts ~build ~post version_map packages)
+  in
+  List.map OpamCudf.cudf2opam
+    (OpamCudf.dependency_sort cudf_universe cudf_packages)
+
 let coinstallability_check universe packages =
   let version_map = cudf_versions_map universe universe.u_packages in
   let cudf_universe =
diff --git a/src/solver/opamSolver.mli b/src/solver/opamSolver.mli
index 0feef6dc421..d8852041e63 100644
--- a/src/solver/opamSolver.mli
+++ b/src/solver/opamSolver.mli
@@ -92,7 +92,7 @@ val installable: universe -> package_set
 (** Like [installable], but within a subset and potentially much faster *)
 val installable_subset: universe -> package_set -> package_set
 
-(** Return the topological sort of the transitive dependency closures
+(** Return the transitive dependency closures
     of a collection of packages.*)
 val dependencies :
   depopts:bool -> build:bool -> post:bool ->
@@ -100,7 +100,7 @@ val dependencies :
   ?unavailable:bool ->
   universe ->
   package_set ->
-  package list
+  package_set
 
 (** Same as [dependencies] but for reverse dependencies *)
 val reverse_dependencies :
@@ -109,6 +109,14 @@ val reverse_dependencies :
   ?unavailable:bool ->
   universe ->
   package_set ->
+  package_set
+
+(** Sorts the given package set in topological order (as much as possible,
+    beware of cycles in particular if [post] is [true]) *)
+val dependency_sort :
+  depopts:bool -> build:bool -> post:bool ->
+  universe ->
+  package_set ->
   package list
 
 module PkgGraph: Graph.Sig.I

From e4e1546ebfe47034ddc25e41a04225500de4114c Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Fri, 9 Oct 2020 17:17:15 +0200
Subject: [PATCH 13/19] Fix formatting of conflict messages

---
 src/client/opamClient.ml |  5 +++--
 src/solver/opamCudf.ml   | 11 ++++++-----
 src/solver/opamCudf.mli  |  2 +-
 3 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml
index c7825b32b00..79195fd5c58 100644
--- a/src/client/opamClient.ml
+++ b/src/client/opamClient.ml
@@ -291,8 +291,9 @@ let upgrade_t
       OpamConsole.warning
         "Upgrade is not possible because of conflicts or packages that \
          are no longer available:";
-      OpamConsole.errmsg "%s"
-        (OpamStd.Format.itemize (OpamCudf.string_of_conflict ~indent:4) reasons);
+      OpamConsole.errmsg "  %s"
+        (OpamStd.Format.itemize (OpamCudf.string_of_conflict ~start_column:2)
+           reasons);
       OpamConsole.errmsg
         "\nYou may run \"opam upgrade --fixup\" to let opam fix the \
          current state.\n"
diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 66d920c3f84..4a13d4d4c4f 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -910,12 +910,13 @@ let extract_explanations packages cudfnv2opam unav_reasons reasons =
 let strings_of_cycles cycles =
   List.map arrow_concat cycles
 
-let string_of_conflict ?(indent=0) (msg1, msg2, msg3) =
-  OpamStd.Format.reformat ~start_column:indent ~indent msg1 ^
+let string_of_conflict ?(start_column=0) (msg1, msg2, msg3) =
+  let width = OpamStd.Sys.terminal_columns () - start_column - 2 in
+  OpamStd.Format.reformat ~start_column ~indent:2 msg1 ^
   OpamStd.List.concat_map ~left:"\n- " ~nil:"" "\n- "
-    (fun s -> OpamStd.Format.reformat ~indent s) msg2 ^
+    (fun s -> OpamStd.Format.reformat ~indent:2 ~width s) msg2 ^
   OpamStd.List.concat_map ~left:"\n" ~nil:"" "\n"
-    (fun s -> OpamStd.Format.reformat ~indent s) msg3
+    (fun s -> OpamStd.Format.reformat ~indent:2 ~width s) msg3
 
 let conflict_explanations packages unav_reasons = function
   | univ, version_map, Conflict_dep reasons ->
@@ -942,7 +943,7 @@ let string_of_conflicts packages unav_reasons conflict =
   if cflts <> [] then
     Buffer.add_string b
       (OpamStd.Format.itemize ~bullet:(OpamConsole.colorise `red "  * ")
-         (string_of_conflict ~indent:4) cflts);
+         (string_of_conflict ~start_column:4) cflts);
   if cflts = [] && cycles = [] then (* No explanation found *)
     Printf.bprintf b
       "Sorry, no solution found: \
diff --git a/src/solver/opamCudf.mli b/src/solver/opamCudf.mli
index 1a40955b1eb..04cb8465ddd 100644
--- a/src/solver/opamCudf.mli
+++ b/src/solver/opamCudf.mli
@@ -221,7 +221,7 @@ val conflict_explanations:
 (** Properly concat a single conflict as returned by [conflict_explanations] for
    display *)
 val string_of_conflict:
-  ?indent:int -> string * string list * string list -> string
+  ?start_column:int -> string * string list * string list -> string
 
 (** Dumps the given cudf universe to the given channel *)
 val dump_universe: out_channel -> Cudf.universe -> unit

From 67b0e12c166b9b639a9c8b8fb978e2a0e499a955 Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Thu, 8 Oct 2020 15:35:11 +0200
Subject: [PATCH 14/19] Fix bugs with autoremove

- restriction to the cone of mentionned packages was broken
- the command could cause conflicts in the case of orphan packages; when we only
  do removals that won't lead to rebuilds, as is the case with autoremove
  without argument, we can actually just ignore orphans (with argument, only
  keep orphans within the reverse dep cone, as usual).
---
 .ocamlinit                   |  1 +
 master_changes.md            |  3 ++-
 src/client/opamClient.ml     | 16 ++++++++--------
 src/state/opamSwitchState.ml |  2 +-
 4 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/.ocamlinit b/.ocamlinit
index 1c2f40d3096..6189228711e 100644
--- a/.ocamlinit
+++ b/.ocamlinit
@@ -1,4 +1,5 @@
 #use "topfind";;
+#use "down.top";;
 #require "opam-client";;
 
 OpamClientConfig.opam_init ();;
diff --git a/master_changes.md b/master_changes.md
index 41f8e773944..4ef2dfeab97 100644
--- a/master_changes.md
+++ b/master_changes.md
@@ -19,7 +19,8 @@ New option/command/subcommand are prefixed with ◈.
   * The stdout of `pre-` and `post-session` hooks is now propagated to the user [#4382 @AltGr - fix #4359]
 
 ## Remove
-  *
+  * Fix `opam remove --autoremove <PKG>` to not autoremove unrelated packages
+  * Fix cases where `opam remove -a` could trigger conflicts in the presence of orphan packages
 
 ## Switch
   * Fix `--update-invariant` when removing or changing package name [#4360 @AltGr - fix #4353]
diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml
index 79195fd5c58..3542de3eb18 100644
--- a/src/client/opamClient.ml
+++ b/src/client/opamClient.ml
@@ -1261,10 +1261,10 @@ let remove_t ?ask ~autoremove ~force atoms t =
     (slog OpamFormula.string_of_atoms) atoms;
 
   let t, full_orphans, orphan_versions =
-    let changes =
-      if autoremove then None
-      else Some (OpamSwitchState.packages_of_atoms t atoms) in
-    orphans ?changes t
+    if atoms = [] then t, OpamPackage.Set.empty, OpamPackage.Set.empty
+    else
+    let changes = OpamSwitchState.packages_of_atoms t atoms in
+    orphans ~changes t
   in
 
   let nothing_to_do = ref true in
@@ -1306,7 +1306,7 @@ let remove_t ?ask ~autoremove ~force atoms t =
     let to_keep =
       (if autoremove then t.installed_roots %% t.installed else t.installed)
       ++ universe.u_base
-      -- to_remove -- full_orphans -- orphan_versions
+      -- to_remove
     in
     let to_keep =
       OpamSolver.dependencies ~build:true ~post:true
@@ -1318,10 +1318,10 @@ let remove_t ?ask ~autoremove ~force atoms t =
     let requested = OpamPackage.names_of_packages packages in
     let to_remove =
       if autoremove then
-        let to_remove = t.installed -- to_keep in
-        if atoms = [] then to_remove
+        let to_remove1 = t.installed -- to_keep in
+        if atoms = [] then to_remove1
         else (* restrict to the dependency cone of removed pkgs *)
-          to_remove %%
+          to_remove1 %%
           (OpamSolver.dependencies ~build:true ~post:true
              ~depopts:true ~installed:true universe to_remove)
       else to_remove in
diff --git a/src/state/opamSwitchState.ml b/src/state/opamSwitchState.ml
index 484dc63acf5..10326d88fc5 100644
--- a/src/state/opamSwitchState.ml
+++ b/src/state/opamSwitchState.ml
@@ -314,7 +314,6 @@ let load lock_kind gt rt switch =
   let opams =
     OpamPackage.Map.union (fun _ x -> x) repos_package_index pinned_opams
   in
-  let packages = OpamPackage.keys opams in
   let available_packages =
     lazy (compute_available_packages gt switch switch_config
             ~pinned ~opams)
@@ -324,6 +323,7 @@ let load lock_kind gt rt switch =
        computing availability *)
     OpamPackage.Map.union (fun _ x -> x) installed_opams opams
   in
+  let packages = OpamPackage.keys opams in
   let installed_without_def =
     OpamPackage.Set.fold (fun nv nodef ->
         if OpamPackage.Map.mem nv installed_opams then nodef else

From 7b4430321af38bcf441b4cb0fad92b6d0788865e Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Wed, 14 Oct 2020 15:23:49 +0200
Subject: [PATCH 15/19] Preprocessing: enable request trimming automatically
 when no max criteria

---
 src/solver/opamCudf.ml | 26 ++++++++++++++++++++++----
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 4a13d4d4c4f..e1c0a7bc47b 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1066,9 +1066,26 @@ let dump_cudf_error ~version_map univ req =
   | Some f -> f
   | None -> assert false
 
-let preprocess_cudf_request (props, univ, creq) =
+let preprocess_cudf_request (props, univ, creq) criteria =
   let chrono = OpamConsole.timer () in
   let univ0 = univ in
+  let do_trimming =
+    match OpamStd.Config.env_bool "CUDFTRIM" with
+    | Some o -> o
+    | None ->
+      (* Trimming is only correct when there is no maximisation criteria, so
+         automatically set it to true in this case *)
+      let neg_crit_re =
+        Re.(seq [char '-';
+                 rep1 (diff any (set ",["));
+                 opt (seq [char '['; rep1 (diff any (char ']')); char ']'])])
+      in
+      let all_neg_re =
+        Re.(whole_string (seq [rep (seq [neg_crit_re; char ',']);
+                               neg_crit_re]))
+      in
+      Re.execp (Re.compile all_neg_re) criteria
+  in
   let univ =
     let open Set.Op in
     let vpkg2set vp = Set.of_list (Common.CudfAdd.resolve_deps univ vp) in
@@ -1078,7 +1095,7 @@ let preprocess_cudf_request (props, univ, creq) =
     in
     let to_install = vpkg2set creq.Cudf.install in
     let packages =
-      if OpamStd.Config.env_bool "CUDFTRIM" = Some true then
+      if do_trimming then
         Set.fixpoint deps
           (to_install ++
            vpkg2set creq.Cudf.remove ++
@@ -1151,7 +1168,8 @@ let preprocess_cudf_request (props, univ, creq) =
     let final_packages = packages -- conflicts ++ installed in
     Cudf.load_universe (Set.elements (final_packages -- conflicts))
   in
-  log "Preprocess cudf request: from %d to %d packages in %.2fs"
+  log "Preprocess cudf request (trimming: %b): from %d to %d packages in %.2fs"
+    do_trimming
     (Cudf.universe_size univ0)
     (Cudf.universe_size univ)
     (chrono ());
@@ -1182,7 +1200,7 @@ let call_external_solver ~version_map univ req =
     try
       let cudf_request =
         if OpamStd.Config.env_bool "PREPRO" = Some false then cudf_request
-        else preprocess_cudf_request cudf_request
+        else preprocess_cudf_request cudf_request criteria
       in
       let r =
         check_request_using

From b109ef9aa6b29b445fe03317749de7d3e113739b Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Wed, 14 Oct 2020 18:14:03 +0200
Subject: [PATCH 16/19] Solver bug: remove (almost) duplicate message

---
 src/solver/opamCudf.ml | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index e1c0a7bc47b..0a43c4147a6 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1280,22 +1280,22 @@ let get_final_universe ~version_map univ req =
     Success (Cudf.load_universe [])
   | Algo.Depsolver.Error str -> fail str
   | Algo.Depsolver.Unsat r   ->
-    OpamConsole.error
-      "The solver (%s) pretends there is no solution while that's apparently \
-       false.\n\
-       This is likely an issue with the solver interface, please try a \
-       different solver and report if you were using a supported one."
-      (let module Solver = (val OpamSolverConfig.(Lazy.force !r.solver)) in
-       Solver.name);
+    let msg =
+      Printf.sprintf
+        "The solver (%s) pretends there is no solution while that's apparently \
+         false.\n\
+         This is likely an issue with the solver interface, please try a \
+         different solver and report if you were using a supported one."
+        (let module Solver = (val OpamSolverConfig.(Lazy.force !r.solver)) in
+         Solver.name)
+    in
     match r with
     | Some ({Algo.Diagnostic.result = Algo.Diagnostic.Failure _; _} as r) ->
+      OpamConsole.error "%s" msg;
       make_conflicts ~version_map univ r
     | Some {Algo.Diagnostic.result = Algo.Diagnostic.Success _; _}
     | None ->
-      raise (Solver_failure
-        "The current solver could not find a solution but dose3 could. \
-         This is probably a bug in the current solver. Please file a bug-report \
-         on the opam bug tracker: https://github.com/ocaml/opam/issues/")
+      raise (Solver_failure msg)
 
 let diff univ sol =
   let before =

From 7bd19a11fea8e62effdb2352a3146f85b1cea538 Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Wed, 14 Oct 2020 18:49:25 +0200
Subject: [PATCH 17/19] CUDF preprocessing: fix overzealous trimming of
 to-be-installed invariants

---
 src/solver/opamCudf.ml | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 0a43c4147a6..119c23c9b3a 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1093,7 +1093,10 @@ let preprocess_cudf_request (props, univ, creq) criteria =
     let installed =
       Set.of_list (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) univ)
     in
-    let to_install = vpkg2set creq.Cudf.install in
+    let to_install =
+      vpkg2set creq.Cudf.install
+      ++ Set.of_list (Cudf.lookup_packages univ opam_invariant_package_name)
+    in
     let packages =
       if do_trimming then
         Set.fixpoint deps

From 20d92c6ebea9af1e23fc31e67ff1996ee27ea18a Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Fri, 25 Sep 2020 14:26:37 +0200
Subject: [PATCH 18/19] CUDF preprocessing: add a "simple" trimming mode

Instead of removing all unrelated packages, remove just the versions of
related packages that we are guaranteed not to need.
---
 src/solver/opamCudf.ml | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 119c23c9b3a..8bec9763b7a 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1090,27 +1090,32 @@ let preprocess_cudf_request (props, univ, creq) criteria =
     let open Set.Op in
     let vpkg2set vp = Set.of_list (Common.CudfAdd.resolve_deps univ vp) in
     let deps p = dependency_set univ p.Cudf.depends in
-    let installed =
-      Set.of_list (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) univ)
-    in
     let to_install =
       vpkg2set creq.Cudf.install
       ++ Set.of_list (Cudf.lookup_packages univ opam_invariant_package_name)
     in
+    let to_map set =
+      Set.fold (fun p ->
+          OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty)
+        set OpamStd.String.Map.empty
+    in
     let packages =
       if do_trimming then
         Set.fixpoint deps
           (to_install ++
            vpkg2set creq.Cudf.remove ++
-           vpkg2set creq.Cudf.upgrade)
+           vpkg2set creq.Cudf.upgrade) ++
+        Set.of_list (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) univ)
+      else if OpamStd.Config.env_string "CUDFTRIM" = Some "simple" then
+        let cone = to_map (Set.fixpoint deps to_install) in
+        let filter p = match OpamStd.String.Map.find_opt p.Cudf.package cone with
+          | Some ps -> Set.mem p ps
+          | None -> true
+        in
+        Set.of_list (Cudf.get_packages ~filter univ)
       else
         Set.of_list (Cudf.get_packages univ)
     in
-    let to_map set =
-      Set.fold (fun p ->
-          OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty)
-        set OpamStd.String.Map.empty
-    in
     let direct_conflicts p =
       let base_conflicts =
         Set.filter (fun q -> q.Cudf.package <> p.Cudf.package)
@@ -1168,8 +1173,7 @@ let preprocess_cudf_request (props, univ, creq) criteria =
     in
     log "Conflicts: %a pkgs to remove"
       (slog OpamStd.Op.(string_of_int @* Set.cardinal)) conflicts;
-    let final_packages = packages -- conflicts ++ installed in
-    Cudf.load_universe (Set.elements (final_packages -- conflicts))
+    Cudf.load_universe (Set.elements (packages -- conflicts))
   in
   log "Preprocess cudf request (trimming: %b): from %d to %d packages in %.2fs"
     do_trimming

From 5ae7c0b6a43b59b63ac65d6cb0e715454400ee5e Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Tue, 20 Oct 2020 16:54:39 +0200
Subject: [PATCH 19/19] Update master_changes.md

Co-authored-by: R. Boujbel <rjbou@ocamlpro.com>
---
 master_changes.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/master_changes.md b/master_changes.md
index 4ef2dfeab97..f4cab3b07b7 100644
--- a/master_changes.md
+++ b/master_changes.md
@@ -19,8 +19,8 @@ New option/command/subcommand are prefixed with ◈.
   * The stdout of `pre-` and `post-session` hooks is now propagated to the user [#4382 @AltGr - fix #4359]
 
 ## Remove
-  * Fix `opam remove --autoremove <PKG>` to not autoremove unrelated packages
-  * Fix cases where `opam remove -a` could trigger conflicts in the presence of orphan packages
+  * Fix `opam remove --autoremove <PKG>` to not autoremove unrelated packages [#4369 @AltGr - fix #4250 #4332]
+  * Fix cases where `opam remove -a` could trigger conflicts in the presence of orphan packages [#4369 @AltGr - fix #4250 #4332]
 
 ## Switch
   * Fix `--update-invariant` when removing or changing package name [#4360 @AltGr - fix #4353]