Merge pull request #733 from rgrinberg/set-env-toolchain

Allow setting ENV vars in findlib.conf per toolchain

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

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)

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

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,19 +53,25 @@ 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
       | 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)
 
@@ -77,9 +91,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
@@ -93,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
@@ -106,6 +128,11 @@ 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:(Rules.interpret ~preds) t.vars
+    |> Env.of_string_map
 end
 
 module Package = struct

src/findlib.mli

@@ -1,6 +1,6 @@
 (** Findlib database *)
 
-open Stdune
+open Import
 
 (** Findlib database *)
 type t
@@ -60,6 +60,11 @@ 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
+
+  val env : t -> Env.t
 end

src/import.ml

@@ -150,6 +150,9 @@ module Fmt = struct
       let pp_sep fmt () = Format.fprintf fmt "@,; " in
       Format.fprintf fmt "@[<hv>{ %a@ }@]"
         (Format.pp_print_list ~pp_sep pp) xs
+
+  let tuple ppfa ppfb fmt (a, b) =
+    Format.fprintf fmt "@[<hv>(%a, %a)@]" ppfa a ppfb b
 end
 
 (* This is ugly *)

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

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

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

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:"<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 = <fun>
+|}]
+
+let env = Findlib.Config.env conf
+
+[%%expect{|
+val env : Jbuilder.Env.t = ((FOO_BAR "my variable"))
+|}]

test/unit-tests/toolchain.d/tlc.conf

@@ -0,0 +1 @@
+FOO_BAR(tlc, env) = "my variable"