From 2ee522be52d34400d59bb0eff79a2b5078983b89 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= <jeremie@dimino.org>
Date: Tue, 28 Feb 2017 06:01:27 +0000
Subject: [PATCH] Add a Findlib.t in the context

---
 bin/main.ml             |  2 +-
 src/cm_kind.ml          |  3 ---
 src/cm_kind.mli         |  1 -
 src/context.ml          |  6 +++---
 src/context.mli         |  3 +--
 src/findlib.ml          | 26 +++++++++++++-------------
 src/findlib.mli         |  7 ++++---
 src/gen_rules.ml        | 37 ++++++++++++++++++++++++++++++-------
 src/jbuild_load.ml      | 19 ++++++++++++++++---
 src/mode.ml             |  7 -------
 src/mode.mli            |  3 ---
 src/named_artifacts.ml  |  9 +++++----
 src/named_artifacts.mli |  2 +-
 13 files changed, 74 insertions(+), 51 deletions(-)

diff --git a/bin/main.ml b/bin/main.ml
index 766326ba..602a86b7 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -81,7 +81,7 @@ let installed_libraries =
     set_common common;
     Future.Scheduler.go ~log:(create_log ())
       (Context.default () >>= fun ctx ->
-       let findlib = Findlib.create ctx in
+       let findlib = ctx.findlib in
        let pkgs = Findlib.all_packages findlib in
        let max_len = List.longest_map pkgs ~f:(fun p -> p.name) in
        List.iter pkgs ~f:(fun pkg ->
diff --git a/src/cm_kind.ml b/src/cm_kind.ml
index 105dfe98..e754bbf3 100644
--- a/src/cm_kind.ml
+++ b/src/cm_kind.ml
@@ -9,7 +9,4 @@ let choose cmi cmo cmx = function
 
 let ext = choose ".cmi" ".cmo" ".cmx"
 
-let compiler t (ctx : Context.t) =
-  choose (Some ctx.ocamlc) (Some ctx.ocamlc) ctx.ocamlopt t
-
 let source = choose Ml_kind.Intf Impl Impl
diff --git a/src/cm_kind.mli b/src/cm_kind.mli
index 51dffdaa..0de11f47 100644
--- a/src/cm_kind.mli
+++ b/src/cm_kind.mli
@@ -3,5 +3,4 @@ type t = Cmi | Cmo | Cmx
 val all : t list
 
 val ext : t -> string
-val compiler : t -> Context.t -> Path.t option
 val source : t -> Ml_kind.t
diff --git a/src/context.ml b/src/context.ml
index 841d45c5..a61d923f 100644
--- a/src/context.ml
+++ b/src/context.ml
@@ -27,9 +27,9 @@ type t =
   ; ocamlyacc               : Path.t
   ; ocamlmklib              : Path.t
   ; env                     : string array
-  ; findlib_path            : Path.t list
+  ; findlib                 : Findlib.t
   ; arch_sixtyfour          : bool
-  ; opam_var_cache : (string, string) Hashtbl.t
+  ; opam_var_cache          : (string, string) Hashtbl.t
   ; ocamlc_config           : (string * string) list
   ; version                 : string
   ; stdlib_dir              : Path.t
@@ -194,7 +194,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin =
     ; ocamlmklib = get_prog  "ocamlmklib"
 
     ; env
-    ; findlib_path
+    ; findlib = Findlib.create ~stdlib_dir ~path:findlib_path
     ; arch_sixtyfour = get_arch_sixtyfour stdlib_dir
 
     ; opam_var_cache
diff --git a/src/context.mli b/src/context.mli
index eb6e28c8..d6ca9437 100644
--- a/src/context.mli
+++ b/src/context.mli
@@ -60,8 +60,7 @@ type t =
   ; (** Environment variables *)
     env : string array
 
-  ; (** Where to look for META files *)
-    findlib_path : Path.t list
+  ; findlib : Findlib.t
 
   ; (** Misc *)
     arch_sixtyfour : bool
diff --git a/src/findlib.ml b/src/findlib.ml
index af3ae012..3f46a7ef 100644
--- a/src/findlib.ml
+++ b/src/findlib.ml
@@ -135,11 +135,19 @@ type present_or_absent =
   | Absent
 
 type t =
-  { context     : Context.t
+  { stdlib_dir  : Path.t
+  ; path        : Path.t list
   ; packages    : (string, present_or_absent) Hashtbl.t
   ; has_headers : (Path.t, bool             ) Hashtbl.t
   }
 
+let create ~stdlib_dir ~path =
+  { stdlib_dir
+  ; path
+  ; packages    = Hashtbl.create 1024
+  ; has_headers = Hashtbl.create 1024
+  }
+
 let has_headers t ~dir =
   match Hashtbl.find t.has_headers dir with
   | Some x -> x
@@ -153,14 +161,6 @@ let has_headers t ~dir =
     Hashtbl.add t.has_headers ~key:dir ~data:x;
     x
 
-let context t = t.context
-
-let create context =
-  { context
-  ; packages    = Hashtbl.create 1024
-  ; has_headers = Hashtbl.create 1024
-  }
-
 module Pkg_step1 = struct
   type t =
     { package          : package
@@ -176,7 +176,7 @@ let parse_package t ~name ~parent_dir ~vars =
     if pkg_dir = "" then
       parent_dir
     else if pkg_dir.[0] = '+' || pkg_dir.[0] = '^' then
-      Path.relative t.context.stdlib_dir
+      Path.relative t.stdlib_dir
         (String.sub pkg_dir ~pos:1 ~len:(String.length pkg_dir - 1))
     else if Filename.is_relative pkg_dir then
       Path.relative parent_dir pkg_dir
@@ -250,10 +250,10 @@ let rec load_meta_rec t root_name ~packages =
           loop dirs
       | [] ->
         match String_map.find root_name Meta.builtins with
-        | Some meta -> (t.context.stdlib_dir, meta)
+        | Some meta -> (t.stdlib_dir, meta)
         | None -> raise (Package_not_found root_name)
     in
-    let dir, meta = loop t.context.findlib_path in
+    let dir, meta = loop t.path in
     let new_packages = parse_meta t ~dir meta in
     let packages =
       List.fold_left new_packages ~init:packages ~f:(fun acc (pkg : Pkg_step1.t) ->
@@ -408,7 +408,7 @@ let closed_ppx_runtime_deps_of pkgs =
 
 let root_packages t =
   let pkgs =
-    List.concat_map t.context.findlib_path ~f:(fun dir ->
+    List.concat_map t.path ~f:(fun dir ->
       Sys.readdir (Path.to_string dir)
       |> Array.to_list
       |> List.filter ~f:(fun name ->
diff --git a/src/findlib.mli b/src/findlib.mli
index d3a4291f..34e01388 100644
--- a/src/findlib.mli
+++ b/src/findlib.mli
@@ -5,9 +5,10 @@ exception Package_not_found of string
 (** Findlib database *)
 type t
 
-val create : Context.t -> t
-
-val context : t -> Context.t
+val create
+  :  stdlib_dir:Path.t
+  -> path:Path.t list
+  -> t
 
 type package =
   { name             : string
diff --git a/src/gen_rules.ml b/src/gen_rules.ml
index a8e705e1..7d19de37 100644
--- a/src/gen_rules.ml
+++ b/src/gen_rules.ml
@@ -123,7 +123,30 @@ module Gen(P : Params) = struct
 
   let ctx = P.context
 
-  let findlib = Findlib.create ctx
+  let findlib = ctx.findlib
+
+  module Mode = struct
+    include Mode
+
+    let choose byte native = function
+      | Byte   -> byte
+      | Native -> native
+
+    let compiler t = choose (Some ctx.ocamlc) ctx.ocamlopt t
+
+    let best =
+      match ctx.ocamlopt with
+      | Some _ -> Native
+      | None   -> Byte
+  end
+
+  module Cm_kind = struct
+    include Cm_kind
+
+    let compiler = function
+      | Cmi | Cmo -> Some ctx.ocamlc
+      | Cmx -> ctx.ocamlopt
+  end
 
   module Lib_db = struct
     open Lib_db
@@ -220,7 +243,7 @@ module Gen(P : Params) = struct
   module Named_artifacts = struct
     open Named_artifacts
 
-    let t = create findlib (List.map P.stanzas ~f:(fun d -> (d.ctx_dir, d.stanzas)))
+    let t = create ctx findlib (List.map P.stanzas ~f:(fun d -> (d.ctx_dir, d.stanzas)))
 
     let binary name = Build.arr (fun _  -> binary t name)
     let in_findlib ~dir ~dep_kind name =
@@ -518,8 +541,8 @@ module Gen(P : Params) = struct
   let ppx_drivers = Hashtbl.create 32
 
   let build_ppx_driver ~dir ~dep_kind ~target ~runner pp_names =
-    let mode = Mode.best ctx in
-    let compiler = Option.value_exn (Mode.compiler mode ctx) in
+    let mode = Mode.best in
+    let compiler = Option.value_exn (Mode.compiler mode) in
     let libs =
       Build.fanout
         (Lib_db.closure ~dir ~dep_kind (Direct "ppx_driver" ::
@@ -761,7 +784,7 @@ module Gen(P : Params) = struct
 
   let build_cm ~flags ~cm_kind ~dep_graph ~requires
         ~(modules : Module.t String_map.t) ~dir ~alias_module (m : Module.t) =
-    Option.iter (Cm_kind.compiler cm_kind ctx) ~f:(fun compiler ->
+    Option.iter (Cm_kind.compiler cm_kind) ~f:(fun compiler ->
       Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src ->
         let ml_kind = Cm_kind.source cm_kind in
         let dst = Module.cm_file m ~dir cm_kind in
@@ -879,7 +902,7 @@ module Gen(P : Params) = struct
     Path.relative dir (sprintf "dll%s_stubs%s" lib.name ctx.ext_dll)
 
   let build_lib (lib : Library.t) ~flags ~dir ~mode ~modules ~dep_graph =
-    Option.iter (Mode.compiler mode ctx) ~f:(fun compiler ->
+    Option.iter (Mode.compiler mode) ~f:(fun compiler ->
       let target = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext mode) in
       let dep_graph = Ml_kind.Dict.get dep_graph Impl in
       let stubs_flags =
@@ -1158,7 +1181,7 @@ module Gen(P : Params) = struct
   let build_exe ~flags ~dir ~requires ~name ~mode ~modules ~dep_graph ~link_flags =
     let exe_ext = Mode.exe_ext mode in
     let mode, link_flags, compiler =
-      match Mode.compiler mode ctx with
+      match Mode.compiler mode with
       | Some compiler -> (mode, link_flags, compiler)
       | None          -> (Byte, "-custom" :: link_flags, ctx.ocamlc)
     in
diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml
index f8f1a0b5..af5e560b 100644
--- a/src/jbuild_load.ml
+++ b/src/jbuild_load.ml
@@ -20,9 +20,19 @@ module Jbuilds = struct
     | Local path -> Path.Local.ensure_parent_directory_exists path
     | External _ -> ()
 
+  let extract_requires str =
+    List.fold_left (String.split str ~on:'\n') ~init:String_set.empty ~f:(fun acc line ->
+      match Scanf.sscanf line "#require %S" (fun x -> x) with
+      | exception _ -> acc
+      | s ->
+        String_set.union acc
+          (String_set.of_list (String.split s ~on:',')))
+    |> String_set.elements
+
   let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper ~target =
+    let plugin = Path.to_string plugin in
+    let plugin_contents = read_file plugin in
     with_file_out (Path.to_string wrapper) ~f:(fun oc ->
-      let plugin = Path.to_string plugin in
       Printf.fprintf oc {|
 module Jbuild_plugin = struct
   module V1 = struct
@@ -48,7 +58,8 @@ end
             List.map context.ocamlc_config ~f:(fun (k, v) ->
                 Printf.sprintf "%-*S , %S" (longest + 2) k v)))
         (Path.reach ~from:exec_dir target)
-        plugin (read_file plugin))
+        plugin plugin_contents);
+    extract_requires plugin_contents
 
   let eval jbuilds ~(context : Context.t) =
     let open Future in
@@ -64,7 +75,9 @@ end
         in
         let wrapper = Path.extend_basename generated_jbuild ~suffix:".ml" in
         ensure_parent_dir_exists generated_jbuild;
-        create_plugin_wrapper context ~exec_dir:dir ~plugin:file ~wrapper ~target:generated_jbuild;
+        let _requires =
+          create_plugin_wrapper context ~exec_dir:dir ~plugin:file ~wrapper ~target:generated_jbuild
+        in
         Future.run Strict ~dir:(Path.to_string dir) ~env:context.env
           (Path.to_string context.Context.ocaml)
           [ Path.reach ~from:dir wrapper ]
diff --git a/src/mode.ml b/src/mode.ml
index 2ffa17f9..5ba79ac9 100644
--- a/src/mode.ml
+++ b/src/mode.ml
@@ -18,19 +18,12 @@ let choose byte native = function
 let compiled_unit_ext = choose ".cmo" ".cmx"
 let compiled_lib_ext = choose ".cma" ".cmxa"
 
-let compiler t (ctx : Context.t) = choose (Some ctx.ocamlc) ctx.ocamlopt t
-
 let findlib_predicate = choose "byte" "native"
 
 let cm_kind = choose Cm_kind.Cmo Cmx
 
 let exe_ext = choose ".bc" ".exe"
 
-let best (ctx : Context.t) =
-  match ctx.ocamlopt with
-  | Some _ -> Native
-  | None   -> Byte
-
 let of_cm_kind : Cm_kind.t -> t = function
   | Cmi | Cmo -> Byte
   | Cmx -> Native
diff --git a/src/mode.mli b/src/mode.mli
index 0fda04e3..ec027631 100644
--- a/src/mode.mli
+++ b/src/mode.mli
@@ -9,15 +9,12 @@ val all : t list
 val compiled_unit_ext : t -> string
 val compiled_lib_ext : t -> string
 val exe_ext : t -> string
-val compiler : t -> Context.t -> Path.t option
 
 val cm_kind : t -> Cm_kind.t
 val of_cm_kind : Cm_kind.t -> t
 
 val findlib_predicate : t -> string
 
-val best : Context.t -> t
-
 module Dict : sig
   type mode = t
 
diff --git a/src/named_artifacts.ml b/src/named_artifacts.ml
index 0a4dacc2..d0a6a103 100644
--- a/src/named_artifacts.ml
+++ b/src/named_artifacts.ml
@@ -2,11 +2,12 @@ open Import
 open Jbuild_types
 
 type t =
-  { findlib   : Findlib.t
+  { context   : Context.t
+  ; findlib   : Findlib.t
   ; artifacts : (string, Path.t) Hashtbl.t
   }
 
-let create findlib stanzas =
+let create context findlib stanzas =
   let artifacts : (string, Path.t) Hashtbl.t = Hashtbl.create 1024 in
   List.iter stanzas ~f:(fun (dir, stanzas) ->
     List.iter stanzas ~f:(fun stanza ->
@@ -14,13 +15,13 @@ let create findlib stanzas =
       | Provides { name; file } ->
         Hashtbl.add artifacts ~key:name ~data:(Path.relative dir file)
       | _ -> ()));
-  { findlib; artifacts }
+  { context; findlib; artifacts }
 
 let binary t name =
   match Hashtbl.find t.artifacts name with
   | Some p -> p
   | None ->
-    match Bin.which ~path:(Findlib.context t.findlib).path name with
+    match Context.which t.context name with
     | Some p ->
       Hashtbl.add t.artifacts ~key:name ~data:p;
       p
diff --git a/src/named_artifacts.mli b/src/named_artifacts.mli
index c131d2f0..af9d0cd0 100644
--- a/src/named_artifacts.mli
+++ b/src/named_artifacts.mli
@@ -7,7 +7,7 @@ open! Import
 
 type t
 
-val create : Findlib.t -> (Path.t * Jbuild_types.Stanza.t list) list -> t
+val create : Context.t -> Findlib.t -> (Path.t * Jbuild_types.Stanza.t list) list -> t
 
 (** In the three following functions, the string argument matches the first argument of
     the [(provides ...)] stanza in the jbuild. *)