sig
  exception Lexer_error of string
  type basename = OpamFilename.Base.t
  type dirname = OpamFilename.Dir.t
  type filename = OpamFilename.t
  type filename_set = OpamFilename.Set.t
  type 'a filename_map = 'OpamFilename.Map.t
  type generic_file =
    OpamFilename.generic_file =
      D of OpamTypes.dirname
    | F of OpamTypes.filename
  type 'a download =
      Up_to_date of 'a
    | Not_available of string
    | Result of 'a
  val download_dir :
    OpamTypes.dirname OpamTypes.download ->
    OpamTypes.generic_file OpamTypes.download
  val download_file :
    OpamTypes.filename OpamTypes.download ->
    OpamTypes.generic_file OpamTypes.download
  type package = OpamPackage.t
  type package_set = OpamPackage.Set.t
  type 'a package_map = 'OpamPackage.Map.t
  type name = OpamPackage.Name.t
  type name_set = OpamPackage.Name.Set.t
  type 'a name_map = 'OpamPackage.Name.Map.t
  type version = OpamPackage.Version.t
  type version_set = OpamPackage.Version.Set.t
  type compiler = OpamCompiler.t
  type compiler_set = OpamCompiler.Set.t
  type 'a compiler_map = 'OpamCompiler.Map.t
  type compiler_version = OpamCompiler.Version.t
  type opam_version = OpamVersion.t
  type compiler_constraint = OpamCompiler.Version.constr
  type variable = OpamVariable.t
  type full_variable = OpamVariable.Full.t
  type section = OpamVariable.Section.t
  type full_section = OpamVariable.Section.Full.t
  type variable_contents =
    OpamVariable.variable_contents =
      B of bool
    | S of string
  type variable_map = OpamVariable.variable_contents OpamVariable.Map.t
  type ppflag = Camlp4 of string list | Cmd of string list
  type 'a generic_formula =
    'OpamFormula.formula =
      Empty
    | Atom of 'a
    | Block of 'OpamTypes.generic_formula
    | And of 'OpamTypes.generic_formula * 'OpamTypes.generic_formula
    | Or of 'OpamTypes.generic_formula * 'OpamTypes.generic_formula
  type atom = OpamFormula.atom
  type formula = OpamFormula.t
  type 'a conjunction = 'OpamFormula.conjunction
  type 'a disjunction = 'OpamFormula.disjunction
  type repository_name = OpamRepositoryName.t
  type 'a repository_name_map = 'OpamRepositoryName.Map.t
  type repository_kind = [ `darcs | `git | `hg | `http | `local ]
  type address = string * string option
  val string_of_address : OpamTypes.address -> string
  val address_of_string : string -> OpamTypes.address
  val guess_repository_kind :
    OpamTypes.repository_kind option ->
    OpamTypes.address -> OpamTypes.repository_kind
  val string_of_repository_kind :
    [ `darcs | `git | `hg | `http | `local ] -> string
  val repository_kind_of_string :
    string -> [ `darcs | `git | `hg | `http | `local ]
  type repository_root = OpamTypes.dirname
  type repository = {
    repo_root : OpamTypes.repository_root;
    repo_name : OpamTypes.repository_name;
    repo_kind : OpamTypes.repository_kind;
    repo_address : OpamTypes.address;
    repo_priority : int;
  }
  type 'a action =
      To_change of 'a option * 'a
    | To_delete of 'a
    | To_recompile of 'a
  type 'a cause =
      Use of 'a list
    | Required_by of 'a list
    | Upstream_changes
    | Unknown
  val action_contents : 'OpamTypes.action -> 'a
  module type ACTION_GRAPH =
    sig
      type package
      type t
      module V :
        sig
          type t = package action
          val compare : t -> t -> int
          val hash : t -> int
          val equal : t -> t -> bool
          type label
          val create : label -> t
          val label : t -> label
        end
      type vertex = V.t
      module E :
        sig
          type t
          val compare : t -> t -> int
          type vertex = vertex
          val src : t -> vertex
          val dst : t -> vertex
          type label
          val create : vertex -> label -> vertex -> t
          val label : t -> label
        end
      type edge = E.t
      val is_directed : bool
      val is_empty : t -> bool
      val nb_vertex : t -> int
      val nb_edges : t -> int
      val out_degree : t -> vertex -> int
      val in_degree : t -> vertex -> int
      val mem_vertex : t -> vertex -> bool
      val mem_edge : t -> vertex -> vertex -> bool
      val mem_edge_e : t -> edge -> bool
      val find_edge : t -> vertex -> vertex -> edge
      val find_all_edges : t -> vertex -> vertex -> edge list
      val succ : t -> vertex -> vertex list
      val pred : t -> vertex -> vertex list
      val succ_e : t -> vertex -> edge list
      val pred_e : t -> vertex -> edge list
      val iter_vertex : (vertex -> unit) -> t -> unit
      val fold_vertex : (vertex -> '-> 'a) -> t -> '-> 'a
      val iter_edges : (vertex -> vertex -> unit) -> t -> unit
      val fold_edges : (vertex -> vertex -> '-> 'a) -> t -> '-> 'a
      val iter_edges_e : (edge -> unit) -> t -> unit
      val fold_edges_e : (edge -> '-> 'a) -> t -> '-> 'a
      val map_vertex : (vertex -> vertex) -> t -> t
      val iter_succ : (vertex -> unit) -> t -> vertex -> unit
      val iter_pred : (vertex -> unit) -> t -> vertex -> unit
      val fold_succ : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
      val fold_pred : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
      val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
      val fold_succ_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
      val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
      val fold_pred_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
      val create : ?size:int -> unit -> t
      val clear : t -> unit
      val copy : t -> t
      val add_vertex : t -> vertex -> unit
      val remove_vertex : t -> vertex -> unit
      val add_edge : t -> vertex -> vertex -> unit
      val add_edge_e : t -> edge -> unit
      val remove_edge : t -> vertex -> vertex -> unit
      val remove_edge_e : t -> edge -> unit
      type g = t
      val transitive_closure : ?reflexive:bool -> g -> g
      val add_transitive_closure : ?reflexive:bool -> g -> g
      val mirror : g -> g
      val complement : g -> g
      val intersect : g -> g -> g
      val union : g -> g -> g
      module Parallel :
        sig
          module G :
            sig
              type t = t
              module V :
                sig
                  type t = V.t
                  val compare : t -> t -> int
                  val hash : t -> int
                  val equal : t -> t -> bool
                  type label
                  val create : label -> t
                  val label : t -> label
                end
              type vertex = V.t
              module E :
                sig
                  type t
                  val compare : t -> t -> int
                  type vertex = vertex
                  val src : t -> vertex
                  val dst : t -> vertex
                  type label
                  val create : vertex -> label -> vertex -> t
                  val label : t -> label
                end
              type edge = E.t
              val is_directed : bool
              val is_empty : t -> bool
              val nb_vertex : t -> int
              val nb_edges : t -> int
              val out_degree : t -> vertex -> int
              val mem_vertex : t -> vertex -> bool
              val mem_edge : t -> vertex -> vertex -> bool
              val mem_edge_e : t -> edge -> bool
              val find_edge : t -> vertex -> vertex -> edge
              val find_all_edges : t -> vertex -> vertex -> edge list
              val succ : t -> vertex -> vertex list
              val pred : t -> vertex -> vertex list
              val succ_e : t -> vertex -> edge list
              val pred_e : t -> vertex -> edge list
              val fold_vertex : (vertex -> '-> 'a) -> t -> '-> 'a
              val iter_edges : (vertex -> vertex -> unit) -> t -> unit
              val fold_edges :
                (vertex -> vertex -> '-> 'a) -> t -> '-> 'a
              val iter_edges_e : (edge -> unit) -> t -> unit
              val fold_edges_e : (edge -> '-> 'a) -> t -> '-> 'a
              val map_vertex : (vertex -> vertex) -> t -> t
              val iter_pred : (vertex -> unit) -> t -> vertex -> unit
              val fold_succ : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
              val fold_pred : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
              val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
              val fold_succ_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
              val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
              val fold_pred_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
              val create : ?size:int -> unit -> t
              val clear : t -> unit
              val copy : t -> t
              val add_vertex : t -> vertex -> unit
              val remove_vertex : t -> vertex -> unit
              val add_edge : t -> vertex -> vertex -> unit
              val add_edge_e : t -> edge -> unit
              val remove_edge : t -> vertex -> vertex -> unit
              val remove_edge_e : t -> edge -> unit
              val iter_vertex : (V.t -> unit) -> t -> unit
              val iter_succ : (V.t -> unit) -> t -> V.t -> unit
              val in_degree : t -> V.t -> int
              val has_cycle : t -> bool
              val scc_list : t -> V.t list list
              val string_of_vertex : V.t -> string
            end
          val iter :
            int ->
            G.t ->
            pre:(G.V.t -> unit) ->
            child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
          val iter_l :
            int ->
            G.vertex list ->
            pre:(G.V.t -> unit) ->
            child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
          val map_reduce :
            int ->
            G.t ->
            map:(G.V.t -> 'a) -> merge:('-> '-> 'a) -> init:'-> 'a
          val map_reduce_l :
            int ->
            G.vertex list ->
            map:(G.V.t -> 'a) -> merge:('-> '-> 'a) -> init:'-> 'a
          val create : G.V.t list -> G.t
          exception Errors of (G.V.t * OpamParallel.error) list * G.V.t list
          exception Cyclic of G.V.t list list
        end
      module Topological :
        sig
          val iter :
            (OpamTypes.ACTION_GRAPH.package OpamTypes.action -> unit) ->
            t -> unit
          val fold :
            (OpamTypes.ACTION_GRAPH.package OpamTypes.action -> '-> 'a) ->
            t -> '-> 'a
        end
      type solution = {
        to_remove : OpamTypes.ACTION_GRAPH.package list;
        to_process : t;
        root_causes :
          (OpamTypes.ACTION_GRAPH.package *
           OpamTypes.ACTION_GRAPH.package OpamTypes.cause)
          list;
      }
      val dump_solution : OpamTypes.ACTION_GRAPH.solution -> unit
    end
  module type PKG =
    sig
      type t
      val compare : t -> t -> int
      val hash : t -> int
      val equal : t -> t -> bool
      val to_string : t -> string
      val string_of_action :
        ?causes:(t -> t OpamTypes.cause) -> t OpamTypes.action -> string
    end
  module MakeActionGraph :
    functor (Pkg : PKG->
      sig
        type package = Pkg.t
        type t
        module V :
          sig
            type t = package action
            val compare : t -> t -> int
            val hash : t -> int
            val equal : t -> t -> bool
            type label
            val create : label -> t
            val label : t -> label
          end
        type vertex = V.t
        module E :
          sig
            type t
            val compare : t -> t -> int
            type vertex = vertex
            val src : t -> vertex
            val dst : t -> vertex
            type label
            val create : vertex -> label -> vertex -> t
            val label : t -> label
          end
        type edge = E.t
        val is_directed : bool
        val is_empty : t -> bool
        val nb_vertex : t -> int
        val nb_edges : t -> int
        val out_degree : t -> vertex -> int
        val in_degree : t -> vertex -> int
        val mem_vertex : t -> vertex -> bool
        val mem_edge : t -> vertex -> vertex -> bool
        val mem_edge_e : t -> edge -> bool
        val find_edge : t -> vertex -> vertex -> edge
        val find_all_edges : t -> vertex -> vertex -> edge list
        val succ : t -> vertex -> vertex list
        val pred : t -> vertex -> vertex list
        val succ_e : t -> vertex -> edge list
        val pred_e : t -> vertex -> edge list
        val iter_vertex : (vertex -> unit) -> t -> unit
        val fold_vertex : (vertex -> '-> 'a) -> t -> '-> 'a
        val iter_edges : (vertex -> vertex -> unit) -> t -> unit
        val fold_edges : (vertex -> vertex -> '-> 'a) -> t -> '-> 'a
        val iter_edges_e : (edge -> unit) -> t -> unit
        val fold_edges_e : (edge -> '-> 'a) -> t -> '-> 'a
        val map_vertex : (vertex -> vertex) -> t -> t
        val iter_succ : (vertex -> unit) -> t -> vertex -> unit
        val iter_pred : (vertex -> unit) -> t -> vertex -> unit
        val fold_succ : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
        val fold_pred : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
        val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
        val fold_succ_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
        val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
        val fold_pred_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
        val create : ?size:int -> unit -> t
        val clear : t -> unit
        val copy : t -> t
        val add_vertex : t -> vertex -> unit
        val remove_vertex : t -> vertex -> unit
        val add_edge : t -> vertex -> vertex -> unit
        val add_edge_e : t -> edge -> unit
        val remove_edge : t -> vertex -> vertex -> unit
        val remove_edge_e : t -> edge -> unit
        type g = t
        val transitive_closure : ?reflexive:bool -> g -> g
        val add_transitive_closure : ?reflexive:bool -> g -> g
        val mirror : g -> g
        val complement : g -> g
        val intersect : g -> g -> g
        val union : g -> g -> g
        module Parallel :
          sig
            module G :
              sig
                type t = t
                module V :
                  sig
                    type t = V.t
                    val compare : t -> t -> int
                    val hash : t -> int
                    val equal : t -> t -> bool
                    type label
                    val create : label -> t
                    val label : t -> label
                  end
                type vertex = V.t
                module E :
                  sig
                    type t
                    val compare : t -> t -> int
                    type vertex = vertex
                    val src : t -> vertex
                    val dst : t -> vertex
                    type label
                    val create : vertex -> label -> vertex -> t
                    val label : t -> label
                  end
                type edge = E.t
                val is_directed : bool
                val is_empty : t -> bool
                val nb_vertex : t -> int
                val nb_edges : t -> int
                val out_degree : t -> vertex -> int
                val mem_vertex : t -> vertex -> bool
                val mem_edge : t -> vertex -> vertex -> bool
                val mem_edge_e : t -> edge -> bool
                val find_edge : t -> vertex -> vertex -> edge
                val find_all_edges : t -> vertex -> vertex -> edge list
                val succ : t -> vertex -> vertex list
                val pred : t -> vertex -> vertex list
                val succ_e : t -> vertex -> edge list
                val pred_e : t -> vertex -> edge list
                val fold_vertex : (vertex -> '-> 'a) -> t -> '-> 'a
                val iter_edges : (vertex -> vertex -> unit) -> t -> unit
                val fold_edges :
                  (vertex -> vertex -> '-> 'a) -> t -> '-> 'a
                val iter_edges_e : (edge -> unit) -> t -> unit
                val fold_edges_e : (edge -> '-> 'a) -> t -> '-> 'a
                val map_vertex : (vertex -> vertex) -> t -> t
                val iter_pred : (vertex -> unit) -> t -> vertex -> unit
                val fold_succ :
                  (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
                val fold_pred :
                  (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
                val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
                val fold_succ_e :
                  (edge -> '-> 'a) -> t -> vertex -> '-> 'a
                val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
                val fold_pred_e :
                  (edge -> '-> 'a) -> t -> vertex -> '-> 'a
                val create : ?size:int -> unit -> t
                val clear : t -> unit
                val copy : t -> t
                val add_vertex : t -> vertex -> unit
                val remove_vertex : t -> vertex -> unit
                val add_edge : t -> vertex -> vertex -> unit
                val add_edge_e : t -> edge -> unit
                val remove_edge : t -> vertex -> vertex -> unit
                val remove_edge_e : t -> edge -> unit
                val iter_vertex : (V.t -> unit) -> t -> unit
                val iter_succ : (V.t -> unit) -> t -> V.t -> unit
                val in_degree : t -> V.t -> int
                val has_cycle : t -> bool
                val scc_list : t -> V.t list list
                val string_of_vertex : V.t -> string
              end
            val iter :
              int ->
              G.t ->
              pre:(G.V.t -> unit) ->
              child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
            val iter_l :
              int ->
              G.vertex list ->
              pre:(G.V.t -> unit) ->
              child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
            val map_reduce :
              int ->
              G.t ->
              map:(G.V.t -> 'a) -> merge:('-> '-> 'a) -> init:'-> 'a
            val map_reduce_l :
              int ->
              G.vertex list ->
              map:(G.V.t -> 'a) -> merge:('-> '-> 'a) -> init:'-> 'a
            val create : G.V.t list -> G.t
            exception Errors of (G.V.t * OpamParallel.error) list *
                        G.V.t list
            exception Cyclic of G.V.t list list
          end
        module Topological :
          sig
            val iter : (package action -> unit) -> t -> unit
            val fold : (package action -> '-> 'a) -> t -> '-> 'a
          end
        type solution = {
          to_remove : package list;
          to_process : t;
          root_causes : (package * package cause) list;
        }
        val dump_solution : solution -> unit
      end
  module PackageAction :
    sig
      type t = package
      val compare : t -> t -> int
      val hash : t -> int
      val equal : t -> t -> bool
      val to_string : t -> string
      val string_of_action : ?causes:(t -> t cause) -> t action -> string
    end
  module PackageActionGraph :
    sig
      type package = package
      type t
      module V :
        sig
          type t = package action
          val compare : t -> t -> int
          val hash : t -> int
          val equal : t -> t -> bool
          type label
          val create : label -> t
          val label : t -> label
        end
      type vertex = V.t
      module E :
        sig
          type t
          val compare : t -> t -> int
          type vertex = vertex
          val src : t -> vertex
          val dst : t -> vertex
          type label
          val create : vertex -> label -> vertex -> t
          val label : t -> label
        end
      type edge = E.t
      val is_directed : bool
      val is_empty : t -> bool
      val nb_vertex : t -> int
      val nb_edges : t -> int
      val out_degree : t -> vertex -> int
      val in_degree : t -> vertex -> int
      val mem_vertex : t -> vertex -> bool
      val mem_edge : t -> vertex -> vertex -> bool
      val mem_edge_e : t -> edge -> bool
      val find_edge : t -> vertex -> vertex -> edge
      val find_all_edges : t -> vertex -> vertex -> edge list
      val succ : t -> vertex -> vertex list
      val pred : t -> vertex -> vertex list
      val succ_e : t -> vertex -> edge list
      val pred_e : t -> vertex -> edge list
      val iter_vertex : (vertex -> unit) -> t -> unit
      val fold_vertex : (vertex -> '-> 'a) -> t -> '-> 'a
      val iter_edges : (vertex -> vertex -> unit) -> t -> unit
      val fold_edges : (vertex -> vertex -> '-> 'a) -> t -> '-> 'a
      val iter_edges_e : (edge -> unit) -> t -> unit
      val fold_edges_e : (edge -> '-> 'a) -> t -> '-> 'a
      val map_vertex : (vertex -> vertex) -> t -> t
      val iter_succ : (vertex -> unit) -> t -> vertex -> unit
      val iter_pred : (vertex -> unit) -> t -> vertex -> unit
      val fold_succ : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
      val fold_pred : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
      val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
      val fold_succ_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
      val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
      val fold_pred_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
      val create : ?size:int -> unit -> t
      val clear : t -> unit
      val copy : t -> t
      val add_vertex : t -> vertex -> unit
      val remove_vertex : t -> vertex -> unit
      val add_edge : t -> vertex -> vertex -> unit
      val add_edge_e : t -> edge -> unit
      val remove_edge : t -> vertex -> vertex -> unit
      val remove_edge_e : t -> edge -> unit
      type g = t
      val transitive_closure : ?reflexive:bool -> g -> g
      val add_transitive_closure : ?reflexive:bool -> g -> g
      val mirror : g -> g
      val complement : g -> g
      val intersect : g -> g -> g
      val union : g -> g -> g
      module Parallel :
        sig
          module G :
            sig
              type t = t
              module V :
                sig
                  type t = V.t
                  val compare : t -> t -> int
                  val hash : t -> int
                  val equal : t -> t -> bool
                  type label
                  val create : label -> t
                  val label : t -> label
                end
              type vertex = V.t
              module E :
                sig
                  type t
                  val compare : t -> t -> int
                  type vertex = vertex
                  val src : t -> vertex
                  val dst : t -> vertex
                  type label
                  val create : vertex -> label -> vertex -> t
                  val label : t -> label
                end
              type edge = E.t
              val is_directed : bool
              val is_empty : t -> bool
              val nb_vertex : t -> int
              val nb_edges : t -> int
              val out_degree : t -> vertex -> int
              val mem_vertex : t -> vertex -> bool
              val mem_edge : t -> vertex -> vertex -> bool
              val mem_edge_e : t -> edge -> bool
              val find_edge : t -> vertex -> vertex -> edge
              val find_all_edges : t -> vertex -> vertex -> edge list
              val succ : t -> vertex -> vertex list
              val pred : t -> vertex -> vertex list
              val succ_e : t -> vertex -> edge list
              val pred_e : t -> vertex -> edge list
              val fold_vertex : (vertex -> '-> 'a) -> t -> '-> 'a
              val iter_edges : (vertex -> vertex -> unit) -> t -> unit
              val fold_edges :
                (vertex -> vertex -> '-> 'a) -> t -> '-> 'a
              val iter_edges_e : (edge -> unit) -> t -> unit
              val fold_edges_e : (edge -> '-> 'a) -> t -> '-> 'a
              val map_vertex : (vertex -> vertex) -> t -> t
              val iter_pred : (vertex -> unit) -> t -> vertex -> unit
              val fold_succ : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
              val fold_pred : (vertex -> '-> 'a) -> t -> vertex -> '-> 'a
              val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
              val fold_succ_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
              val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
              val fold_pred_e : (edge -> '-> 'a) -> t -> vertex -> '-> 'a
              val create : ?size:int -> unit -> t
              val clear : t -> unit
              val copy : t -> t
              val add_vertex : t -> vertex -> unit
              val remove_vertex : t -> vertex -> unit
              val add_edge : t -> vertex -> vertex -> unit
              val add_edge_e : t -> edge -> unit
              val remove_edge : t -> vertex -> vertex -> unit
              val remove_edge_e : t -> edge -> unit
              val iter_vertex : (V.t -> unit) -> t -> unit
              val iter_succ : (V.t -> unit) -> t -> V.t -> unit
              val in_degree : t -> V.t -> int
              val has_cycle : t -> bool
              val scc_list : t -> V.t list list
              val string_of_vertex : V.t -> string
            end
          val iter :
            int ->
            G.t ->
            pre:(G.V.t -> unit) ->
            child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
          val iter_l :
            int ->
            G.vertex list ->
            pre:(G.V.t -> unit) ->
            child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
          val map_reduce :
            int ->
            G.t ->
            map:(G.V.t -> 'a) -> merge:('-> '-> 'a) -> init:'-> 'a
          val map_reduce_l :
            int ->
            G.vertex list ->
            map:(G.V.t -> 'a) -> merge:('-> '-> 'a) -> init:'-> 'a
          val create : G.V.t list -> G.t
          exception Errors of (G.V.t * OpamParallel.error) list * G.V.t list
          exception Cyclic of G.V.t list list
        end
      module Topological :
        sig
          val iter : (package action -> unit) -> t -> unit
          val fold : (package action -> '-> 'a) -> t -> '-> 'a
        end
      type solution = {
        to_remove : package list;
        to_process : t;
        root_causes : (package * package cause) list;
      }
      val dump_solution : solution -> unit
    end
  type solution = OpamTypes.PackageActionGraph.solution
  type solver_result =
      Nothing_to_do
    | OK of OpamTypes.package OpamTypes.action list
    | Aborted
    | No_solution
    | Error of OpamTypes.package OpamTypes.action list *
        OpamTypes.package OpamTypes.action list *
        OpamTypes.package OpamTypes.action list
  type ('a, 'b) result = Success of '| Conflicts of (unit -> 'b)
  type 'a request = {
    wish_install : 'OpamTypes.conjunction;
    wish_remove : 'OpamTypes.conjunction;
    wish_upgrade : 'OpamTypes.conjunction;
  }
  type user_action =
      Install of OpamTypes.name_set
    | Upgrade of OpamTypes.package_set
    | Reinstall
    | Depends
    | Init of OpamTypes.name_set
    | Remove
    | Switch of OpamTypes.name_set
    | Import of OpamTypes.name_set
  type universe = {
    u_packages : OpamTypes.package_set;
    u_installed : OpamTypes.package_set;
    u_available : OpamTypes.package_set;
    u_depends : OpamTypes.formula OpamTypes.package_map;
    u_depopts : OpamTypes.formula OpamTypes.package_map;
    u_conflicts : OpamTypes.formula OpamTypes.package_map;
    u_action : OpamTypes.user_action;
    u_installed_roots : OpamTypes.package_set;
    u_pinned : OpamTypes.name_set;
  }
  type upload = {
    upl_opam : OpamTypes.filename;
    upl_descr : OpamTypes.filename;
    upl_archive : OpamTypes.filename;
  }
  val string_of_upload : OpamTypes.upload -> string
  type pin_option =
      Version of OpamTypes.version
    | Local of OpamTypes.dirname
    | Git of OpamTypes.address
    | Darcs of OpamTypes.address
    | Hg of OpamTypes.address
    | Unpin
    | Edit
  type pin = {
    pin_package : OpamTypes.name;
    pin_option : OpamTypes.pin_option;
  }
  val string_of_pin : OpamTypes.pin -> string
  type pin_kind = [ `darcs | `git | `hg | `local | `version ]
  val repository_kind_of_pin_kind :
    OpamTypes.pin_kind -> OpamTypes.repository_kind option
  val pin_kind_of_string : string -> OpamTypes.pin_kind
  val string_of_pin_kind : OpamTypes.pin_kind -> string
  val pin_option_of_string :
    ?kind:OpamTypes.pin_kind -> string -> OpamTypes.pin_option
  val string_of_pin_option : OpamTypes.pin_option -> string
  val kind_of_pin_option : OpamTypes.pin_option -> OpamTypes.pin_kind option
  type config = {
    conf_is_rec : bool;
    conf_is_byte : bool;
    conf_is_link : bool;
    conf_options : OpamVariable.Section.Full.t list;
  }
  type shell = [ `bash | `csh | `fish | `sh | `zsh ]
  val string_of_shell : OpamTypes.shell -> string
  type global_config = { complete : bool; switch_eval : bool; }
  type user_config = {
    shell : OpamTypes.shell;
    ocamlinit : bool;
    dot_profile : OpamTypes.filename option;
  }
  type symbol = Eq | Neq | Le | Ge | Lt | Gt
  val string_of_symbol : OpamTypes.symbol -> string
  type filter =
      FBool of bool
    | FString of string
    | FIdent of string
    | FOp of OpamTypes.filter * OpamTypes.symbol * OpamTypes.filter
    | FAnd of OpamTypes.filter * OpamTypes.filter
    | FOr of OpamTypes.filter * OpamTypes.filter
    | FNot of OpamTypes.filter
  val string_of_filter : OpamTypes.filter -> string
  type simple_arg = CString of string | CIdent of string
  type arg = OpamTypes.simple_arg * OpamTypes.filter option
  type command = OpamTypes.arg list * OpamTypes.filter option
  type value =
      Bool of bool
    | Int of int
    | String of string
    | Symbol of string
    | Ident of string
    | List of OpamTypes.value list
    | Group of OpamTypes.value list
    | Option of OpamTypes.value * OpamTypes.value list
  type file_section = {
    section_kind : string;
    section_name : string;
    section_items : OpamTypes.file_item list;
  }
  and file_item =
      Section of OpamTypes.file_section
    | Variable of string * OpamTypes.value
  type file = {
    file_contents : OpamTypes.file_item list;
    file_name : string;
    file_format : OpamTypes.opam_version;
  }
  type switch = OpamSwitch.t
  type switch_set = OpamSwitch.Set.t
  type 'a switch_map = 'OpamSwitch.Map.t
  type lock =
      Read_lock of (unit -> unit)
    | Global_lock of (unit -> unit)
    | Switch_lock of (unit -> unit)
  type file_attribute = OpamFilename.Attribute.t
  type file_attribute_set = OpamFilename.Attribute.Set.t
  type 'a optional = { c : 'a; optional : bool; }
  type stats = {
    s_install : int;
    s_reinstall : int;
    s_upgrade : int;
    s_downgrade : int;
    s_remove : int;
  }
  type env = (string * string) list
  type env_updates = (string * string * string) list
  type tags = OpamMisc.StringSet.t OpamMisc.StringSetMap.t
  type checksums = string list
  type json = OpamJson.t
  type 'a updates = {
    created : 'a;
    updated : 'a;
    deleted : 'a;
    changed : 'a;
  }
end