Add a Findlib.t in the context
This commit is contained in:
parent
9123508e43
commit
2ee522be52
|
@ -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 ->
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ->
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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. *)
|
||||||
|
|
Loading…
Reference in New Issue