matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge pull request #1209 from rgrinberg/lib-info-mod 

Move Lib.Info to own module
This commit is contained in:
Rudi Grinberg 2018-09-03 16:23:04 +04:00 committed by GitHub
parent 7ae939313b 7f306e3504
commit ede1487d04
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 223 additions and 229 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

228
src/lib.ml
View File

@ -2,196 +2,6 @@ open Import
open! Stdune
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 |
+-----------------------------------------------------------------+ *)
@ -264,7 +74,7 @@ module Id = struct
end
type t =
{ info : Info.t
{ info : Lib_info.t
; name : Lib_name.t
; unique_id : int
; requires : t list Or_exn.t
@ -304,8 +114,8 @@ and error =
and resolve_result =
| Not_found
| Found of Info.t
| Hidden of Info.t * string
| Found of Lib_info.t
| Hidden of Lib_info.t * string
| Redirect of db option * Lib_name.t
and conflict =
@ -635,13 +445,14 @@ module Dep_stack = struct
end
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 (
Private_deps_not_allowed { private_dep = lib ; pd_loc = loc }))
else
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 sexp =
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_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 =
Dep_stack.create_and_push stack name info.src_dir
in
@ -679,7 +490,7 @@ let rec instantiate db name (info : Info.t) ~stack ~hidden =
(* Add [id] to the table, to detect loops *)
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 =
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
; pps
; 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
}
in
@ -787,9 +598,8 @@ and resolve_name db name ~stack =
instantiate db name info ~stack ~hidden:(Some hidden)
and available_internal db (name : Lib_name.t) ~stack =
match resolve_dep db name ~allow_private_deps:true ~loc:Loc.none ~stack with
| Ok _ -> true
| Error _ -> false
resolve_dep db name ~allow_private_deps:true ~loc:Loc.none ~stack
|> Result.is_ok
and resolve_simple_deps db (names : ((Loc.t * Lib_name.t) list)) ~allow_private_deps ~stack =
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)
and resolve_deps db deps ~allow_private_deps ~stack =
match (deps : Info.Deps.t) with
match (deps : Lib_info.Deps.t) with
| Simple names ->
(resolve_simple_deps db names ~allow_private_deps ~stack, [])
| Complex names ->
@ -991,8 +801,8 @@ module DB = struct
module Resolve_result = struct
type t = resolve_result =
| Not_found
| Found of Info.t
| Hidden of Info.t * string
| Found of Lib_info.t
| Hidden of Lib_info.t * string
| Redirect of db option * Lib_name.t
end
@ -1008,7 +818,7 @@ module DB = struct
let create_from_library_stanzas ?parent ~ext_lib stanzas =
let map =
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
| None ->
[Dune_file.Library.best_name conf, Resolve_result.Found info]
@ -1053,18 +863,18 @@ module DB = struct
create ()
~resolve:(fun name ->
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 ->
match e with
| Not_found ->
if external_lib_deps_mode then
Found
(Info.of_findlib_package
(Lib_info.of_findlib_package
(Findlib.dummy_package findlib ~name))
else
Not_found
| Hidden pkg ->
Hidden (Info.of_findlib_package pkg,
Hidden (Lib_info.of_findlib_package pkg,
"unsatisfied 'exist_if'"))
~all:(fun () ->
Findlib.all_packages findlib
@ -1099,7 +909,7 @@ module DB = struct
let resolve_user_written_deps t ?(allow_overlaps=false) deps ~pps =
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
in
let requires =

22
src/lib.mli
View File

@ -37,16 +37,7 @@ module Set : Set.S with type elt = t
module Map : Map.S with type key = t
module Status : sig
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 status : t -> Lib_info.Status.t
val package : t -> Package.Name.t option
@ -87,13 +78,6 @@ module Lib_and_module : sig
end
(** {1 Raw library descriptions} *)
(** Information about a library *)
module Info : sig
type t
end
(** {1 Errors} *)
module Error : sig
@ -215,8 +199,8 @@ module DB : sig
module Resolve_result : sig
type nonrec t =
| Not_found
| Found of Info.t
| Hidden of Info.t * string
| Found of Lib_info.t
| Hidden of Lib_info.t * string
| Redirect of t option * Lib_name.t
end

147
src/lib_info.ml Normal file
View File

@ -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
}

53
src/lib_info.mli Normal file
View File

@ -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

2
src/link_time_code_gen.ml
View File

@ -23,7 +23,7 @@ let libraries_link ~name ~mode cctx libs =
after findlib.dynload a module containing the info *)
let libs =
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
in
let preds = Variant.Set.add Findlib.Package.preds (Mode.variant mode) in