Refactor library management (#516)

Lib module
----------

We have a new module Lib that replaces Lib, parts of Lib_db and parts
of Findlib. It is used to manage all libraries (internal and
extrernal). Lib.t represent a completely resolved library, i.e. where
all the dependencies have been resolved. Lib.Compile is used to
provide what is necessary to build the library itself. Lib.Meta
provides what is necessary to generate the META file for the library.

We also have library databases represented as Lib.DB.t. A library
database is simply a mapping from names to Lib.t values and and
created from a resolve function that looks up a name and return a
Lib.Info.t. A Lib.Info.t is the same as a Lib.t except that
dependencies are not resolved.

A library database can have a parent database that is used to lookup
names that are not found in the current database. In practice we have
the following hierarchy:

1. For every scope, we have a library database that holds all the
   libraries of this scope. In this DB, a library can be referred by
   either it's name or public name

2. the parent of each of these databases is a database that holds all
   the public libraries of the workspace. In this DB libraries must be
   referred by their public name

3. the parent of this DB is for installed libraries

(1) databases are accessible via Scope.libs
    (Super_context.find_scope_by_{name,dir} sctx xxx)
(2) is accessible via Super_context.public_libs sctx
(3) is accessible via Super_context.installed_libs sctx

The dependencies of a library are always resolved inside the DB it is
part of. When we compute a transitive closure, we check that we don't
have two libraries from two different DB with the same name. So for
instance linting Base should now supported.

Jbuild.Scope_info
-----------------

Jbuild.Scope was renamed Jbuild.Scope_info

Scope module
------------

This replaces Lib_db. A Scope.t is now just a pair of a
Jbuild.Scope_info.t and a Lib.DB.t. Scope.DB.t is an object used to
lookup scopes by either name or directory.

We no longer have an external scope or special anonymous
scope. Instead one should use Super_context.installed_libs or
Super_context.public_libs depending on the context.

CHANGES.md

@@ -42,6 +42,9 @@
   `@doc-private` alias has been added to build documentation for private
   libraries.
 
+- Refactor internal library management. It should now be possible to
+  run `jbuilder build @lint` in Base for instance (#516)
+
 1.0+beta17 (01/02/2018)
 -----------------------
 

Makefile

@@ -47,6 +47,5 @@ doc:
 update-jbuilds: $(BIN)
 	$(BIN) build --dev @doc/runtest --auto-promote
 
-.DEFAULT_GOAL := default
 .PHONY: default install uninstall reinstall clean test doc
 .PHONY: promote accept-corrections

bin/main.ml

@@ -492,21 +492,19 @@ let installed_libraries =
        let findlib = ctx.findlib in
        if na then begin
          let pkgs = Findlib.all_unavailable_packages findlib in
-         let longest = List.longest_map pkgs ~f:(fun na -> na.package) in
+         let longest = List.longest_map pkgs ~f:(fun (n, _) -> n) in
          let ppf = Format.std_formatter in
-         List.iter pkgs ~f:(fun (na : Findlib.Package_not_available.t) ->
-           Format.fprintf ppf "%-*s -> %a@\n" longest na.package
-             Findlib.Package_not_available.explain na.reason);
+         List.iter pkgs ~f:(fun (n, r) ->
+           Format.fprintf ppf "%-*s -> %a@\n" longest n
+             Findlib.Unavailable_reason.pp r);
          Format.pp_print_flush ppf ();
          Fiber.return ()
        end else begin
          let pkgs = Findlib.all_packages findlib in
          let max_len = List.longest_map pkgs ~f:Findlib.Package.name in
          List.iter pkgs ~f:(fun pkg ->
            let ver =
-             match Findlib.Package.version pkg with
-             | "" -> "n/a"
-             | v  -> v
+             Option.value (Findlib.Package.version pkg) ~default:"n/a"
            in
            Printf.printf "%-*s (version: %s)\n" max_len
              (Findlib.Package.name pkg) ver);

src/artifacts.ml

@@ -2,59 +2,53 @@ open Import
 open Jbuild
 
 type t =
-  { context    : Context.t
-  ; local_bins : Path.t String_map.t
-  ; local_libs : Public_lib.t String_map.t
+  { context     : Context.t
+  ; local_bins  : Path.t String_map.t
+  ; public_libs : Lib.DB.t
   }
 
-let create (context : Context.t) l ~f =
+let create (context : Context.t) ~public_libs l ~f =
   let bin_dir = Config.local_install_bin_dir ~context:context.name in
-  let local_bins, local_libs =
-    List.fold_left l ~init:(String_map.empty, String_map.empty)
-      ~f:(fun acc x ->
-        List.fold_left (f x) ~init:acc
-          ~f:(fun (local_bins, local_libs) stanza ->
-            match (stanza : Stanza.t) with
-            | Install { section = Bin; files; _ } ->
-              (List.fold_left files ~init:local_bins
-                 ~f:(fun acc { Install_conf. src; dst } ->
-                   let name =
-                     match dst with
-                     | Some s -> s
-                     | None -> Filename.basename src
-                   in
-                   let key =
-                     if Sys.win32 && Filename.extension name = ".exe" then
-                       String.sub name ~pos:0 ~len:(String.length name - 4)
-                     else
-                       name
-                   in
-                   let in_bin_dir =
-                     let fn =
-                       if Sys.win32 then
-                         match Filename.extension src with
-                         | ".exe" | ".bc" ->
-                           if Filename.extension name <> ".exe" then
-                             name ^ ".exe"
-                           else
-                             name
-                         | _ -> name
-                       else
-                         name
-                     in
-                     Path.relative bin_dir fn
-                   in
-                   String_map.add acc ~key ~data:in_bin_dir),
-               local_libs)
-            | Library { public = Some pub; _ } ->
-              (local_bins,
-               String_map.add local_libs ~key:pub.name ~data:pub)
-            | _ ->
-              (local_bins, local_libs)))
+  let local_bins =
+    List.fold_left l ~init:String_map.empty ~f:(fun acc x ->
+      List.fold_left (f x) ~init:acc ~f:(fun local_bins stanza ->
+        match (stanza : Stanza.t) with
+        | Install { section = Bin; files; _ } ->
+          List.fold_left files ~init:local_bins
+            ~f:(fun acc { Install_conf. src; dst } ->
+              let name =
+                match dst with
+                | Some s -> s
+                | None -> Filename.basename src
+              in
+              let key =
+                if Sys.win32 && Filename.extension name = ".exe" then
+                  String.sub name ~pos:0 ~len:(String.length name - 4)
+                else
+                  name
+              in
+              let in_bin_dir =
+                let fn =
+                  if Sys.win32 then
+                    match Filename.extension src with
+                    | ".exe" | ".bc" ->
+                      if Filename.extension name <> ".exe" then
+                        name ^ ".exe"
+                      else
+                        name
+                    | _ -> name
+                  else
+                    name
+                in
+                Path.relative bin_dir fn
+              in
+              String_map.add acc ~key ~data:in_bin_dir)
+        | _ ->
+          local_bins))
   in
   { context
   ; local_bins
-  ; local_libs
+  ; public_libs
   }
 
 let binary t ?hint name =
@@ -74,25 +68,24 @@ let binary t ?hint name =
           ; context = t.context.Context.name
           }
 
-let file_of_lib t ~from ~lib ~file =
-  match String_map.find lib t.local_libs with
-  | Some { package; sub_dir; _ } ->
-    let lib_install_dir =
-      Config.local_install_lib_dir ~context:t.context.name ~package:package.name
-    in
-    let lib_install_dir =
-      match sub_dir with
-      | None -> lib_install_dir
-      | Some dir -> Path.relative lib_install_dir dir
-    in
-    Ok (Path.relative lib_install_dir file)
-  | None ->
-    match
-      Findlib.find t.context.findlib lib
-        ~required_by:[With_required_by.Entry.jbuild_file_in ~dir:from]
-    with
-    | Ok pkg ->
-      Ok (Path.relative (Findlib.Package.dir pkg) file)
-    | Error na ->
-      Error { fail = fun () ->
-        raise (Findlib.Findlib (Package_not_available na)) }
+let file_of_lib t ~loc ~lib ~file =
+  match Lib.DB.find t.public_libs lib with
+  | Error reason ->
+    Error { fail = fun () ->
+      Lib.not_available ~loc reason "Public library %S" lib  }
+  | Ok lib ->
+    if Lib.is_local lib then begin
+      match String.split (Lib.name lib) ~on:'.' with
+      | [] -> assert false
+      | package :: rest ->
+        let lib_install_dir =
+          Config.local_install_lib_dir ~context:t.context.name ~package
+        in
+        let lib_install_dir =
+          match rest with
+          | [] -> lib_install_dir
+          | _  -> Path.relative lib_install_dir (String.concat rest ~sep:"/")
+        in
+        Ok (Path.relative lib_install_dir file)
+    end else
+      Ok (Path.relative (Lib.src_dir lib) file)

src/artifacts.mli

@@ -4,6 +4,7 @@ type t
 
 val create
   :  Context.t
+  -> public_libs:Lib.DB.t
   -> 'a list
   -> f:('a -> Jbuild.Stanza.t list)
   -> t
@@ -18,11 +19,11 @@ val binary
   -> string
   -> Action.Prog.t
 
-(** [file_of_lib t ~from ~lib ~file] returns the path to a file in the directory of the
-    given library. *)
+(** [file_of_lib t ~from ~lib ~file] returns the path to a file in the
+    directory of the given library. *)
 val file_of_lib
   :  t
-  -> from:Path.t
+  -> loc:Loc.t
   -> lib:string
   -> file:string
   -> (Path.t, fail) result

src/build_system.ml

@@ -464,10 +464,14 @@ module Build_exec = struct
         | Unevaluated ->
           m.state <- Evaluating;
           let dyn_deps' = ref Pset.empty in
-          let x = exec dyn_deps' m.t x in
-          m.state <- Evaluated (x, !dyn_deps');
-          dyn_deps := Pset.union !dyn_deps !dyn_deps';
-          x
+          match exec dyn_deps' m.t x with
+          | x ->
+            m.state <- Evaluated (x, !dyn_deps');
+            dyn_deps := Pset.union !dyn_deps !dyn_deps';
+            x
+          | exception exn ->
+            m.state <- Unevaluated;
+            reraise exn
     in
     let dyn_deps = ref Pset.empty in
     let action = exec dyn_deps (Build.repr t) x in

src/context.ml

@@ -217,8 +217,8 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
     let get_tool_using_findlib_config prog =
       Option.bind findlib_config ~f:(fun conf ->
         match Findlib.Config.get conf prog with
-        | "" -> None
-        | s ->
+        | None -> None
+        | Some s ->
           match Filename.analyze_program_name s with
           | In_path | Relative_to_current_dir -> which s
           | Absolute -> Some (Path.absolute s))