From 4d587cce80ac247f853c4fb08dd37d01b58ca7a1 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 27 Mar 2019 20:47:23 +0700 Subject: [PATCH 1/6] Distinguish between external/local obj_dirs These have a slightly different format and we should just make that explicit. Signed-off-by: Rudi Grinberg --- src/dir_contents.ml | 2 +- src/dune_file.ml | 2 +- src/dune_package.ml | 3 +- src/lib_info.ml | 2 +- src/lib_modules.ml | 6 +- src/lib_modules.mli | 2 +- src/module.ml | 9 +- src/module.mli | 2 +- src/obj_dir.ml | 294 ++++++++++++++++++++++++++------------------ src/obj_dir.mli | 2 +- 10 files changed, 190 insertions(+), 134 deletions(-) diff --git a/src/dir_contents.ml b/src/dir_contents.ml index 690c2f9c68b..aa70e216aec 100644 --- a/src/dir_contents.ml +++ b/src/dir_contents.ml @@ -29,7 +29,7 @@ module Modules = struct match (stanza : Stanza.t) with | Library lib -> let obj_dir = - Obj_dir.make_local ~dir:d.ctx_dir (snd lib.name) + Obj_dir.make_lib ~dir:d.ctx_dir (snd lib.name) ~has_private_modules:(Option.is_some lib.private_modules) in let modules = diff --git a/src/dune_file.ml b/src/dune_file.ml index 97f4e5176b4..220eccfb5cb 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -1059,7 +1059,7 @@ module Library = struct let is_impl t = Option.is_some t.implements let obj_dir ~dir t = - Obj_dir.make_local ~dir + Obj_dir.make_lib ~dir ~has_private_modules:(t.private_modules <> None) (snd t.name) diff --git a/src/dune_package.ml b/src/dune_package.ml index edf3d520916..a337cc61656 100644 --- a/src/dune_package.ml +++ b/src/dune_package.ml @@ -135,6 +135,7 @@ module Lib = struct >>= fun default_implementation -> field "name" Lib_name.decode >>= fun name -> let dir = Path.append_local base (dir_of_name name) in + let obj_dir = Obj_dir.make_external ~dir in let+ synopsis = field_o "synopsis" string and+ loc = loc and+ modes = field_l "modes" Mode.decode @@ -150,7 +151,7 @@ module Lib = struct and+ sub_systems = Sub_system_info.record_parser () and+ orig_src_dir = field_o "orig_src_dir" path and+ modules = field_o "modules" (Lib_modules.decode - ~implements:(Option.is_some implements) ~dir) + ~implements:(Option.is_some implements) ~obj_dir) in let modes = Mode.Dict.Set.of_list modes in { kind diff --git a/src/lib_info.ml b/src/lib_info.ml index df3dd1b9e83..f974b501839 100644 --- a/src/lib_info.ml +++ b/src/lib_info.ml @@ -88,7 +88,7 @@ let of_library_stanza ~dir ~has_native ~ext_lib ~ext_obj (conf : Dune_file.Library.t) = let (_loc, lib_name) = conf.name in let obj_dir = - Obj_dir.make_local ~dir + Obj_dir.make_lib ~dir ~has_private_modules:(conf.private_modules <> None) lib_name in let gen_archive_file ~dir ext = Path.relative dir (Lib_name.Local.to_string lib_name ^ ext) in diff --git a/src/lib_modules.ml b/src/lib_modules.ml index 583ca5550d3..b7de8bbc4dc 100644 --- a/src/lib_modules.ml +++ b/src/lib_modules.ml @@ -228,13 +228,13 @@ let encode ; field "wrapped" Wrapped.encode wrapped ] -let decode ~implements ~dir = +let decode ~implements ~obj_dir = let open Stanza.Decoder in fields ( - let+ alias_module = field_o "alias_module" (Module.decode ~dir) + let+ alias_module = field_o "alias_module" (Module.decode ~obj_dir) and+ main_module_name = field_o "main_module_name" Module.Name.decode and+ modules = - field ~default:[] "modules" (list (enter (Module.decode ~dir))) + field ~default:[] "modules" (list (enter (Module.decode ~obj_dir))) and+ wrapped = field "wrapped" Wrapped.decode in let modules = diff --git a/src/lib_modules.mli b/src/lib_modules.mli index 09cabb1df6b..5de56fcf581 100644 --- a/src/lib_modules.mli +++ b/src/lib_modules.mli @@ -42,7 +42,7 @@ val for_alias : t -> Module.Name_map.t val encode : t -> Dune_lang.t list -val decode : implements:bool -> dir:Path.t -> t Dune_lang.Decoder.t +val decode : implements:bool -> obj_dir:Obj_dir.t -> t Dune_lang.Decoder.t val is_wrapped : t -> bool diff --git a/src/module.ml b/src/module.ml index 0f9bf46604f..c8d516444d0 100644 --- a/src/module.ml +++ b/src/module.ml @@ -446,7 +446,7 @@ let encode ; obj_name ; pp = _ ; visibility - ; obj_dir + ; obj_dir = _ ; kind } as t) = let open Dune_lang.Encoder in @@ -465,11 +465,11 @@ let encode ; field_o "kind" Kind.encode kind ; field_b "impl" has_impl ; field_b "intf" (has_intf t) - ; field_i "obj_dir" Obj_dir.encode obj_dir ] -let decode ~dir = +let decode ~obj_dir = let open Dune_lang.Decoder in + let dir = Obj_dir.dir obj_dir in fields ( let+ name = field "name" Name.decode and+ obj_name = field "obj_name" string @@ -477,9 +477,6 @@ let decode ~dir = and+ kind = field_o "kind" Kind.decode and+ impl = field_b "impl" and+ intf = field_b "intf" - and+ obj_dir = - let default = Obj_dir.make_external ~dir in - field ~default "obj_dir" (Obj_dir.decode ~dir) in let file exists ml_kind = if exists then diff --git a/src/module.mli b/src/module.mli index 7f074910dca..d960d3954cf 100644 --- a/src/module.mli +++ b/src/module.mli @@ -172,7 +172,7 @@ val visibility : t -> Visibility.t val encode : t -> Dune_lang.t list -val decode : dir:Path.t -> t Dune_lang.Decoder.t +val decode : obj_dir:Obj_dir.t -> t Dune_lang.Decoder.t (* Only the source of a module, not yet associated to a library *) module Source : sig diff --git a/src/obj_dir.ml b/src/obj_dir.ml index 735c3cd551d..6afe47058d3 100644 --- a/src/obj_dir.ml +++ b/src/obj_dir.ml @@ -1,127 +1,185 @@ open! Stdune open Import +module External = struct + type t = + { public_dir : Path.t + ; private_dir : Path.t option + } + + let has_public_cmi_dir t = Option.is_some t.private_dir + + let public_cmi_dir t = t.public_dir + + let to_dyn { public_dir; private_dir } = + let open Dyn.Encoder in + record + [ "public_dir", Path.to_dyn public_dir + ; "private_dir", option Path.to_dyn private_dir + ] + + let encode + { public_dir + ; private_dir + } = + let open Dune_lang.Encoder in + let extract d = + Path.descendant ~of_:public_dir d + |> Option.value_exn + |> Path.to_string + in + let private_dir = Option.map ~f:extract private_dir in + record_fields + [ field_o "private_dir" string private_dir + ] + + let decode ~dir = + let open Dune_lang.Decoder in + fields ( + let+ private_dir = field_o "private_dir" string + in + let public_dir = dir in + let private_dir = Option.map ~f:(Path.relative dir) private_dir in + { public_dir + ; private_dir + } + ) + + let byte_dir t = t.public_dir + let native_dir t = t.public_dir + let dir t = t.public_dir + let obj_dir t = t.public_dir + + let all_obj_dirs t ~mode:_ = + [t.public_dir] +end + +module Local = struct + type t = + { dir: Path.t + ; obj_dir: Path.t + ; native_dir: Path.t + ; byte_dir: Path.t + ; public_cmi_dir: Path.t option + } + + let to_dyn { dir; obj_dir; native_dir; byte_dir; public_cmi_dir } = + let open Dyn.Encoder in + record + [ "dir", Path.to_dyn dir + ; "obj_dir", Path.to_dyn obj_dir + ; "native_dir", Path.to_dyn native_dir + ; "byte_dir", Path.to_dyn byte_dir + ; "public_cmi_dir", option Path.to_dyn public_cmi_dir + ] + + let make ~dir ~obj_dir ~native_dir ~byte_dir ~public_cmi_dir = + { dir + ; obj_dir + ; native_dir + ; byte_dir + ; public_cmi_dir + } + + let has_public_cmi_dir t = Option.is_some t.public_cmi_dir + + let public_cmi_dir t = + Option.value ~default:t.byte_dir t.public_cmi_dir + + let dir t = t.dir + let obj_dir t = t.obj_dir + let byte_dir t = t.byte_dir + let native_dir t = t.native_dir + + let all_obj_dirs t ~(mode : Mode.t) = + let dirs = [t.byte_dir; public_cmi_dir t] in + let dirs = + match mode with + | Byte -> dirs + | Native -> t.native_dir :: dirs + in + Path.Set.of_list dirs + |> Path.Set.to_list + + let make_lib ~dir ~has_private_modules lib_name = + let obj_dir = Utils.library_object_directory ~dir lib_name in + let public_cmi_dir = + Option.some_if + has_private_modules + (Utils.library_public_cmi_dir ~obj_dir) + in + make ~dir + ~obj_dir + ~native_dir:(Utils.library_native_dir ~obj_dir) + ~byte_dir:(Utils.library_byte_dir ~obj_dir) + ~public_cmi_dir + + let make_exe ~dir ~name = + let obj_dir = Utils.executable_object_directory ~dir name in + make ~dir + ~obj_dir + ~native_dir:(Utils.library_native_dir ~obj_dir) + ~byte_dir:(Utils.library_byte_dir ~obj_dir) + ~public_cmi_dir:None +end + type t = - { dir: Path.t - ; obj_dir: Path.t - ; native_dir: Path.t - ; byte_dir: Path.t - ; public_cmi_dir: Path.t option - } - -let has_public_cmi_dir t = Option.is_some t.public_cmi_dir - -let public_cmi_dir t = - Option.value ~default:t.byte_dir t.public_cmi_dir - -let dir t = t.dir -let obj_dir t = t.obj_dir -let byte_dir t = t.byte_dir -let native_dir t = t.native_dir - -let all_obj_dirs t ~(mode : Mode.t) = - let dirs = [t.byte_dir; public_cmi_dir t] in - let dirs = - match mode with - | Byte -> dirs - | Native -> t.native_dir :: dirs - in - Path.Set.of_list dirs - |> Path.Set.to_list - -let make ~dir ~obj_dir ~native_dir ~byte_dir ~public_cmi_dir = - { dir - ; obj_dir - ; native_dir - ; byte_dir - ; public_cmi_dir - } - -let make_local ~dir ~has_private_modules lib_name = - let obj_dir = Utils.library_object_directory ~dir lib_name in - let public_cmi_dir = - Option.some_if - has_private_modules - (Utils.library_public_cmi_dir ~obj_dir) - in - make ~dir - ~obj_dir - ~native_dir:(Utils.library_native_dir ~obj_dir) - ~byte_dir:(Utils.library_byte_dir ~obj_dir) - ~public_cmi_dir - -let make_exe ~dir ~name = - let obj_dir = Utils.executable_object_directory ~dir name in - make ~dir - ~obj_dir - ~native_dir:(Utils.library_native_dir ~obj_dir) - ~byte_dir:(Utils.library_byte_dir ~obj_dir) - ~public_cmi_dir:None + | External of External.t + | Local of Local.t -let make_external ~dir = - { dir - ; obj_dir = dir - ; native_dir = dir - ; byte_dir = dir - ; public_cmi_dir = None - } - -let to_sexp { dir; obj_dir; native_dir; byte_dir; public_cmi_dir } = - let open Sexp.Encoder in - record - [ "dir", Path.to_sexp dir - ; "obj_dir", Path.to_sexp obj_dir - ; "native_dir", Path.to_sexp native_dir - ; "byte_dir", Path.to_sexp byte_dir - ; "public_cmi_dir", (option Path.to_sexp) public_cmi_dir - ] - -let pp fmt { dir; obj_dir; native_dir; byte_dir; public_cmi_dir } = - Fmt.record fmt - [ "dir", Fmt.const Path.pp dir - ; "obj_dir", Fmt.const Path.pp obj_dir - ; "native_dir", Fmt.const Path.pp native_dir - ; "byte_dir", Fmt.const Path.pp byte_dir - ; "public_cmi_dir", Fmt.const (Fmt.optional Path.pp) public_cmi_dir - ] - - -let encode - { dir - ; obj_dir - ; native_dir - ; byte_dir - ; public_cmi_dir - } = - let open Dune_lang.Encoder in - let extract d = - Path.descendant ~of_:dir d - |> Option.value_exn - |> Path.to_string - in - let obj_dir = extract obj_dir in - let native_dir = extract native_dir in - let byte_dir = extract byte_dir in - let public_cmi_dir = Option.map ~f:extract public_cmi_dir in - record_fields - [ field "obj_dir" ~equal:String.equal ~default:"." string obj_dir - ; field "native_dir" ~equal:String.equal ~default:"." string native_dir - ; field "byte_dir" ~equal:String.equal ~default:"." string byte_dir - ; field_o "public_cmi_dir" string public_cmi_dir - ] +let has_public_cmi_dir = function + | External e -> External.has_public_cmi_dir e + | Local e -> Local.has_public_cmi_dir e +let encode = function + | Local obj_dir -> + Exn.code_error "Obj_dir.encode: local paths cannot be encoded" + [ "obj_dir", Dyn.to_sexp (Local.to_dyn obj_dir) + ] + | External e -> External.encode e let decode ~dir = let open Dune_lang.Decoder in - fields ( - let+ obj_dir = field ~default:"." "obj_dir" string - and+ native_dir = field ~default:"." "native_dir" string - and+ byte_dir = field ~default:"." "byte_dir" string - and+ public_cmi_dir = field_o "public_cmi_dir" string - in - make ~dir - ~obj_dir:(Path.relative dir obj_dir) - ~native_dir:(Path.relative dir native_dir) - ~byte_dir:(Path.relative dir byte_dir) - ~public_cmi_dir:(Option.map ~f:(Path.relative dir) public_cmi_dir) - ) + let+ external_ = External.decode ~dir in + External external_ + +let make_exe ~dir ~name = Local (Local.make_exe ~dir ~name) +let make_lib ~dir ~has_private_modules lib_name = + Local (Local.make_lib ~dir ~has_private_modules lib_name) + +let make_external ~dir = + External { External.public_dir = dir; private_dir = None } + +let all_obj_dirs t ~mode = + match t with + | External e -> External.all_obj_dirs e ~mode + | Local e -> Local.all_obj_dirs e ~mode + +let public_cmi_dir = function + | External e -> External.public_cmi_dir e + | Local e -> Local.public_cmi_dir e + +let byte_dir = function + | External e -> External.byte_dir e + | Local e -> Local.byte_dir e + +let native_dir = function + | External e -> External.native_dir e + | Local e -> Local.native_dir e + +let dir = function + | External e -> External.dir e + | Local e -> Local.dir e + +let obj_dir = function + | External e -> External.obj_dir e + | Local e -> Local.obj_dir e + +let to_dyn = + let open Dyn.Encoder in + function + | Local e -> constr "Local" [Local.to_dyn e] + | External e -> constr "External" [External.to_dyn e] + +let to_sexp t = Dyn.to_sexp (to_dyn t) +let pp fmt t = Dyn.pp fmt (to_dyn t) diff --git a/src/obj_dir.mli b/src/obj_dir.mli index 66b0d912344..c6c0b30f1bc 100644 --- a/src/obj_dir.mli +++ b/src/obj_dir.mli @@ -24,7 +24,7 @@ val to_sexp: t -> Sexp.t val all_obj_dirs : t -> mode:Mode.t -> Path.t list -val make_local +val make_lib : dir:Path.t -> has_private_modules:bool -> Lib_name.Local.t From 3e84e0d598b38ba101f36fd15a16118567f18024 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 27 Mar 2019 21:05:27 +0700 Subject: [PATCH 2/6] Encode obj_dir properly into dune-package Signed-off-by: Rudi Grinberg --- src/dune_lang/dune_lang.ml | 1 + src/dune_lang/dune_lang.mli | 1 + src/dune_package.ml | 34 +++++++++++++++++++++------------- src/dune_package.mli | 3 ++- src/findlib.ml | 3 ++- src/lib.ml | 5 +++-- src/lib_modules.ml | 5 ++--- src/lib_modules.mli | 4 ++-- src/obj_dir.ml | 2 +- 9 files changed, 35 insertions(+), 23 deletions(-) diff --git a/src/dune_lang/dune_lang.ml b/src/dune_lang/dune_lang.ml index 4851b7b0c18..700239817a1 100644 --- a/src/dune_lang/dune_lang.ml +++ b/src/dune_lang/dune_lang.ml @@ -1080,6 +1080,7 @@ module Decoder = struct | Values (loc, cstr, _) -> (Values (loc, cstr), state) | Fields (loc, cstr, _) -> (Fields (loc, cstr), state) + let ( let* ) = ( >>= ) let ( let+ ) = ( >>| ) let ( and+ ) a b ctx state = let a, state = a ctx state in diff --git a/src/dune_lang/dune_lang.mli b/src/dune_lang/dune_lang.mli index 5b80b1deb9c..b77e274ecc4 100644 --- a/src/dune_lang/dune_lang.mli +++ b/src/dune_lang/dune_lang.mli @@ -487,6 +487,7 @@ module Decoder : sig val leftover_fields : Ast.t list fields_parser + val ( let* ) : ('a, 'k) parser -> ('a -> ('b, 'k) parser) -> ('b, 'k) parser val ( let+ ) : ('a, 'k) parser -> ('a -> 'b) -> ('b, 'k) parser val ( and+ ) : ('a, 'k) parser -> ('b, 'k) parser -> ('a * 'b, 'k) parser end diff --git a/src/dune_package.ml b/src/dune_package.ml index a337cc61656..f2ca61bc0dd 100644 --- a/src/dune_package.ml +++ b/src/dune_package.ml @@ -7,7 +7,7 @@ module Lib = struct type 'sub_system t = { loc : Loc.t ; name : Lib_name.t - ; dir : Path.t + ; obj_dir : Obj_dir.t ; orig_src_dir : Path.t option ; kind : Lib_kind.t ; synopsis : string option @@ -33,7 +33,8 @@ module Lib = struct ~foreign_archives ~jsoo_runtime ~main_module_name ~sub_systems ~requires ~ppx_runtime_deps ~implements ~variant ~default_implementation ~virtual_ ~modules ~modes - ~version ~orig_src_dir ~dir = + ~version ~orig_src_dir ~obj_dir = + let dir = Obj_dir.dir obj_dir in let map_path p = if Path.is_managed p then Path.relative dir (Path.basename p) @@ -59,14 +60,15 @@ module Lib = struct ; variant ; default_implementation ; version - ; dir ; orig_src_dir ; virtual_ ; modules ; modes + ; obj_dir } - let dir t = t.dir + let obj_dir t = t.obj_dir + let dir t = Obj_dir.dir t.obj_dir let orig_src_dir t = t.orig_src_dir let set_subsystems t sub_systems = @@ -81,7 +83,7 @@ module Lib = struct ; foreign_objects ; foreign_archives ; jsoo_runtime ; requires ; ppx_runtime_deps ; sub_systems ; virtual_ ; implements ; variant ; default_implementation - ; main_module_name ; version = _; dir = _; orig_src_dir + ; main_module_name ; version = _; obj_dir ; orig_src_dir ; modules ; modes } = let open Dune_lang.Encoder in @@ -110,6 +112,7 @@ module Lib = struct (no_loc Lib_name.encode) default_implementation ; field_o "main_module_name" Module.Name.encode main_module_name ; field_l "modes" sexp (Mode.Dict.Set.encode modes) + ; field_l "obj_dir" sexp (Obj_dir.encode obj_dir) ; field_l "modules" sexp (match modules with | None -> [] @@ -128,14 +131,19 @@ module Lib = struct field ~default:Mode.Dict.List.empty name (Mode.Dict.List.decode path) in record ( - field_o "main_module_name" Module.Name.decode >>= fun main_module_name -> - field_o "implements" (located Lib_name.decode) >>= fun implements -> - field_o "variant" Variant.decode >>= fun variant -> - field_o "default_implementation" (located Lib_name.decode) - >>= fun default_implementation -> - field "name" Lib_name.decode >>= fun name -> + let* main_module_name = field_o "main_module_name" Module.Name.decode in + let* implements = field_o "implements" (located Lib_name.decode) in + let* variant = field_o "variant" Variant.decode in + let* default_implementation = + field_o "default_implementation" (located Lib_name.decode) in + let* name = field "name" Lib_name.decode in let dir = Path.append_local base (dir_of_name name) in - let obj_dir = Obj_dir.make_external ~dir in + let* obj_dir = field_o "obj_dir" (Obj_dir.decode ~dir) in + let obj_dir = + match obj_dir with + | None -> Obj_dir.make_external ~dir + | Some obj_dir -> obj_dir + in let+ synopsis = field_o "synopsis" string and+ loc = loc and+ modes = field_l "modes" Mode.decode @@ -172,8 +180,8 @@ module Lib = struct ; main_module_name ; virtual_ ; version = None - ; dir ; orig_src_dir + ; obj_dir ; modules ; modes } diff --git a/src/dune_package.mli b/src/dune_package.mli index e340aa78e90..bbf75d0f032 100644 --- a/src/dune_package.mli +++ b/src/dune_package.mli @@ -5,6 +5,7 @@ module Lib : sig val dir : _ t -> Path.t val orig_src_dir : _ t -> Path.t option + val obj_dir : _ t -> Obj_dir.t val requires : _ t -> (Loc.t * Lib_name.t) list val name : _ t -> Lib_name.t val version : _ t -> string option @@ -55,7 +56,7 @@ module Lib : sig -> modes:Mode.Dict.Set.t -> version:string option -> orig_src_dir:Path.t option - -> dir:Path.t + -> obj_dir:Obj_dir.t -> 'a t val set_subsystems : 'a t -> 'b Sub_system_name.Map.t -> 'b t diff --git a/src/findlib.ml b/src/findlib.ml index c91fd4b614a..986f0a78f46 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -212,6 +212,7 @@ module Package = struct | Some p -> Installed_dune_file.load p in let archives = archives t in + let obj_dir = Obj_dir.make_external ~dir:t.dir in let modes : Mode.Dict.Set.t = Mode.Dict.map ~f:(fun x -> not (List.is_empty x)) archives in Dune_package.Lib.make @@ -236,7 +237,7 @@ module Package = struct ~main_module_name:None (* XXX remove *) ~version:(version t) ~modes - ~dir:t.dir + ~obj_dir let parse db ~meta_file ~name ~parent_dir ~vars = let pkg_dir = Vars.get vars "directory" Ps.empty in diff --git a/src/lib.ml b/src/lib.ml index f404808ba85..19eb792080c 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -1604,8 +1604,9 @@ let () = let to_dune_lib ({ name ; info ; _ } as lib) ~lib_modules ~foreign_objects ~dir = let add_loc = List.map ~f:(fun x -> (info.loc, x.name)) in let virtual_ = Option.is_some info.virtual_ in + let obj_dir = Obj_dir.make_external ~dir in let lib_modules = - Lib_modules.version_installed ~install_dir:dir lib_modules in + Lib_modules.version_installed ~install_dir:obj_dir lib_modules in let orig_src_dir = if !Clflags.store_orig_src_dir then Some ( @@ -1624,7 +1625,7 @@ let to_dune_lib ({ name ; info ; _ } as lib) ~lib_modules ~foreign_objects ~dir | Local -> foreign_objects in Dune_package.Lib.make - ~dir + ~obj_dir ~orig_src_dir ~name ~loc:info.loc diff --git a/src/lib_modules.ml b/src/lib_modules.ml index b7de8bbc4dc..331a183239e 100644 --- a/src/lib_modules.ml +++ b/src/lib_modules.ml @@ -160,9 +160,8 @@ let installable_modules t = | None -> modules | Some alias -> alias :: modules -let version_installed t ~install_dir:(dir) = - let obj_dir = Obj_dir.make_external ~dir in - let set = Module.set_obj_dir ~obj_dir in +let version_installed t ~install_dir = + let set = Module.set_obj_dir ~obj_dir:install_dir in { t with alias_module = Option.map ~f:set t.alias_module ; modules = Module.Name.Map.map ~f:set t.modules; diff --git a/src/lib_modules.mli b/src/lib_modules.mli index 5de56fcf581..0c34088c677 100644 --- a/src/lib_modules.mli +++ b/src/lib_modules.mli @@ -1,4 +1,4 @@ -open Stdune +open! Stdune type t @@ -32,7 +32,7 @@ val make val set_modules : t -> Module.Name_map.t -> t -val version_installed : t -> install_dir:Path.t -> t +val version_installed : t -> install_dir:Obj_dir.t -> t val for_compilation : t -> Module.Name_map.t diff --git a/src/obj_dir.ml b/src/obj_dir.ml index 6afe47058d3..209dd52c651 100644 --- a/src/obj_dir.ml +++ b/src/obj_dir.ml @@ -133,7 +133,7 @@ let has_public_cmi_dir = function let encode = function | Local obj_dir -> - Exn.code_error "Obj_dir.encode: local paths cannot be encoded" + Exn.code_error "Obj_dir.encode: local obj_dir cannot be encoded" [ "obj_dir", Dyn.to_sexp (Local.to_dyn obj_dir) ] | External e -> External.encode e From fda07b0ac2482d80819ad12d7f6c45039abe59cf Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 27 Mar 2019 21:17:17 +0700 Subject: [PATCH 3/6] Add support for private dir in external obj dir Signed-off-by: Rudi Grinberg --- src/dune_package.ml | 2 +- src/findlib.ml | 2 +- src/lib.ml | 2 +- src/lib_info.ml | 2 +- src/obj_dir.ml | 27 +++++++++++++++++-- src/obj_dir.mli | 4 ++- .../test-cases/dune-package/run.t | 1 + 7 files changed, 33 insertions(+), 7 deletions(-) diff --git a/src/dune_package.ml b/src/dune_package.ml index f2ca61bc0dd..3318344f208 100644 --- a/src/dune_package.ml +++ b/src/dune_package.ml @@ -141,7 +141,7 @@ module Lib = struct let* obj_dir = field_o "obj_dir" (Obj_dir.decode ~dir) in let obj_dir = match obj_dir with - | None -> Obj_dir.make_external ~dir + | None -> Obj_dir.make_external_no_private ~dir | Some obj_dir -> obj_dir in let+ synopsis = field_o "synopsis" string diff --git a/src/findlib.ml b/src/findlib.ml index 986f0a78f46..f79fd0f9421 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -212,7 +212,7 @@ module Package = struct | Some p -> Installed_dune_file.load p in let archives = archives t in - let obj_dir = Obj_dir.make_external ~dir:t.dir in + let obj_dir = Obj_dir.make_external_no_private ~dir:t.dir in let modes : Mode.Dict.Set.t = Mode.Dict.map ~f:(fun x -> not (List.is_empty x)) archives in Dune_package.Lib.make diff --git a/src/lib.ml b/src/lib.ml index 19eb792080c..663ac43906c 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -1604,7 +1604,7 @@ let () = let to_dune_lib ({ name ; info ; _ } as lib) ~lib_modules ~foreign_objects ~dir = let add_loc = List.map ~f:(fun x -> (info.loc, x.name)) in let virtual_ = Option.is_some info.virtual_ in - let obj_dir = Obj_dir.make_external ~dir in + let obj_dir = Obj_dir.convert_to_external ~dir (obj_dir lib) in let lib_modules = Lib_modules.version_installed ~install_dir:obj_dir lib_modules in let orig_src_dir = diff --git a/src/lib_info.ml b/src/lib_info.ml index f974b501839..1e56f95a672 100644 --- a/src/lib_info.ml +++ b/src/lib_info.ml @@ -196,7 +196,7 @@ let of_dune_lib dp = Lib.wrapped dp |> Option.map ~f:(fun w -> Dune_file.Library.Inherited.This w) in - let obj_dir = Obj_dir.make_external ~dir:src_dir in + let obj_dir = Lib.obj_dir dp in { loc = Lib.loc dp ; name = Lib.name dp ; kind = Lib.kind dp diff --git a/src/obj_dir.ml b/src/obj_dir.ml index 209dd52c651..b17cf3c173c 100644 --- a/src/obj_dir.ml +++ b/src/obj_dir.ml @@ -7,6 +7,17 @@ module External = struct ; private_dir : Path.t option } + let make ~dir ~has_private_modules = + let private_dir = + if has_private_modules then + Some (Path.relative dir ".private") + else + None + in + { public_dir = dir + ; private_dir + } + let has_public_cmi_dir t = Option.is_some t.private_dir let public_cmi_dir t = t.public_dir @@ -147,8 +158,8 @@ let make_exe ~dir ~name = Local (Local.make_exe ~dir ~name) let make_lib ~dir ~has_private_modules lib_name = Local (Local.make_lib ~dir ~has_private_modules lib_name) -let make_external ~dir = - External { External.public_dir = dir; private_dir = None } +let make_external_no_private ~dir = + External (External.make ~dir ~has_private_modules:false) let all_obj_dirs t ~mode = match t with @@ -183,3 +194,15 @@ let to_dyn = let to_sexp t = Dyn.to_sexp (to_dyn t) let pp fmt t = Dyn.pp fmt (to_dyn t) + +let convert_to_external t ~dir = + match t with + | Local e -> + let has_private_modules = Local.has_public_cmi_dir e in + External (External.make ~dir ~has_private_modules) + | External obj_dir -> + Exn.code_error + "Obj_dir.convert_to_external: converting already external dir" + [ "dir", Path.to_sexp dir + ; "obj_dir", Dyn.to_sexp (External.to_dyn obj_dir) + ] diff --git a/src/obj_dir.mli b/src/obj_dir.mli index c6c0b30f1bc..8f03c4a9868 100644 --- a/src/obj_dir.mli +++ b/src/obj_dir.mli @@ -32,7 +32,9 @@ val make_lib val make_exe: dir:Path.t -> name:string -> t -val make_external: dir:Path.t -> t +val make_external_no_private : dir:Path.t -> t val encode : t -> Dune_lang.t list val decode : dir:Path.t -> t Dune_lang.Decoder.t + +val convert_to_external : t -> dir:Path.t -> t diff --git a/test/blackbox-tests/test-cases/dune-package/run.t b/test/blackbox-tests/test-cases/dune-package/run.t index 83acec6244b..931d126c075 100644 --- a/test/blackbox-tests/test-cases/dune-package/run.t +++ b/test/blackbox-tests/test-cases/dune-package/run.t @@ -23,6 +23,7 @@ (foreign_archives (native b/c/c$ext_lib)) (main_module_name C) (modes byte native) + (obj_dir (private_dir .private)) (modules (alias_module (name C) (obj_name c) (visibility public) (impl)) (main_module_name C) From be75e398462ddf8db479a0a1dd1d1787ddad16fd Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 27 Mar 2019 21:49:27 +0700 Subject: [PATCH 4/6] Module.obj_file should not know so much about Obj_dir internals Obj_dir should do the dir selection based on the Cm_kind.t Signed-off-by: Rudi Grinberg --- src/exe.ml | 2 +- src/install_rules.ml | 2 +- src/lib_rules.ml | 14 ++++----- src/module.ml | 56 +++++----------------------------- src/module.mli | 8 +---- src/module_compilation.ml | 2 +- src/modules_field_evaluator.ml | 2 +- src/obj_dir.ml | 33 ++++++++++++++++++++ src/obj_dir.mli | 8 ++++- src/visibility.ml | 31 +++++++++++++++++++ src/visibility.mli | 12 ++++++++ 11 files changed, 103 insertions(+), 67 deletions(-) create mode 100644 src/visibility.ml create mode 100644 src/visibility.mli diff --git a/src/exe.ml b/src/exe.ml index 723dc02524a..365923d7bc8 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -134,7 +134,7 @@ let link_exe let compiler = Option.value_exn (Context.compiler ctx mode) in let kind = Mode.cm_kind mode in let artifacts ~ext modules = - List.map modules ~f:(Module.obj_file ~mode ~ext) + List.map modules ~f:(Module.obj_file ~kind ~ext) in let modules_and_cm_files = Build.memoize "cm files" diff --git a/src/install_rules.ml b/src/install_rules.ml index 4d850dc09e9..e8ea3ac3dda 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -235,7 +235,7 @@ let lib_install_files sctx ~dir_contents ~dir ~sub_dir ~scope ~dir_kind ; if_ (byte && Module.has_impl m && virtual_library) [ Module.cm_file_unsafe m Cmo ] ; if_ (native && Module.has_impl m && virtual_library) - [ Module.obj_file m ~mode:Native ~ext:ctx.ext_obj ] + [ Module.obj_file m ~kind:Cmx ~ext:ctx.ext_obj ] ; List.filter_map Ml_kind.all ~f:(Module.cmt_file m) ]) in diff --git a/src/lib_rules.ml b/src/lib_rules.ml index 64a6f6db59d..6959baf3b2b 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -46,7 +46,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct Fn.id in let artifacts ~ext modules = - List.map modules ~f:(Module.obj_file ~mode ~ext) + List.map modules ~f:(Module.obj_file ~kind ~ext) in let obj_deps = Build.paths (artifacts modules ~ext:(Cm_kind.ext kind)) @@ -346,11 +346,11 @@ module Gen (P : sig val sctx : Super_context.t end) = struct | Some m -> (* These files needs to be alongside stdlib.cma as the compiler implicitly adds this module. *) - [ Mode.Native, ".cmx" - ; Byte, ".cmo" - ; Native, ctx.ext_obj ] - |> List.iter ~f:(fun (mode, ext) -> - let src = Module.obj_file m ~mode ~ext in + [ Cm_kind.Cmx, ".cmx" + ; Cmo, ".cmo" + ; Cmx, ctx.ext_obj ] + |> List.iter ~f:(fun (kind, ext) -> + let src = Module.obj_file m ~kind ~ext in let dst = Path.relative dir ((Module.obj_name m) ^ ext) in SC.add_rule sctx ~dir (Build.copy ~src ~dst)); Module.Name.Map.remove modules name @@ -524,7 +524,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct ; compile_info }; - let objs_dirs = Path.Set.singleton (Obj_dir.byte_dir obj_dir) in + let objs_dirs = Path.Set.of_list (Obj_dir.all_cmis obj_dir) in (cctx, Merlin.make () diff --git a/src/module.ml b/src/module.ml index c8d516444d0..8732f440827 100644 --- a/src/module.ml +++ b/src/module.ml @@ -102,38 +102,6 @@ module File = struct ] end -module Visibility = struct - type t = Public | Private - - let to_string = function - | Public -> "public" - | Private -> "private" - - let pp fmt t = Format.pp_print_string fmt (to_string t) - - let to_sexp t = Sexp.Encoder.string (to_string t) - - let encode = - let open Dune_lang.Encoder in - function - | Public -> string "public" - | Private -> string "private" - - let decode = - let open Dune_lang.Decoder in - plain_string (fun ~loc -> function - | "public" -> Public - | "private" -> Private - | _ -> Errors.fail loc - "Not a valid visibility. Valid visibility is public or private") - - let is_public = function - | Public -> true - | Private -> false - - let is_private t = not (is_public t) -end - module Kind = struct type t = | Intf_only @@ -255,12 +223,8 @@ let file t (kind : Ml_kind.t) = in Option.map file ~f:(fun f -> f.path) -let obj_file t ~mode ~ext = - let base = - match mode with - | Mode.Byte -> Obj_dir.byte_dir t.obj_dir - | Native -> Obj_dir.native_dir t.obj_dir - in +let obj_file t ~kind ~ext = + let base = Obj_dir.cm_dir t.obj_dir kind t.visibility in Path.relative base (t.obj_name ^ ext) let obj_name t = t.obj_name @@ -268,9 +232,8 @@ let obj_name t = t.obj_name let cm_source t kind = file t (Cm_kind.source kind) let cm_file_unsafe t ?ext kind = - let mode = match kind with Cm_kind.Cmx -> Mode.Native | Cmo | Cmi -> Byte in let ext = Option.value ext ~default:(Cm_kind.ext kind) in - obj_file t ~mode ~ext + obj_file t ~kind ~ext let cm_file t ?ext (kind : Cm_kind.t) = match kind with @@ -279,10 +242,7 @@ let cm_file t ?ext (kind : Cm_kind.t) = let cm_public_file_unsafe t ?ext kind = let ext = Option.value ext ~default:(Cm_kind.ext kind) in - let base = match kind with - | Cm_kind.Cmx -> Obj_dir.native_dir t.obj_dir - | Cmo -> Obj_dir.byte_dir t.obj_dir - | Cmi -> Obj_dir.public_cmi_dir t.obj_dir in + let base = Obj_dir.cm_public_dir t.obj_dir kind in Path.relative base (t.obj_name ^ ext) let cm_public_file t ?ext (kind : Cm_kind.t) = @@ -293,8 +253,8 @@ let cm_public_file t ?ext (kind : Cm_kind.t) = let cmt_file t (kind : Ml_kind.t) = match kind with - | Impl -> Option.map t.impl ~f:(fun _ -> obj_file t ~mode:Byte ~ext:".cmt" ) - | Intf -> Option.map t.intf ~f:(fun _ -> obj_file t ~mode:Byte ~ext:".cmti") + | Impl -> Option.map t.impl ~f:(fun _ -> obj_file t ~kind:Cmi ~ext:".cmt" ) + | Intf -> Option.map t.intf ~f:(fun _ -> obj_file t ~kind:Cmi ~ext:".cmti") let odoc_file t ~doc_dir = let base = @@ -306,8 +266,8 @@ let odoc_file t ~doc_dir = let cmti_file t = match t.intf with - | None -> obj_file t ~mode:Byte ~ext:".cmt" - | Some _ -> obj_file t ~mode:Byte ~ext:".cmti" + | None -> obj_file t ~kind:Cmi ~ext:".cmt" + | Some _ -> obj_file t ~kind:Cmi ~ext:".cmti" let iter t ~f = Option.iter t.impl ~f:(f Ml_kind.Impl); diff --git a/src/module.mli b/src/module.mli index d960d3954cf..62e4a2431e6 100644 --- a/src/module.mli +++ b/src/module.mli @@ -52,12 +52,6 @@ module File : sig val make : Syntax.t -> Path.t -> t end -module Visibility : sig - type t = Public | Private - - include Dune_lang.Conv with type t := t -end - module Kind : sig type t = Intf_only | Virtual | Impl @@ -94,7 +88,7 @@ val cm_file : t -> ?ext:string -> Cm_kind.t -> Path.t option val cm_public_file : t -> ?ext:string -> Cm_kind.t -> Path.t option val cmt_file : t -> Ml_kind.t -> Path.t option -val obj_file : t -> mode:Mode.t -> ext:string -> Path.t +val obj_file : t -> kind:Cm_kind.t -> ext:string -> Path.t val obj_name : t -> string diff --git a/src/module_compilation.ml b/src/module_compilation.ml index fd6a449db4a..f012743fa87 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -65,7 +65,7 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs in let other_targets = match cm_kind with - | Cmx -> Module.obj_file m ~mode:Native ~ext:ctx.ext_obj :: other_targets + | Cmx -> Module.obj_file m ~kind:Cmx ~ext:ctx.ext_obj :: other_targets | Cmi | Cmo -> other_targets in let dep_graph = Ml_kind.Dict.get dep_graphs ml_kind in diff --git a/src/modules_field_evaluator.ml b/src/modules_field_evaluator.ml index d68395917a0..6ceb7298290 100644 --- a/src/modules_field_evaluator.ml +++ b/src/modules_field_evaluator.ml @@ -213,7 +213,7 @@ let eval ~modules:(all_modules : Module.Source.t Module.Name.Map.t) let name = Module.Source.name m in let visibility = if Module.Name.Map.mem private_modules name then - Module.Visibility.Private + Visibility.Private else Public in diff --git a/src/obj_dir.ml b/src/obj_dir.ml index b17cf3c173c..61777a34c02 100644 --- a/src/obj_dir.ml +++ b/src/obj_dir.ml @@ -29,6 +29,16 @@ module External = struct ; "private_dir", option Path.to_dyn private_dir ] + let cm_dir t (cm_kind : Cm_kind.t) (visibility : Visibility.t) = + match cm_kind, visibility, t.private_dir with + | Cmi, Private, Some p -> p + | Cmi, Private, None -> + Exn.code_error "External.cm_dir" + [ "t", Dyn.to_sexp (to_dyn t) + ] + | Cmi, Public, _ + | (Cmo | Cmx), _, _ -> t.public_dir + let encode { public_dir ; private_dir @@ -63,6 +73,9 @@ module External = struct let all_obj_dirs t ~mode:_ = [t.public_dir] + + let all_cmis {public_dir; private_dir} = + List.filter_opt [Some public_dir; private_dir] end module Local = struct @@ -132,6 +145,11 @@ module Local = struct ~native_dir:(Utils.library_native_dir ~obj_dir) ~byte_dir:(Utils.library_byte_dir ~obj_dir) ~public_cmi_dir:None + + let cm_dir t cm_kind _ = + match cm_kind with + | Cm_kind.Cmx -> native_dir t + | Cmo | Cmi -> byte_dir t end type t = @@ -206,3 +224,18 @@ let convert_to_external t ~dir = [ "dir", Path.to_sexp dir ; "obj_dir", Dyn.to_sexp (External.to_dyn obj_dir) ] + +let all_cmis = function + | Local e -> [Local.byte_dir e] + | External e -> External.all_cmis e + +let cm_dir t cm_kind visibility = + match t with + | External e -> External.cm_dir e cm_kind visibility + | Local e -> Local.cm_dir e cm_kind visibility + +let cm_public_dir t (cm_kind : Cm_kind.t) = + match cm_kind with + | Cmx -> native_dir t + | Cmo -> byte_dir t + | Cmi -> public_cmi_dir t diff --git a/src/obj_dir.mli b/src/obj_dir.mli index 8f03c4a9868..84ee29bb903 100644 --- a/src/obj_dir.mli +++ b/src/obj_dir.mli @@ -11,9 +11,11 @@ val obj_dir : t -> Path.t (** The private compiled native file directory *) val native_dir : t -> Path.t -(** The private compiled byte file directory, and all cmi *) +(** The private compiled byte file directories, and all cmi *) val byte_dir : t -> Path.t +val all_cmis: t -> Path.t list + (** The public compiled cmi file directory *) val public_cmi_dir: t -> Path.t @@ -38,3 +40,7 @@ val encode : t -> Dune_lang.t list val decode : dir:Path.t -> t Dune_lang.Decoder.t val convert_to_external : t -> dir:Path.t -> t + +val cm_dir : t -> Cm_kind.t -> Visibility.t -> Path.t + +val cm_public_dir : t -> Cm_kind.t -> Path.t diff --git a/src/visibility.ml b/src/visibility.ml new file mode 100644 index 00000000000..26941341023 --- /dev/null +++ b/src/visibility.ml @@ -0,0 +1,31 @@ +open Stdune + +type t = Public | Private + +let to_string = function + | Public -> "public" + | Private -> "private" + +let pp fmt t = Format.pp_print_string fmt (to_string t) + +let to_sexp t = Sexp.Encoder.string (to_string t) + +let encode = + let open Dune_lang.Encoder in + function + | Public -> string "public" + | Private -> string "private" + +let decode = + let open Dune_lang.Decoder in + plain_string (fun ~loc -> function + | "public" -> Public + | "private" -> Private + | _ -> Errors.fail loc + "Not a valid visibility. Valid visibility is public or private") + +let is_public = function + | Public -> true + | Private -> false + +let is_private t = not (is_public t) diff --git a/src/visibility.mli b/src/visibility.mli new file mode 100644 index 00000000000..8a0254ff800 --- /dev/null +++ b/src/visibility.mli @@ -0,0 +1,12 @@ +open! Stdune + +type t = Public | Private + +include Dune_lang.Conv with type t := t + +val is_public : t -> bool +val is_private : t -> bool + +val to_sexp : t -> Sexp.t + +val pp : t Fmt.t From a063572e4f064ac3cac8913262775baa94d0dc76 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 27 Mar 2019 22:03:45 +0700 Subject: [PATCH 5/6] Install private .cmi's Signed-off-by: Rudi Grinberg --- src/install_rules.ml | 33 ++++++++++++++----- .../test-cases/private-modules/run.t | 2 ++ 2 files changed, 26 insertions(+), 9 deletions(-) diff --git a/src/install_rules.ml b/src/install_rules.ml index e8ea3ac3dda..a0e9d701e0e 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -189,10 +189,10 @@ let lib_ppxs sctx ~(lib : Dune_file.Library.t) ~scope ~dir_kind = in [Preprocessing.get_compat_ppx_exe sctx ~name ~kind:(Jbuild driver)] -let lib_install_files sctx ~dir_contents ~dir ~sub_dir ~scope ~dir_kind - (lib : Library.t) = +let lib_install_files sctx ~dir_contents ~dir ~sub_dir:default_subdir + ~scope ~dir_kind (lib : Library.t) = let loc = lib.buildable.loc in - let make_entry section ?dst fn = + let make_entry section ?sub_dir ?dst fn = ( Some loc , Install.Entry.make section fn ~dst:( @@ -201,6 +201,11 @@ let lib_install_files sctx ~dir_contents ~dir ~sub_dir ~scope ~dir_kind | Some s -> s | None -> Path.basename fn in + let sub_dir = + match sub_dir with + | Some _ -> sub_dir + | None -> default_subdir + in match sub_dir with | None -> dst | Some dir -> sprintf "%s/%s" dir dst)) @@ -227,23 +232,33 @@ let lib_install_files sctx ~dir_contents ~dir ~sub_dir ~scope ~dir_kind in let virtual_library = Library.is_virtual lib in List.concat_map installable_modules ~f:(fun m -> - List.concat - [ if_ (Module.is_public m) - [ Module.cm_public_file_unsafe m Cmi ] - ; if_ (native && Module.has_impl m) + let cmi_file = (Module.visibility m, Module.cm_file_unsafe m Cmi) in + let other_cm_files = + [ if_ (native && Module.has_impl m) [ Module.cm_file_unsafe m Cmx ] ; if_ (byte && Module.has_impl m && virtual_library) [ Module.cm_file_unsafe m Cmo ] ; if_ (native && Module.has_impl m && virtual_library) [ Module.obj_file m ~kind:Cmx ~ext:ctx.ext_obj ] ; List.filter_map Ml_kind.all ~f:(Module.cmt_file m) - ]) + ] + |> List.concat + |> List.map ~f:(fun f -> (Visibility.Public, f)) + in + cmi_file :: other_cm_files + ) in let archives = Lib_archives.make ~ctx ~dir_contents ~dir lib in let execs = lib_ppxs sctx ~lib ~scope ~dir_kind in List.concat [ sources - ; List.map module_files ~f:(make_entry Lib) + ; List.map module_files ~f:(fun (visibility, file) -> + let sub_dir = + match (visibility : Visibility.t) with + | Public -> None + | Private -> Some ".private" + in + make_entry ?sub_dir Lib file) ; List.map (Lib_archives.files archives) ~f:(make_entry Lib) ; List.map execs ~f:(make_entry Libexec) ; List.map (Lib_archives.dlls archives) ~f:(fun a -> diff --git a/test/blackbox-tests/test-cases/private-modules/run.t b/test/blackbox-tests/test-cases/private-modules/run.t index 8ede94d6e9e..07b3fe43d6b 100644 --- a/test/blackbox-tests/test-cases/private-modules/run.t +++ b/test/blackbox-tests/test-cases/private-modules/run.t @@ -11,6 +11,8 @@ $ dune build --root excluded-from-install-file | grep -i priv Entering directory 'excluded-from-install-file' + "_build/install/default/lib/lib/.private/lib__Priv.cmi" {".private/lib__Priv.cmi"} + "_build/install/default/lib/lib/.private/priv2.cmi" {".private/priv2.cmi"} "_build/install/default/lib/lib/foo/priv2.cmt" {"foo/priv2.cmt"} "_build/install/default/lib/lib/foo/priv2.cmx" {"foo/priv2.cmx"} "_build/install/default/lib/lib/foo/priv2.ml" {"foo/priv2.ml"} From d135f68a77ef927263bc26fe4fb32ae48896a33d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Mar 2019 22:20:15 +0700 Subject: [PATCH 6/6] Obj_dir: rename has_public_cmi_dir to need_dedicated_public_dir Signed-off-by: Rudi Grinberg --- src/module_compilation.ml | 2 +- src/obj_dir.ml | 12 ++++++------ src/obj_dir.mli | 2 +- src/virtual_rules.ml | 2 +- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/module_compilation.ml b/src/module_compilation.ml index f012743fa87..31ce4f3cf08 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -37,7 +37,7 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs let copy_interface () = (* symlink the .cmi into the public interface directory *) if not (Module.is_private m) - && (Obj_dir.has_public_cmi_dir obj_dir) then + && (Obj_dir.need_dedicated_public_dir obj_dir) then SC.add_rule sctx ~sandbox:false ~dir (Build.symlink ~src:(Module.cm_file_unsafe m Cmi) diff --git a/src/obj_dir.ml b/src/obj_dir.ml index 61777a34c02..8cd2e15e5e0 100644 --- a/src/obj_dir.ml +++ b/src/obj_dir.ml @@ -18,7 +18,7 @@ module External = struct ; private_dir } - let has_public_cmi_dir t = Option.is_some t.private_dir + let need_dedicated_public_dir t = Option.is_some t.private_dir let public_cmi_dir t = t.public_dir @@ -105,7 +105,7 @@ module Local = struct ; public_cmi_dir } - let has_public_cmi_dir t = Option.is_some t.public_cmi_dir + let need_dedicated_public_dir t = Option.is_some t.public_cmi_dir let public_cmi_dir t = Option.value ~default:t.byte_dir t.public_cmi_dir @@ -156,9 +156,9 @@ type t = | External of External.t | Local of Local.t -let has_public_cmi_dir = function - | External e -> External.has_public_cmi_dir e - | Local e -> Local.has_public_cmi_dir e +let need_dedicated_public_dir = function + | External e -> External.need_dedicated_public_dir e + | Local e -> Local.need_dedicated_public_dir e let encode = function | Local obj_dir -> @@ -216,7 +216,7 @@ let pp fmt t = Dyn.pp fmt (to_dyn t) let convert_to_external t ~dir = match t with | Local e -> - let has_private_modules = Local.has_public_cmi_dir e in + let has_private_modules = Local.need_dedicated_public_dir e in External (External.make ~dir ~has_private_modules) | External obj_dir -> Exn.code_error diff --git a/src/obj_dir.mli b/src/obj_dir.mli index 84ee29bb903..9d2f0752d46 100644 --- a/src/obj_dir.mli +++ b/src/obj_dir.mli @@ -19,7 +19,7 @@ val all_cmis: t -> Path.t list (** The public compiled cmi file directory *) val public_cmi_dir: t -> Path.t -val has_public_cmi_dir : t -> bool +val need_dedicated_public_dir : t -> bool val pp: t Fmt.t val to_sexp: t -> Sexp.t diff --git a/src/virtual_rules.ml b/src/virtual_rules.ml index b8aad0d515d..febc88f87bc 100644 --- a/src/virtual_rules.ml +++ b/src/virtual_rules.ml @@ -51,7 +51,7 @@ let setup_copy_rules_for_impl ~sctx ~dir vimpl = let copy_objs src = let dst = Module.set_obj_dir ~obj_dir:impl_obj_dir src in copy_obj_file ~src ~dst Cmi; - if Module.is_public dst && Obj_dir.has_public_cmi_dir impl_obj_dir + if Module.is_public dst && Obj_dir.need_dedicated_public_dir impl_obj_dir then begin let src = Module.cm_public_file_unsafe src Cmi in let dst = Module.cm_public_file_unsafe dst Cmi in