Add a Findlib.t in the context

This commit is contained in:
Jérémie Dimino 2017-02-28 06:01:27 +00:00
parent 9123508e43
commit 2ee522be52
13 changed files with 74 additions and 51 deletions

View File

@ -81,7 +81,7 @@ let installed_libraries =
set_common common; set_common common;
Future.Scheduler.go ~log:(create_log ()) Future.Scheduler.go ~log:(create_log ())
(Context.default () >>= fun ctx -> (Context.default () >>= fun ctx ->
let findlib = Findlib.create ctx in let findlib = ctx.findlib in
let pkgs = Findlib.all_packages findlib in let pkgs = Findlib.all_packages findlib in
let max_len = List.longest_map pkgs ~f:(fun p -> p.name) in let max_len = List.longest_map pkgs ~f:(fun p -> p.name) in
List.iter pkgs ~f:(fun pkg -> List.iter pkgs ~f:(fun pkg ->

View File

@ -9,7 +9,4 @@ let choose cmi cmo cmx = function
let ext = choose ".cmi" ".cmo" ".cmx" 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 let source = choose Ml_kind.Intf Impl Impl

View File

@ -3,5 +3,4 @@ type t = Cmi | Cmo | Cmx
val all : t list val all : t list
val ext : t -> string val ext : t -> string
val compiler : t -> Context.t -> Path.t option
val source : t -> Ml_kind.t val source : t -> Ml_kind.t

View File

@ -27,9 +27,9 @@ type t =
; ocamlyacc : Path.t ; ocamlyacc : Path.t
; ocamlmklib : Path.t ; ocamlmklib : Path.t
; env : string array ; env : string array
; findlib_path : Path.t list ; findlib : Findlib.t
; arch_sixtyfour : bool ; arch_sixtyfour : bool
; opam_var_cache : (string, string) Hashtbl.t ; opam_var_cache : (string, string) Hashtbl.t
; ocamlc_config : (string * string) list ; ocamlc_config : (string * string) list
; version : string ; version : string
; stdlib_dir : Path.t ; stdlib_dir : Path.t
@ -194,7 +194,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin =
; ocamlmklib = get_prog "ocamlmklib" ; ocamlmklib = get_prog "ocamlmklib"
; env ; env
; findlib_path ; findlib = Findlib.create ~stdlib_dir ~path:findlib_path
; arch_sixtyfour = get_arch_sixtyfour stdlib_dir ; arch_sixtyfour = get_arch_sixtyfour stdlib_dir
; opam_var_cache ; opam_var_cache

View File

@ -60,8 +60,7 @@ type t =
; (** Environment variables *) ; (** Environment variables *)
env : string array env : string array
; (** Where to look for META files *) ; findlib : Findlib.t
findlib_path : Path.t list
; (** Misc *) ; (** Misc *)
arch_sixtyfour : bool arch_sixtyfour : bool

View File

@ -135,11 +135,19 @@ type present_or_absent =
| Absent | Absent
type t = type t =
{ context : Context.t { stdlib_dir : Path.t
; path : Path.t list
; packages : (string, present_or_absent) Hashtbl.t ; packages : (string, present_or_absent) Hashtbl.t
; has_headers : (Path.t, bool ) 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 = let has_headers t ~dir =
match Hashtbl.find t.has_headers dir with match Hashtbl.find t.has_headers dir with
| Some x -> x | Some x -> x
@ -153,14 +161,6 @@ let has_headers t ~dir =
Hashtbl.add t.has_headers ~key:dir ~data:x; Hashtbl.add t.has_headers ~key:dir ~data:x;
x x
let context t = t.context
let create context =
{ context
; packages = Hashtbl.create 1024
; has_headers = Hashtbl.create 1024
}
module Pkg_step1 = struct module Pkg_step1 = struct
type t = type t =
{ package : package { package : package
@ -176,7 +176,7 @@ let parse_package t ~name ~parent_dir ~vars =
if pkg_dir = "" then if pkg_dir = "" then
parent_dir parent_dir
else if pkg_dir.[0] = '+' || pkg_dir.[0] = '^' then 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)) (String.sub pkg_dir ~pos:1 ~len:(String.length pkg_dir - 1))
else if Filename.is_relative pkg_dir then else if Filename.is_relative pkg_dir then
Path.relative parent_dir pkg_dir Path.relative parent_dir pkg_dir
@ -250,10 +250,10 @@ let rec load_meta_rec t root_name ~packages =
loop dirs loop dirs
| [] -> | [] ->
match String_map.find root_name Meta.builtins with 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) | None -> raise (Package_not_found root_name)
in 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 new_packages = parse_meta t ~dir meta in
let packages = let packages =
List.fold_left new_packages ~init:packages ~f:(fun acc (pkg : Pkg_step1.t) -> 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 root_packages t =
let pkgs = 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) Sys.readdir (Path.to_string dir)
|> Array.to_list |> Array.to_list
|> List.filter ~f:(fun name -> |> List.filter ~f:(fun name ->

View File

@ -5,9 +5,10 @@ exception Package_not_found of string
(** Findlib database *) (** Findlib database *)
type t type t
val create : Context.t -> t val create
: stdlib_dir:Path.t
val context : t -> Context.t -> path:Path.t list
-> t
type package = type package =
{ name : string { name : string

View File

@ -123,7 +123,30 @@ module Gen(P : Params) = struct
let ctx = P.context 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 module Lib_db = struct
open Lib_db open Lib_db
@ -220,7 +243,7 @@ module Gen(P : Params) = struct
module Named_artifacts = struct module Named_artifacts = struct
open Named_artifacts 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 binary name = Build.arr (fun _ -> binary t name)
let in_findlib ~dir ~dep_kind name = let in_findlib ~dir ~dep_kind name =
@ -518,8 +541,8 @@ module Gen(P : Params) = struct
let ppx_drivers = Hashtbl.create 32 let ppx_drivers = Hashtbl.create 32
let build_ppx_driver ~dir ~dep_kind ~target ~runner pp_names = let build_ppx_driver ~dir ~dep_kind ~target ~runner pp_names =
let mode = Mode.best ctx in let mode = Mode.best in
let compiler = Option.value_exn (Mode.compiler mode ctx) in let compiler = Option.value_exn (Mode.compiler mode) in
let libs = let libs =
Build.fanout Build.fanout
(Lib_db.closure ~dir ~dep_kind (Direct "ppx_driver" :: (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 let build_cm ~flags ~cm_kind ~dep_graph ~requires
~(modules : Module.t String_map.t) ~dir ~alias_module (m : Module.t) = ~(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 -> Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src ->
let ml_kind = Cm_kind.source cm_kind in let ml_kind = Cm_kind.source cm_kind in
let dst = Module.cm_file m ~dir 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) 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 = 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 target = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext mode) in
let dep_graph = Ml_kind.Dict.get dep_graph Impl in let dep_graph = Ml_kind.Dict.get dep_graph Impl in
let stubs_flags = 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 build_exe ~flags ~dir ~requires ~name ~mode ~modules ~dep_graph ~link_flags =
let exe_ext = Mode.exe_ext mode in let exe_ext = Mode.exe_ext mode in
let mode, link_flags, compiler = let mode, link_flags, compiler =
match Mode.compiler mode ctx with match Mode.compiler mode with
| Some compiler -> (mode, link_flags, compiler) | Some compiler -> (mode, link_flags, compiler)
| None -> (Byte, "-custom" :: link_flags, ctx.ocamlc) | None -> (Byte, "-custom" :: link_flags, ctx.ocamlc)
in in

View File

@ -20,9 +20,19 @@ module Jbuilds = struct
| Local path -> Path.Local.ensure_parent_directory_exists path | Local path -> Path.Local.ensure_parent_directory_exists path
| External _ -> () | 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 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 -> with_file_out (Path.to_string wrapper) ~f:(fun oc ->
let plugin = Path.to_string plugin in
Printf.fprintf oc {| Printf.fprintf oc {|
module Jbuild_plugin = struct module Jbuild_plugin = struct
module V1 = struct module V1 = struct
@ -48,7 +58,8 @@ end
List.map context.ocamlc_config ~f:(fun (k, v) -> List.map context.ocamlc_config ~f:(fun (k, v) ->
Printf.sprintf "%-*S , %S" (longest + 2) k v))) Printf.sprintf "%-*S , %S" (longest + 2) k v)))
(Path.reach ~from:exec_dir target) (Path.reach ~from:exec_dir target)
plugin (read_file plugin)) plugin plugin_contents);
extract_requires plugin_contents
let eval jbuilds ~(context : Context.t) = let eval jbuilds ~(context : Context.t) =
let open Future in let open Future in
@ -64,7 +75,9 @@ end
in in
let wrapper = Path.extend_basename generated_jbuild ~suffix:".ml" in let wrapper = Path.extend_basename generated_jbuild ~suffix:".ml" in
ensure_parent_dir_exists generated_jbuild; 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 Future.run Strict ~dir:(Path.to_string dir) ~env:context.env
(Path.to_string context.Context.ocaml) (Path.to_string context.Context.ocaml)
[ Path.reach ~from:dir wrapper ] [ Path.reach ~from:dir wrapper ]

View File

@ -18,19 +18,12 @@ let choose byte native = function
let compiled_unit_ext = choose ".cmo" ".cmx" let compiled_unit_ext = choose ".cmo" ".cmx"
let compiled_lib_ext = choose ".cma" ".cmxa" 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 findlib_predicate = choose "byte" "native"
let cm_kind = choose Cm_kind.Cmo Cmx let cm_kind = choose Cm_kind.Cmo Cmx
let exe_ext = choose ".bc" ".exe" 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 let of_cm_kind : Cm_kind.t -> t = function
| Cmi | Cmo -> Byte | Cmi | Cmo -> Byte
| Cmx -> Native | Cmx -> Native

View File

@ -9,15 +9,12 @@ val all : t list
val compiled_unit_ext : t -> string val compiled_unit_ext : t -> string
val compiled_lib_ext : t -> string val compiled_lib_ext : t -> string
val exe_ext : t -> string val exe_ext : t -> string
val compiler : t -> Context.t -> Path.t option
val cm_kind : t -> Cm_kind.t val cm_kind : t -> Cm_kind.t
val of_cm_kind : Cm_kind.t -> t val of_cm_kind : Cm_kind.t -> t
val findlib_predicate : t -> string val findlib_predicate : t -> string
val best : Context.t -> t
module Dict : sig module Dict : sig
type mode = t type mode = t

View File

@ -2,11 +2,12 @@ open Import
open Jbuild_types open Jbuild_types
type t = type t =
{ findlib : Findlib.t { context : Context.t
; findlib : Findlib.t
; artifacts : (string, Path.t) Hashtbl.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 let artifacts : (string, Path.t) Hashtbl.t = Hashtbl.create 1024 in
List.iter stanzas ~f:(fun (dir, stanzas) -> List.iter stanzas ~f:(fun (dir, stanzas) ->
List.iter stanzas ~f:(fun stanza -> List.iter stanzas ~f:(fun stanza ->
@ -14,13 +15,13 @@ let create findlib stanzas =
| Provides { name; file } -> | Provides { name; file } ->
Hashtbl.add artifacts ~key:name ~data:(Path.relative dir file) Hashtbl.add artifacts ~key:name ~data:(Path.relative dir file)
| _ -> ())); | _ -> ()));
{ findlib; artifacts } { context; findlib; artifacts }
let binary t name = let binary t name =
match Hashtbl.find t.artifacts name with match Hashtbl.find t.artifacts name with
| Some p -> p | Some p -> p
| None -> | None ->
match Bin.which ~path:(Findlib.context t.findlib).path name with match Context.which t.context name with
| Some p -> | Some p ->
Hashtbl.add t.artifacts ~key:name ~data:p; Hashtbl.add t.artifacts ~key:name ~data:p;
p p

View File

@ -7,7 +7,7 @@ open! Import
type t 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 (** In the three following functions, the string argument matches the first argument of
the [(provides ...)] stanza in the jbuild. *) the [(provides ...)] stanza in the jbuild. *)