Skip to content

Move info to lib #1082

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
rgrinberg merged 1 commit into from
Aug 1, 2018
Merged

Move info to lib #1082

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
81 changes: 29 additions & 52 deletions src/lib.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -221,26 +221,14 @@ module Id = struct
end

type t =
{ loc : Loc.t
{ info : Info.t
; name : string
; 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
; ppx_runtime_deps : t list Or_exn.t
; pps : t list Or_exn.t
; resolved_selects : Resolved_select.t list
; optional : bool
; user_written_deps : Jbuild.Lib_deps.t
; dune_version : Syntax.Version.t option
; (* This is mutable to avoid this error:

{[
Expand Down Expand Up @@ -340,24 +328,24 @@ let not_available ~loc reason fmt =

let name t = t.name

let kind t = t.kind
let synopsis t = t.synopsis
let archives t = t.archives
let plugins t = t.plugins
let jsoo_runtime t = t.jsoo_runtime
let kind t = t.info.kind
let synopsis t = t.info.synopsis
let archives t = t.info.archives
let plugins t = t.info.plugins
let jsoo_runtime t = t.info.jsoo_runtime
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 obj_dir t = t.obj_dir
let src_dir t = t.info.src_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 =
match t.status with
match t.info.status with
| Installed ->
Some (Findlib.root_package_name t.name
|> Package.Name.of_string)
Expand All @@ -367,7 +355,7 @@ let package t =

let to_id t : Id.t =
{ unique_id = t.unique_id
; path = t.src_dir
; path = t.info.src_dir
; name = t.name
}

Expand Down Expand Up @@ -405,7 +393,7 @@ module L = struct
let c_include_paths ts ~stdlib_dir =
let dirs =
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
Path.Set.remove dirs stdlib_dir

Expand All @@ -415,7 +403,8 @@ module L = struct
let link_flags ts ~mode ~stdlib_dir =
Arg_spec.S
(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 dirs =
Expand All @@ -426,15 +415,15 @@ module L = struct
Arg_spec.S
(to_iflags dirs ::
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 =
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 =
List.concat_map ts ~f:(fun t ->
Mode.Dict.get t.archives mode @
List.map (Mode.Dict.get t.foreign_archives mode)
Mode.Dict.get t.info.archives mode @
List.map (Mode.Dict.get t.info.foreign_archives mode)
~f:(Path.extend_basename ~suffix:ext_lib))

let remove_dups l =
Expand Down Expand Up @@ -587,7 +576,7 @@ module Dep_stack = struct
end

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 (
Private_deps_not_allowed { private_dep = lib ; pd_loc = loc }))
else
Expand All @@ -602,7 +591,7 @@ let already_in_table (info : Info.t) name x =
Path.sexp_of_t x.path]
| St_found t ->
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 ->
Sexp.unsafe_atom_of_string "Not_found"
| St_hidden (_, { path; reason; _ }) ->
Expand Down Expand Up @@ -648,27 +637,15 @@ let rec instantiate db name (info : Info.t) ~stack ~hidden =
let resolve (loc, name) =
resolve_dep db name ~allow_private_deps ~loc ~stack in
let t =
{ loc = info.loc
{ info = info
; name = name
; 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
; ppx_runtime_deps = ppx_runtime_deps
; pps = pps
; resolved_selects = resolved_selects
; optional = info.optional
; user_written_deps = Info.user_written_deps info
; sub_systems = Sub_system_name.Map.empty
; dune_version = info.dune_version
}
in
t.sub_systems <-
Expand All @@ -688,7 +665,7 @@ let rec instantiate db name (info : Info.t) ~stack ~hidden =
match hidden with
| None -> St_found t
| Some reason ->
St_hidden (t, { name; path = t.src_dir; reason })
St_hidden (t, { name; path = t.info.src_dir; reason })
in
Hashtbl.replace db.table ~key:name ~data:res;
res
Expand Down Expand Up @@ -941,7 +918,7 @@ module Compile = struct
; requires = t.requires >>= closure_with_overlap_checks db
; resolved_selects = t.resolved_selects
; pps = t.pps
; optional = t.optional
; optional = t.info.optional
; user_written_deps = t.user_written_deps
; sub_systems = t.sub_systems
}
Expand Down Expand Up @@ -1161,9 +1138,9 @@ let report_lib_error ppf (e : Error.t) =
- %S in %s@,\
\ %a@,\
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
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
| Overlap { in_workspace = lib1; installed = (lib2, rb2) } ->
Format.fprintf ppf
Expand All @@ -1172,8 +1149,8 @@ let report_lib_error ppf (e : Error.t) =
- %S in %s@,\
\ %a@,\
This is not allowed.@\n"
lib1.name (Path.to_string_maybe_quoted lib1.src_dir)
lib2.name (Path.to_string_maybe_quoted lib2.src_dir)
lib1.name (Path.to_string_maybe_quoted lib1.info.src_dir)
lib2.name (Path.to_string_maybe_quoted lib2.info.src_dir)
Dep_path.Entries.pp rb2
| No_solution_found_for_select { loc } ->
Format.fprintf ppf
Expand Down