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)
|
||||
~virtual_modules =
|
||||
let main_module_name =
|
||||
Module.Name.of_string (Lib_name.Local.to_string lib.name) in
|
||||
let main_module_name = Library.main_module_name lib in
|
||||
let (modules, wrapped_compat) =
|
||||
let wrap_modules modules =
|
||||
let open Module.Name.Infix in
|
||||
|
|
|
@ -916,7 +916,7 @@ module Library = struct
|
|||
; no_keep_locs : bool
|
||||
; dune_version : Syntax.Version.t
|
||||
; virtual_modules : Ordered_set_lang.t option
|
||||
; implements : (Loc.t * string) option
|
||||
; implements : (Loc.t * Lib_name.t) option
|
||||
}
|
||||
|
||||
let dparse =
|
||||
|
@ -958,7 +958,7 @@ module Library = struct
|
|||
and implements =
|
||||
field_o "implements" (
|
||||
Syntax.since Variants.syntax (0, 1)
|
||||
>>= fun () -> (located string))
|
||||
>>= fun () -> located Lib_name.dparse)
|
||||
in
|
||||
let name =
|
||||
let open Syntax.Version.Infix in
|
||||
|
@ -993,7 +993,8 @@ module Library = struct
|
|||
of_sexp_errorf
|
||||
(Ordered_set_lang.loc virtual_modules
|
||||
|> 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
|
||||
| Some _, Some (loc, Wrapped.Simple false), _ ->
|
||||
of_sexp_error loc "A virtual library must be wrapped"
|
||||
|
@ -1052,6 +1053,9 @@ module Library = struct
|
|||
| Some p -> snd p.name
|
||||
|
||||
let is_virtual t = Option.is_some t.virtual_modules
|
||||
|
||||
let main_module_name t =
|
||||
Module.Name.of_local_lib_name t.name
|
||||
end
|
||||
|
||||
module Install_conf = struct
|
||||
|
|
|
@ -250,7 +250,7 @@ module Library : sig
|
|||
; no_keep_locs : bool
|
||||
; dune_version : Syntax.Version.t
|
||||
; virtual_modules : Ordered_set_lang.t option
|
||||
; implements : (Loc.t * string) option
|
||||
; implements : (Loc.t * Lib_name.t) option
|
||||
}
|
||||
|
||||
val has_stubs : t -> bool
|
||||
|
@ -259,6 +259,7 @@ module Library : sig
|
|||
val archive : t -> dir:Path.t -> ext:string -> Path.t
|
||||
val best_name : t -> Lib_name.t
|
||||
val is_virtual : t -> bool
|
||||
val main_module_name : t -> Module.Name.t
|
||||
end
|
||||
|
||||
module Install_conf : sig
|
||||
|
|
30
src/lib.ml
30
src/lib.ml
|
@ -82,6 +82,7 @@ type t =
|
|||
; pps : t list Or_exn.t
|
||||
; resolved_selects : Resolved_select.t list
|
||||
; user_written_deps : Dune_file.Lib_deps.t
|
||||
; implements : t Or_exn.t option
|
||||
; (* 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 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 =
|
||||
resolve_user_deps db info.requires ~allow_private_deps ~pps:info.pps ~stack
|
||||
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 =
|
||||
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
|
||||
let map_error x =
|
||||
Result.map_error x ~f:(fun e ->
|
||||
|
@ -504,8 +527,6 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
|||
in
|
||||
let requires = map_error requires 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 =
|
||||
{ info
|
||||
; name
|
||||
|
@ -516,6 +537,7 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
|||
; resolved_selects
|
||||
; user_written_deps = Lib_info.user_written_deps info
|
||||
; sub_systems = Sub_system_name.Map.empty
|
||||
; implements
|
||||
}
|
||||
in
|
||||
t.sub_systems <-
|
||||
|
@ -702,7 +724,7 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack =
|
|||
in
|
||||
(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 res = ref [] in
|
||||
let orig_stack = stack in
|
||||
|
|
|
@ -41,6 +41,23 @@ module Deps = struct
|
|||
| Complex l -> l
|
||||
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 =
|
||||
{ loc : Loc.t
|
||||
; kind : Dune_file.Library.Kind.t
|
||||
|
@ -60,6 +77,8 @@ type t =
|
|||
; 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
|
||||
; virtual_ : Virtual.t option
|
||||
; implements : (Loc.t * Lib_name.t) option
|
||||
}
|
||||
|
||||
let user_written_deps t =
|
||||
|
@ -96,6 +115,14 @@ let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) =
|
|||
:: stubs
|
||||
}
|
||||
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
|
||||
; kind = conf.kind
|
||||
; 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
|
||||
; sub_systems = conf.sub_systems
|
||||
; dune_version = Some conf.dune_version
|
||||
; virtual_
|
||||
; implements = conf.implements
|
||||
}
|
||||
|
||||
let of_findlib_package pkg =
|
||||
|
@ -144,4 +173,6 @@ let of_findlib_package pkg =
|
|||
foreign_archives = Mode.Dict.make_both []
|
||||
; sub_systems = sub_systems
|
||||
; dune_version = None
|
||||
; virtual_ = None
|
||||
; implements = None
|
||||
}
|
||||
|
|
|
@ -21,6 +21,23 @@ module Deps : sig
|
|||
val of_lib_deps : Dune_file.Lib_deps.t -> t
|
||||
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
|
||||
{ loc : Loc.t
|
||||
; kind : Dune_file.Library.Kind.t
|
||||
|
@ -40,6 +57,8 @@ type t = private
|
|||
; 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
|
||||
; virtual_ : Virtual.t option
|
||||
; implements : (Loc.t * Lib_name.t) option
|
||||
}
|
||||
|
||||
val of_library_stanza
|
||||
|
|
|
@ -28,6 +28,9 @@ module Name = struct
|
|||
module Map = String.Map
|
||||
module Top_closure = Top_closure.String
|
||||
module Infix = Comparable.Operators(T)
|
||||
|
||||
let of_local_lib_name s =
|
||||
of_string (Lib_name.Local.to_string s)
|
||||
end
|
||||
|
||||
module Syntax = struct
|
||||
|
|
|
@ -24,6 +24,8 @@ module Name : sig
|
|||
module Top_closure : Top_closure.S with type key := t
|
||||
|
||||
module Infix : Comparable.OPS with type t = t
|
||||
|
||||
val of_local_lib_name : Lib_name.Local.t -> t
|
||||
end
|
||||
|
||||
module Syntax : sig
|
||||
|
|
Loading…
Reference in New Issue