Fix some problems related to public_interfaces

The dependencies on library artifacts are now properly setup to point
to the files in _build/install/...

Moreorver, private interfaces are now only visible inside the library
itself and are only allowed for private libraries. When a project
defines multiple packages, this ensures that the visibility when all
packages are built simultaneously and when they are installed one by
one.

We can relax these restrictions later with a bit more work and a clear
definition of where private modules should be visible.
This commit is contained in:
Jeremie Dimino 2017-07-21 16:52:28 +01:00
parent cec825bf18
commit 9893c14500
13 changed files with 118 additions and 76 deletions

View File

@ -82,10 +82,10 @@ modules you want.
foo))``
- ``(public_interfaces <modules>)`` specifies the modules that are
user of the library can see. Modules that are not part of this list
will only be visible in the same scope as where the library is
defined. ``<public_interfaces>`` uses the same `Ordered set
language` than ``<modules>``.
visible to users of the library. Modules that are not part of this
list will only be visible inside the library itself.
``<public_interfaces>`` uses the same `Ordered set language` than
``<modules>`` and is currently only allowed for public libraries.
- ``(libraries (<library-dependencies>))`` is used to specify the dependencies
of the library. See the section about `Library dependencies`_ for more details

View File

@ -131,7 +131,7 @@ module Gen(P : Params) = struct
(Dep ctx.ocamlc)
[ As (Utils.g ())
; Dyn (fun (c_flags, libs) ->
S [ Lib.c_include_flags ~context:ctx.name ~scope:lib.scope libs
S [ Lib.c_include_flags ~context:ctx.name ~source_dir:Internal libs
; Arg_spec.quote_args "-ccopt" c_flags
])
; A "-o"; Target dst
@ -159,7 +159,7 @@ module Gen(P : Params) = struct
[ S [A "-I"; Path ctx.stdlib_dir]
; As (SC.cxx_flags sctx)
; Dyn (fun (cxx_flags, libs) ->
S [ Lib.c_include_flags ~context:ctx.name ~scope:lib.scope libs
S [ Lib.c_include_flags ~context:ctx.name ~source_dir:Internal libs
; As cxx_flags
])
; A "-o"; Target dst
@ -268,15 +268,14 @@ module Gen(P : Params) = struct
let dynlink = lib.dynlink in
let js_of_ocaml = lib.buildable.js_of_ocaml in
Module_compilation.build_modules sctx
~js_of_ocaml ~dynlink ~flags ~scope:lib.scope ~dir ~dep_graph ~modules ~requires ~alias_module;
~js_of_ocaml ~dynlink ~flags ~dir ~dep_graph ~modules ~requires ~alias_module;
Option.iter alias_module ~f:(fun m ->
let flags = Ocaml_flags.default () in
Module_compilation.build_module sctx m
~js_of_ocaml
~js_of_ocaml
~dynlink
~sandbox:alias_module_build_sandbox
~flags:{ flags with common = flags.common @ ["-w"; "-49"] }
~scope:lib.scope
~dir
~modules:(String_map.singleton m.name m)
~dep_graph:(Ml_kind.Dict.make_both (Build.return (String_map.singleton m.name [])))
@ -350,17 +349,46 @@ module Gen(P : Params) = struct
end
end;
List.iter Cm_kind.all ~f:(fun cm_kind ->
let files =
String_map.fold modules ~init:[] ~f:(fun ~key:_ ~data:m acc ->
Module.cm_file m ~dir cm_kind :: acc)
(* Setup artifact aliases for users of the library *)
begin
(* If the library is public, users of the library read the files from
"_build/install/..." *)
let artifact_dir, modules =
match lib.public with
| None -> dir, modules
| Some { package; sub_dir; _ } ->
let dir =
let install_dir = Config.local_install_dir ~context:ctx.name in
let dir = Path.append install_dir (Install.lib_install_path ~package) in
match sub_dir with
| None -> dir
| Some s -> Path.relative dir s
in
let modules =
if Ordered_set_lang.is_standard lib.public_interfaces then
modules
else
let public_interfaces =
Ordered_set_lang.eval_with_standard lib.public_interfaces
~standard:(String_map.keys modules)
|> String_set.of_list
in
String_map.filter modules ~f:(fun m _ -> String_set.mem m public_interfaces)
in
(dir, modules)
in
SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:(Cm_kind.ext cm_kind)
files);
SC.Libs.setup_file_deps_group_alias sctx (dir, lib) ~exts:[".cmi"; ".cmx"];
SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:".h"
(List.map lib.install_c_headers ~f:(fun header ->
Path.relative dir (header ^ ".h")));
List.iter Cm_kind.all ~f:(fun cm_kind ->
let files =
String_map.fold modules ~init:[] ~f:(fun ~key:_ ~data:m acc ->
Module.cm_file m ~dir:artifact_dir cm_kind :: acc)
in
SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:(Cm_kind.ext cm_kind)
files);
SC.Libs.setup_file_deps_group_alias sctx (dir, lib) ~exts:[".cmi"; ".cmx"];
SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:".h"
(List.map lib.install_c_headers ~f:(fun header ->
Path.relative artifact_dir (header ^ ".h")));
end;
List.iter Mode.all ~f:(fun mode ->
build_lib lib ~flags ~dir ~mode ~modules ~dep_graph);
@ -413,7 +441,7 @@ module Gen(P : Params) = struct
| Executables stuff |
+-----------------------------------------------------------------+ *)
let build_exe ~js_of_ocaml ~flags ~scope ~dir ~requires ~name ~mode ~modules ~dep_graph
let build_exe ~js_of_ocaml ~flags ~dir ~requires ~name ~mode ~modules ~dep_graph
~link_flags ~force_custom_bytecode =
let exe_ext = Mode.exe_ext mode in
let mode, link_flags, compiler =
@ -443,7 +471,8 @@ module Gen(P : Params) = struct
[ Ocaml_flags.get flags mode
; A "-o"; Target exe
; As link_flags
; Dyn (fun (libs, _) -> Lib.link_flags libs ~context:ctx.name ~scope ~mode)
; Dyn (fun (libs, _) -> Lib.link_flags libs ~context:ctx.name
~source_dir:Internal ~mode)
; Dyn (fun (_, cm_files) -> Deps cm_files)
]);
if mode = Mode.Byte then
@ -489,12 +518,12 @@ module Gen(P : Params) = struct
(* CR-someday jdimino: this should probably say [~dynlink:false] *)
Module_compilation.build_modules sctx
~js_of_ocaml:exes.buildable.js_of_ocaml
~dynlink:true ~flags ~scope ~dir ~dep_graph ~modules
~dynlink:true ~flags ~dir ~dep_graph ~modules
~requires ~alias_module:None;
List.iter exes.names ~f:(fun name ->
List.iter Mode.all ~f:(fun mode ->
build_exe ~js_of_ocaml:exes.buildable.js_of_ocaml ~flags ~scope ~dir ~requires ~name
build_exe ~js_of_ocaml:exes.buildable.js_of_ocaml ~flags ~dir ~requires ~name
~mode ~modules ~dep_graph ~link_flags:exes.link_flags
~force_custom_bytecode:(mode = Native && not exes.modes.native)));
{ Merlin.
@ -700,7 +729,7 @@ Add it to your jbuild file to remove this warning.
Some (executables_rules exes ~dir ~all_modules:(Lazy.force all_modules)
~scope)
| _ -> None)
|> Merlin.add_rules sctx ~scope ~dir:ctx_dir
|> Merlin.add_rules sctx ~dir:ctx_dir
let () = List.iter (SC.stanzas sctx) ~f:rules
let () =
@ -904,7 +933,7 @@ Add it to your jbuild file to remove this warning.
in
let ppx_exe =
SC.PP.get_ppx_driver sctx pps
~scope:lib.scope ~dir ~dep_kind:(if lib.optional then Build.Optional else Required)
~dir ~dep_kind:(if lib.optional then Build.Optional else Required)
in
[ppx_exe]
in

View File

@ -545,7 +545,7 @@ module Library = struct
; optional : bool
; buildable : Buildable.t
; dynlink : bool
; public_interfaces : Ordered_set_lang.t
; public_interfaces : Ordered_set_lang.t
}
let v1 pkgs =
@ -569,7 +569,12 @@ module Library = struct
field_b "optional" >>= fun optional ->
field "self_build_stubs_archive" (option string) ~default:None >>= fun self_build_stubs_archive ->
field_b "no_dynlink" >>= fun no_dynlink ->
field_osl "public_interfaces" >>= fun public_interfaces ->
map_validate (field_o "public_interfaces" Ordered_set_lang.t) ~f:(fun public_interfaces ->
match public_interfaces, public with
| Some _, None ->
Error "Field 'public_interfaces' is not allowed for private libraries."
| _ -> Ok public_interfaces)
>>= fun public_interfaces ->
return
{ name
; scope = pkgs
@ -591,7 +596,8 @@ module Library = struct
; optional
; buildable
; dynlink = not no_dynlink
; public_interfaces
; public_interfaces =
Option.value public_interfaces ~default:Ordered_set_lang.standard
})
let has_stubs t =

View File

@ -151,7 +151,7 @@ module Library : sig
; optional : bool
; buildable : Buildable.t
; dynlink : bool
; public_interfaces : Ordered_set_lang.t
; public_interfaces : Ordered_set_lang.t
}
val has_stubs : t -> bool

View File

@ -22,36 +22,39 @@ end
include T
module Set = Set.Make(T)
let dir ~context ~scope = function
| Internal (dir, lib) ->
if Jbuild.Scope.compare scope lib.scope = 0 then
dir
else begin
match lib.public with
| Some {sub_dir; package; _} ->
module Source_dir = struct
type t =
| Internal
| Install
end
let dir ~context ~source_dir = function
| Internal (dir, lib) -> begin
match lib.public, (source_dir : Source_dir.t) with
| None, _ | _, Internal ->
dir
| Some { package; sub_dir; _ }, Install ->
let install_dir = Config.local_install_dir ~context in
Path.relative
(Path.append install_dir (Install.lib_install_path ~package))
(Option.value ~default:"" sub_dir)
| _ ->
code_errorf "The non public library %s is accessed in %s outside its scope."
lib.name (Jbuild.Scope.name scope)
let dir = Path.append install_dir (Install.lib_install_path ~package) in
match sub_dir with
| None -> dir
| Some x -> Path.relative dir x
end
| External pkg -> pkg.dir
let include_paths ~context ~scope ts =
let include_paths ~context ~source_dir ts =
List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t ->
Path.Set.add (dir ~context ~scope t) acc)
Path.Set.add (dir ~context ~source_dir t) acc)
let include_flags ~context ~scope ts =
let dirs = include_paths ~context ~scope ts in
let include_flags ~context ~source_dir ts =
let dirs = include_paths ~context ~source_dir ts in
Arg_spec.S (List.concat_map (Path.Set.elements dirs) ~f:(fun dir ->
[Arg_spec.A "-I"; Path dir]))
let c_include_flags ~context ~scope ts =
let c_include_flags ~context ~source_dir ts =
let dirs =
List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t ->
Path.Set.add (dir ~context ~scope t) acc)
Path.Set.add (dir ~context ~source_dir t) acc)
in
Arg_spec.S (List.concat_map (Path.Set.elements dirs) ~f:(fun dir ->
[Arg_spec.A "-I"; Path dir]))
@ -65,9 +68,9 @@ let describe = function
| External pkg ->
sprintf "%s (external)" pkg.name
let link_flags ~context ~scope ts ~mode =
let link_flags ~context ~source_dir ts ~mode =
Arg_spec.S
(include_flags ~context ~scope ts ::
(include_flags ~context ~source_dir ts ::
List.map ts ~f:(fun t ->
match t with
| External pkg ->

View File

@ -12,28 +12,35 @@ module Set : Set.S with type elt := t
(*val deps : t -> string list*)
module Source_dir : sig
(** Which include directory to use for internal public libraries *)
type t =
| Internal (** use the directory from "_build/<context>" *)
| Install (** use the directory from "_build/install/<context>" *)
end
(** The scope given is the current one *)
val include_paths
: context:string
-> scope:Jbuild.Scope.t
-> source_dir:Source_dir.t
-> t list
-> Path.Set.t
val include_flags
: context:string
-> scope:Jbuild.Scope.t
-> source_dir:Source_dir.t
-> t list
-> _ Arg_spec.t
val c_include_flags
: context:string
-> scope:Jbuild.Scope.t
-> source_dir:Source_dir.t
-> t list
-> _ Arg_spec.t
val link_flags
: context:string
-> scope:Jbuild.Scope.t
-> source_dir:Source_dir.t
-> t list
-> mode:Mode.t
-> _ Arg_spec.t

View File

@ -11,10 +11,10 @@ type t =
; libname : string option
}
let ppx_flags sctx ~scope ~dir ~src_dir { preprocess; libname; _ } =
let ppx_flags sctx ~dir ~src_dir { preprocess; libname; _ } =
match preprocess with
| Pps { pps; flags } ->
let exe = SC.PP.get_ppx_driver sctx pps ~scope ~dir ~dep_kind:Optional in
let exe = SC.PP.get_ppx_driver sctx pps ~dir ~dep_kind:Optional in
let command =
List.map (Path.reach exe ~from:src_dir
:: "--as-ppx"
@ -26,7 +26,7 @@ let ppx_flags sctx ~scope ~dir ~src_dir { preprocess; libname; _ } =
[sprintf "FLG -ppx \"%s\"" command]
| _ -> []
let dot_merlin sctx ~scope ~dir ({ requires; flags; _ } as t) =
let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
match Path.extract_build_context dir with
| Some (_, remaindir) ->
let path = Path.relative remaindir ".merlin" in
@ -37,7 +37,7 @@ let dot_merlin sctx ~scope ~dir ({ requires; flags; _ } as t) =
SC.add_rule sctx (
requires
>>^ (fun libs ->
let ppx_flags = ppx_flags sctx ~scope ~dir ~src_dir:remaindir t in
let ppx_flags = ppx_flags sctx ~dir ~src_dir:remaindir t in
let internals, externals =
List.fold_left libs ~init:([], []) ~f:(fun (internals, externals) ->
function
@ -94,8 +94,8 @@ let merge_two a b =
| None -> b.libname
}
let add_rules sctx ~scope ~dir ts =
let add_rules sctx ~dir ts =
if (SC.context sctx).merlin then
match ts with
| [] -> ()
| t :: ts -> dot_merlin sctx ~scope ~dir (List.fold_left ts ~init:t ~f:merge_two)
| t :: ts -> dot_merlin sctx ~dir (List.fold_left ts ~init:t ~f:merge_two)

View File

@ -8,4 +8,4 @@ type t =
}
(** Add rules for generating the .merlin in a directory *)
val add_rules : Super_context.t -> scope:Jbuild.Scope.t -> dir:Path.t -> t list -> unit
val add_rules : Super_context.t -> dir:Path.t -> t list -> unit

View File

@ -5,7 +5,7 @@ open! No_io
module SC = Super_context
let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_graph)
~requires ~(modules : Module.t String_map.t) ~scope ~dir ~alias_module (m : Module.t) =
~requires ~(modules : Module.t String_map.t) ~dir ~alias_module (m : Module.t) =
let ctx = SC.context sctx in
Option.iter (Mode.of_cm_kind cm_kind |> Context.compiler ctx) ~f:(fun compiler ->
Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src ->
@ -66,7 +66,7 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_gra
~extra_targets
[ Ocaml_flags.get_for_cm flags ~cm_kind
; cmt_args
; Dyn (Lib.include_flags ~context:ctx.name ~scope)
; Dyn (Lib.include_flags ~context:ctx.name ~source_dir:Install)
; As extra_args
; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink"
; A "-no-alias-deps"
@ -78,17 +78,17 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_gra
; A "-c"; Ml_kind.flag ml_kind; Dep src
])))
let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~scope ~dir ~dep_graph
let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~dir ~dep_graph
~modules ~requires ~alias_module =
List.iter Cm_kind.all ~f:(fun cm_kind ->
let requires = Cm_kind.Dict.get requires cm_kind in
build_cm sctx ?sandbox ~dynlink ~flags ~scope ~dir ~dep_graph ~modules m ~cm_kind
build_cm sctx ?sandbox ~dynlink ~flags ~dir ~dep_graph ~modules m ~cm_kind
~requires ~alias_module);
(* Build *.cmo.js *)
let src = Module.cm_file m ~dir Cm_kind.Cmo in
SC.add_rules sctx (Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml ~src)
let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~scope ~dir ~dep_graph ~modules ~requires
let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~dir ~dep_graph ~modules ~requires
~alias_module =
let cmi_requires =
Build.memoize "cmi library dependencies"
@ -113,5 +113,5 @@ let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~scope ~dir ~dep_graph ~modu
| None -> modules
| Some (m : Module.t) -> String_map.remove m.name modules)
~f:(fun ~key:_ ~data:m ->
build_module sctx m ~dynlink ~js_of_ocaml ~flags ~scope ~dir ~dep_graph ~modules ~requires
build_module sctx m ~dynlink ~js_of_ocaml ~flags ~dir ~dep_graph ~modules ~requires
~alias_module)

View File

@ -13,7 +13,6 @@ val build_module
-> js_of_ocaml:Jbuild.Js_of_ocaml.t
-> flags:Ocaml_flags.t
-> Module.t
-> scope:Jbuild.Scope.t
-> dir:Path.t
-> dep_graph:Ocamldep.dep_graph
-> modules:Module.t String_map.t
@ -27,7 +26,6 @@ val build_modules
-> dynlink:bool
-> js_of_ocaml:Jbuild.Js_of_ocaml.t
-> flags:Ocaml_flags.t
-> scope:Jbuild.Scope.t
-> dir:Path.t
-> dep_graph:Ocamldep.dep_graph
-> modules:Module.t String_map.t

View File

@ -134,7 +134,7 @@ let setup_library_rules sctx (lib : Library.t) ~dir ~modules ~requires
(requires
>>>
SC.Libs.file_deps sctx ~ext:odoc_ext
>>^ Lib.include_flags ~context:context.name ~scope:lib.scope)
>>^ Lib.include_flags ~context:context.name ~source_dir:Internal)
in
let modules_and_odoc_files =
List.map (String_map.values modules)

View File

@ -724,7 +724,7 @@ module PP = struct
let migrate_driver_main = "ocaml-migrate-parsetree.driver-main"
let build_ppx_driver sctx ~scope ~dir ~dep_kind ~target pp_names ~driver =
let build_ppx_driver sctx ~dir ~dep_kind ~target pp_names ~driver =
let ctx = sctx.context in
let mode = Context.best_mode ctx in
let compiler = Option.value_exn (Context.compiler ctx mode) in
@ -786,10 +786,10 @@ module PP = struct
>>>
Build.run ~context:ctx (Dep compiler)
[ A "-o" ; Target target
; Dyn (Lib.link_flags ~context:ctx.name ~scope ~mode)
; Dyn (Lib.link_flags ~context:ctx.name ~source_dir:Internal ~mode)
])
let get_ppx_driver sctx pps ~scope ~dir ~dep_kind =
let get_ppx_driver sctx pps ~dir ~dep_kind =
let driver, names =
match List.rev_map pps ~f:Pp.to_string with
| [] -> (None, [])
@ -806,7 +806,7 @@ module PP = struct
| None ->
let ppx_dir = Path.relative sctx.ppx_dir key in
let exe = Path.relative ppx_dir "ppx.exe" in
build_ppx_driver sctx names ~scope ~dir ~dep_kind ~target:exe ~driver;
build_ppx_driver sctx names ~dir ~dep_kind ~target:exe ~driver;
Hashtbl.add sctx.ppx_drivers ~key ~data:exe;
exe
@ -878,7 +878,7 @@ module PP = struct
~targets:(Static [dst])
~scope))
| Pps { pps; flags } ->
let ppx_exe = get_ppx_driver sctx pps ~scope ~dir ~dep_kind in
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
pped_module m ~dir ~f:(fun kind src dst ->
add_rule sctx
(preprocessor_deps

View File

@ -158,7 +158,6 @@ module PP : sig
val get_ppx_driver
: t
-> Pp.t list
-> scope:Scope.t
-> dir:Path.t
-> dep_kind:Build.lib_dep_kind
-> Path.t