Variants v2 (#2169)

Variants v2

CHANGES.md

@@ -3,6 +3,11 @@ unreleased
 
 - Don't reserve the `Ppx` toplevel module name for ppx rewriters (#...., @diml)
 
+- Redesign of the library variant feature according to the #2134 proposal. The
+  set of variants is now computed when the virtual library is installed.
+  Introducing a new `external_variant` stanza. (#2169, fixes #2134, @TheLortex,
+  review by @diml)
+
 1.10.0 (04/06/2019)
 -------------------
 

doc/dune-files.rst

@@ -983,6 +983,23 @@ run this toplevel with:
 
    $ dune exec ./tt.exe
 
+external_variant
+-----------------
+
+The ``external_variant`` allow to declare a tagged implementation that does not
+live inside the virtual library project.
+
+.. code:: scheme
+
+   (external_variant
+    (variant foo)
+    (implementation lib-foo)
+    (virtual_library vlib))
+
+This will add `lib-foo` to the list of known implementations of `vlib`. For more
+details see :ref:`dune-variants`
+
+
 Common items
 ============
 

doc/variants.rst

@@ -76,11 +76,13 @@ implementation for every virtual library that we've used:
      clock_unix ;; leaving this dependency will make dune loudly complain
      calendar))
 
+.. _dune-variants:
+
 Variants
 ========
 
 This feature is still under development and may change with new dune
-releases. You need to write ``(using library_variants 0.1)`` in your
+releases. You need to write ``(using library_variants 0.2)`` in your
 ``dune-project`` file to unlock it.
 
 When building a binary, implementations can be selected using a set of variants
@@ -108,6 +110,21 @@ implementation would have the following configuration:
     (implements time)
     (variant js))
 
+The list of available variants is computed while building the virtual library.
+This means only variant implementations that are part of the same project are
+implicitely taken into account. It's possible to declare an external
+implementation by using the `external_variant` stanza in the virtual library
+scope.
+
+.. code:: scheme
+
+   (external_variant
+    (variant foo)
+    (implementation lib-foo)
+    (virtual_library vlib))
+
+This will add `lib-foo` to the list of known implementations of `vlib`.
+
 Default implementation
 ======================
 

src/dune_file.ml

@@ -55,7 +55,7 @@ let library_variants =
   let syntax =
     Syntax.create ~name:"library_variants"
       ~desc:"the experimental library variants feature."
-      [ (0, 1) ]
+      [ (0, 2) ]
   in
   Dune_project.Extension.register_simple ~experimental:true
     syntax (Dune_lang.Decoder.return []);
@@ -830,6 +830,34 @@ module Mode_conf = struct
   end
 end
 
+module External_variant = struct
+  type t =
+    { implementation : Lib_name.t
+    ; virtual_lib : Lib_name.t
+    ; variant : Variant.t
+    ; project : Dune_project.t
+    ; loc : Loc.t
+    }
+
+  let decode =
+    let open Stanza.Decoder in
+    record (
+      let+ loc = loc
+      and+ variant = field "variant" Variant.decode
+      and+ virtual_lib = field "virtual_library" Lib_name.decode
+      and+ implementation = field "implementation" Lib_name.decode
+      and+ project = Dune_project.get_exn ()
+      in
+      { implementation
+      ; virtual_lib
+      ; variant
+      ; project
+      ; loc
+      }
+    )
+end
+
+
 module Library = struct
   module Inherited = struct
     type 'a t =
@@ -1041,7 +1069,7 @@ module Library = struct
            "A library cannot be both virtual and implement %s"
            (Lib_name.to_string impl));
        match virtual_modules, default_implementation with
-       | None, Some (loc, _) ->
+       | None, (Some (loc, _)) ->
          of_sexp_error loc
            "Only virtual libraries can specify a default implementation."
        | _ -> ();
@@ -2171,16 +2199,17 @@ module Include_subdirs = struct
 end
 
 type Stanza.t +=
-  | Library         of Library.t
-  | Executables     of Executables.t
-  | Rule            of Rule.t
-  | Install         of File_binding.Unexpanded.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
-  | Toplevel        of Toplevel.t
+  | Library                of Library.t
+  | Executables            of Executables.t
+  | Rule                   of Rule.t
+  | Install                of File_binding.Unexpanded.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
+  | Toplevel               of Toplevel.t
+  | External_variant of External_variant.t
 
 module Stanzas = struct
   type t = Stanza.t list
@@ -2249,6 +2278,10 @@ module Stanzas = struct
       (let+ () = Syntax.since Stanza.syntax (1, 0)
        and+ t = Tests.single in
        [Tests t])
+    ; "external_variant",
+      (let+ () = Syntax.since library_variants (0, 2)
+       and+ t = External_variant.decode in
+       [External_variant t])
     ; "env",
       (let+ x = Dune_env.Stanza.decode in
        [Dune_env.T x])

src/dune_file.mli

@@ -181,6 +181,16 @@ module Mode_conf : sig
   end
 end
 
+module External_variant : sig
+  type t =
+    { implementation : Lib_name.t
+    ; virtual_lib : Lib_name.t
+    ; variant : Variant.t
+    ; project : Dune_project.t
+    ; loc : Loc.t
+    }
+end
+
 module Library : sig
   module Inherited : sig
     type 'a t =
@@ -467,16 +477,17 @@ module Include_subdirs : sig
 end
 
 type Stanza.t +=
-  | Library         of Library.t
-  | Executables     of Executables.t
-  | Rule            of Rule.t
-  | Install         of File_binding.Unexpanded.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
-  | Toplevel        of Toplevel.t
+  | Library                of Library.t
+  | Executables            of Executables.t
+  | Rule                   of Rule.t
+  | Install                of File_binding.Unexpanded.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
+  | Toplevel               of Toplevel.t
+  | External_variant       of External_variant.t
 
 val stanza_package : Stanza.t -> Package.t option
 

src/dune_load.ml

@@ -26,6 +26,18 @@ module Dune_file = struct
     ; stanzas
     ; kind
     }
+
+  let rec fold_stanzas l ~init ~f =
+    match l with
+    | [] -> init
+    | t :: l -> inner_fold t t.stanzas l ~init ~f
+
+  and inner_fold t inner_list l ~init ~f =
+    match inner_list with
+    | [] -> fold_stanzas l ~init ~f
+    | x :: inner_list ->
+      inner_fold t inner_list l ~init:(f t x init) ~f
+
 end
 
 module Dune_files = struct

src/dune_load.mli

@@ -7,6 +7,12 @@ module Dune_file : sig
     ; stanzas : Dune_file.Stanzas.t
     ; kind    : Dune_lang.File_syntax.t
     }
+
+  val fold_stanzas :
+      t list
+    -> init:'acc
+    -> f:(t -> Stanza.t -> 'acc -> 'acc)
+    -> 'acc
 end
 
 module Dune_files : sig

src/dune_package.ml

@@ -19,9 +19,9 @@ module Lib = struct
     ; ppx_runtime_deps : (Loc.t * Lib_name.t) list
     ; sub_systems      : 'sub_system Sub_system_name.Map.t
     ; virtual_         : bool
-    ; implements       : (Loc.t * Lib_name.t) option
-    ; variant          : Variant.t option
+    ; known_implementations :  (Loc.t * Lib_name.t) Variant.Map.t
     ; default_implementation  : (Loc.t * Lib_name.t)  option
+    ; implements       : (Loc.t * Lib_name.t) option
     ; modules          : Lib_modules.t option
     ; main_module_name : Module.Name.t option
     ; requires         : (Loc.t * Lib_name.t) list
@@ -33,8 +33,8 @@ module Lib = struct
 
   let make ~loc ~kind ~name ~synopsis ~archives ~plugins ~foreign_objects
         ~foreign_archives ~jsoo_runtime ~main_module_name ~sub_systems
-        ~requires ~ppx_runtime_deps ~implements ~variant
-        ~default_implementation ~virtual_ ~modules ~modes
+        ~requires ~ppx_runtime_deps ~implements
+        ~default_implementation ~virtual_ ~known_implementations ~modules ~modes
         ~version ~orig_src_dir ~obj_dir
         ~special_builtin_support =
     let dir = Obj_dir.dir obj_dir in
@@ -60,11 +60,11 @@ module Lib = struct
     ; requires
     ; ppx_runtime_deps
     ; implements
-    ; variant
-    ; default_implementation
     ; version
     ; orig_src_dir
     ; virtual_
+    ; known_implementations
+    ; default_implementation
     ; modules
     ; modes
     ; obj_dir
@@ -85,8 +85,8 @@ module Lib = struct
   let encode ~package_root
         { loc = _ ; kind ; synopsis ; name ; archives ; plugins
         ; foreign_objects ; foreign_archives ; jsoo_runtime ; requires
-        ; ppx_runtime_deps ; sub_systems ; virtual_
-        ; implements ; variant ; default_implementation
+        ; ppx_runtime_deps ; sub_systems ; virtual_ ; known_implementations
+        ; implements ; default_implementation
         ; main_module_name ; version = _; obj_dir ; orig_src_dir
         ; modules ; modes ; special_builtin_support
         } =
@@ -96,6 +96,7 @@ module Lib = struct
     let paths name f = field_l name path f in
     let mode_paths name (xs : Path.t Mode.Dict.List.t) =
       field_l name sexp (Mode.Dict.List.encode path xs) in
+    let known_implementations = Variant.Map.to_list known_implementations in
     let libs name = field_l name (no_loc Lib_name.encode) in
     record_fields @@
     [ field "name" Lib_name.encode name
@@ -111,7 +112,8 @@ module Lib = struct
     ; libs "requires" requires
     ; libs "ppx_runtime_deps" ppx_runtime_deps
     ; field_o "implements" (no_loc Lib_name.encode) implements
-    ; field_o "variant" Variant.encode variant
+    ; field_l "known_implementations"
+        (pair Variant.encode (no_loc Lib_name.encode)) known_implementations
     ; field_o "default_implementation"
         (no_loc Lib_name.encode) default_implementation
     ; field_o "main_module_name" Module.Name.encode main_module_name
@@ -139,7 +141,6 @@ module Lib = struct
     record (
       let* main_module_name = field_o "main_module_name" Module.Name.decode in
       let* implements = field_o "implements" (located Lib_name.decode) in
-      let* variant = field_o "variant" Variant.decode in
       let* default_implementation =
         field_o "default_implementation" (located Lib_name.decode) in
       let* name = field "name" Lib_name.decode in
@@ -162,15 +163,21 @@ module Lib = struct
       and+ requires = libs "requires"
       and+ ppx_runtime_deps = libs "ppx_runtime_deps"
       and+ virtual_ = field_b "virtual"
+      and+ known_implementations = field_l "known_implementations"
+                                     (pair Variant.decode
+                                             (located Lib_name.decode))
       and+ sub_systems = Sub_system_info.record_parser ()
       and+ orig_src_dir = field_o "orig_src_dir" path
       and+ modules = field_o "modules" (Lib_modules.decode
-                                          ~implements:(Option.is_some implements) ~obj_dir)
-       and+ special_builtin_support =
-         field_o "special_builtin_support"
-           (Syntax.since Stanza.syntax (1, 10) >>>
-            Dune_file.Library.Special_builtin_support.decode)
+                                          ~implements:(Option.is_some
+                                                         implements) ~obj_dir)
+      and+ special_builtin_support =
+        field_o "special_builtin_support"
+          (Syntax.since Stanza.syntax (1, 10) >>>
+           Dune_file.Library.Special_builtin_support.decode)
       in
+      let known_implementations =
+        Variant.Map.of_list_exn known_implementations in
       let modes = Mode.Dict.Set.of_list modes in
       { kind
       ; name
@@ -184,8 +191,8 @@ module Lib = struct
       ; requires
       ; ppx_runtime_deps
       ; implements
-      ; variant
       ; default_implementation
+      ; known_implementations
       ; sub_systems
       ; main_module_name
       ; virtual_
@@ -215,7 +222,7 @@ module Lib = struct
   let foreign_archives t = t.foreign_archives
   let requires t = t.requires
   let implements t = t.implements
-  let variant t = t.variant
+  let known_implementations t = t.known_implementations
   let default_implementation t = t.default_implementation
   let modes t = t.modes
   let special_builtin_support t = t.special_builtin_support

src/dune_package.mli

@@ -23,7 +23,7 @@ module Lib : sig
   val plugins : _ t -> Path.t list Mode.Dict.t
   val jsoo_runtime : _ t -> Path.t list
   val implements : _ t -> (Loc.t * Lib_name.t) option
-  val variant : _ t -> Variant.t option
+  val known_implementations : _ t -> (Loc.t * Lib_name.t) Variant.Map.t
   val default_implementation : _ t -> (Loc.t * Lib_name.t) option
   val special_builtin_support
     : _ t -> Dune_file.Library.Special_builtin_support.t option
@@ -51,9 +51,9 @@ module Lib : sig
     -> requires:(Loc.t * Lib_name.t) list
     -> ppx_runtime_deps:(Loc.t * Lib_name.t) list
     -> implements:(Loc.t * Lib_name.t) option
-    -> variant: (Variant.t) option
     -> default_implementation: (Loc.t * Lib_name.t) option
     -> virtual_:bool
+    -> known_implementations: (Loc.t * Lib_name.t) Variant.Map.t
     -> modules:Lib_modules.t option
     -> modes:Mode.Dict.Set.t
     -> version:string option

src/dune_project.ml

@@ -15,6 +15,7 @@ module Name : sig
 
   val to_dyn : t -> Dyn.t
 
+  val equal : t -> t -> bool
   val compare : t -> t -> Ordering.t
 
   val to_string_hum : t -> string
@@ -44,6 +45,8 @@ end = struct
       | Anonymous x, Anonymous y -> Path.Source.compare x y
       | Named     _, Anonymous _ -> Lt
       | Anonymous _, Named     _ -> Gt
+
+    let equal a b = Ordering.is_eq (compare a b)
   end
 
   include T