From 3e9bc8c0c38cc0e390414d2b6dbfcc80c3a2a952 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 1 May 2018 00:13:50 +0700 Subject: [PATCH 1/4] Allow setting ENV vars in findlib.conf per toolchain This is useful for configuring PKG CONFIG for cross compilation --- src/context.ml | 4 ++++ src/env.ml | 5 +++++ src/env.mli | 3 +++ src/findlib.ml | 17 +++++++++++++---- src/findlib.mli | 2 ++ 5 files changed, 27 insertions(+), 4 deletions(-) diff --git a/src/context.ml b/src/context.ml index a38ffcfd..360c2e77 100644 --- a/src/context.ml +++ b/src/context.ml @@ -315,6 +315,10 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () = | Some host -> Env.get host.env "PATH" ) + |> Env.extend_env ( + Option.value ~default:Env.empty + (Option.map findlib_config ~f:Findlib.Config.env) + ) in let stdlib_dir = Path.of_string (Ocaml_config.standard_library ocfg) in let natdynlink_supported = Ocaml_config.natdynlink_supported ocfg in diff --git a/src/env.ml b/src/env.ml index 09cf9cd9..4eb5df57 100644 --- a/src/env.ml +++ b/src/env.ml @@ -22,6 +22,8 @@ let make vars = ; unix = None } +let empty = make Map.empty + let get t k = Map.find t.vars k let to_unix t = @@ -73,3 +75,6 @@ let diff x y = let update t ~var ~f = make (Map.update t.vars var ~f) + +let of_string_map m = + make (String.Map.foldi ~init:Map.empty ~f:(fun k v acc -> Map.add acc k v) m) diff --git a/src/env.mli b/src/env.mli index 25763588..8b20f1ae 100644 --- a/src/env.mli +++ b/src/env.mli @@ -9,6 +9,8 @@ type t module Map : Map.S with type key = Var.t +val empty : t + (** The environment when the process started *) val initial : t @@ -28,3 +30,4 @@ val update : t -> var:string -> f:(string option -> string option) -> t val sexp_of_t : t -> Sexp.t +val of_string_map : string String.Map.t -> t diff --git a/src/findlib.ml b/src/findlib.ml index e534ed3b..04ef1751 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -45,22 +45,24 @@ module Rules = struct ; add_rules : Rule.t list } - let interpret t ~preds = + let interpret' t ~preds = let rec find_set_rule = function - | [] -> "" + | [] -> None | rule :: rules -> if Rule.matches rule ~preds then - rule.value + Some rule.value else find_set_rule rules in let v = find_set_rule t.set_rules in List.fold_left t.add_rules ~init:v ~f:(fun v rule -> if Rule.matches rule ~preds then - v ^ " " ^ rule.value + Some ((Option.value ~default:"" v) ^ " " ^ rule.value) else v) + let interpret t ~preds = Option.value ~default:"" (interpret' t ~preds) + let of_meta_rules (rules : Meta.Simplified.Rules.t) = let add_rules = List.map rules.add_rules ~f:Rule.make in let set_rules = @@ -106,6 +108,13 @@ module Config = struct let get { vars; preds } var = Vars.get vars var preds + + let env t = + let preds = Ps.add t.preds (P.make "env") in + String.Map.filter_map ~f:(fun rules -> + Rules.interpret' rules ~preds + ) t.vars + |> Env.of_string_map end module Package = struct diff --git a/src/findlib.mli b/src/findlib.mli index 39c875d8..535332ac 100644 --- a/src/findlib.mli +++ b/src/findlib.mli @@ -62,4 +62,6 @@ module Config : sig type t val load : Path.t -> toolchain:string -> context:string -> t val get : t -> string -> string option + + val env : t -> Env.t end From ec3a3bf673eaf33530cf8b52608203ccf009b5ee Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 1 May 2018 18:50:51 +0700 Subject: [PATCH 2/4] Remove interpret' --- src/findlib.ml | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/src/findlib.ml b/src/findlib.ml index 04ef1751..8ea0c0c7 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -45,7 +45,7 @@ module Rules = struct ; add_rules : Rule.t list } - let interpret' t ~preds = + let interpret t ~preds = let rec find_set_rule = function | [] -> None | rule :: rules -> @@ -61,8 +61,6 @@ module Rules = struct else v) - let interpret t ~preds = Option.value ~default:"" (interpret' t ~preds) - let of_meta_rules (rules : Meta.Simplified.Rules.t) = let add_rules = List.map rules.add_rules ~f:Rule.make in let set_rules = @@ -79,9 +77,8 @@ module Vars = struct type t = Rules.t String.Map.t let get (t : t) var preds = - match String.Map.find t var with - | None -> None - | Some rules -> Some (Rules.interpret rules ~preds) + Option.map (String.Map.find t var) ~f:(fun r -> + Option.value ~default:"" (Rules.interpret r ~preds)) let get_words t var preds = match get t var preds with @@ -111,9 +108,7 @@ module Config = struct let env t = let preds = Ps.add t.preds (P.make "env") in - String.Map.filter_map ~f:(fun rules -> - Rules.interpret' rules ~preds - ) t.vars + String.Map.filter_map ~f:(Rules.interpret ~preds) t.vars |> Env.of_string_map end From 5f237e3a4d7cc2705f9873d16889cdebb32fd034 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 1 May 2018 19:37:51 +0700 Subject: [PATCH 3/4] Add pretty printers to Findlib.Conf.t --- src/findlib.ml | 23 +++++++++++++++++++++++ src/findlib.mli | 5 ++++- src/import.ml | 3 +++ src/interned.ml | 6 ++++++ src/interned.mli | 2 ++ 5 files changed, 38 insertions(+), 1 deletion(-) diff --git a/src/findlib.ml b/src/findlib.ml index 8ea0c0c7..e2fecae1 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -11,6 +11,14 @@ module Rule = struct ; value : string } + let pp fmt { preds_required; preds_forbidden; value } = + Fmt.record fmt + [ "preds_required", Fmt.const Ps.pp preds_required + ; "preds_forbidden", Fmt.const Ps.pp preds_forbidden + ; "value", Fmt.const (fun fmt -> Format.fprintf fmt "%S") value + ] + + let formal_predicates_count t = Ps.cardinal t.preds_required + Ps.cardinal t.preds_forbidden @@ -45,6 +53,12 @@ module Rules = struct ; add_rules : Rule.t list } + let pp fmt { set_rules; add_rules } = + Fmt.record fmt + [ "set_rules", (fun fmt () -> Fmt.ocaml_list Rule.pp fmt set_rules) + ; "add_rules", (fun fmt () -> Fmt.ocaml_list Rule.pp fmt add_rules) + ] + let interpret t ~preds = let rec find_set_rule = function | [] -> None @@ -92,6 +106,15 @@ module Config = struct ; preds : Ps.t } + let pp fmt { vars; preds } = + Fmt.record fmt + [ "vars" + , Fmt.const (Fmt.ocaml_list (Fmt.tuple Format.pp_print_string Rules.pp)) + (String.Map.to_list vars) + ; "preds" + , Fmt.const Ps.pp preds + ] + let load path ~toolchain ~context = let path = Path.extend_basename path ~suffix:".d" in let conf_file = Path.relative path (toolchain ^ ".conf") in diff --git a/src/findlib.mli b/src/findlib.mli index 535332ac..83875550 100644 --- a/src/findlib.mli +++ b/src/findlib.mli @@ -1,6 +1,6 @@ (** Findlib database *) -open Stdune +open Import (** Findlib database *) type t @@ -60,6 +60,9 @@ val dummy_package : t -> name:string -> Package.t module Config : sig type t + + val pp : t Fmt.t + val load : Path.t -> toolchain:string -> context:string -> t val get : t -> string -> string option diff --git a/src/import.ml b/src/import.ml index fd1640f2..ca2d0407 100644 --- a/src/import.ml +++ b/src/import.ml @@ -150,6 +150,9 @@ module Fmt = struct let pp_sep fmt () = Format.fprintf fmt "@,; " in Format.fprintf fmt "@[{ %a@ }@]" (Format.pp_print_list ~pp_sep pp) xs + + let tuple ppfa ppfb fmt (a, b) = + Format.fprintf fmt "@[(%a, %a)@]" ppfa a ppfb b end (* This is ugly *) diff --git a/src/interned.ml b/src/interned.ml index 34111eb5..ac663573 100644 --- a/src/interned.ml +++ b/src/interned.ml @@ -9,6 +9,8 @@ module type S = sig module Set : sig include Set.S with type elt = t val make : string list -> t + + val pp : t Fmt.t end module Map : Map.S with type key = t module Table : sig @@ -72,11 +74,15 @@ module Make() = struct let to_string t = Table.get names t + let pp fmt t = Format.fprintf fmt "%S" (to_string t) + module Set = struct include Int_set let make l = List.fold_left l ~init:empty ~f:(fun acc s -> add acc (make s)) + + let pp fmt (t : t) = Fmt.ocaml_list pp fmt (to_list t) end module Map = Int_map diff --git a/src/interned.mli b/src/interned.mli index 14aee82d..613020bc 100644 --- a/src/interned.mli +++ b/src/interned.mli @@ -17,6 +17,8 @@ module type S = sig include Set.S with type elt = t val make : string list -> t + + val pp : t Fmt.t end module Map : Map.S with type key = t From 623ebfc2daa0ada23f610a6dbb4e0ad19cb48420 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 1 May 2018 19:38:01 +0700 Subject: [PATCH 4/4] Add expectation test to parsing out of findlib toolchain config --- test/unit-tests/jbuild | 1 + test/unit-tests/tests.mlt | 35 ++++++++++++++++++++++++++++ test/unit-tests/toolchain.d/tlc.conf | 1 + 3 files changed, 37 insertions(+) create mode 100644 test/unit-tests/toolchain.d/tlc.conf diff --git a/test/unit-tests/jbuild b/test/unit-tests/jbuild index 729685a4..eae5a281 100644 --- a/test/unit-tests/jbuild +++ b/test/unit-tests/jbuild @@ -23,6 +23,7 @@ (deps (tests.mlt (glob_files ${SCOPE_ROOT}/src/.jbuilder.objs/*.cmi) (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi) + (files_recursively_in toolchain.d) (files_recursively_in findlib-db))) (action (chdir ${SCOPE_ROOT} (progn diff --git a/test/unit-tests/tests.mlt b/test/unit-tests/tests.mlt index 0cded15a..c3fafb4e 100644 --- a/test/unit-tests/tests.mlt +++ b/test/unit-tests/tests.mlt @@ -77,3 +77,38 @@ val meta : Jbuilder.Meta.Simplified.t = ; subs = [] } |}] + +#install_printer Findlib.Config.pp;; + +let conf = + Findlib.Config.load (Path.of_string "test/unit-tests/toolchain") + ~toolchain:"tlc" ~context:"" + +[%%expect{| +val conf : Jbuilder.Findlib.Config.t = + { vars = + [ (FOO_BAR, { set_rules = + [ { preds_required = [ "tlc"; "env" ] + ; preds_forbidden = [] + ; value = "my variable" + } + ] + ; add_rules = [] + }) + ] + ; preds = [ "tlc" ] + } +|}] + +let env_pp fmt env = Sexp.pp fmt (Env.sexp_of_t env);; +#install_printer env_pp;; + +[%%expect{| +val env_pp : Format.formatter -> Jbuilder.Env.t -> unit = +|}] + +let env = Findlib.Config.env conf + +[%%expect{| +val env : Jbuilder.Env.t = ((FOO_BAR "my variable")) +|}] diff --git a/test/unit-tests/toolchain.d/tlc.conf b/test/unit-tests/toolchain.d/tlc.conf new file mode 100644 index 00000000..71f5150d --- /dev/null +++ b/test/unit-tests/toolchain.d/tlc.conf @@ -0,0 +1 @@ +FOO_BAR(tlc, env) = "my variable" \ No newline at end of file