Add (explicit_js_mode)

Signed-off-by: Nicolás Ojeda Bär <[email protected]>
Signed-off-by: Rudi Grinberg <[email protected]>

dune-project

@@ -1,4 +1,5 @@
-(lang dune 1.8)
+(lang dune 1.9)
 (name dune)
 
-(implicit_transitive_deps false)
+(implicit_transitive_deps false)
+(explicit_js_mode)

src/binary_kind.ml

@@ -5,7 +5,6 @@ type t =
   | Exe
   | Object
   | Shared_object
-  | Js
 
 let decode =
   let open Dune_lang.Decoder in
@@ -14,20 +13,18 @@ let decode =
     ; "exe"           , return Exe
     ; "object"        , return Object
     ; "shared_object" , return Shared_object
-    ; "js"            , Syntax.since Stanza.syntax (1, 9) >>> return Js
     ]
 
 let to_string = function
   | C -> "c"
   | Exe -> "exe"
   | Object -> "object"
   | Shared_object -> "shared_object"
-  | Js -> "js"
 
 let pp fmt t =
   Format.pp_print_string fmt (to_string t)
 
 let encode t =
   Dune_lang.unsafe_atom_of_string (to_string t)
 
-let all = [C; Exe; Object; Shared_object; Js]
+let all = [C; Exe; Object; Shared_object]

src/binary_kind.mli

@@ -7,7 +7,6 @@ type t =
   | Exe
   | Object
   | Shared_object
-  | Js
 
 include Dune_lang.Conv with type t := t
 

src/dune_file.ml

@@ -745,6 +745,7 @@ module Mode_conf = struct
       | Byte
       | Native
       | Best
+      | Js
     let compare (a : t) b = compare a b
   end
   include T
@@ -754,12 +755,14 @@ module Mode_conf = struct
       [ "byte"  , Byte
       ; "native", Native
       ; "best"  , Best
+      ; "js"    , Js
       ]
 
   let to_string = function
     | Byte -> "byte"
     | Native -> "native"
     | Best -> "best"
+    | Js -> "js"
 
   let pp fmt t =
     Format.pp_print_string fmt (to_string t)
@@ -776,7 +779,7 @@ module Mode_conf = struct
 
     let eval t ~has_native =
       let has_best = mem t Best in
-      let byte = mem t Byte || (has_best && (not has_native)) in
+      let byte = mem t Js || mem t Byte || (has_best && (not has_native)) in
       let native = has_native && (mem t Native || has_best) in
       { Mode.Dict.byte; native }
   end
@@ -1309,6 +1312,7 @@ module Executables = struct
     let shared_object = make Best Shared_object
 
     let byte_exe           = make Byte Exe
+    let js                 = make Js Exe
 
     let native_exe           = make Native Exe
     let native_object        = make Native Object
@@ -1326,6 +1330,7 @@ module Executables = struct
       ; "shared_object" , shared_object
       ; "byte"          , byte
       ; "native"        , native
+      ; "js"            , js
       ]
 
     let simple =
@@ -1447,6 +1452,7 @@ module Executables = struct
             match mode.mode with
             | Native | Best -> ".exe"
             | Byte -> ".bc"
+            | Js -> ".bc.js"
           in
           Names.install_conf names ~ext
       in

src/dune_file.mli

@@ -154,6 +154,7 @@ module Mode_conf : sig
     | Byte
     | Native
     | Best (** [Native] if available and [Byte] if not *)
+    | Js
 
   val decode : t Dune_lang.Decoder.t
   val compare : t -> t -> Ordering.t
@@ -273,6 +274,7 @@ module Executables : sig
     val object_       : t
     val shared_object : t
     val byte          : t
+    val js            : t
     val native        : t
 
     val compare : t -> t -> Ordering.t

src/dune_project.ml

@@ -167,6 +167,7 @@ type t =
   ; implicit_transitive_deps : bool
   ; dune_version    : Syntax.Version.t
   ; allow_approx_merlin : bool
+  ; explicit_js_mode : bool;
   }
 
 let equal = (==)
@@ -180,11 +181,12 @@ let stanza_parser t = t.stanza_parser
 let file t = t.project_file.file
 let implicit_transitive_deps t = t.implicit_transitive_deps
 let allow_approx_merlin t = t.allow_approx_merlin
+let explicit_js_mode t = t.explicit_js_mode
 
 let pp fmt { name ; root ; version ; project_file ; parsing_context = _
            ; extension_args = _; stanza_parser = _ ; packages
            ; implicit_transitive_deps ; dune_version
-           ; allow_approx_merlin } =
+           ; allow_approx_merlin; explicit_js_mode } =
   Fmt.record fmt
     [ "name", Fmt.const Name.pp name
     ; "root", Fmt.const Path.Local.pp root
@@ -199,6 +201,8 @@ let pp fmt { name ; root ; version ; project_file ; parsing_context = _
     ; "dune_version", Fmt.const Syntax.Version.pp dune_version
     ; "allow_approx_merlin"
     , Fmt.const Format.pp_print_bool allow_approx_merlin
+    ; "explicit_js_mode",
+      Fmt.const Format.pp_print_bool explicit_js_mode
     ]
 
 let find_extension_args t key =
@@ -439,7 +443,7 @@ let key =
     (fun { name; root; version; project_file
          ; stanza_parser = _; packages = _ ; extension_args = _
          ; parsing_context ; implicit_transitive_deps ; dune_version
-         ; allow_approx_merlin } ->
+         ; allow_approx_merlin ; explicit_js_mode } ->
       Sexp.Encoder.record
         [ "name", Name.to_sexp name
         ; "root", Path.Local.to_sexp root
@@ -450,6 +454,7 @@ let key =
         ; "dune_version", Syntax.Version.to_sexp dune_version
         ; "allow_approx_merlin"
         , Sexp.Encoder.bool allow_approx_merlin
+        ; "explicit_js_mode", Sexp.Encoder.bool explicit_js_mode
         ])
 
 let set t = Dune_lang.Decoder.set key t
@@ -491,6 +496,7 @@ let anonymous = lazy (
   ; parsing_context
   ; dune_version = lang.version
   ; allow_approx_merlin = true
+  ; explicit_js_mode = false
   })
 
 let default_name ~dir ~packages =
@@ -538,6 +544,8 @@ let parse ~dir ~lang ~packages ~file =
          ~check:(Syntax.since Stanza.syntax (1, 7))
      and+ allow_approx_merlin =
        field_o_b "allow_approximate_merlin"
+     and+ explicit_js_mode =
+       field_o_b "explicit_js_mode"
          ~check:(Syntax.since Stanza.syntax (1, 9))
      and+ () = Versioned_file.no_more_lang
      in
@@ -555,6 +563,9 @@ let parse ~dir ~lang ~packages ~file =
      in
      let allow_approx_merlin =
        Option.value ~default:false allow_approx_merlin in
+     let explicit_js_mode =
+       Option.value explicit_js_mode ~default:false
+     in
      { name
      ; root = get_local_path dir
      ; version
@@ -566,6 +577,7 @@ let parse ~dir ~lang ~packages ~file =
      ; implicit_transitive_deps
      ; dune_version = lang.version
      ; allow_approx_merlin
+     ; explicit_js_mode
      })
 
 let load_dune_project ~dir packages =
@@ -596,6 +608,7 @@ let make_jbuilder_project ~dir packages =
   ; implicit_transitive_deps = true
   ; dune_version = lang.version
   ; allow_approx_merlin = true
+  ; explicit_js_mode = false
   }
 
 let read_name file =

src/dune_project.mli

@@ -132,6 +132,8 @@ val set_parsing_context : t -> 'a Dune_lang.Decoder.t -> 'a Dune_lang.Decoder.t
 
 val implicit_transitive_deps : t -> bool
 
+val explicit_js_mode : t -> bool
+
 val dune_version : t -> Syntax.Version.t
 
 val pp : t Fmt.t

src/exe.ml

@@ -60,25 +60,25 @@ module Linkage = struct
       | Byte   -> Byte
       | Native -> Native
       | Best   -> Native
+      | Js     -> Byte
     in
     let real_mode : Mode.t =
       match m.mode with
       | Byte   -> Byte
       | Native -> Native
       | Best   -> if Option.is_some ctx.ocamlopt then Native else Byte
+      | Js     -> Byte
     in
     let ext =
       match wanted_mode, m.kind with
       | Byte   , C             -> ".bc.c"
       | Native , C             -> Errors.fail m.loc "C file generation only supports bytecode!"
-      | Byte   , Exe           -> ".bc"
+      | Byte   , Exe           -> if m.mode = Js then ".bc.js" else ".bc"
       | Native , Exe           -> ".exe"
       | Byte   , Object        -> ".bc"  ^ ctx.ext_obj
       | Native , Object        -> ".exe" ^ ctx.ext_obj
       | Byte   , Shared_object -> ".bc"  ^ ctx.ext_dll
       | Native , Shared_object ->          ctx.ext_dll
-      | Byte   , Js            -> ".bc.js"
-      | Native , Js            -> Errors.fail m.loc "Javascript generation only supports bytecode!"
     in
     let flags =
       match m.kind with
@@ -107,7 +107,6 @@ module Linkage = struct
         | Byte ->
           so_flags
         end
-      | Js -> []
     in
     { ext
     ; mode = real_mode
@@ -125,7 +124,7 @@ let link_exe
       ~top_sorted_modules
       ~arg_spec_for_requires
       ?(link_flags=Build.arr (fun _ -> []))
-      ?(js_of_ocaml=Dune_file.Js_of_ocaml.default)
+      ?js_of_ocaml
       cctx
   =
   let sctx     = CC.super_context cctx in
@@ -177,29 +176,38 @@ let link_exe
        ; Dyn (fun (cm_files, _, _) -> Deps cm_files)
        ]);
   if linkage.ext = ".bc" then
-    let rules =
-      Js_of_ocaml_rules.build_exe cctx ~js_of_ocaml ~src:exe
-    in
-    let cm_and_flags =
-      Build.fanout
-        (modules_and_cm_files >>^ snd)
-        (Expander.expand_and_eval_set expander
-           js_of_ocaml.flags
-           ~standard:(Build.return (Js_of_ocaml_rules.standard sctx)))
-    in
-    SC.add_rules ~dir sctx (List.map rules ~f:(fun r -> cm_and_flags >>> r))
+    Option.iter ~f:(fun js_of_ocaml ->
+      let rules = Js_of_ocaml_rules.build_exe cctx ~js_of_ocaml ~src:exe in
+      let cm_and_flags =
+        Build.fanout
+          (modules_and_cm_files >>^ snd)
+          (Expander.expand_and_eval_set expander
+             js_of_ocaml.flags
+             ~standard:(Build.return (Js_of_ocaml_rules.standard sctx)))
+      in
+      SC.add_rules ~dir sctx (List.map rules ~f:(fun r -> cm_and_flags >>> r))
+    ) js_of_ocaml
 
 let build_and_link_many
       ~programs
       ~linkages
       ?link_flags
-      ?(js_of_ocaml=Dune_file.Js_of_ocaml.default)
+      ?js_of_ocaml
       cctx
   =
   let dep_graphs = Ocamldep.rules cctx in
 
+  let explicit_js_mode =
+    Dune_project.explicit_js_mode (Scope.project (CC.scope cctx))
+  in
+  let js_of_ocaml =
+    match explicit_js_mode, js_of_ocaml with
+    | false, None -> Some Dune_file.Js_of_ocaml.default
+    | _ -> js_of_ocaml
+  in
+
   (* CR-someday jdimino: this should probably say [~dynlink:false] *)
-  Module_compilation.build_modules cctx ~js_of_ocaml ~dep_graphs;
+  Module_compilation.build_modules cctx ?js_of_ocaml ~dep_graphs;
 
   List.iter programs ~f:(fun { Program.name; main_module_name ; loc } ->
     let top_sorted_modules =
@@ -219,7 +227,7 @@ let build_and_link_many
         ~name
         ~linkage
         ~top_sorted_modules
-        ~js_of_ocaml
+        ?js_of_ocaml
         ~arg_spec_for_requires
         ?link_flags))
 

src/exe_rules.ml

@@ -47,12 +47,20 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander
                   Module.Name.pp mod_name)
   in
 
+  let has_js = Dune_file.Executables.Link_mode.(Set.mem exes.modes js) in
+
   let linkages =
     let module L = Dune_file.Executables.Link_mode in
     let ctx = SC.context sctx in
+    let modes =
+      if has_js then
+        L.Set.remove (L.Set.add exes.modes L.byte) L.js
+      else
+        exes.modes
+    in
     let l =
       let has_native = Option.is_some ctx.ocamlopt in
-      List.filter_map (L.Set.to_list exes.modes) ~f:(fun (mode : L.t) ->
+      List.filter_map (L.Set.to_list modes) ~f:(fun (mode : L.t) ->
         match has_native, mode.mode with
         | false, Native ->
           None
@@ -97,12 +105,19 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander
   in
 
   let requires_compile = Compilation_context.requires_compile cctx in
+  let explicit_js_mode = Dune_project.explicit_js_mode (Scope.project scope) in
+  let js_of_ocaml =
+    if not explicit_js_mode || has_js then
+      Some exes.buildable.js_of_ocaml
+    else
+      None
+  in
 
   Exe.build_and_link_many cctx
     ~programs
     ~linkages
     ~link_flags
-    ~js_of_ocaml:exes.buildable.js_of_ocaml;
+    ?js_of_ocaml;
 
   (cctx,
    Merlin.make ()