Merge pull request #1209 from rgrinberg/lib-info-mod
Move Lib.Info to own module
This commit is contained in:
commit
ede1487d04
228
src/lib.ml
228
src/lib.ml
|
@ -2,196 +2,6 @@ open Import
|
||||||
open! Stdune
|
open! Stdune
|
||||||
open Result.O
|
open Result.O
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
|
||||||
| Raw library information |
|
|
||||||
+-----------------------------------------------------------------+ *)
|
|
||||||
|
|
||||||
module Status = struct
|
|
||||||
type t =
|
|
||||||
| Installed
|
|
||||||
| Public of Package.t
|
|
||||||
| Private of Dune_project.Name.t
|
|
||||||
|
|
||||||
let pp ppf t =
|
|
||||||
Format.pp_print_string ppf
|
|
||||||
(match t with
|
|
||||||
| Installed -> "installed"
|
|
||||||
| Public _ -> "public"
|
|
||||||
| Private name ->
|
|
||||||
sprintf "private (%s)" (Dune_project.Name.to_string_hum name))
|
|
||||||
|
|
||||||
let is_private = function
|
|
||||||
| Private _ -> true
|
|
||||||
| Installed | Public _ -> false
|
|
||||||
end
|
|
||||||
|
|
||||||
module Info : sig
|
|
||||||
module Deps : sig
|
|
||||||
type t =
|
|
||||||
| Simple of (Loc.t * Lib_name.t) list
|
|
||||||
| Complex of Dune_file.Lib_dep.t list
|
|
||||||
|
|
||||||
val of_lib_deps : Dune_file.Lib_deps.t -> t
|
|
||||||
end
|
|
||||||
|
|
||||||
type t = private
|
|
||||||
{ loc : Loc.t
|
|
||||||
; kind : Dune_file.Library.Kind.t
|
|
||||||
; status : Status.t
|
|
||||||
; src_dir : Path.t
|
|
||||||
; obj_dir : Path.t
|
|
||||||
; version : string option
|
|
||||||
; synopsis : string option
|
|
||||||
; archives : Path.t list Mode.Dict.t
|
|
||||||
; plugins : Path.t list Mode.Dict.t
|
|
||||||
; foreign_archives : Path.t list Mode.Dict.t (** [.a/.lib/...] files *)
|
|
||||||
; jsoo_runtime : Path.t list
|
|
||||||
; requires : Deps.t
|
|
||||||
; ppx_runtime_deps : (Loc.t * Lib_name.t) list
|
|
||||||
; pps : (Loc.t * Dune_file.Pp.t) list
|
|
||||||
; optional : bool
|
|
||||||
; virtual_deps : (Loc.t * Lib_name.t) list
|
|
||||||
; dune_version : Syntax.Version.t option
|
|
||||||
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
|
||||||
}
|
|
||||||
|
|
||||||
val of_library_stanza
|
|
||||||
: dir:Path.t
|
|
||||||
-> ext_lib:string
|
|
||||||
-> Dune_file.Library.t
|
|
||||||
-> t
|
|
||||||
|
|
||||||
val of_findlib_package : Findlib.Package.t -> t
|
|
||||||
|
|
||||||
val user_written_deps : t -> Dune_file.Lib_deps.t
|
|
||||||
end = struct
|
|
||||||
module Deps = struct
|
|
||||||
type t =
|
|
||||||
| Simple of (Loc.t * Lib_name.t) list
|
|
||||||
| Complex of Dune_file.Lib_dep.t list
|
|
||||||
|
|
||||||
let of_lib_deps deps =
|
|
||||||
let rec loop acc (deps : Dune_file.Lib_dep.t list) =
|
|
||||||
match deps with
|
|
||||||
| [] -> Some (List.rev acc)
|
|
||||||
| Direct x :: deps -> loop (x :: acc) deps
|
|
||||||
| Select _ :: _ -> None
|
|
||||||
in
|
|
||||||
match loop [] deps with
|
|
||||||
| Some l -> Simple l
|
|
||||||
| None -> Complex deps
|
|
||||||
|
|
||||||
let to_lib_deps = function
|
|
||||||
| Simple l -> List.map l ~f:Dune_file.Lib_dep.direct
|
|
||||||
| Complex l -> l
|
|
||||||
end
|
|
||||||
|
|
||||||
type t =
|
|
||||||
{ loc : Loc.t
|
|
||||||
; kind : Dune_file.Library.Kind.t
|
|
||||||
; status : Status.t
|
|
||||||
; src_dir : Path.t
|
|
||||||
; obj_dir : Path.t
|
|
||||||
; version : string option
|
|
||||||
; synopsis : string option
|
|
||||||
; archives : Path.t list Mode.Dict.t
|
|
||||||
; plugins : Path.t list Mode.Dict.t
|
|
||||||
; foreign_archives : Path.t list Mode.Dict.t
|
|
||||||
; jsoo_runtime : Path.t list
|
|
||||||
; requires : Deps.t
|
|
||||||
; ppx_runtime_deps : (Loc.t * Lib_name.t) list
|
|
||||||
; pps : (Loc.t * Dune_file.Pp.t) list
|
|
||||||
; optional : bool
|
|
||||||
; virtual_deps : (Loc.t * Lib_name.t) list
|
|
||||||
; dune_version : Syntax.Version.t option
|
|
||||||
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
|
||||||
}
|
|
||||||
|
|
||||||
let user_written_deps t =
|
|
||||||
List.fold_left (t.virtual_deps @ t.ppx_runtime_deps)
|
|
||||||
~init:(Deps.to_lib_deps t.requires)
|
|
||||||
~f:(fun acc s -> Dune_file.Lib_dep.Direct s :: acc)
|
|
||||||
|
|
||||||
let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) =
|
|
||||||
let archive_file ext =
|
|
||||||
Path.relative dir (Lib_name.Local.to_string conf.name ^ ext) in
|
|
||||||
let archive_files ~f_ext =
|
|
||||||
Mode.Dict.of_func (fun ~mode -> [archive_file (f_ext mode)])
|
|
||||||
in
|
|
||||||
let jsoo_runtime =
|
|
||||||
List.map conf.buildable.js_of_ocaml.javascript_files
|
|
||||||
~f:(Path.relative dir)
|
|
||||||
in
|
|
||||||
let status =
|
|
||||||
match conf.public with
|
|
||||||
| None -> Status.Private (Dune_project.name conf.project)
|
|
||||||
| Some p -> Public p.package
|
|
||||||
in
|
|
||||||
let foreign_archives =
|
|
||||||
let stubs =
|
|
||||||
if Dune_file.Library.has_stubs conf then
|
|
||||||
[Dune_file.Library.stubs_archive conf ~dir ~ext_lib]
|
|
||||||
else
|
|
||||||
[]
|
|
||||||
in
|
|
||||||
{ Mode.Dict.
|
|
||||||
byte = stubs
|
|
||||||
; native =
|
|
||||||
Path.relative dir (Lib_name.Local.to_string conf.name ^ ext_lib)
|
|
||||||
:: stubs
|
|
||||||
}
|
|
||||||
in
|
|
||||||
{ loc = conf.buildable.loc
|
|
||||||
; kind = conf.kind
|
|
||||||
; src_dir = dir
|
|
||||||
; obj_dir = Utils.library_object_directory ~dir conf.name
|
|
||||||
; version = None
|
|
||||||
; synopsis = conf.synopsis
|
|
||||||
; archives = archive_files ~f_ext:Mode.compiled_lib_ext
|
|
||||||
; plugins = archive_files ~f_ext:Mode.plugin_ext
|
|
||||||
; optional = conf.optional
|
|
||||||
; foreign_archives
|
|
||||||
; jsoo_runtime
|
|
||||||
; status
|
|
||||||
; virtual_deps = conf.virtual_deps
|
|
||||||
; requires = Deps.of_lib_deps conf.buildable.libraries
|
|
||||||
; ppx_runtime_deps = conf.ppx_runtime_libraries
|
|
||||||
; pps = Dune_file.Preprocess_map.pps conf.buildable.preprocess
|
|
||||||
; sub_systems = conf.sub_systems
|
|
||||||
; dune_version = Some conf.dune_version
|
|
||||||
}
|
|
||||||
|
|
||||||
let of_findlib_package pkg =
|
|
||||||
let module P = Findlib.Package in
|
|
||||||
let loc = Loc.in_file (Path.to_string (P.meta_file pkg)) in
|
|
||||||
let add_loc x = (loc, x) in
|
|
||||||
let sub_systems =
|
|
||||||
match P.dune_file pkg with
|
|
||||||
| None -> Sub_system_name.Map.empty
|
|
||||||
| Some fn -> Installed_dune_file.load fn
|
|
||||||
in
|
|
||||||
{ loc = loc
|
|
||||||
; kind = Normal
|
|
||||||
; src_dir = P.dir pkg
|
|
||||||
; obj_dir = P.dir pkg
|
|
||||||
; version = P.version pkg
|
|
||||||
; synopsis = P.description pkg
|
|
||||||
; archives = P.archives pkg
|
|
||||||
; plugins = P.plugins pkg
|
|
||||||
; jsoo_runtime = P.jsoo_runtime pkg
|
|
||||||
; requires = Simple (List.map (P.requires pkg) ~f:add_loc)
|
|
||||||
; ppx_runtime_deps = List.map (P.ppx_runtime_deps pkg) ~f:add_loc
|
|
||||||
; pps = []
|
|
||||||
; virtual_deps = []
|
|
||||||
; optional = false
|
|
||||||
; status = Installed
|
|
||||||
; (* We don't know how these are named for external libraries *)
|
|
||||||
foreign_archives = Mode.Dict.make_both []
|
|
||||||
; sub_systems = sub_systems
|
|
||||||
; dune_version = None
|
|
||||||
}
|
|
||||||
end
|
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| Types |
|
| Types |
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
@ -264,7 +74,7 @@ module Id = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ info : Info.t
|
{ info : Lib_info.t
|
||||||
; name : Lib_name.t
|
; name : Lib_name.t
|
||||||
; unique_id : int
|
; unique_id : int
|
||||||
; requires : t list Or_exn.t
|
; requires : t list Or_exn.t
|
||||||
|
@ -304,8 +114,8 @@ and error =
|
||||||
|
|
||||||
and resolve_result =
|
and resolve_result =
|
||||||
| Not_found
|
| Not_found
|
||||||
| Found of Info.t
|
| Found of Lib_info.t
|
||||||
| Hidden of Info.t * string
|
| Hidden of Lib_info.t * string
|
||||||
| Redirect of db option * Lib_name.t
|
| Redirect of db option * Lib_name.t
|
||||||
|
|
||||||
and conflict =
|
and conflict =
|
||||||
|
@ -635,13 +445,14 @@ module Dep_stack = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
let check_private_deps lib ~loc ~allow_private_deps =
|
let check_private_deps lib ~loc ~allow_private_deps =
|
||||||
if (not allow_private_deps) && Status.is_private lib.info.status then
|
if (not allow_private_deps) && Lib_info.Status.is_private lib.info.status
|
||||||
|
then
|
||||||
Result.Error (Error (
|
Result.Error (Error (
|
||||||
Private_deps_not_allowed { private_dep = lib ; pd_loc = loc }))
|
Private_deps_not_allowed { private_dep = lib ; pd_loc = loc }))
|
||||||
else
|
else
|
||||||
Ok lib
|
Ok lib
|
||||||
|
|
||||||
let already_in_table (info : Info.t) name x =
|
let already_in_table (info : Lib_info.t) name x =
|
||||||
let to_sexp = Sexp.To_sexp.(pair Path.to_sexp Lib_name.to_sexp) in
|
let to_sexp = Sexp.To_sexp.(pair Path.to_sexp Lib_name.to_sexp) in
|
||||||
let sexp =
|
let sexp =
|
||||||
match x with
|
match x with
|
||||||
|
@ -670,7 +481,7 @@ let result_of_resolve_status = function
|
||||||
| St_not_found -> Error Error.Library_not_available.Reason.Not_found
|
| St_not_found -> Error Error.Library_not_available.Reason.Not_found
|
||||||
| St_hidden (_, hidden) -> Error (Hidden hidden)
|
| St_hidden (_, hidden) -> Error (Hidden hidden)
|
||||||
|
|
||||||
let rec instantiate db name (info : Info.t) ~stack ~hidden =
|
let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
||||||
let id, stack =
|
let id, stack =
|
||||||
Dep_stack.create_and_push stack name info.src_dir
|
Dep_stack.create_and_push stack name info.src_dir
|
||||||
in
|
in
|
||||||
|
@ -679,7 +490,7 @@ let rec instantiate db name (info : Info.t) ~stack ~hidden =
|
||||||
(* Add [id] to the table, to detect loops *)
|
(* Add [id] to the table, to detect loops *)
|
||||||
Hashtbl.add db.table name (St_initializing id);
|
Hashtbl.add db.table name (St_initializing id);
|
||||||
|
|
||||||
let allow_private_deps = Status.is_private info.status in
|
let allow_private_deps = Lib_info.Status.is_private info.status in
|
||||||
|
|
||||||
let requires, pps, resolved_selects =
|
let requires, pps, resolved_selects =
|
||||||
resolve_user_deps db info.requires ~allow_private_deps ~pps:info.pps ~stack
|
resolve_user_deps db info.requires ~allow_private_deps ~pps:info.pps ~stack
|
||||||
|
@ -703,7 +514,7 @@ let rec instantiate db name (info : Info.t) ~stack ~hidden =
|
||||||
; ppx_runtime_deps
|
; ppx_runtime_deps
|
||||||
; pps
|
; pps
|
||||||
; resolved_selects
|
; resolved_selects
|
||||||
; user_written_deps = Info.user_written_deps info
|
; user_written_deps = Lib_info.user_written_deps info
|
||||||
; sub_systems = Sub_system_name.Map.empty
|
; sub_systems = Sub_system_name.Map.empty
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
|
@ -787,9 +598,8 @@ and resolve_name db name ~stack =
|
||||||
instantiate db name info ~stack ~hidden:(Some hidden)
|
instantiate db name info ~stack ~hidden:(Some hidden)
|
||||||
|
|
||||||
and available_internal db (name : Lib_name.t) ~stack =
|
and available_internal db (name : Lib_name.t) ~stack =
|
||||||
match resolve_dep db name ~allow_private_deps:true ~loc:Loc.none ~stack with
|
resolve_dep db name ~allow_private_deps:true ~loc:Loc.none ~stack
|
||||||
| Ok _ -> true
|
|> Result.is_ok
|
||||||
| Error _ -> false
|
|
||||||
|
|
||||||
and resolve_simple_deps db (names : ((Loc.t * Lib_name.t) list)) ~allow_private_deps ~stack =
|
and resolve_simple_deps db (names : ((Loc.t * Lib_name.t) list)) ~allow_private_deps ~stack =
|
||||||
Result.List.map names ~f:(fun (loc, name) ->
|
Result.List.map names ~f:(fun (loc, name) ->
|
||||||
|
@ -848,7 +658,7 @@ and resolve_complex_deps db deps ~allow_private_deps ~stack =
|
||||||
(res, resolved_selects)
|
(res, resolved_selects)
|
||||||
|
|
||||||
and resolve_deps db deps ~allow_private_deps ~stack =
|
and resolve_deps db deps ~allow_private_deps ~stack =
|
||||||
match (deps : Info.Deps.t) with
|
match (deps : Lib_info.Deps.t) with
|
||||||
| Simple names ->
|
| Simple names ->
|
||||||
(resolve_simple_deps db names ~allow_private_deps ~stack, [])
|
(resolve_simple_deps db names ~allow_private_deps ~stack, [])
|
||||||
| Complex names ->
|
| Complex names ->
|
||||||
|
@ -991,8 +801,8 @@ module DB = struct
|
||||||
module Resolve_result = struct
|
module Resolve_result = struct
|
||||||
type t = resolve_result =
|
type t = resolve_result =
|
||||||
| Not_found
|
| Not_found
|
||||||
| Found of Info.t
|
| Found of Lib_info.t
|
||||||
| Hidden of Info.t * string
|
| Hidden of Lib_info.t * string
|
||||||
| Redirect of db option * Lib_name.t
|
| Redirect of db option * Lib_name.t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -1008,7 +818,7 @@ module DB = struct
|
||||||
let create_from_library_stanzas ?parent ~ext_lib stanzas =
|
let create_from_library_stanzas ?parent ~ext_lib stanzas =
|
||||||
let map =
|
let map =
|
||||||
List.concat_map stanzas ~f:(fun (dir, (conf : Dune_file.Library.t)) ->
|
List.concat_map stanzas ~f:(fun (dir, (conf : Dune_file.Library.t)) ->
|
||||||
let info = Info.of_library_stanza ~dir ~ext_lib conf in
|
let info = Lib_info.of_library_stanza ~dir ~ext_lib conf in
|
||||||
match conf.public with
|
match conf.public with
|
||||||
| None ->
|
| None ->
|
||||||
[Dune_file.Library.best_name conf, Resolve_result.Found info]
|
[Dune_file.Library.best_name conf, Resolve_result.Found info]
|
||||||
|
@ -1053,18 +863,18 @@ module DB = struct
|
||||||
create ()
|
create ()
|
||||||
~resolve:(fun name ->
|
~resolve:(fun name ->
|
||||||
match Findlib.find findlib name with
|
match Findlib.find findlib name with
|
||||||
| Ok pkg -> Found (Info.of_findlib_package pkg)
|
| Ok pkg -> Found (Lib_info.of_findlib_package pkg)
|
||||||
| Error e ->
|
| Error e ->
|
||||||
match e with
|
match e with
|
||||||
| Not_found ->
|
| Not_found ->
|
||||||
if external_lib_deps_mode then
|
if external_lib_deps_mode then
|
||||||
Found
|
Found
|
||||||
(Info.of_findlib_package
|
(Lib_info.of_findlib_package
|
||||||
(Findlib.dummy_package findlib ~name))
|
(Findlib.dummy_package findlib ~name))
|
||||||
else
|
else
|
||||||
Not_found
|
Not_found
|
||||||
| Hidden pkg ->
|
| Hidden pkg ->
|
||||||
Hidden (Info.of_findlib_package pkg,
|
Hidden (Lib_info.of_findlib_package pkg,
|
||||||
"unsatisfied 'exist_if'"))
|
"unsatisfied 'exist_if'"))
|
||||||
~all:(fun () ->
|
~all:(fun () ->
|
||||||
Findlib.all_packages findlib
|
Findlib.all_packages findlib
|
||||||
|
@ -1099,7 +909,7 @@ module DB = struct
|
||||||
|
|
||||||
let resolve_user_written_deps t ?(allow_overlaps=false) deps ~pps =
|
let resolve_user_written_deps t ?(allow_overlaps=false) deps ~pps =
|
||||||
let res, pps, resolved_selects =
|
let res, pps, resolved_selects =
|
||||||
resolve_user_deps t (Info.Deps.of_lib_deps deps) ~pps
|
resolve_user_deps t (Lib_info.Deps.of_lib_deps deps) ~pps
|
||||||
~stack:Dep_stack.empty ~allow_private_deps:true
|
~stack:Dep_stack.empty ~allow_private_deps:true
|
||||||
in
|
in
|
||||||
let requires =
|
let requires =
|
||||||
|
|
22
src/lib.mli
22
src/lib.mli
|
@ -37,16 +37,7 @@ module Set : Set.S with type elt = t
|
||||||
|
|
||||||
module Map : Map.S with type key = t
|
module Map : Map.S with type key = t
|
||||||
|
|
||||||
module Status : sig
|
val status : t -> Lib_info.Status.t
|
||||||
type t =
|
|
||||||
| Installed
|
|
||||||
| Public of Package.t
|
|
||||||
| Private of Dune_project.Name.t
|
|
||||||
|
|
||||||
val pp : t Fmt.t
|
|
||||||
end
|
|
||||||
|
|
||||||
val status : t -> Status.t
|
|
||||||
|
|
||||||
val package : t -> Package.Name.t option
|
val package : t -> Package.Name.t option
|
||||||
|
|
||||||
|
@ -87,13 +78,6 @@ module Lib_and_module : sig
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
(** {1 Raw library descriptions} *)
|
|
||||||
|
|
||||||
(** Information about a library *)
|
|
||||||
module Info : sig
|
|
||||||
type t
|
|
||||||
end
|
|
||||||
|
|
||||||
(** {1 Errors} *)
|
(** {1 Errors} *)
|
||||||
|
|
||||||
module Error : sig
|
module Error : sig
|
||||||
|
@ -215,8 +199,8 @@ module DB : sig
|
||||||
module Resolve_result : sig
|
module Resolve_result : sig
|
||||||
type nonrec t =
|
type nonrec t =
|
||||||
| Not_found
|
| Not_found
|
||||||
| Found of Info.t
|
| Found of Lib_info.t
|
||||||
| Hidden of Info.t * string
|
| Hidden of Lib_info.t * string
|
||||||
| Redirect of t option * Lib_name.t
|
| Redirect of t option * Lib_name.t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,147 @@
|
||||||
|
open Stdune
|
||||||
|
|
||||||
|
module Status = struct
|
||||||
|
type t =
|
||||||
|
| Installed
|
||||||
|
| Public of Package.t
|
||||||
|
| Private of Dune_project.Name.t
|
||||||
|
|
||||||
|
let pp ppf t =
|
||||||
|
Format.pp_print_string ppf
|
||||||
|
(match t with
|
||||||
|
| Installed -> "installed"
|
||||||
|
| Public _ -> "public"
|
||||||
|
| Private name ->
|
||||||
|
sprintf "private (%s)" (Dune_project.Name.to_string_hum name))
|
||||||
|
|
||||||
|
let is_private = function
|
||||||
|
| Private _ -> true
|
||||||
|
| Installed | Public _ -> false
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module Deps = struct
|
||||||
|
type t =
|
||||||
|
| Simple of (Loc.t * Lib_name.t) list
|
||||||
|
| Complex of Dune_file.Lib_dep.t list
|
||||||
|
|
||||||
|
let of_lib_deps deps =
|
||||||
|
let rec loop acc (deps : Dune_file.Lib_dep.t list) =
|
||||||
|
match deps with
|
||||||
|
| [] -> Some (List.rev acc)
|
||||||
|
| Direct x :: deps -> loop (x :: acc) deps
|
||||||
|
| Select _ :: _ -> None
|
||||||
|
in
|
||||||
|
match loop [] deps with
|
||||||
|
| Some l -> Simple l
|
||||||
|
| None -> Complex deps
|
||||||
|
|
||||||
|
let to_lib_deps = function
|
||||||
|
| Simple l -> List.map l ~f:Dune_file.Lib_dep.direct
|
||||||
|
| Complex l -> l
|
||||||
|
end
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ loc : Loc.t
|
||||||
|
; kind : Dune_file.Library.Kind.t
|
||||||
|
; status : Status.t
|
||||||
|
; src_dir : Path.t
|
||||||
|
; obj_dir : Path.t
|
||||||
|
; version : string option
|
||||||
|
; synopsis : string option
|
||||||
|
; archives : Path.t list Mode.Dict.t
|
||||||
|
; plugins : Path.t list Mode.Dict.t
|
||||||
|
; foreign_archives : Path.t list Mode.Dict.t
|
||||||
|
; jsoo_runtime : Path.t list
|
||||||
|
; requires : Deps.t
|
||||||
|
; ppx_runtime_deps : (Loc.t * Lib_name.t) list
|
||||||
|
; pps : (Loc.t * Dune_file.Pp.t) list
|
||||||
|
; optional : bool
|
||||||
|
; virtual_deps : (Loc.t * Lib_name.t) list
|
||||||
|
; dune_version : Syntax.Version.t option
|
||||||
|
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
||||||
|
}
|
||||||
|
|
||||||
|
let user_written_deps t =
|
||||||
|
List.fold_left (t.virtual_deps @ t.ppx_runtime_deps)
|
||||||
|
~init:(Deps.to_lib_deps t.requires)
|
||||||
|
~f:(fun acc s -> Dune_file.Lib_dep.Direct s :: acc)
|
||||||
|
|
||||||
|
let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) =
|
||||||
|
let archive_file ext =
|
||||||
|
Path.relative dir (Lib_name.Local.to_string conf.name ^ ext) in
|
||||||
|
let archive_files ~f_ext =
|
||||||
|
Mode.Dict.of_func (fun ~mode -> [archive_file (f_ext mode)])
|
||||||
|
in
|
||||||
|
let jsoo_runtime =
|
||||||
|
List.map conf.buildable.js_of_ocaml.javascript_files
|
||||||
|
~f:(Path.relative dir)
|
||||||
|
in
|
||||||
|
let status =
|
||||||
|
match conf.public with
|
||||||
|
| None -> Status.Private (Dune_project.name conf.project)
|
||||||
|
| Some p -> Public p.package
|
||||||
|
in
|
||||||
|
let foreign_archives =
|
||||||
|
let stubs =
|
||||||
|
if Dune_file.Library.has_stubs conf then
|
||||||
|
[Dune_file.Library.stubs_archive conf ~dir ~ext_lib]
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
in
|
||||||
|
{ Mode.Dict.
|
||||||
|
byte = stubs
|
||||||
|
; native =
|
||||||
|
Path.relative dir (Lib_name.Local.to_string conf.name ^ ext_lib)
|
||||||
|
:: stubs
|
||||||
|
}
|
||||||
|
in
|
||||||
|
{ loc = conf.buildable.loc
|
||||||
|
; kind = conf.kind
|
||||||
|
; src_dir = dir
|
||||||
|
; obj_dir = Utils.library_object_directory ~dir conf.name
|
||||||
|
; version = None
|
||||||
|
; synopsis = conf.synopsis
|
||||||
|
; archives = archive_files ~f_ext:Mode.compiled_lib_ext
|
||||||
|
; plugins = archive_files ~f_ext:Mode.plugin_ext
|
||||||
|
; optional = conf.optional
|
||||||
|
; foreign_archives
|
||||||
|
; jsoo_runtime
|
||||||
|
; status
|
||||||
|
; virtual_deps = conf.virtual_deps
|
||||||
|
; requires = Deps.of_lib_deps conf.buildable.libraries
|
||||||
|
; ppx_runtime_deps = conf.ppx_runtime_libraries
|
||||||
|
; pps = Dune_file.Preprocess_map.pps conf.buildable.preprocess
|
||||||
|
; sub_systems = conf.sub_systems
|
||||||
|
; dune_version = Some conf.dune_version
|
||||||
|
}
|
||||||
|
|
||||||
|
let of_findlib_package pkg =
|
||||||
|
let module P = Findlib.Package in
|
||||||
|
let loc = Loc.in_file (Path.to_string (P.meta_file pkg)) in
|
||||||
|
let add_loc x = (loc, x) in
|
||||||
|
let sub_systems =
|
||||||
|
match P.dune_file pkg with
|
||||||
|
| None -> Sub_system_name.Map.empty
|
||||||
|
| Some fn -> Installed_dune_file.load fn
|
||||||
|
in
|
||||||
|
{ loc = loc
|
||||||
|
; kind = Normal
|
||||||
|
; src_dir = P.dir pkg
|
||||||
|
; obj_dir = P.dir pkg
|
||||||
|
; version = P.version pkg
|
||||||
|
; synopsis = P.description pkg
|
||||||
|
; archives = P.archives pkg
|
||||||
|
; plugins = P.plugins pkg
|
||||||
|
; jsoo_runtime = P.jsoo_runtime pkg
|
||||||
|
; requires = Simple (List.map (P.requires pkg) ~f:add_loc)
|
||||||
|
; ppx_runtime_deps = List.map (P.ppx_runtime_deps pkg) ~f:add_loc
|
||||||
|
; pps = []
|
||||||
|
; virtual_deps = []
|
||||||
|
; optional = false
|
||||||
|
; status = Installed
|
||||||
|
; (* We don't know how these are named for external libraries *)
|
||||||
|
foreign_archives = Mode.Dict.make_both []
|
||||||
|
; sub_systems = sub_systems
|
||||||
|
; dune_version = None
|
||||||
|
}
|
|
@ -0,0 +1,53 @@
|
||||||
|
(** {1 Raw library descriptions} *)
|
||||||
|
|
||||||
|
open Stdune
|
||||||
|
|
||||||
|
module Status : sig
|
||||||
|
type t =
|
||||||
|
| Installed
|
||||||
|
| Public of Package.t
|
||||||
|
| Private of Dune_project.Name.t
|
||||||
|
|
||||||
|
val pp : t Fmt.t
|
||||||
|
|
||||||
|
val is_private : t -> bool
|
||||||
|
end
|
||||||
|
|
||||||
|
module Deps : sig
|
||||||
|
type t =
|
||||||
|
| Simple of (Loc.t * Lib_name.t) list
|
||||||
|
| Complex of Dune_file.Lib_dep.t list
|
||||||
|
|
||||||
|
val of_lib_deps : Dune_file.Lib_deps.t -> t
|
||||||
|
end
|
||||||
|
|
||||||
|
type t = private
|
||||||
|
{ loc : Loc.t
|
||||||
|
; kind : Dune_file.Library.Kind.t
|
||||||
|
; status : Status.t
|
||||||
|
; src_dir : Path.t
|
||||||
|
; obj_dir : Path.t
|
||||||
|
; version : string option
|
||||||
|
; synopsis : string option
|
||||||
|
; archives : Path.t list Mode.Dict.t
|
||||||
|
; plugins : Path.t list Mode.Dict.t
|
||||||
|
; foreign_archives : Path.t list Mode.Dict.t (** [.a/.lib/...] files *)
|
||||||
|
; jsoo_runtime : Path.t list
|
||||||
|
; requires : Deps.t
|
||||||
|
; ppx_runtime_deps : (Loc.t * Lib_name.t) list
|
||||||
|
; pps : (Loc.t * Dune_file.Pp.t) list
|
||||||
|
; optional : bool
|
||||||
|
; virtual_deps : (Loc.t * Lib_name.t) list
|
||||||
|
; dune_version : Syntax.Version.t option
|
||||||
|
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
||||||
|
}
|
||||||
|
|
||||||
|
val of_library_stanza
|
||||||
|
: dir:Path.t
|
||||||
|
-> ext_lib:string
|
||||||
|
-> Dune_file.Library.t
|
||||||
|
-> t
|
||||||
|
|
||||||
|
val of_findlib_package : Findlib.Package.t -> t
|
||||||
|
|
||||||
|
val user_written_deps : t -> Dune_file.Lib_deps.t
|
|
@ -23,7 +23,7 @@ let libraries_link ~name ~mode cctx libs =
|
||||||
after findlib.dynload a module containing the info *)
|
after findlib.dynload a module containing the info *)
|
||||||
let libs =
|
let libs =
|
||||||
List.filter
|
List.filter
|
||||||
~f:(fun lib -> match Lib.status lib with | Lib.Status.Private _ -> false | _ -> true)
|
~f:(fun lib -> not (Lib_info.Status.is_private (Lib.status lib)))
|
||||||
libs
|
libs
|
||||||
in
|
in
|
||||||
let preds = Variant.Set.add Findlib.Package.preds (Mode.variant mode) in
|
let preds = Variant.Set.add Findlib.Package.preds (Mode.variant mode) in
|
||||||
|
|
Loading…
Reference in New Issue