Add re_exports for libraries

CHANGES.md

@@ -130,6 +130,10 @@
   the executable source. Programs that use this feature can be run by a new
   action (dynamic-run <progn> ...). (#2635, @staronj, @aalekseyev)
 
+- Add support for dependencies that are re-exported. Such dependencies
+  are marked with`re_export` and will automatically be provided to
+  users of a library (#2605, @rgrinberg)
+
 1.11.3 (23/08/2019)
 -------------------
 

src/dune/cinaps.ml

@@ -5,7 +5,7 @@ open Build.O
 type t =
   { loc : Loc.t
   ; files : Predicate_lang.t
-  ; libraries : Dune_file.Lib_dep.t list
+  ; libraries : Lib_dep.t list
   ; preprocess : Dune_file.Preprocess_map.t
   ; preprocessor_deps : Dune_file.Dep_conf.t list
   ; flags : Ocaml_flags.Spec.t
@@ -27,7 +27,10 @@ let decode =
          ~default:Dune_file.Preprocess_map.default
      and+ preprocessor_deps =
        field "preprocessor_deps" (repeat Dune_file.Dep_conf.decode) ~default:[]
-     and+ libraries = field "libraries" Dune_file.Lib_deps.decode ~default:[]
+     and+ libraries =
+       field "libraries"
+         (Dune_file.Lib_deps.decode ~allow_re_export:false)
+         ~default:[]
      and+ flags = Ocaml_flags.Spec.decode in
      { loc; files; libraries; preprocess; preprocessor_deps; flags })
 
@@ -87,8 +90,7 @@ let gen_rules sctx t ~dir ~scope =
   let compile_info =
     Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope)
       [ (t.loc, name) ]
-      ( Dune_file.Lib_dep.Direct
-          (loc, Lib_name.of_string_exn "cinaps.runtime" ~loc:None)
+      ( Lib_dep.Direct (loc, Lib_name.of_string_exn "cinaps.runtime" ~loc:None)
       :: t.libraries )
       ~pps:(Dune_file.Preprocess_map.pps t.preprocess)
       ~variants:None ~optional:false

src/dune/dir_contents.ml

@@ -430,8 +430,10 @@ end = struct
            |Executables { buildable; _ } ->
             (* Manually add files generated by the (select ...) dependencies *)
             List.filter_map buildable.libraries ~f:(fun dep ->
-                match (dep : Dune_file.Lib_dep.t) with
-                | Direct _ -> None
+                match (dep : Lib_dep.t) with
+                | Re_export _
+                 |Direct _ ->
+                  None
                 | Select s -> Some s.result_fn)
           | _ -> [])
       |> String.Set.of_list
@@ -443,9 +445,13 @@ end = struct
            |Executables { buildable; _ } ->
             (* add files used by the (select ...) dependencies *)
             List.concat_map buildable.libraries ~f:(fun dep ->
-                match (dep : Dune_file.Lib_dep.t) with
-                | Direct _ -> []
-                | Select s -> List.map s.choices ~f:(fun s -> s.Lib_dep.file))
+                match (dep : Lib_dep.t) with
+                | Re_export _
+                 |Direct _ ->
+                  []
+                | Select s ->
+                  List.map s.choices ~f:(fun (s : Lib_dep.Select.choice) ->
+                      s.file))
           | _ -> [])
       |> String.Set.of_list
     in

src/dune/dune_file.ml

@@ -37,15 +37,6 @@ let module_name =
           Module_name.of_string s
         with Exit -> invalid_module_name ~loc name ))
 
-let file =
-  plain_string (fun ~loc s ->
-      match s with
-      | "."
-       |".." ->
-        User_error.raise ~loc
-          [ Pp.textf "'.' and '..' are not valid filenames" ]
-      | fn -> fn)
-
 let relative_file =
   plain_string (fun ~loc fn ->
       if Filename.is_relative fn then
@@ -492,86 +483,6 @@ module Js_of_ocaml = struct
     { flags = Ordered_set_lang.Unexpanded.standard; javascript_files = [] }
 end
 
-module Lib_dep = struct
-  type choice =
-    { required : Lib_name.Set.t
-    ; forbidden : Lib_name.Set.t
-    ; file : string
-    }
-
-  type select =
-    { result_fn : string
-    ; choices : choice list
-    ; loc : Loc.t (* For error messages *)
-    }
-
-  type t =
-    | Direct of (Loc.t * Lib_name.t)
-    | Select of select
-
-  let choice =
-    enter
-      (let+ loc = loc
-       and+ preds, file =
-         until_keyword "->"
-           ~before:
-             (let+ s = string
-              and+ loc = loc in
-              let len = String.length s in
-              if len > 0 && s.[0] = '!' then
-                Right
-                  (Lib_name.of_string_exn ~loc:(Some loc) (String.drop s 1))
-              else
-                Left (Lib_name.of_string_exn ~loc:(Some loc) s))
-           ~after:file
-       in
-       match file with
-       | None ->
-         User_error.raise ~loc
-           [ Pp.textf "(<[!]libraries>... -> <file>) expected" ]
-       | Some file ->
-         let rec loop required forbidden = function
-           | [] ->
-             let common = Lib_name.Set.inter required forbidden in
-             Option.iter (Lib_name.Set.choose common) ~f:(fun name ->
-                 User_error.raise ~loc
-                   [ Pp.textf
-                       "library %S is both required and forbidden in this \
-                        clause"
-                       (Lib_name.to_string name)
-                   ]);
-             { required; forbidden; file }
-           | Left s :: l -> loop (Lib_name.Set.add required s) forbidden l
-           | Right s :: l -> loop required (Lib_name.Set.add forbidden s) l
-         in
-         loop Lib_name.Set.empty Lib_name.Set.empty preds)
-
-  let decode =
-    if_list
-      ~then_:
-        (enter
-           (let+ loc = loc
-            and+ () = keyword "select"
-            and+ result_fn = file
-            and+ () = keyword "from"
-            and+ choices = repeat choice in
-            Select { result_fn; choices; loc }))
-      ~else_:
-        (let+ loc, name = located Lib_name.decode in
-         Direct (loc, name))
-
-  let to_lib_names = function
-    | Direct (_, s) -> [ s ]
-    | Select s ->
-      List.fold_left s.choices ~init:Lib_name.Set.empty ~f:(fun acc x ->
-          Lib_name.Set.union acc (Lib_name.Set.union x.required x.forbidden))
-      |> Lib_name.Set.to_list
-
-  let direct x = Direct x
-
-  let of_lib_name (loc, pp) = Direct (loc, pp)
-end
-
 module Lib_deps = struct
   type t = Lib_dep.t list
 
@@ -580,9 +491,9 @@ module Lib_deps = struct
     | Optional
     | Forbidden
 
-  let decode =
+  let decode ~allow_re_export =
     let+ loc = loc
-    and+ t = repeat Lib_dep.decode in
+    and+ t = repeat (Lib_dep.decode ~allow_re_export) in
     let add kind name acc =
       match Lib_name.Map.find acc name with
       | None -> Lib_name.Map.set acc name kind
@@ -612,26 +523,29 @@ module Lib_deps = struct
     ignore
       ( List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x ->
             match x with
-            | Lib_dep.Direct (_, s) -> add Required s acc
+            | Lib_dep.Re_export (_, s)
+             |Lib_dep.Direct (_, s) ->
+              add Required s acc
             | Select { choices; _ } ->
-              List.fold_left choices ~init:acc ~f:(fun acc c ->
+              List.fold_left choices ~init:acc
+                ~f:(fun acc (c : Lib_dep.Select.choice) ->
                   let acc =
-                    Lib_name.Set.fold c.Lib_dep.required ~init:acc
-                      ~f:(add Optional)
+                    Lib_name.Set.fold c.required ~init:acc ~f:(add Optional)
                   in
                   Lib_name.Set.fold c.forbidden ~init:acc ~f:(add Forbidden)))
         : kind Lib_name.Map.t );
     t
 
-  let of_pps pps =
-    List.map pps ~f:(fun pp -> Lib_dep.of_lib_name (Loc.none, pp))
+  let of_pps pps = List.map pps ~f:(fun pp -> Lib_dep.direct (Loc.none, pp))
 
   let info t ~kind =
     List.concat_map t ~f:(function
-      | Lib_dep.Direct (_, s) -> [ (s, kind) ]
+      | Lib_dep.Re_export (_, s)
+       |Lib_dep.Direct (_, s) ->
+        [ (s, kind) ]
       | Select { choices; _ } ->
-        List.concat_map choices ~f:(fun c ->
-            Lib_name.Set.to_list c.Lib_dep.required
+        List.concat_map choices ~f:(fun (c : Lib_dep.Select.choice) ->
+            Lib_name.Set.to_list c.required
             |> List.map ~f:(fun d -> (d, Lib_deps_info.Kind.Optional))))
     |> Lib_name.Map.of_list_reduce ~f:Lib_deps_info.Kind.merge
 end
@@ -655,7 +569,7 @@ module Buildable = struct
     ; allow_overlapping_dependencies : bool
     }
 
-  let decode ~since_c =
+  let decode ~since_c ~allow_re_export =
     let check_c t =
       match since_c with
       | None -> t
@@ -673,7 +587,8 @@ module Buildable = struct
     and+ modules = modules_field "modules"
     and+ modules_without_implementation =
       modules_field "modules_without_implementation"
-    and+ libraries = field "libraries" Lib_deps.decode ~default:[]
+    and+ libraries =
+      field "libraries" (Lib_deps.decode ~allow_re_export) ~default:[]
     and+ flags = Ocaml_flags.Spec.decode
     and+ js_of_ocaml =
       field "js_of_ocaml" Js_of_ocaml.decode ~default:Js_of_ocaml.default
@@ -1022,7 +937,7 @@ module Library = struct
 
   let decode =
     fields
-      (let+ buildable = Buildable.decode ~since_c:None
+      (let+ buildable = Buildable.decode ~since_c:None ~allow_re_export:true
        and+ loc = loc
        and+ name = field_o "name" Lib_name.Local.decode_loc
        and+ public = Public_lib.public_name_field
@@ -1610,7 +1525,8 @@ module Executables = struct
     }
 
   let common =
-    let+ buildable = Buildable.decode ~since_c:(Some (2, 0))
+    let+ buildable =
+      Buildable.decode ~since_c:(Some (2, 0)) ~allow_re_export:false
     and+ (_ : bool) =
       field "link_executables" ~default:true
         (Dune_lang.Syntax.deleted_in Stanza.syntax (1, 0) >>> bool)
@@ -2120,7 +2036,8 @@ module Tests = struct
 
   let gen_parse names =
     fields
-      (let+ buildable = Buildable.decode ~since_c:(Some (2, 0))
+      (let+ buildable =
+         Buildable.decode ~since_c:(Some (2, 0)) ~allow_re_export:false
        and+ link_flags = field_oslu "link_flags"
        and+ variants = variants_field
        and+ names = names

src/dune/dune_file.mli

@@ -73,38 +73,14 @@ module Js_of_ocaml : sig
   val default : t
 end
 
-module Lib_dep : sig
-  type choice =
-    { required : Lib_name.Set.t
-    ; forbidden : Lib_name.Set.t
-    ; file : string
-    }
-
-  type select =
-    { result_fn : string
-    ; choices : choice list
-    ; loc : Loc.t
-    }
-
-  type t =
-    | Direct of (Loc.t * Lib_name.t)
-    | Select of select
-
-  val to_lib_names : t -> Lib_name.t list
-
-  val direct : Loc.t * Lib_name.t -> t
-
-  val of_lib_name : Loc.t * Lib_name.t -> t
-end
-
 module Lib_deps : sig
-  type t = Lib_dep.t list
+  type nonrec t = Lib_dep.t list
 
   val of_pps : Lib_name.t list -> t
 
   val info : t -> kind:Lib_deps_info.Kind.t -> Lib_deps_info.t
 
-  val decode : t Dune_lang.Decoder.t
+  val decode : allow_re_export:bool -> t Dune_lang.Decoder.t
 end
 
 module Dep_conf : sig

src/dune/dune_package.ml

@@ -14,10 +14,9 @@ module Lib = struct
     { info : Path.t Lib_info.t
     ; modules : Modules.t option
     ; main_module_name : Module_name.t option
-    ; requires : (Loc.t * Lib_name.t) list
     }
 
-  let make ~info ~main_module_name ~requires ~modules =
+  let make ~info ~main_module_name ~modules =
     let obj_dir = Lib_info.obj_dir info in
     let dir = Obj_dir.dir obj_dir in
     let map_path p =
@@ -27,13 +26,13 @@ module Lib = struct
         p
     in
     let info = Lib_info.map_path info ~f:map_path in
-    { info; main_module_name; requires; modules }
+    { info; main_module_name; modules }
 
   let dir_of_name name =
     let _, components = Lib_name.split name in
     Path.Local.L.relative Path.Local.root components
 
-  let encode ~package_root { info; requires; main_module_name; modules } =
+  let encode ~package_root { info; main_module_name; modules } =
     let open Dune_lang.Encoder in
     let no_loc f (_loc, x) = f x in
     let path = Dpath.Local.encode ~dir:package_root in
@@ -58,6 +57,7 @@ module Lib = struct
     let archives = Lib_info.archives info in
     let sub_systems = Lib_info.sub_systems info in
     let plugins = Lib_info.plugins info in
+    let requires = Lib_info.requires info in
     let foreign_archives = Lib_info.foreign_archives info in
     let foreign_objects =
       match Lib_info.foreign_objects info with
@@ -77,7 +77,7 @@ module Lib = struct
        ; paths "foreign_objects" foreign_objects
        ; mode_paths "foreign_archives" foreign_archives
        ; paths "jsoo_runtime" jsoo_runtime
-       ; libs "requires" requires
+       ; Lib_dep.L.field_encode requires ~name:"requires"
        ; libs "ppx_runtime_deps" ppx_runtime_deps
        ; field_o "implements" (no_loc Lib_name.encode) implements
        ; field_l "known_implementations"
@@ -134,7 +134,8 @@ module Lib = struct
        and+ foreign_objects = paths "foreign_objects"
        and+ foreign_archives = mode_paths "foreign_archives"
        and+ jsoo_runtime = paths "jsoo_runtime"
-       and+ requires = libs "requires"
+       and+ requires =
+         field_l "requires" (Lib_dep.decode ~allow_re_export:true)
        and+ ppx_runtime_deps = libs "ppx_runtime_deps"
        and+ virtual_ = field_b "virtual"
        and+ known_implementations =
@@ -166,7 +167,6 @@ module Lib = struct
            Dune_file.Library.Inherited.This main_module_name
          in
          let foreign_objects = Lib_info.Source.External foreign_objects in
-         let requires = Lib_info.Deps.Simple requires in
          let jsoo_archive = None in
          let pps = [] in
          let virtual_deps = [] in
@@ -191,14 +191,12 @@ module Lib = struct
            ~known_implementations ~default_implementation ~modes ~wrapped
            ~special_builtin_support
        in
-       { info; requires; main_module_name; modules })
+       { info; main_module_name; modules })
 
   let modules t = t.modules
 
   let main_module_name t = t.main_module_name
 
-  let requires t = t.requires
-
   let compare_name x y =
     let x = Lib_info.name x.info in
     let y = Lib_info.name y.info in