Introduce Variants/Default implemeantions

Variants are a mechanism for selecting virtual library implementations en masse.
This PR includes the following changes:

* Add a [variant] field to implementations. This tags a virtual library
  implementation with a variant.

* Add [variants] field to executables and toplevels. This allows us to select
  implementations en masse when linking.

Default implementation is a feature to select a library to be a default
implementation when no implementation is selected by the user. This feature
allows to smoothly port existing libraries to be virtual.

Signed-off-by: Lucas Pluvinage <lucas.pluvinage@gmail.com>
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

CHANGES.md

@@ -11,6 +11,9 @@ unreleased
 
 - Fix glob dependencies on installed directories (#1965, @rgrinberg)
 
+- Add support for library variants and default implementations. (#1900,
+  @TheLortex)
+
 1.8.2 (10/03/2019)
 ------------------
 

doc/variants.rst

@@ -76,6 +76,47 @@ implementation for every virtual library that we've used:
      clock_unix ;; leaving this dependency will make dune loudly complain
      calendar))
 
+Variants
+========
+
+When building a binary, implementations can be selected using a set of variants
+rather than individually specifying implementations.
+
+An example where this is useful is providing JavaScript implementation. It would
+be tedious to select the JS implementation for every single virtual library.
+Instead, such implementations could select a ``js`` variant. Here's the syntax:
+
+.. code:: scheme
+
+   (executable
+    (name foo)
+    (libraries time filesystem)
+    (variants js))
+
+An implementation can specify which variant it corresponds to using the
+``variant`` option. Say for example that ``time`` is a virtual library. Its JS
+implementation would have the following configuration:
+
+.. code:: scheme
+
+   (library
+    (name time-js)
+    (implements time)
+    (variant js))
+
+Default implementation
+======================
+
+A virtual library may select a default implementation, which is enabled after
+variant resolution, if no suitable implementation has been found.
+
+.. code:: scheme
+
+   (library
+    (name time)
+    (virtual_modules time)
+    (default_implementation time-js))
+
 Limitations
 ===========
 
@@ -103,24 +144,3 @@ Some of these are temporary.
   library. This isn't very useful, but technically, it could be used to create
   partial implementations. It is possible to lift this restriction if there's
   enough demand for this.
-
-Variants
-========
-
-The term variants is commonly mentioned along with virtual libraries. This term
-refers to a *proposed* feature to simplify the selection of implementations. The
-proposal is to mark related implementations with a variant name. When building a
-binary, implementations are selected using a set of variants rather than
-individually specifying implementations.
-
-An example where this is useful is providing JavaScript implementation. It would
-be tedious to select the JS implementation for every single virtual library.
-Instead, such implementations could select a ``js`` variant. Here's a proposed
-syntax:
-
-.. code:: scheme
-
-   (executable
-    (name foo)
-    (libraries time filesystem)
-    (variants js))

editor-integration/emacs/dune.el

@@ -77,7 +77,7 @@
        "cxx_flags" "c_library_flags" "self_build_stubs_archive"
        "modules_without_implementation" "private_modules"
        ;; + virtual libraries
-       "virtual_modules" "implements"
+       "virtual_modules" "implements" "variant" "default_implementation"
        "allow_overlapping_dependencies"
        ;; + for "executable" and "executables":
        "package" "link_flags" "link_deps" "names" "public_names"

src/dune_file.ml

@@ -50,6 +50,11 @@ let relative_file =
     else
       of_sexp_errorf loc "relative filename expected")
 
+let variants_field =
+  field_o "variants" (
+    Syntax.since Stanza.syntax (1, 9) >>= fun () ->
+    located (list Variant.decode >>| Variant.Set.of_list))
+
 (* Parse and resolve "package" fields *)
 module Pkg = struct
   let listing packages =
@@ -864,6 +869,8 @@ module Library = struct
     ; dune_version             : Syntax.Version.t
     ; virtual_modules          : Ordered_set_lang.t option
     ; implements               : (Loc.t * Lib_name.t) option
+    ; variant                  : Variant.t option
+    ; default_implementation   : (Loc.t * Lib_name.t) option
     ; private_modules          : Ordered_set_lang.t option
     ; stdlib                   : Stdlib.t option
     }
@@ -909,6 +916,14 @@ module Library = struct
          field_o "implements" (
            Syntax.since Stanza.syntax (1, 7)
            >>= fun () -> located Lib_name.decode)
+       and+ variant =
+         field_o "variant" (
+           Syntax.since Stanza.syntax (1, 9)
+           >>= fun () -> located Variant.decode)
+       and+ default_implementation =
+         field_o "default_implementation" (
+           Syntax.since Stanza.syntax (1, 9)
+           >>= fun () -> located Lib_name.decode)
        and+ private_modules =
          field_o "private_modules" (
            Syntax.since Stanza.syntax (1, 2)
@@ -952,51 +967,64 @@ module Library = struct
             |> Option.value_exn)
            "A library cannot be both virtual and implement %s"
            (Lib_name.to_string impl));
-       let self_build_stubs_archive =
-         let loc, self_build_stubs_archive = self_build_stubs_archive in
-         let err =
-           match c_names, cxx_names, self_build_stubs_archive with
-           | _, _, None -> None
-           | Some _, _, Some _ -> Some "c_names"
-           | _, Some _, Some _ -> Some "cxx_names"
-           | None, None, _ -> None
-         in
-         match err with
-         | None ->
-           self_build_stubs_archive
-         | Some name ->
-           of_sexp_errorf loc
-             "A library cannot use (self_build_stubs_archive ...) \
-              and (%s ...) simultaneously." name
-       in
-       { name
-       ; public
-       ; synopsis
-       ; install_c_headers
-       ; ppx_runtime_libraries
-       ; modes
-       ; kind
-       ; c_names
-       ; c_flags
-       ; cxx_names
-       ; cxx_flags
-       ; library_flags
-       ; c_library_flags
-       ; self_build_stubs_archive
-       ; virtual_deps
-       ; wrapped
-       ; optional
-       ; buildable
-       ; dynlink = Dynlink_supported.of_bool (not no_dynlink)
-       ; project
-       ; sub_systems
-       ; no_keep_locs
-       ; dune_version
-       ; virtual_modules
-       ; implements
-       ; private_modules
-       ; stdlib
-       })
+       match virtual_modules, default_implementation with
+       | None, Some (loc, _) ->
+         of_sexp_error loc
+           "Only virtual libraries can specify a default implementation."
+       | _ -> ();
+         match implements, variant with
+         | None, Some (loc, _) ->
+           of_sexp_error loc
+             "Only implementations can specify a variant."
+         | _ -> ();
+           let variant = Option.map variant ~f:(fun (_, v) -> v) in
+           let self_build_stubs_archive =
+             let loc, self_build_stubs_archive = self_build_stubs_archive in
+             let err =
+               match c_names, cxx_names, self_build_stubs_archive with
+               | _, _, None -> None
+               | Some _, _, Some _ -> Some "c_names"
+               | _, Some _, Some _ -> Some "cxx_names"
+               | None, None, _ -> None
+             in
+             match err with
+             | None ->
+               self_build_stubs_archive
+             | Some name ->
+               of_sexp_errorf loc
+                 "A library cannot use (self_build_stubs_archive ...) \
+                  and (%s ...) simultaneously." name
+           in
+           { name
+           ; public
+           ; synopsis
+           ; install_c_headers
+           ; ppx_runtime_libraries
+           ; modes
+           ; kind
+           ; c_names
+           ; c_flags
+           ; cxx_names
+           ; cxx_flags
+           ; library_flags
+           ; c_library_flags
+           ; self_build_stubs_archive
+           ; virtual_deps
+           ; wrapped
+           ; optional
+           ; buildable
+           ; dynlink = Dynlink_supported.of_bool (not no_dynlink)
+           ; project
+           ; sub_systems
+           ; no_keep_locs
+           ; dune_version
+           ; virtual_modules
+           ; implements
+           ; variant
+           ; default_implementation
+           ; private_modules
+           ; stdlib
+           })
 
   let has_stubs t =
     match t.c_names, t.cxx_names, t.self_build_stubs_archive with
@@ -1368,6 +1396,7 @@ module Executables = struct
     ; link_deps  : Dep_conf.t list
     ; modes      : Link_mode.Set.t
     ; buildable  : Buildable.t
+    ; variants   : (Loc.t * Variant.Set.t) option
     }
 
   let common =
@@ -1377,6 +1406,7 @@ module Executables = struct
     and+ link_deps = field "link_deps" (list Dep_conf.decode) ~default:[]
     and+ link_flags = field_oslu "link_flags"
     and+ modes = field "modes" Link_mode.Set.decode ~default:Link_mode.Set.default
+    and+ variants = variants_field
     and+ () = map_validate (
       field "inline_tests" (repeat junk >>| fun _ -> true) ~default:false)
       ~f:(function
@@ -1395,6 +1425,7 @@ module Executables = struct
         ; link_deps
         ; modes
         ; buildable
+        ; variants
         }
       in
       let install_conf =
@@ -1840,6 +1871,7 @@ module Tests = struct
     record
       (let+ buildable = Buildable.decode
        and+ link_flags = field_oslu "link_flags"
+       and+ variants = variants_field
        and+ names = names
        and+ package = field_o "package" Pkg.decode
        and+ locks = field "locks" (list String_with_vars.decode) ~default:[]
@@ -1860,6 +1892,7 @@ module Tests = struct
            ; modes
            ; buildable
            ; names
+           ; variants
            }
        ; locks
        ; package
@@ -1877,6 +1910,7 @@ module Toplevel = struct
   type t =
     { name : string
     ; libraries : (Loc.t * Lib_name.t) list
+    ; variants : (Loc.t * Variant.Set.t) option
     ; loc : Loc.t
     }
 
@@ -1885,12 +1919,14 @@ module Toplevel = struct
     record (
       let+ loc = loc
       and+ name = field "name" string
+      and+ variants = variants_field
       and+ libraries =
         field "libraries" (list (located Lib_name.decode)) ~default:[]
       in
       { name
       ; libraries
       ; loc
+      ; variants
       }
     )
 end

src/dune_file.mli

@@ -221,6 +221,8 @@ module Library : sig
     ; dune_version             : Syntax.Version.t
     ; virtual_modules          : Ordered_set_lang.t option
     ; implements               : (Loc.t * Lib_name.t) option
+    ; variant                  : Variant.t option
+    ; default_implementation   : (Loc.t * Lib_name.t) option
     ; private_modules          : Ordered_set_lang.t option
     ; stdlib                   : Stdlib.t option
     }
@@ -286,6 +288,7 @@ module Executables : sig
     ; link_deps  : Dep_conf.t list
     ; modes      : Link_mode.Set.t
     ; buildable  : Buildable.t
+    ; variants   : (Loc.t * Variant.Set.t) option
     }
 end
 
@@ -396,6 +399,7 @@ module Toplevel : sig
   type t =
     { name : string
     ; libraries : (Loc.t * Lib_name.t) list
+    ; variants : (Loc.t * Variant.Set.t) option
     ; loc : Loc.t
     }
 end