Add virtual implementation info to lib info
Only support internal vlibs and implementations for now Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
7ecd664785
commit
9b409da352
|
@ -231,8 +231,7 @@ end = struct
|
||||||
|
|
||||||
let make (lib : Library.t) ~dir (modules : Module.Name_map.t)
|
let make (lib : Library.t) ~dir (modules : Module.Name_map.t)
|
||||||
~virtual_modules =
|
~virtual_modules =
|
||||||
let main_module_name =
|
let main_module_name = Library.main_module_name lib in
|
||||||
Module.Name.of_string (Lib_name.Local.to_string lib.name) in
|
|
||||||
let (modules, wrapped_compat) =
|
let (modules, wrapped_compat) =
|
||||||
let wrap_modules modules =
|
let wrap_modules modules =
|
||||||
let open Module.Name.Infix in
|
let open Module.Name.Infix in
|
||||||
|
|
|
@ -916,7 +916,7 @@ module Library = struct
|
||||||
; no_keep_locs : bool
|
; no_keep_locs : bool
|
||||||
; dune_version : Syntax.Version.t
|
; dune_version : Syntax.Version.t
|
||||||
; virtual_modules : Ordered_set_lang.t option
|
; virtual_modules : Ordered_set_lang.t option
|
||||||
; implements : (Loc.t * string) option
|
; implements : (Loc.t * Lib_name.t) option
|
||||||
}
|
}
|
||||||
|
|
||||||
let dparse =
|
let dparse =
|
||||||
|
@ -958,7 +958,7 @@ module Library = struct
|
||||||
and implements =
|
and implements =
|
||||||
field_o "implements" (
|
field_o "implements" (
|
||||||
Syntax.since Variants.syntax (0, 1)
|
Syntax.since Variants.syntax (0, 1)
|
||||||
>>= fun () -> (located string))
|
>>= fun () -> located Lib_name.dparse)
|
||||||
in
|
in
|
||||||
let name =
|
let name =
|
||||||
let open Syntax.Version.Infix in
|
let open Syntax.Version.Infix in
|
||||||
|
@ -993,7 +993,8 @@ module Library = struct
|
||||||
of_sexp_errorf
|
of_sexp_errorf
|
||||||
(Ordered_set_lang.loc virtual_modules
|
(Ordered_set_lang.loc virtual_modules
|
||||||
|> Option.value_exn)
|
|> Option.value_exn)
|
||||||
"A library cannot be both virtual and implement %s" impl);
|
"A library cannot be both virtual and implement %s"
|
||||||
|
(Lib_name.to_string impl));
|
||||||
begin match virtual_modules, wrapped, implements with
|
begin match virtual_modules, wrapped, implements with
|
||||||
| Some _, Some (loc, Wrapped.Simple false), _ ->
|
| Some _, Some (loc, Wrapped.Simple false), _ ->
|
||||||
of_sexp_error loc "A virtual library must be wrapped"
|
of_sexp_error loc "A virtual library must be wrapped"
|
||||||
|
@ -1052,6 +1053,9 @@ module Library = struct
|
||||||
| Some p -> snd p.name
|
| Some p -> snd p.name
|
||||||
|
|
||||||
let is_virtual t = Option.is_some t.virtual_modules
|
let is_virtual t = Option.is_some t.virtual_modules
|
||||||
|
|
||||||
|
let main_module_name t =
|
||||||
|
Module.Name.of_local_lib_name t.name
|
||||||
end
|
end
|
||||||
|
|
||||||
module Install_conf = struct
|
module Install_conf = struct
|
||||||
|
|
|
@ -250,7 +250,7 @@ module Library : sig
|
||||||
; no_keep_locs : bool
|
; no_keep_locs : bool
|
||||||
; dune_version : Syntax.Version.t
|
; dune_version : Syntax.Version.t
|
||||||
; virtual_modules : Ordered_set_lang.t option
|
; virtual_modules : Ordered_set_lang.t option
|
||||||
; implements : (Loc.t * string) option
|
; implements : (Loc.t * Lib_name.t) option
|
||||||
}
|
}
|
||||||
|
|
||||||
val has_stubs : t -> bool
|
val has_stubs : t -> bool
|
||||||
|
@ -259,6 +259,7 @@ module Library : sig
|
||||||
val archive : t -> dir:Path.t -> ext:string -> Path.t
|
val archive : t -> dir:Path.t -> ext:string -> Path.t
|
||||||
val best_name : t -> Lib_name.t
|
val best_name : t -> Lib_name.t
|
||||||
val is_virtual : t -> bool
|
val is_virtual : t -> bool
|
||||||
|
val main_module_name : t -> Module.Name.t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Install_conf : sig
|
module Install_conf : sig
|
||||||
|
|
30
src/lib.ml
30
src/lib.ml
|
@ -82,6 +82,7 @@ type t =
|
||||||
; pps : t list Or_exn.t
|
; pps : t list Or_exn.t
|
||||||
; resolved_selects : Resolved_select.t list
|
; resolved_selects : Resolved_select.t list
|
||||||
; user_written_deps : Dune_file.Lib_deps.t
|
; user_written_deps : Dune_file.Lib_deps.t
|
||||||
|
; implements : t Or_exn.t option
|
||||||
; (* This is mutable to avoid this error:
|
; (* This is mutable to avoid this error:
|
||||||
|
|
||||||
{[
|
{[
|
||||||
|
@ -492,11 +493,33 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
||||||
|
|
||||||
let allow_private_deps = Lib_info.Status.is_private info.status in
|
let allow_private_deps = Lib_info.Status.is_private info.status in
|
||||||
|
|
||||||
|
let resolve (loc, name) =
|
||||||
|
resolve_dep db (name : Lib_name.t) ~allow_private_deps ~loc ~stack in
|
||||||
|
|
||||||
|
let implements = Option.map info.implements ~f:resolve 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
|
||||||
in
|
in
|
||||||
|
let requires =
|
||||||
|
match implements with
|
||||||
|
| None -> requires
|
||||||
|
| Some implements ->
|
||||||
|
implements >>= fun implements ->
|
||||||
|
implements.requires >>= fun irequires ->
|
||||||
|
requires >>| fun requires ->
|
||||||
|
L.remove_dups (List.rev_append irequires requires)
|
||||||
|
in
|
||||||
let ppx_runtime_deps =
|
let ppx_runtime_deps =
|
||||||
resolve_simple_deps db info.ppx_runtime_deps ~allow_private_deps ~stack
|
let ppx_rd =
|
||||||
|
resolve_simple_deps db info.ppx_runtime_deps ~allow_private_deps ~stack in
|
||||||
|
match implements with
|
||||||
|
| None -> ppx_rd
|
||||||
|
| Some implements ->
|
||||||
|
implements >>= fun implements ->
|
||||||
|
implements.ppx_runtime_deps >>= fun ippx_rd ->
|
||||||
|
ppx_rd >>| fun ppx_rd ->
|
||||||
|
L.remove_dups (List.rev_append ippx_rd ppx_rd)
|
||||||
in
|
in
|
||||||
let map_error x =
|
let map_error x =
|
||||||
Result.map_error x ~f:(fun e ->
|
Result.map_error x ~f:(fun e ->
|
||||||
|
@ -504,8 +527,6 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
||||||
in
|
in
|
||||||
let requires = map_error requires in
|
let requires = map_error requires in
|
||||||
let ppx_runtime_deps = map_error ppx_runtime_deps in
|
let ppx_runtime_deps = map_error ppx_runtime_deps in
|
||||||
let resolve (loc, name) =
|
|
||||||
resolve_dep db (name : Lib_name.t) ~allow_private_deps ~loc ~stack in
|
|
||||||
let t =
|
let t =
|
||||||
{ info
|
{ info
|
||||||
; name
|
; name
|
||||||
|
@ -516,6 +537,7 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
||||||
; resolved_selects
|
; resolved_selects
|
||||||
; user_written_deps = Lib_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
|
||||||
|
; implements
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
t.sub_systems <-
|
t.sub_systems <-
|
||||||
|
@ -702,7 +724,7 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack =
|
||||||
in
|
in
|
||||||
(deps, pps, resolved_selects)
|
(deps, pps, resolved_selects)
|
||||||
|
|
||||||
and closure_with_overlap_checks db ts ~stack =
|
and closure_with_overlap_checks db ts ~stack =
|
||||||
let visited = ref Lib_name.Map.empty in
|
let visited = ref Lib_name.Map.empty in
|
||||||
let res = ref [] in
|
let res = ref [] in
|
||||||
let orig_stack = stack in
|
let orig_stack = stack in
|
||||||
|
|
|
@ -41,6 +41,23 @@ module Deps = struct
|
||||||
| Complex l -> l
|
| Complex l -> l
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Virtual = struct
|
||||||
|
module Modules = struct
|
||||||
|
type t =
|
||||||
|
| Unexpanded
|
||||||
|
end
|
||||||
|
|
||||||
|
module Dep_graph = struct
|
||||||
|
type t =
|
||||||
|
| Local
|
||||||
|
end
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ modules : Modules.t
|
||||||
|
; dep_graph : Dep_graph.t
|
||||||
|
}
|
||||||
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ loc : Loc.t
|
{ loc : Loc.t
|
||||||
; kind : Dune_file.Library.Kind.t
|
; kind : Dune_file.Library.Kind.t
|
||||||
|
@ -60,6 +77,8 @@ type t =
|
||||||
; virtual_deps : (Loc.t * Lib_name.t) list
|
; virtual_deps : (Loc.t * Lib_name.t) list
|
||||||
; dune_version : Syntax.Version.t option
|
; dune_version : Syntax.Version.t option
|
||||||
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
||||||
|
; virtual_ : Virtual.t option
|
||||||
|
; implements : (Loc.t * Lib_name.t) option
|
||||||
}
|
}
|
||||||
|
|
||||||
let user_written_deps t =
|
let user_written_deps t =
|
||||||
|
@ -96,6 +115,14 @@ let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) =
|
||||||
:: stubs
|
:: stubs
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
|
let virtual_ =
|
||||||
|
Option.map conf.virtual_modules ~f:(fun _ ->
|
||||||
|
{ Virtual.
|
||||||
|
modules = Virtual.Modules.Unexpanded
|
||||||
|
; dep_graph = Virtual.Dep_graph.Local
|
||||||
|
}
|
||||||
|
)
|
||||||
|
in
|
||||||
{ loc = conf.buildable.loc
|
{ loc = conf.buildable.loc
|
||||||
; kind = conf.kind
|
; kind = conf.kind
|
||||||
; src_dir = dir
|
; src_dir = dir
|
||||||
|
@ -114,6 +141,8 @@ let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) =
|
||||||
; pps = Dune_file.Preprocess_map.pps conf.buildable.preprocess
|
; pps = Dune_file.Preprocess_map.pps conf.buildable.preprocess
|
||||||
; sub_systems = conf.sub_systems
|
; sub_systems = conf.sub_systems
|
||||||
; dune_version = Some conf.dune_version
|
; dune_version = Some conf.dune_version
|
||||||
|
; virtual_
|
||||||
|
; implements = conf.implements
|
||||||
}
|
}
|
||||||
|
|
||||||
let of_findlib_package pkg =
|
let of_findlib_package pkg =
|
||||||
|
@ -144,4 +173,6 @@ let of_findlib_package pkg =
|
||||||
foreign_archives = Mode.Dict.make_both []
|
foreign_archives = Mode.Dict.make_both []
|
||||||
; sub_systems = sub_systems
|
; sub_systems = sub_systems
|
||||||
; dune_version = None
|
; dune_version = None
|
||||||
|
; virtual_ = None
|
||||||
|
; implements = None
|
||||||
}
|
}
|
||||||
|
|
|
@ -21,6 +21,23 @@ module Deps : sig
|
||||||
val of_lib_deps : Dune_file.Lib_deps.t -> t
|
val of_lib_deps : Dune_file.Lib_deps.t -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Virtual : sig
|
||||||
|
module Modules : sig
|
||||||
|
type t = private
|
||||||
|
| Unexpanded
|
||||||
|
end
|
||||||
|
|
||||||
|
module Dep_graph : sig
|
||||||
|
type t = private
|
||||||
|
| Local
|
||||||
|
end
|
||||||
|
|
||||||
|
type t = private
|
||||||
|
{ modules : Modules.t
|
||||||
|
; dep_graph : Dep_graph.t
|
||||||
|
}
|
||||||
|
end
|
||||||
|
|
||||||
type t = private
|
type t = private
|
||||||
{ loc : Loc.t
|
{ loc : Loc.t
|
||||||
; kind : Dune_file.Library.Kind.t
|
; kind : Dune_file.Library.Kind.t
|
||||||
|
@ -40,6 +57,8 @@ type t = private
|
||||||
; virtual_deps : (Loc.t * Lib_name.t) list
|
; virtual_deps : (Loc.t * Lib_name.t) list
|
||||||
; dune_version : Syntax.Version.t option
|
; dune_version : Syntax.Version.t option
|
||||||
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
||||||
|
; virtual_ : Virtual.t option
|
||||||
|
; implements : (Loc.t * Lib_name.t) option
|
||||||
}
|
}
|
||||||
|
|
||||||
val of_library_stanza
|
val of_library_stanza
|
||||||
|
|
|
@ -28,6 +28,9 @@ module Name = struct
|
||||||
module Map = String.Map
|
module Map = String.Map
|
||||||
module Top_closure = Top_closure.String
|
module Top_closure = Top_closure.String
|
||||||
module Infix = Comparable.Operators(T)
|
module Infix = Comparable.Operators(T)
|
||||||
|
|
||||||
|
let of_local_lib_name s =
|
||||||
|
of_string (Lib_name.Local.to_string s)
|
||||||
end
|
end
|
||||||
|
|
||||||
module Syntax = struct
|
module Syntax = struct
|
||||||
|
|
|
@ -24,6 +24,8 @@ module Name : sig
|
||||||
module Top_closure : Top_closure.S with type key := t
|
module Top_closure : Top_closure.S with type key := t
|
||||||
|
|
||||||
module Infix : Comparable.OPS with type t = t
|
module Infix : Comparable.OPS with type t = t
|
||||||
|
|
||||||
|
val of_local_lib_name : Lib_name.Local.t -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Syntax : sig
|
module Syntax : sig
|
||||||
|
|
Loading…
Reference in New Issue