Merge pull request #1554 from rgrinberg/installed-package

Introduce Local_package module

src/dir_contents.ml

@@ -85,11 +85,11 @@ let mlds t (doc : Documentation.t) =
 
 (* As a side-effect, setup user rules and copy_files rules. *)
 let load_text_files sctx ft_dir
-      { Super_context.Dir_with_dune.
+      { Dir_with_dune.
         ctx_dir = dir
       ; src_dir
       ; scope
-      ; stanzas
+      ; data = stanzas
       ; kind = _
       } =
   (* Interpret a few stanzas in order to determine the list of
@@ -152,9 +152,10 @@ let modules_of_files ~dir ~files =
   Module.Name.Map.merge impls intfs ~f:(fun name impl intf ->
     Some (Module.make name ~visibility:Public ?impl ?intf))
 
-let build_modules_map (d : Super_context.Dir_with_dune.t) ~scope ~modules =
+let build_modules_map (d : _ Dir_with_dune.t) ~modules =
+  let scope = d.scope in
   let libs, exes =
-    List.filter_partition_map d.stanzas ~f:(fun stanza ->
+    List.filter_partition_map d.data ~f:(fun stanza ->
       match (stanza : Stanza.t) with
       | Library lib ->
         let { Modules_field_evaluator.
@@ -282,15 +283,15 @@ let build_modules_map (d : Super_context.Dir_with_dune.t) ~scope ~modules =
   in
   { libraries; executables; rev_map }
 
-let build_mlds_map (d : Super_context.Dir_with_dune.t) ~files =
+let build_mlds_map (d : _ Dir_with_dune.t) ~files =
   let dir = d.ctx_dir in
   let mlds = lazy (
     String.Set.fold files ~init:String.Map.empty ~f:(fun fn acc ->
       match String.lsplit2 fn ~on:'.' with
       | Some (s, "mld") -> String.Map.add acc s fn
       | _ -> acc))
   in
-  List.filter_map d.stanzas ~f:(function
+  List.filter_map d.data ~f:(function
     | Documentation doc ->
       let mlds =
         let mlds = Lazy.force mlds in
@@ -330,7 +331,7 @@ let rec get sctx ~dir =
           { kind = Standalone
           ; dir
           ; text_files = files
-          ; modules = lazy (build_modules_map d ~scope:d.scope
+          ; modules = lazy (build_modules_map d
                               ~modules:(modules_of_files ~dir:d.ctx_dir ~files))
           ; mlds = lazy (build_mlds_map d ~files)
           }
@@ -394,7 +395,7 @@ let rec get sctx ~dir =
                   (Fmt.optional Path.pp) (Module.src_dir x)
                   (Fmt.optional Path.pp) (Module.src_dir y)))
         in
-        build_modules_map d ~scope:d.scope ~modules)
+        build_modules_map d ~modules)
       in
       let t =
         { kind = Group_root

src/dir_status.ml

@@ -3,17 +3,17 @@ open Dune_file
 
 type t =
   | Standalone of
-      (File_tree.Dir.t * Super_context.Dir_with_dune.t option) option
+      (File_tree.Dir.t * Stanza.t list Dir_with_dune.t option) option
   (* Directory not part of a multi-directory group. The argument is
      [None] for directory that are not from the source tree, such as
      generated ones. *)
 
   | Group_root of File_tree.Dir.t
-                  * Super_context.Dir_with_dune.t
+                  * Stanza.t list Dir_with_dune.t
   (* Directory with [(include_subdirs x)] where [x] is not [no] *)
 
   | Is_component_of_a_group_but_not_the_root of
-      Super_context.Dir_with_dune.t option
+      Stanza.t list Dir_with_dune.t option
   (* Sub-directory of a [Group_root _] *)
 
 let is_standalone = function
@@ -74,7 +74,7 @@ let rec get sctx ~dir =
           else
             Is_component_of_a_group_but_not_the_root None
         | Some d ->
-          match get_include_subdirs d.stanzas with
+          match get_include_subdirs d.data with
           | Some Unqualified ->
             Group_root (ft_dir, d)
           | Some No ->
@@ -83,7 +83,7 @@ let rec get sctx ~dir =
             if dir <> project_root &&
                not (is_standalone (get sctx ~dir:(Path.parent_exn dir)))
             then begin
-              check_no_module_consumer d.stanzas;
+              check_no_module_consumer d.data;
               Is_component_of_a_group_but_not_the_root (Some d)
             end else
               Standalone (Some (ft_dir, Some d))
@@ -99,13 +99,13 @@ let get_assuming_parent_is_part_of_group sctx ~dir ft_dir =
       match Super_context.stanzas_in sctx ~dir with
       | None -> Is_component_of_a_group_but_not_the_root None
       | Some d ->
-        match get_include_subdirs d.stanzas with
+        match get_include_subdirs d.data with
         | Some Unqualified ->
           Group_root (ft_dir, d)
         | Some No ->
           Standalone (Some (ft_dir, Some d))
         | None ->
-          check_no_module_consumer d.stanzas;
+          check_no_module_consumer d.data;
           Is_component_of_a_group_but_not_the_root (Some d)
     in
     Hashtbl.add cache dir t;

src/dir_status.mli

@@ -2,17 +2,17 @@ open Stdune
 
 type t =
   | Standalone of
-      (File_tree.Dir.t * Super_context.Dir_with_dune.t option) option
+      (File_tree.Dir.t * Stanza.t list Dir_with_dune.t option) option
   (* Directory not part of a multi-directory group. The argument is
      [None] for directory that are not from the source tree, such as
      generated ones. *)
 
   | Group_root of File_tree.Dir.t
-                  * Super_context.Dir_with_dune.t
+                  * Stanza.t list Dir_with_dune.t
   (* Directory with [(include_subdirs x)] where [x] is not [no] *)
 
   | Is_component_of_a_group_but_not_the_root of
-      Super_context.Dir_with_dune.t option
+      Stanza.t list Dir_with_dune.t option
   (* Sub-directory of a [Group_root _] *)
 
 val get : Super_context.t -> dir:Path.t -> t

src/dir_with_dune.ml

@@ -0,0 +1,9 @@
+open Stdune
+
+type 'data t =
+  { src_dir : Path.t
+  ; ctx_dir : Path.t
+  ; data    : 'data
+  ; scope   : Scope.t
+  ; kind    : Dune_lang.Syntax.t
+  }

src/dir_with_dune.mli

@@ -0,0 +1,10 @@
+open Stdune
+
+(** A directory with a [dune] file *)
+type 'data t =
+  { src_dir : Path.t
+  ; ctx_dir : Path.t  (** [_build/context-name/src_dir] *)
+  ; data    : 'data
+  ; scope   : Scope.t
+  ; kind    : Dune_lang.Syntax.t
+  }

src/dune_file.ml

@@ -1088,9 +1088,9 @@ module Library = struct
 end
 
 module Install_conf = struct
-  type t =
+  type 'file t =
     { section : Install.Section.t
-    ; files   : File_bindings.Unexpanded.t
+    ; files   : 'file File_bindings.t
     ; package : Package.t
     }
 
@@ -1842,7 +1842,7 @@ type Stanza.t +=
   | Library         of Library.t
   | Executables     of Executables.t
   | Rule            of Rule.t
-  | Install         of Install_conf.t
+  | Install         of String_with_vars.t Install_conf.t
   | Alias           of Alias_conf.t
   | Copy_files      of Copy_files.t
   | Documentation   of Documentation.t
@@ -2001,3 +2001,12 @@ module Stanzas = struct
       Errors.fail e.loc "The 'env' stanza cannot appear more than once"
     | _ -> stanzas
 end
+
+let stanza_package = function
+  | Library { public = Some { package; _ }; _ }
+  | Alias { package = Some package ;  _ }
+  | Install { package; _ }
+  | Documentation { package; _ }
+  | Tests { package = Some package; _} ->
+    Some package
+  | _ -> None

src/dune_file.mli

@@ -283,9 +283,9 @@ module Library : sig
 end
 
 module Install_conf : sig
-  type t =
+  type 'file t =
     { section : Install.Section.t
-    ; files   : File_bindings.Unexpanded.t
+    ; files   : 'file File_bindings.t
     ; package : Package.t
     }
 end
@@ -419,13 +419,15 @@ type Stanza.t +=
   | Library         of Library.t
   | Executables     of Executables.t
   | Rule            of Rule.t
-  | Install         of Install_conf.t
+  | Install         of String_with_vars.t Install_conf.t
   | Alias           of Alias_conf.t
   | Copy_files      of Copy_files.t
   | Documentation   of Documentation.t
   | Tests           of Tests.t
   | Include_subdirs of Loc.t * Include_subdirs.t
 
+val stanza_package : Stanza.t -> Package.t option
+
 module Stanzas : sig
   type t = Stanza.t list
 

src/gen_rules.ml

@@ -4,17 +4,6 @@ module Menhir_rules = Menhir
 open Dune_file
 open! No_io
 
-(* Utils *)
-
-let stanza_package = function
-  | Library { public = Some { package; _ }; _ }
-  | Alias { package = Some package ;  _ }
-  | Install { package; _ }
-  | Documentation { package; _ }
-  | Tests { package = Some package; _} ->
-    Some package
-  | _ -> None
-
 module For_stanza = struct
   type ('merlin, 'cctx, 'js) t =
     { merlin : 'merlin
@@ -78,7 +67,7 @@ module Gen(P : Install_rules.Params) = struct
   (* Stanza *)
 
   let gen_rules dir_contents cctxs
-        { SC.Dir_with_dune. src_dir; ctx_dir; stanzas; scope; kind = dir_kind } =
+        { Dir_with_dune. src_dir; ctx_dir; data = stanzas; scope; kind = dir_kind } =
     let for_stanza ~dir = function
       | Library lib ->
         let cctx, merlin =
@@ -257,7 +246,7 @@ end
 
 let relevant_stanzas pkgs stanzas =
   List.filter stanzas ~f:(fun stanza ->
-    match stanza_package stanza with
+    match Dune_file.stanza_package stanza with
     | Some package -> Package.Name.Set.mem pkgs package.name
     | None -> true)