From 9893c145004954042a9af00980069471a923cab9 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 21 Jul 2017 16:52:28 +0100 Subject: [PATCH] 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. --- doc/jbuild.rst | 8 ++--- src/gen_rules.ml | 71 +++++++++++++++++++++++++++----------- src/jbuild.ml | 12 +++++-- src/jbuild.mli | 2 +- src/lib.ml | 45 +++++++++++++----------- src/lib.mli | 15 +++++--- src/merlin.ml | 12 +++---- src/merlin.mli | 2 +- src/module_compilation.ml | 12 +++---- src/module_compilation.mli | 2 -- src/odoc.ml | 2 +- src/super_context.ml | 10 +++--- src/super_context.mli | 1 - 13 files changed, 118 insertions(+), 76 deletions(-) diff --git a/doc/jbuild.rst b/doc/jbuild.rst index e6ef5da8..8b050627 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -82,10 +82,10 @@ modules you want. foo))`` - ``(public_interfaces )`` 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. ```` uses the same `Ordered set - language` than ````. + visible to users of the library. Modules that are not part of this + list will only be visible inside the library itself. + ```` uses the same `Ordered set language` than + ```` and is currently only allowed for public libraries. - ``(libraries ())`` is used to specify the dependencies of the library. See the section about `Library dependencies`_ for more details diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 82b66f03..826bcf6d 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -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 diff --git a/src/jbuild.ml b/src/jbuild.ml index 5bbe3163..2a013d39 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -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 = diff --git a/src/jbuild.mli b/src/jbuild.mli index 0f2505c1..99747006 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -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 diff --git a/src/lib.ml b/src/lib.ml index 2a8a0c52..b3b280a8 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -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 -> diff --git a/src/lib.mli b/src/lib.mli index e677e6e7..dcbbaef3 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -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/" *) + | Install (** use the directory from "_build/install/" *) +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 diff --git a/src/merlin.ml b/src/merlin.ml index 2fbec284..108f300e 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -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) diff --git a/src/merlin.mli b/src/merlin.mli index 28872117..0eadba47 100644 --- a/src/merlin.mli +++ b/src/merlin.mli @@ -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 diff --git a/src/module_compilation.ml b/src/module_compilation.ml index 3d850b9c..b987226a 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -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) diff --git a/src/module_compilation.mli b/src/module_compilation.mli index a1e1da6f..028c774e 100644 --- a/src/module_compilation.mli +++ b/src/module_compilation.mli @@ -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 diff --git a/src/odoc.ml b/src/odoc.ml index af553e10..93c7ea6a 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -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) diff --git a/src/super_context.ml b/src/super_context.ml index 5812f1ae..94d11c6c 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -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 diff --git a/src/super_context.mli b/src/super_context.mli index 74209e2a..ea561e55 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -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