Discover binaries created by install stanzas without listing buildable targets

CHANGES.md

@@ -1,6 +1,10 @@
 unreleased
 ----------
 
+- Restricted the set of variables available for expansion in the destination filename
+  of `install` stanza to simplify implementation and avoid dependency
+  cycles. (#2073, @aalekseyev, @diml)
+
 - Fix a bug where `dune install` would install man pages to incorrect
   paths when compared to `opam-installer`. For example dune now
   installs `(foo.1 as man1/foo.1)` correctly and previously that was

bin/install_uninstall.ml

@@ -225,10 +225,9 @@ let install_uninstall ~what =
                 ()
             in
             let files_deleted_in = ref Path.Set.empty in
-            List.iter entries ~f:(fun { Install.Entry. src; dst; section } ->
+            List.iter entries ~f:(fun entry ->
               let dst =
-                dst
-                |> Install.Section.Paths.install_path paths section
+                Install.Entry.relative_installed_path entry ~paths
                 |> interpret_destdir ~destdir
               in
               let dir = Path.parent_exn dst in
@@ -237,9 +236,9 @@ let install_uninstall ~what =
                   (Path.to_string_maybe_quoted dst);
                 Ops.mkdir_p dir;
                 let executable =
-                  Install.Section.should_set_executable_bit section
+                  Install.Section.should_set_executable_bit entry.section
                 in
-                Ops.copy_file ~src ~dst ~executable
+                Ops.copy_file ~src:entry.src ~dst ~executable
               end else begin
                 Ops.remove_if_exists dst;
                 files_deleted_in := Path.Set.add !files_deleted_in dir;

src/artifacts.ml

@@ -1,21 +1,48 @@
 open! Stdune
 open Import
 
-type t =
-  { context     : Context.t
-  ; local_bins  : Path.t String.Map.t lazy_t
-  ; public_libs : Lib.DB.t
+module Bin = struct
+
+  type t = {
+    context : Context.t;
+    (* Mapping from executable names to their actual path in the
+       workspace. The keys are the executable names without the .exe,
+       even on Windows. *)
+    local_bins : Path.t String.Map.t;
   }
 
-let create (context : Context.t) ~public_libs =
-  let bin_dir = Config.local_install_bin_dir ~context:context.name in
-  let local_bins =
-    lazy (
-      Build_system.targets_of ~dir:bin_dir
-      |> Path.Set.fold ~init:String.Map.empty ~f:(fun path acc ->
+  let binary t ?hint ~loc name =
+    if not (Filename.is_relative name) then
+      Ok (Path.of_filename_relative_to_initial_cwd name)
+    else
+      match String.Map.find t.local_bins name with
+      | Some path -> Ok path
+      | None ->
+        match Context.which t.context name with
+        | Some p -> Ok p
+        | None ->
+          Error
+            { Action.Prog.Not_found.
+              program = name
+            ; hint
+            ; context = t.context.Context.name
+            ; loc
+            }
+
+  let add_binaries t ~dir l =
+    let local_bins =
+      List.fold_left l ~init:t.local_bins
+        ~f:(fun acc fb ->
+          let path = File_binding.Expanded.dst_path fb
+                       ~dir:(Utils.local_bin dir) in
+          String.Map.add acc (Path.basename path) path)
+    in
+    { t with local_bins }
+
+  let create ~(context : Context.t) ~local_bins =
+    let local_bins =
+      Path.Set.fold local_bins ~init:String.Map.empty ~f:(fun path acc ->
         let name = Filename.basename (Path.to_string path) in
-        (* The keys in the map are the executable names
-         * without the .exe, even on Windows. *)
         let key =
           if Sys.win32 then
             Option.value ~default:name
@@ -24,60 +51,50 @@ let create (context : Context.t) ~public_libs =
             name
         in
         String.Map.add acc key path)
-    )
-  in
-  { context
-  ; local_bins
-  ; public_libs
+    in
+    { context
+    ; local_bins
+    }
+
+end
+
+module Public_libs = struct
+  type t = {
+    context : Context.t;
+    public_libs : Lib.DB.t;
   }
 
-let binary t ?hint ~loc name =
-  if not (Filename.is_relative name) then
-    Ok (Path.of_filename_relative_to_initial_cwd name)
-  else
-    match String.Map.find (Lazy.force t.local_bins) name with
-    | Some path -> Ok path
-    | None ->
-      match Context.which t.context name with
-      | Some p -> Ok p
-      | None ->
-        Error
-          { Action.Prog.Not_found.
-            program = name
-          ; hint
-          ; context = t.context.Context.name
-          ; loc
-          }
+  let create ~context ~public_libs = { context; public_libs; }
 
-let add_binaries t ~dir = function
-  | [] -> t
-  | bindings ->
-    let local_bins =
-      lazy (
-        List.fold_left bindings ~init:(Lazy.force t.local_bins)
-          ~f:(fun acc fb ->
-            let path = File_binding.Expanded.dst_path fb
-                         ~dir:(Utils.local_bin dir) in
-            String.Map.add acc (Path.basename path) path))
-    in
-    { t with local_bins }
+  let file_of_lib t ~loc ~lib ~file =
+    match Lib.DB.find t.public_libs lib with
+    | Error reason ->
+      Error { fail = fun () ->
+        Lib.not_available ~loc reason "Public library %a" Lib_name.pp_quoted lib }
+    | Ok lib ->
+      if Lib.is_local lib then begin
+        let (package, rest) = Lib_name.split (Lib.name lib) in
+        let lib_install_dir =
+          Config.local_install_lib_dir ~context:t.context.name ~package
+        in
+        let lib_install_dir =
+          match rest with
+          | [] -> lib_install_dir
+          | _  -> Path.relative lib_install_dir (String.concat rest ~sep:"/")
+        in
+        Ok (Path.relative lib_install_dir file)
+      end else
+        Ok (Path.relative (Lib.src_dir lib) file)
+
+end
 
-let file_of_lib t ~loc ~lib ~file =
-  match Lib.DB.find t.public_libs lib with
-  | Error reason ->
-    Error { fail = fun () ->
-      Lib.not_available ~loc reason "Public library %a" Lib_name.pp_quoted lib }
-  | Ok lib ->
-    if Lib.is_local lib then begin
-      let (package, rest) = Lib_name.split (Lib.name lib) in
-      let lib_install_dir =
-        Config.local_install_lib_dir ~context:t.context.name ~package
-      in
-      let lib_install_dir =
-        match rest with
-        | [] -> lib_install_dir
-        | _  -> Path.relative lib_install_dir (String.concat rest ~sep:"/")
-      in
-      Ok (Path.relative lib_install_dir file)
-    end else
-      Ok (Path.relative (Lib.src_dir lib) file)
+type t = {
+  public_libs : Public_libs.t;
+  bin : Bin.t;
+}
+
+let create (context : Context.t) ~public_libs ~local_bins =
+  {
+    public_libs = Public_libs.create ~context ~public_libs;
+    bin = Bin.create ~context ~local_bins;
+  }

src/artifacts.mli

@@ -1,34 +1,51 @@
 open! Stdune
 open! Import
 
-type t
+module Bin : sig
+  type t
+
+  (** A named artifact that is looked up in the PATH if not found in the tree
+      If the name is an absolute path, it is used as it.
+  *)
+  val binary
+    :  t
+    -> ?hint:string
+    -> loc:Loc.t option
+    -> string
+    -> Action.Prog.t
+
+  val add_binaries
+    :  t
+    -> dir:Path.t
+    -> File_binding.Expanded.t list
+    -> t
+
+  val create : context:Context.t -> local_bins:Path.Set.t -> t
+end
+
+module Public_libs : sig
+  type t = {
+    context : Context.t;
+    public_libs : Lib.DB.t;
+  }
+
+  (** [file_of_lib t ~from ~lib ~file] returns the path to a file in the
+      directory of the given library. *)
+  val file_of_lib
+    :  t
+    -> loc:Loc.t
+    -> lib:Lib_name.t
+    -> file:string
+    -> (Path.t, fail) result
+end
+
+type t = {
+  public_libs : Public_libs.t;
+  bin : Bin.t;
+}
 
 val create
   :  Context.t
   -> public_libs:Lib.DB.t
+  -> local_bins:Path.Set.t
   -> t
-
-(** A named artifact that is looked up in the PATH if not found in the tree
-    If the name is an absolute path, it is used as it.
-*)
-val binary
-  :  t
-  -> ?hint:string
-  -> loc:Loc.t option
-  -> string
-  -> Action.Prog.t
-
-val add_binaries
-  :  t
-  -> dir:Path.t
-  -> File_binding.Expanded.t list
-  -> t
-
-(** [file_of_lib t ~from ~lib ~file] returns the path to a file in the
-    directory of the given library. *)
-val file_of_lib
-  :  t
-  -> loc:Loc.t
-  -> lib:Lib_name.t
-  -> file:string
-  -> (Path.t, fail) result

src/dir_with_dune.ml

@@ -8,3 +8,18 @@ type 'data t =
   ; kind            : Dune_lang.File_syntax.t
   ; dune_version    : Syntax.Version.t
   }
+
+let data t = t.data
+
+let map t ~f = { t with data = f t.data }
+
+let rec deep_fold l ~init ~f =
+  match l with
+  | [] -> init
+  | t :: l -> inner_fold t t.data l ~init ~f
+
+and inner_fold t inner_list l ~init ~f =
+  match inner_list with
+  | [] -> deep_fold l ~init ~f
+  | x :: inner_list ->
+    inner_fold t inner_list l ~init:(f t x init) ~f

src/dir_with_dune.mli

@@ -9,3 +9,13 @@ type 'data t =
   ; kind            : Dune_lang.File_syntax.t
   ; dune_version    : Syntax.Version.t
   }
+
+val data : 'data t -> 'data
+
+val map : 'a t -> f:('a -> 'b) -> 'b t
+
+val deep_fold
+  :  'a list t list
+  -> init:'acc
+  -> f:('a list t -> 'a -> 'acc -> 'acc)
+  -> 'acc

src/dune_file.ml

@@ -173,10 +173,10 @@ module Pps_and_flags = struct
       in
       let pps, more_flags =
         List.partition_map l ~f:(fun s ->
-          if String.is_prefix ~prefix:"-"
-            (String_with_vars.known_prefix s) then
+          match String_with_vars.is_prefix ~prefix:"-" s with
+          | Yes ->
             Right s
-          else
+          | No | Unknown _ ->
             let loc = String_with_vars.loc s in
             match String_with_vars.text_only s with
             | None -> no_templates loc "in the ppx library names"
@@ -188,11 +188,11 @@ module Pps_and_flags = struct
       if syntax_version < (1, 10) then
         List.iter ~f:
           (fun flag ->
-            if String_with_vars.has_vars flag then
-              Syntax.Error.since (String_with_vars.loc flag)
-                Stanza.syntax
-                (1, 10)
-                  ~what:"Using variables in pps flags"
+             if String_with_vars.has_vars flag then
+               Syntax.Error.since (String_with_vars.loc flag)
+                 Stanza.syntax
+                 (1, 10)
+                 ~what:"Using variables in pps flags"
           ) all_flags;
       (pps, all_flags)
   end

src/env_node.ml

@@ -9,20 +9,20 @@ type t =
   ; mutable ocaml_flags   : Ocaml_flags.t option
   ; mutable c_flags       : (unit, string list) Build.t C.Kind.Dict.t option
   ; mutable external_     : Env.t option
-  ; mutable artifacts     : Artifacts.t option
+  ; mutable bin_artifacts     : Artifacts.Bin.t option
   }
 
 let scope t = t.scope
 
-let make ~dir ~inherit_from ~scope ~config ~env =
+let make ~dir ~inherit_from ~scope ~config =
   { dir
   ; inherit_from
   ; scope
   ; config
   ; ocaml_flags = None
   ; c_flags = None
-  ; external_ = env
-  ; artifacts = None
+  ; external_ = None
+  ; bin_artifacts = None
   ; local_binaries = None
   }
 
@@ -78,21 +78,21 @@ let rec external_ t ~profile ~default =
     t.external_ <- Some env;
     env
 
-let rec artifacts t ~profile ~default ~expander =
-  match t.artifacts with
+let rec bin_artifacts t ~profile ~default ~expander =
+  match t.bin_artifacts with
   | Some x -> x
   | None ->
     let default =
       match t.inherit_from with
       | None -> default
-      | Some (lazy t) -> artifacts t ~default ~profile ~expander
+      | Some (lazy t) -> bin_artifacts t ~default ~profile ~expander
     in
-    let artifacts =
+    let bin_artifacts =
       local_binaries t ~profile ~expander
-      |> Artifacts.add_binaries default ~dir:t.dir
+      |> Artifacts.Bin.add_binaries default ~dir:t.dir
     in
-    t.artifacts <- Some artifacts;
-    artifacts
+    t.bin_artifacts <- Some bin_artifacts;
+    bin_artifacts
 
 let rec ocaml_flags t ~profile ~expander =
   match t.ocaml_flags with