Move info to lib

This cuts down on a lot of duplication between the library and info

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-08-01 13:48:57 +02:00
parent 385a3ebd54
commit 6eb20866f6
1 changed files with 29 additions and 52 deletions

View File

@ -221,26 +221,14 @@ module Id = struct
end end
type t = type t =
{ loc : Loc.t { info : Info.t
; name : string ; name : string
; unique_id : int ; unique_id : int
; kind : Jbuild.Library.Kind.t
; status : Status.t
; src_dir : Path.t
; obj_dir : Path.t
; version : string option
; synopsis : string option
; archives : Path.t list Mode.Dict.t
; plugins : Path.t list Mode.Dict.t
; foreign_archives : Path.t list Mode.Dict.t
; jsoo_runtime : Path.t list
; requires : t list Or_exn.t ; requires : t list Or_exn.t
; ppx_runtime_deps : t list Or_exn.t ; ppx_runtime_deps : t list Or_exn.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
; optional : bool
; user_written_deps : Jbuild.Lib_deps.t ; user_written_deps : Jbuild.Lib_deps.t
; dune_version : Syntax.Version.t option
; (* This is mutable to avoid this error: ; (* This is mutable to avoid this error:
{[ {[
@ -340,24 +328,24 @@ let not_available ~loc reason fmt =
let name t = t.name let name t = t.name
let kind t = t.kind let kind t = t.info.kind
let synopsis t = t.synopsis let synopsis t = t.info.synopsis
let archives t = t.archives let archives t = t.info.archives
let plugins t = t.plugins let plugins t = t.info.plugins
let jsoo_runtime t = t.jsoo_runtime let jsoo_runtime t = t.info.jsoo_runtime
let unique_id t = t.unique_id let unique_id t = t.unique_id
let dune_version t = t.dune_version let dune_version t = t.info.dune_version
let src_dir t = t.src_dir let src_dir t = t.info.src_dir
let obj_dir t = t.obj_dir let obj_dir t = t.info.obj_dir
let is_local t = Path.is_managed t.obj_dir let is_local t = Path.is_managed t.info.obj_dir
let status t = t.status let status t = t.info.status
let package t = let package t =
match t.status with match t.info.status with
| Installed -> | Installed ->
Some (Findlib.root_package_name t.name Some (Findlib.root_package_name t.name
|> Package.Name.of_string) |> Package.Name.of_string)
@ -367,7 +355,7 @@ let package t =
let to_id t : Id.t = let to_id t : Id.t =
{ unique_id = t.unique_id { unique_id = t.unique_id
; path = t.src_dir ; path = t.info.src_dir
; name = t.name ; name = t.name
} }
@ -405,7 +393,7 @@ module L = struct
let c_include_paths ts ~stdlib_dir = let c_include_paths ts ~stdlib_dir =
let dirs = let dirs =
List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t -> List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t ->
Path.Set.add acc t.src_dir) Path.Set.add acc t.info.src_dir)
in in
Path.Set.remove dirs stdlib_dir Path.Set.remove dirs stdlib_dir
@ -415,7 +403,8 @@ module L = struct
let link_flags ts ~mode ~stdlib_dir = let link_flags ts ~mode ~stdlib_dir =
Arg_spec.S Arg_spec.S
(c_include_flags ts ~stdlib_dir :: (c_include_flags ts ~stdlib_dir ::
List.map ts ~f:(fun t -> Arg_spec.Deps (Mode.Dict.get t.archives mode))) List.map ts ~f:(fun t ->
Arg_spec.Deps (Mode.Dict.get t.info.archives mode)))
let compile_and_link_flags ~compile ~link ~mode ~stdlib_dir = let compile_and_link_flags ~compile ~link ~mode ~stdlib_dir =
let dirs = let dirs =
@ -426,15 +415,15 @@ module L = struct
Arg_spec.S Arg_spec.S
(to_iflags dirs :: (to_iflags dirs ::
List.map link ~f:(fun t -> List.map link ~f:(fun t ->
Arg_spec.Deps (Mode.Dict.get t.archives mode))) Arg_spec.Deps (Mode.Dict.get t.info.archives mode)))
let jsoo_runtime_files ts = let jsoo_runtime_files ts =
List.concat_map ts ~f:(fun t -> t.jsoo_runtime) List.concat_map ts ~f:(fun t -> t.info.jsoo_runtime)
let archive_files ts ~mode ~ext_lib = let archive_files ts ~mode ~ext_lib =
List.concat_map ts ~f:(fun t -> List.concat_map ts ~f:(fun t ->
Mode.Dict.get t.archives mode @ Mode.Dict.get t.info.archives mode @
List.map (Mode.Dict.get t.foreign_archives mode) List.map (Mode.Dict.get t.info.foreign_archives mode)
~f:(Path.extend_basename ~suffix:ext_lib)) ~f:(Path.extend_basename ~suffix:ext_lib))
let remove_dups l = let remove_dups l =
@ -587,7 +576,7 @@ module Dep_stack = struct
end end
let check_private_deps ~(lib : lib) ~loc ~allow_private_deps = let check_private_deps ~(lib : lib) ~loc ~allow_private_deps =
if (not allow_private_deps) && Status.is_private lib.status then if (not allow_private_deps) && Status.is_private lib.info.status then
Result.Error (Error ( Result.Error (Error (
Private_deps_not_allowed { private_dep = lib ; pd_loc = loc })) Private_deps_not_allowed { private_dep = lib ; pd_loc = loc }))
else else
@ -602,7 +591,7 @@ let already_in_table (info : Info.t) name x =
Path.sexp_of_t x.path] Path.sexp_of_t x.path]
| St_found t -> | St_found t ->
List [Sexp.unsafe_atom_of_string "Found"; List [Sexp.unsafe_atom_of_string "Found";
Path.sexp_of_t t.src_dir] Path.sexp_of_t t.info.src_dir]
| St_not_found -> | St_not_found ->
Sexp.unsafe_atom_of_string "Not_found" Sexp.unsafe_atom_of_string "Not_found"
| St_hidden (_, { path; reason; _ }) -> | St_hidden (_, { path; reason; _ }) ->
@ -648,27 +637,15 @@ let rec instantiate db name (info : Info.t) ~stack ~hidden =
let resolve (loc, name) = let resolve (loc, name) =
resolve_dep db name ~allow_private_deps ~loc ~stack in resolve_dep db name ~allow_private_deps ~loc ~stack in
let t = let t =
{ loc = info.loc { info = info
; name = name ; name = name
; unique_id = id.unique_id ; unique_id = id.unique_id
; kind = info.kind
; status = info.status
; src_dir = info.src_dir
; obj_dir = info.obj_dir
; version = info.version
; synopsis = info.synopsis
; archives = info.archives
; plugins = info.plugins
; foreign_archives = info.foreign_archives
; jsoo_runtime = info.jsoo_runtime
; requires = requires ; requires = requires
; ppx_runtime_deps = ppx_runtime_deps ; ppx_runtime_deps = ppx_runtime_deps
; pps = pps ; pps = pps
; resolved_selects = resolved_selects ; resolved_selects = resolved_selects
; optional = info.optional
; user_written_deps = Info.user_written_deps info ; user_written_deps = Info.user_written_deps info
; sub_systems = Sub_system_name.Map.empty ; sub_systems = Sub_system_name.Map.empty
; dune_version = info.dune_version
} }
in in
t.sub_systems <- t.sub_systems <-
@ -688,7 +665,7 @@ let rec instantiate db name (info : Info.t) ~stack ~hidden =
match hidden with match hidden with
| None -> St_found t | None -> St_found t
| Some reason -> | Some reason ->
St_hidden (t, { name; path = t.src_dir; reason }) St_hidden (t, { name; path = t.info.src_dir; reason })
in in
Hashtbl.replace db.table ~key:name ~data:res; Hashtbl.replace db.table ~key:name ~data:res;
res res
@ -941,7 +918,7 @@ module Compile = struct
; requires = t.requires >>= closure_with_overlap_checks db ; requires = t.requires >>= closure_with_overlap_checks db
; resolved_selects = t.resolved_selects ; resolved_selects = t.resolved_selects
; pps = t.pps ; pps = t.pps
; optional = t.optional ; optional = t.info.optional
; user_written_deps = t.user_written_deps ; user_written_deps = t.user_written_deps
; sub_systems = t.sub_systems ; sub_systems = t.sub_systems
} }
@ -1161,9 +1138,9 @@ let report_lib_error ppf (e : Error.t) =
- %S in %s@,\ - %S in %s@,\
\ %a@,\ \ %a@,\
This cannot work.@\n" This cannot work.@\n"
lib1.name (Path.to_string_maybe_quoted lib1.src_dir) lib1.name (Path.to_string_maybe_quoted lib1.info.src_dir)
Dep_path.Entries.pp rb1 Dep_path.Entries.pp rb1
lib2.name (Path.to_string_maybe_quoted lib2.src_dir) lib2.name (Path.to_string_maybe_quoted lib2.info.src_dir)
Dep_path.Entries.pp rb2 Dep_path.Entries.pp rb2
| Overlap { in_workspace = lib1; installed = (lib2, rb2) } -> | Overlap { in_workspace = lib1; installed = (lib2, rb2) } ->
Format.fprintf ppf Format.fprintf ppf
@ -1172,8 +1149,8 @@ let report_lib_error ppf (e : Error.t) =
- %S in %s@,\ - %S in %s@,\
\ %a@,\ \ %a@,\
This is not allowed.@\n" This is not allowed.@\n"
lib1.name (Path.to_string_maybe_quoted lib1.src_dir) lib1.name (Path.to_string_maybe_quoted lib1.info.src_dir)
lib2.name (Path.to_string_maybe_quoted lib2.src_dir) lib2.name (Path.to_string_maybe_quoted lib2.info.src_dir)
Dep_path.Entries.pp rb2 Dep_path.Entries.pp rb2
| No_solution_found_for_select { loc } -> | No_solution_found_for_select { loc } ->
Format.fprintf ppf Format.fprintf ppf