Merge pull request #5317 from kit-ty-kate/speedup-opam-list-installed

Various speedups on tasks that do not require availability information (e.g. opam list --installed)

master_changes.md

@@ -52,6 +52,7 @@ users)
 
 ## List
   * ◈ Add a new `--latests-only` option to only list the latest packages [#5375 @kit-ty-kate]
+  * Speedup `opam list` on options that do not use availibility information [#5317 @kit-ty-kate - fix #5314]
 
 ## Show
 
@@ -216,12 +217,16 @@ users)
 
 ## opam-state
  * `OpamStateConfig.opamroot_with_provenance`: restore previous behaviour to `OpamStateConfig.opamroot` for compatibility with third party code [#6047 @dra27]
+  * `OpamSwitchState.{,reverse_}dependencies`: make `unavailable` a non-optional argument to enforce speedups when availability information is not needed [#5317 @kit-ty-kate]
 
 ## opam-solver
  * `OpamCudfCriteria`, `OpamBuiltinZ3.Syntax`: Move `OpamBuiltinZ3.Syntax` into a dedicated module `OpamCudfCriteria` [#6130 @kit-ty-kate]
+ * `OpamSolver.dependency_graph`: make `unavailable` a non-optional argument to enforce speedups when availability information is not needed [#5317 @kit-ty-kate]
 
 ## opam-format
   * Add `OpamTypesBase.switch_selections_{compare,equal}`: proper comparison functions for `OpamTypes.switch_selections` [#6102 @kit-ty-kate]
+  * `OpamFormula`: add `exists` [#5317 @kit-ty-kate]
+  * `OpamTypes.universe`: make `u_available` and `u_attrs` lazy to speedup actions that do not require availiblity information [#5317 @kit-ty-kate - fix #5314]
 
 ## opam-core
   * `OpamStd.Env`: add `env_string_list` for parsing string list environment variables (comma separated) [#5682 @desumn]

src/client/opamAdminCheck.ml

@@ -36,7 +36,7 @@ let get_universe ~with_test ~with_doc ~dev opams =
     u_packages = packages;
     u_action = Query;
     u_installed = OpamPackage.Set.empty;
-    u_available = packages;
+    u_available = lazy packages;
     u_depends =
       OpamPackage.Map.mapi
         (fun nv o ->

src/client/opamClient.ml

@@ -2386,6 +2386,7 @@ let remove_t ?ask ~autoremove ~force ?(formula=OpamFormula.Empty) atoms t =
         let keep_cone =
           keep |> OpamSwitchState.dependencies t
             ~build:true ~post:true ~depopts:true ~installed:true
+            ~unavailable:false
         in
         let autoremove =
           packages ++ (t.installed -- keep_cone)
@@ -2395,10 +2396,12 @@ let remove_t ?ask ~autoremove ~force ?(formula=OpamFormula.Empty) atoms t =
         let remove_cone =
           packages |> OpamSwitchState.reverse_dependencies t
             ~build:true ~post:true ~depopts:false ~installed:true
+            ~unavailable:false
         in
         autoremove %%
         (remove_cone |> OpamSwitchState.dependencies t
-           ~build:true ~post:true ~depopts:false ~installed:true)
+           ~build:true ~post:true ~depopts:false ~installed:true
+           ~unavailable:false)
       else
         packages
     in

src/client/opamCommands.ml

@@ -750,7 +750,8 @@ let list ?(force_search=false) cli =
     let results =
       OpamListCommand.filter ~base:all st filter
     in
-    if not no_depexts && not silent then
+    if not no_depexts && not silent &&
+       OpamFormula.exists OpamListCommand.uses_depexts state_selector then
       (let drop_by_depexts =
          List.fold_left (fun missing str ->
              let is_missing pkgs =
@@ -1585,7 +1586,7 @@ let config cli =
                 | Some o -> OpamFile.OPAM.has_flag Pkgflag_Compiler o
                 | None -> false)
             |> OpamSwitchState.dependencies ~depopts:true ~post:true ~build:true
-              ~installed:true state
+              ~installed:true ~unavailable:false state
             |> OpamPackage.Set.iter process;
             if not Sys.win32 && List.mem "." (OpamStd.Sys.split_path_variable (Sys.getenv "PATH"))
             then OpamConsole.warning

src/client/opamListCommand.ml

@@ -217,6 +217,30 @@ let pattern_selector patterns =
               Atom (Pattern (version_patt, version))])
         patterns)
 
+let uses_depexts = function
+  | Any
+  | Installed
+  | Root
+  | Compiler
+  | Pinned
+  | Latests_only
+  | Pattern _
+  | Atoms _
+  | Flag _
+  | NotFlag _
+  | Tag _
+  | From_repository _
+  | Owns_file _
+    -> false
+  | Available
+  | Installable
+  | Depends_on _
+  | Required_by _
+  | Conflicts_with _
+  | Coinstallable_with _
+  | Solution _
+    -> true
+
 let apply_selector ~base st = function
   | Any -> base
   | Installed -> st.installed

src/client/opamListCommand.mli

@@ -63,6 +63,10 @@ type selector =
   | From_repository of repository_name list
   | Owns_file of filename
 
+(** Returns [true] if the selector might require depexts availibility
+    information when applied using {!filter}. Returns [false] otherwise. *)
+val uses_depexts : selector -> bool
+
 (** Applies a formula of selectors to filter the package from a given switch
     state *)
 val filter:

src/client/opamLockCommand.ml

@@ -133,7 +133,7 @@ let lock_opam ?(only_direct=false) st opam =
   (* Depends *)
   let all_depends =
     OpamSwitchState.dependencies
-      ~depopts:true ~build:true ~post:true ~installed:true
+      ~depopts:true ~build:true ~post:true ~installed:true ~unavailable:false
       st (OpamPackage.Set.singleton nv) |>
     OpamPackage.Set.remove nv
   in
@@ -177,7 +177,7 @@ let lock_opam ?(only_direct=false) st opam =
       else
         (OpamSwitchState.dependencies
            ~depopts:false ~build:true ~post:true ~installed:true
-           st installed
+           ~unavailable:false st installed
          -- all_depends)
         |> map_of_set (`other_dep typ)
         |> OpamPackage.Map.union (fun _v _o -> `other_dep typ) depends_map

src/client/opamTreeCommand.ml

@@ -140,7 +140,8 @@ let build_deps_forest st universe tog filter names =
   let root, graph =
     let graph =
       OpamSolver.dependency_graph
-        ~depopts:false ~build ~post ~installed:true universe
+        ~depopts:false ~build ~post ~installed:true ~unavailable:false
+        universe
     in
     let root =
       st.installed |> OpamPackage.Set.filter (is_root graph)
@@ -187,7 +188,8 @@ let build_revdeps_forest st universe tog filter names =
   let root, graph =
     let graph =
       OpamSolver.dependency_graph
-        ~depopts:false ~build ~post ~installed:true universe
+        ~depopts:false ~build ~post ~installed:true ~unavailable:false
+        universe
     in
     let root =
       st.installed |> OpamPackage.Set.filter (is_leaf graph)

src/format/opamFormula.ml

@@ -193,6 +193,12 @@ let rec fold_right f i = function
   | And(x,y) -> fold_right f (fold_right f i y) x
   | Or(x,y)  -> fold_right f (fold_right f i y) x
 
+let rec exists f = function
+  | Empty    -> false
+  | Atom x   -> f x
+  | Block x  -> exists f x
+  | And(x,y) | Or(x,y) -> exists f x || exists f y
+
 type version_formula = version_constraint formula
 
 type t = (OpamPackage.Name.t * version_formula) formula

src/format/opamFormula.mli

@@ -135,6 +135,10 @@ val fold_left: ('a -> 'b -> 'a) -> 'a -> 'b formula -> 'a
 (** Fold function (bottom-up, right-to-left) *)
 val fold_right: ('a -> 'b -> 'a) -> 'a -> 'b formula -> 'a
 
+(** [exists f formula] scans the whole [formula] until [f atom] returns [true],
+    in which case it returns [true]. Returns [false] otherwise *)
+val exists: ('a -> bool) -> 'a formula -> bool
+
 (** Sort formula, using [compare] function. `Block` around `Or` and `And` \
     are removed. *)
 val sort: ('a -> 'a -> int) -> 'a formula -> 'a formula

src/format/opamTypes.mli

@@ -301,7 +301,7 @@ type user_action =
 type universe = {
   u_packages : package_set;
   u_installed: package_set;
-  u_available: package_set;
+  u_available: package_set Lazy.t;
   u_depends  : filtered_formula package_map;
   u_depopts  : filtered_formula package_map;
   u_conflicts: formula package_map;
@@ -310,7 +310,7 @@ type universe = {
   u_pinned   : package_set;
   u_invariant: formula;
   u_reinstall: package_set;
-  u_attrs    : (string * package_set) list;
+  u_attrs    : (string * package_set Lazy.t) list;
 }
 
 (** {2 Command line arguments} *)

src/solver/opamSolver.ml

@@ -24,7 +24,7 @@ let empty_universe =
   {
     u_packages = OpamPackage.Set.empty;
     u_installed = OpamPackage.Set.empty;
-    u_available = OpamPackage.Set.empty;
+    u_available = lazy OpamPackage.Set.empty;
     u_depends = OpamPackage.Map.empty;
     u_depopts = OpamPackage.Map.empty;
     u_conflicts = OpamPackage.Map.empty;
@@ -189,8 +189,11 @@ let opam2cudf_map universe version_map packages =
   let installed_root_map = set_to_bool_map universe.u_installed_roots in
   let pinned_to_current_version_map = set_to_bool_map universe.u_pinned in
   let avoid_versions =
-    OpamStd.Option.default OpamPackage.Set.empty @@
-    OpamStd.List.assoc_opt String.equal "avoid-version" universe.u_attrs
+    match
+      OpamStd.List.assoc_opt String.equal "avoid-version" universe.u_attrs
+    with
+    | None -> OpamPackage.Set.empty
+    | Some attr -> Lazy.force attr
   in
   let version_lag_map =
     OpamPackage.Name.Map.fold (fun name version_set acc ->
@@ -222,6 +225,7 @@ let opam2cudf_map universe version_map packages =
   in
   let extras_maps =
     List.map (fun (label, set) ->
+        let set = Lazy.force set in
         OpamPackage.Set.fold (fun nv ->
             OpamPackage.Map.add nv (label, `Int 1))
           (packages %% set) OpamPackage.Map.empty)
@@ -281,7 +285,7 @@ let opam2cudf_map universe version_map packages =
         OpamPackage.Map.update nv
           (fun deps -> OpamFormula.ands [unav_dep; deps])
           OpamFormula.Empty)
-      (universe.u_installed -- universe.u_available)
+      (universe.u_installed -- Lazy.force universe.u_available)
       depends_map
   in
   let depopts_map =
@@ -437,7 +441,7 @@ let cycle_conflict ~version_map univ cycles =
 
 let resolve universe request =
   log "resolve request=%a" (slog string_of_request) request;
-  let all_packages = universe.u_available ++ universe.u_installed in
+  let all_packages = Lazy.force universe.u_available ++ universe.u_installed in
   let version_map = cudf_versions_map universe in
   let univ_gen = load_cudf_universe universe ~version_map all_packages in
   let cudf_universe = univ_gen ~depopts:false ~build:true ~post:true () in
@@ -516,7 +520,7 @@ let coinstallable_subset universe ?(add_invariant=true) set packages =
     (slog OpamPackage.Set.to_string) packages;
   let cudf_packages_map =
     load_cudf_packages ~add_invariant ~build:true ~post:true universe
-      (universe.u_available ++ set ++ packages) ()
+      (Lazy.force universe.u_available ++ set ++ packages) ()
   in
   let cudf_set, cudf_packages_map =
     OpamPackage.Set.fold (fun nv (set, map) ->
@@ -560,17 +564,17 @@ let installable_subset universe packages =
     universe ~add_invariant:true OpamPackage.Set.empty packages
 
 let installable universe =
-  installable_subset universe universe.u_available
+  installable_subset universe (Lazy.force universe.u_available)
 
 module PkgGraph = Graph.Imperative.Digraph.ConcreteBidirectional(OpamPackage)
 
 let dependency_graph
-    ~depopts ~build ~post ~installed ?(unavailable=false)
+    ~depopts ~build ~post ~installed ~unavailable
     universe =
   let u_packages =
     if installed then universe.u_installed else
     if unavailable then universe.u_packages else
-      universe.u_available in
+      Lazy.force universe.u_available in
   let cudf_graph =
     load_cudf_universe ~depopts ~build ~post universe u_packages () |>
     OpamCudf.Graph.of_universe
@@ -625,7 +629,7 @@ let atom_coinstallability_check universe atoms =
       (check_pkg ::
        opam_invariant_package version_map universe.u_invariant ::
        OpamCudf.Set.elements
-         (opam2cudf_set universe version_map universe.u_available
+         (opam2cudf_set universe version_map (Lazy.force universe.u_available)
             ~depopts:false ~build:true ~post:true))
   in
   Dose_algo.Depsolver.edos_install cudf_universe check_pkg
@@ -776,12 +780,12 @@ let dump_universe universe oc =
   let version_map = cudf_versions_map universe in
   let cudf_univ =
     load_cudf_universe ~depopts:false ~build:true ~post:true ~version_map
-      universe universe.u_available () in
+      universe (Lazy.force universe.u_available) () in
   OpamCudf.dump_universe oc cudf_univ;
   (* Add explicit bindings to retrieve original versions of non-available and
      non-existing (but referred to) packages *)
   OpamPackage.Map.iter (fun nv i ->
-      if not (OpamPackage.Set.mem nv universe.u_available) then
+      if not (OpamPackage.Set.mem nv (Lazy.force universe.u_available)) then
         Printf.fprintf oc "#v2v:%s:%d=%s\n"
           (OpamPackage.name_to_string nv) i (OpamPackage.version_to_string nv)
     ) version_map

src/solver/opamSolver.mli

@@ -114,7 +114,7 @@ module PkgGraph: Graph.Sig.I
 val dependency_graph :
   depopts:bool -> build:bool -> post:bool ->
   installed:bool ->
-  ?unavailable:bool ->
+  unavailable:bool ->
   universe -> PkgGraph.t
 
 (** Check the current set of installed packages in a universe for

src/state/opamSwitchState.ml

@@ -998,7 +998,7 @@ let universe st
        would be much more involved, but some solvers might struggle without any
        cleanup at this point *)
     (* remove_conflicts st base *)
-    (Lazy.force st.available_packages)
+    st.available_packages
   in
   let u_reinstall =
     (* Ignore reinstalls outside of the dependency cone of
@@ -1019,15 +1019,18 @@ let universe st
     | None -> OpamPackage.Set.empty
   in
   let missing_depexts =
-    OpamPackage.Map.fold (fun nv status acc ->
-        if OpamSysPkg.Set.is_empty status.OpamSysPkg.s_available
-        then acc
-        else OpamPackage.Set.add nv acc)
-      (Lazy.force st.sys_packages)
-      OpamPackage.Set.empty
+    lazy (
+      OpamPackage.Map.fold (fun nv status acc ->
+          if OpamSysPkg.Set.is_empty status.OpamSysPkg.s_available
+          then acc
+          else OpamPackage.Set.add nv acc)
+        (Lazy.force st.sys_packages)
+        OpamPackage.Set.empty)
   in
   let avoid_versions =
-    OpamPackage.Set.filter (avoid_version st) u_available
+    lazy (
+      OpamPackage.Set.filter (avoid_version st)
+        (Lazy.force u_available))
   in
   let u =
 {
@@ -1042,7 +1045,7 @@ let universe st
   u_pinned    = OpamPinned.packages st;
   u_invariant;
   u_reinstall;
-  u_attrs     = ["opam-query", requested;
+  u_attrs     = ["opam-query", lazy requested;
                  "missing-depexts", missing_depexts;
                  "avoid-version", avoid_versions];
 }
@@ -1343,7 +1346,7 @@ let dependencies_filter_to_formula_t ~build ~post st nv =
   OpamFilter.filter_formula ~default:true env
 
 let dependencies_t st base_deps_compute deps_compute
-    ~depopts ~installed ?(unavailable=false) packages =
+    ~depopts ~installed ~unavailable packages =
   if OpamPackage.Set.is_empty packages then OpamPackage.Set.empty else
   let base =
     packages ++

src/state/opamSwitchState.mli

@@ -167,20 +167,23 @@ val depexts: 'a switch_state -> package -> OpamSysPkg.Set.t
 (** Return the transitive dependency closures
     of a collection of packages.
 
-    [depopts]: include optional dependencies (depopts: foo)
-    [build]: include build dependencies (depends: foo {build})
-    [post]: include post dependencies (depends: foo {post})
-    [installed]: only consider already-installed packages
-    [unavaiable]: also consider unavailable packages
+    @param depopts include optional dependencies (depopts: foo)
+    @param build include build dependencies (depends: foo {build})
+    @param post include post dependencies (depends: foo {post})
+    @param installed only consider already-installed packages
+    @param unavaiable also consider unavailable packages.
+                      If the availability of packages hasn't been computed yet,
+                      setting this [false] can have a significant performance
+                      impact depending on the platform.
 *)
 val dependencies:
   'a switch_state -> build:bool -> post:bool -> depopts:bool ->
-  installed:bool -> ?unavailable:bool -> package_set -> package_set
+  installed:bool -> unavailable:bool -> package_set -> package_set
 
 (** Same as [dependencies] but for reverse dependencies. *)
 val reverse_dependencies:
   'a switch_state -> build:bool -> post:bool -> depopts:bool ->
-  installed:bool -> ?unavailable:bool -> package_set -> package_set
+  installed:bool -> unavailable:bool -> package_set -> package_set
 
 (** Returns required system packages of each of the given packages (elements are
     not added to the map  if they don't have system dependencies) *)