Introduce multicore parallelism for 40% speed-up on presenting opam install plan

src/client/opamAdminCheck.ml

@@ -62,11 +62,11 @@ let get_universe ~with_test ~with_doc ~dev opams =
     u_reinstall = OpamPackage.Set.empty;
   }
 
-let installability_check univ =
+let installability_check ~task_pool univ =
   let packages = univ.u_packages in
   let graph =
     OpamCudf.Graph.of_universe @@
-    OpamSolver.load_cudf_universe
+    OpamSolver.load_cudf_universe ~task_pool
       ~depopts:false ~build:true ~post:true univ packages ()
   in
   let filter_roots g packages =
@@ -78,7 +78,7 @@ let installability_check univ =
         else acc)
       g OpamPackage.Set.empty
   in
-  let installable = OpamSolver.installable univ in
+  let installable = OpamSolver.installable ~task_pool univ in
   let uninstallable = packages -- installable in
   let unav_roots = filter_roots graph uninstallable in
   unav_roots, uninstallable
@@ -98,9 +98,9 @@ let formula_of_pkglist packages = function
          (OpamPackage.versions_of_packages
             (OpamPackage.Set.of_list nvs)))
 
-let cycle_check univ =
+let cycle_check ~task_pool univ =
   let cudf_univ =
-    OpamSolver.load_cudf_universe
+    OpamSolver.load_cudf_universe ~task_pool
       ~depopts:true ~build:true ~post:false univ univ.u_packages ()
   in
   let graph =
@@ -403,7 +403,7 @@ let get_obsolete univ opams =
       if is_obsolete then acc ++ pkgs else acc)
     aggregates PkgSet.empty
 
-let check ~quiet ~installability ~cycles ~obsolete ~ignore_test repo_root =
+let check ~task_pool ~quiet ~installability ~cycles ~obsolete ~ignore_test repo_root =
   let pkg_prefixes = OpamRepository.packages_with_prefixes repo_root in
   let opams =
     OpamPackage.Map.fold (fun nv prefix acc ->
@@ -431,7 +431,7 @@ let check ~quiet ~installability ~cycles ~obsolete ~ignore_test repo_root =
       if not quiet then
         OpamConsole.msg "Checking installability of every package. This may \
                          take a few minutes...\n";
-      installability_check univ
+      installability_check ~task_pool univ
     )
   in
   if not quiet then
@@ -449,7 +449,7 @@ let check ~quiet ~installability ~cycles ~obsolete ~ignore_test repo_root =
   (* Cyclic dependency checks *)
   let cycle_packages, cycle_formulas =
     if not cycles then PkgSet.empty, []
-    else cycle_check univ
+    else cycle_check ~task_pool univ
   in
   if not quiet && cycle_formulas <> [] then
     (OpamConsole.error "Dependency cycles detected:";

src/client/opamAdminCheck.mli

@@ -13,17 +13,18 @@ open OpamTypes
 (** Analyses a given package universe, and returns
     [uninstallable_roots,uninstallable]. The first is a subset of the second,
     where internal dependents have been removed. *)
-val installability_check: universe -> package_set * package_set
+val installability_check: task_pool:Domainslib.Task.pool -> universe -> package_set * package_set
 
 (** Analyses a universe for dependency cycles. Returns the set of packages
     involved, and the cycles (reduced to formula lists) *)
-val cycle_check: universe -> package_set * formula list list
+val cycle_check: task_pool:Domainslib.Task.pool -> universe -> package_set * formula list list
 
 (** Runs checks on the repository at the given repository. Returns
     [all_packages], [uninstallable_roots], [uninstallable], [cycle_packages],
     [obsolete_packages]. If the corresponding option was disabled, the returned
     sets are empty. *)
 val check:
+  task_pool:Domainslib.Task.pool ->
   quiet:bool -> installability:bool -> cycles:bool -> obsolete:bool ->
   ignore_test:bool ->
   dirname -> package_set * package_set * package_set * package_set * package_set

src/client/opamAdminCommand.ml

@@ -785,6 +785,7 @@ let check_command cli =
   let cmd global_options ignore_test print_short
       installability cycles obsolete () =
     OpamArg.apply_global_options cli global_options;
+    OpamMulticore.run_with_task_pool @@ fun task_pool ->
     let repo_root = checked_repo_root () in
     let installability, cycles, obsolete =
       if installability || cycles || obsolete
@@ -793,7 +794,7 @@ let check_command cli =
     in
     let pkgs, unav_roots, uninstallable, cycle_packages, obsolete =
       OpamAdminCheck.check
-        ~quiet:print_short ~installability ~cycles ~obsolete ~ignore_test
+        ~quiet:print_short ~installability ~cycles ~obsolete ~ignore_test ~task_pool
         repo_root
     in
     let all_ok =
@@ -803,27 +804,27 @@ let check_command cli =
     in
     let open OpamPackage.Set.Op in
     (if print_short then
-       OpamConsole.msg "%s\n"
-         (OpamStd.List.concat_map "\n" OpamPackage.to_string
+      OpamConsole.msg "%s\n"
+        (OpamStd.List.concat_map "\n" OpamPackage.to_string
             (OpamPackage.Set.elements
-               (uninstallable ++ cycle_packages ++ obsolete)))
-     else if all_ok then
-       OpamConsole.msg "No issues detected on this repository's %d packages\n"
-         (OpamPackage.Set.cardinal pkgs)
-     else
-     let pr set msg =
-       if OpamPackage.Set.is_empty set then ""
-       else Printf.sprintf "- %d %s\n" (OpamPackage.Set.cardinal set) msg
-     in
-     OpamConsole.msg "Summary: out of %d packages (%d distinct names)\n\
+              (uninstallable ++ cycle_packages ++ obsolete)))
+    else if all_ok then
+      OpamConsole.msg "No issues detected on this repository's %d packages\n"
+        (OpamPackage.Set.cardinal pkgs)
+    else
+    let pr set msg =
+      if OpamPackage.Set.is_empty set then ""
+      else Printf.sprintf "- %d %s\n" (OpamPackage.Set.cardinal set) msg
+    in
+    OpamConsole.msg "Summary: out of %d packages (%d distinct names)\n\
                       %s%s%s%s\n"
-       (OpamPackage.Set.cardinal pkgs)
-       (OpamPackage.Name.Set.cardinal (OpamPackage.names_of_packages pkgs))
-       (pr unav_roots "uninstallable roots")
-       (pr (uninstallable -- unav_roots) "uninstallable dependent packages")
-       (pr (cycle_packages -- uninstallable)
+      (OpamPackage.Set.cardinal pkgs)
+      (OpamPackage.Name.Set.cardinal (OpamPackage.names_of_packages pkgs))
+      (pr unav_roots "uninstallable roots")
+      (pr (uninstallable -- unav_roots) "uninstallable dependent packages")
+      (pr (cycle_packages -- uninstallable)
           "packages part of dependency cycles")
-       (pr obsolete "obsolete packages"));
+      (pr obsolete "obsolete packages"));
     OpamStd.Sys.exit_because (if all_ok then `Success else `False)
   in
   OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
@@ -898,7 +899,7 @@ let get_virtual_switch_state repo_root env =
   let singl x = OpamRepositoryName.Map.singleton repo.repo_name x in
   let repos_tmp =
     let t = Hashtbl.create 1 in
-    Hashtbl.add t repo.repo_name (lazy repo_root); t
+    Hashtbl.add t repo.repo_name (OpamLazy.create (fun () -> repo_root)); t
   in
   let rt = {
     repos_global = gt;
@@ -912,7 +913,7 @@ let get_virtual_switch_state repo_root env =
     {gt with global_variables =
                OpamVariable.Map.of_list @@
                List.map (fun (var, value) ->
-                   var, (lazy (Some value), "Manually defined"))
+                   var, (OpamLazy.create (fun () -> (Some value)), "Manually defined"))
                  env }
   in
   OpamSwitchState.load_virtual
@@ -944,6 +945,7 @@ let list_command cli =
       global_options package_selection disjunction state_selection
       package_listing env packages () =
     OpamArg.apply_global_options cli global_options;
+    OpamMulticore.run_with_task_pool @@ fun task_pool ->
     let format =
       let force_all_versions =
         match packages with
@@ -954,7 +956,7 @@ let list_command cli =
             | Some (n, _v) -> n
           in
           (try ignore (OpamPackage.Name.of_string nameglob); true
-           with Failure _ -> false)
+          with Failure _ -> false)
         | _ -> false
       in
       package_listing ~force_all_versions
@@ -975,9 +977,9 @@ let list_command cli =
       OpamConsole.msg "# Packages matching: %s\n"
         (OpamListCommand.string_of_formula filter);
     let results =
-      OpamListCommand.filter ~base:st.packages st filter
+      OpamListCommand.filter ~task_pool ~base:st.packages st filter
     in
-    OpamListCommand.display st format results
+    OpamListCommand.display ~task_pool st format results
   in
   OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
   Term.(const cmd $ global_options cli $ OpamArg.package_selection cli $
@@ -1011,6 +1013,7 @@ let filter_command cli =
       global_options package_selection disjunction state_selection env
       remove dryrun packages () =
     OpamArg.apply_global_options cli global_options;
+    OpamMulticore.run_with_task_pool @@ fun task_pool ->
     let repo_root = OpamFilename.cwd () in
     let pattern_selector = OpamListCommand.pattern_selector packages in
     let join =
@@ -1021,15 +1024,15 @@ let filter_command cli =
         Atom state_selection;
         join
           (pattern_selector ::
-           List.map (fun x -> Atom x) package_selection)
+          List.map (fun x -> Atom x) package_selection)
       ]
     in
     let st = get_virtual_switch_state repo_root env in
-    let packages = OpamListCommand.filter ~base:st.packages st filter in
+    let packages = OpamListCommand.filter ~task_pool ~base:st.packages st filter in
     if OpamPackage.Set.is_empty packages then
       if remove then
         (OpamConsole.warning "No packages match the selection criteria";
-         OpamStd.Sys.exit_because `Success)
+        OpamStd.Sys.exit_because `Success)
       else
         OpamConsole.error_and_exit `Not_found
           "No packages match the selection criteria";
@@ -1038,17 +1041,17 @@ let filter_command cli =
     if remove then
       OpamConsole.formatted_msg
         "The following %d packages will be REMOVED from the repository (%d \
-         packages will be kept):\n%s\n"
+        packages will be kept):\n%s\n"
         num_selected (num_total - num_selected)
         (OpamStd.List.concat_map " " OpamPackage.to_string
-           (OpamPackage.Set.elements packages))
+          (OpamPackage.Set.elements packages))
     else
       OpamConsole.formatted_msg
         "The following %d packages will be kept in the repository (%d packages \
-         will be REMOVED):\n%s\n"
+        will be REMOVED):\n%s\n"
         num_selected (num_total - num_selected)
         (OpamStd.List.concat_map " " OpamPackage.to_string
-           (OpamPackage.Set.elements packages));
+          (OpamPackage.Set.elements packages));
     let packages =
       if remove then packages else OpamPackage.Set.Op.(st.packages -- packages)
     in
@@ -1063,9 +1066,9 @@ let filter_command cli =
             OpamConsole.msg "rm -rf %s\n" (OpamFilename.Dir.to_string d)
           else
             (OpamFilename.cleandir d;
-             OpamFilename.rmdir_cleanup d))
+            OpamFilename.rmdir_cleanup d))
       pkg_prefixes
-  in
+in
   OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
   Term.(const cmd $ global_options cli $ OpamArg.package_selection cli $
         or_arg cli $ state_selection_arg cli $ env_arg cli $ remove_arg $

src/client/opamArg.ml

@@ -500,12 +500,12 @@ let apply_global_options cli o =
   let some x = match x with None -> None | some -> Some some in
   let solver =
     if o.use_internal_solver then
-      Some (lazy (OpamCudfSolver.get_solver ~internal:true
+      Some (OpamLazy.create (fun () -> OpamCudfSolver.get_solver ~internal:true
                     OpamCudfSolver.default_solver_selection))
     else
-      o.external_solver >>| fun s -> lazy (OpamCudfSolver.solver_of_string s)
+      o.external_solver >>| fun s -> OpamLazy.create (fun () -> OpamCudfSolver.solver_of_string s)
   in
-  let solver_prefs = o.solver_preferences >>| fun p -> lazy (Some p) in
+  let solver_prefs = o.solver_preferences >>| fun p -> OpamLazy.create (fun () -> Some p) in
   let yes = OpamStd.Option.(map some o.yes) in
   init_opam_env_variabes cli;
   OpamClientConfig.opam_init
@@ -658,14 +658,14 @@ let apply_build_options cli b =
     ();
   OpamStateConfig.update
     (* ?root: -- handled globally *)
-    ?jobs:(b.jobs >>| fun j -> lazy j)
+    ?jobs:(b.jobs >>| fun j -> OpamLazy.create (fun () -> j))
     (* ?dl_jobs:int *)
     (* ?no_base_packages:(flag o.no_base_packages) -- handled globally *)
     ?build_test:(flag b.build_test)
     ?build_doc:(flag b.build_doc)
     ?dev_setup:(flag b.dev_setup)
     ?dryrun:(flag b.dryrun)
-    ?makecmd:(b.make >>| fun m -> lazy m)
+    ?makecmd:(b.make >>| fun m -> OpamLazy.create (fun () -> m))
     ?ignore_constraints_on:
       (b.ignore_constraints_on >>|
        OpamPackage.Name.Set.of_list)

src/client/opamAuxCommands.ml

@@ -380,11 +380,11 @@ let simulate_local_pinnings ?quiet ?(for_view=false) st to_pin =
       OpamPackage.Map.union (fun _ o -> o) st.opams local_opams;
     packages =
       OpamPackage.Set.union st.packages local_packages;
-    available_packages = lazy (
+    available_packages = OpamLazy.create (fun () ->
       OpamPackage.Set.union
         (OpamPackage.Set.filter
            (fun nv -> not (OpamPackage.Name.Set.mem nv.name local_names))
-           (Lazy.force st.available_packages))
+           (OpamLazy.force st.available_packages))
         (OpamSwitchState.compute_available_packages
            st.switch_global st.switch st.switch_config ~pinned
            ~opams:local_opams)
@@ -520,7 +520,7 @@ let check_and_revert_sandboxing root config =
     | None ->
       OpamStd.Option.(Op.(of_Not_found
                             (OpamStd.List.assoc OpamVariable.equal fv)
-                            OpamSysPoll.variables >>= Lazy.force))
+                            OpamSysPoll.variables >>= OpamLazy.force))
   in
   match OpamFilter.commands env sdbx_wrappers with
   | [] -> config

src/client/opamCliMain.ml

@@ -253,7 +253,7 @@ let check_and_run_external_commands () =
           if OpamPackage.Set.is_empty plugins then
             plugins
           else
-            OpamPackage.Set.inter plugins (Lazy.force st.available_packages)
+            OpamPackage.Set.inter plugins (OpamLazy.force st.available_packages)
         in
         let installed = OpamPackage.Set.inter plugins st.installed in
         if OpamPackage.Set.is_empty candidates then (cli, argv)
@@ -299,14 +299,15 @@ let check_and_run_external_commands () =
           OpamSolverConfig.init ();
           OpamClientConfig.init ();
           OpamSwitchState.with_ `Lock_write gt (fun st ->
-              OpamSwitchState.drop @@ (
-              if cmd = None then
-                OpamClient.install st [OpamSolution.eq_atom_of_package nv]
-              else if root_upgraded then
-                OpamClient.reinstall st [OpamSolution.eq_atom_of_package nv]
-              else
-                OpamClient.upgrade st ~all:false [OpamSolution.eq_atom_of_package nv])
-            );
+            OpamMulticore.run_with_task_pool @@ fun task_pool ->
+            OpamSwitchState.drop @@ (
+            if cmd = None then
+              OpamClient.install ~task_pool st [OpamSolution.eq_atom_of_package nv]
+            else if root_upgraded then
+              OpamClient.reinstall ~task_pool st [OpamSolution.eq_atom_of_package nv]
+            else
+              OpamClient.upgrade ~task_pool st ~all:false [OpamSolution.eq_atom_of_package nv])
+          );
           match OpamSystem.resolve_command ~env command with
           | None ->
             OpamConsole.error_and_exit `Package_operation_error
@@ -439,6 +440,7 @@ let rec main_catch_all f =
     exit exit_code
 
 let run () =
+  (*Dose_doseparse.StdDebug.all_enabled ();*)
   OpamStd.Option.iter OpamVersion.set_git OpamGitVersion.version;
   OpamSystem.init ();
   OpamArg.preinit_opam_env_variables ();