(!! new) Deprecate -bs-suffix; add extensions to -bs-package-output

Additionally involed:

 - Split `cmj_case` type into new, simplified `leading_case` type and aformentioned `package_info` changes
 - Store file-extension(s) in `.cmj` files
 - Bump `cmj_magic_number`, as it now contains new information

Backwards-compatibility is maintained.

Author: ELLIOTTCABLE

jscomp/common/bs_warnings.ml

@@ -39,11 +39,11 @@ let to_string t =
 
 let warning_formatter = Format.err_formatter
 
-let print_string_warning (loc : Location.t) x =
+let print_string_warning (loc : Location.t) ?(kind = "Warning") x =
   if loc.loc_ghost then
     Format.fprintf warning_formatter "File %s@." !Location.input_name
   else Location.print warning_formatter loc;
-  Format.fprintf warning_formatter "@{<error>Warning@}: %s@." x
+  Format.fprintf warning_formatter "@{<error>%s@}: %s@." kind x
 
 
 let prerr_bs_ffi_warning loc x =
@@ -72,6 +72,14 @@ let () =
     | _ -> None)
 
 
+let warn_deprecated_bs_suffix_flag () =
+  if not !Clflags.bs_quiet then (
+    print_string_warning Location.none ~kind:"DEPRECATED"
+      "`-bs-suffix` used; consider using third field of `-bs-package-output` \
+       instead";
+    Format.pp_print_flush warning_formatter () )
+
+
 let warn_missing_primitive loc txt =
   if (not !Js_config.no_warn_unimplemented_external) && not !Clflags.bs_quiet
   then (

jscomp/common/bs_warnings.mli

@@ -26,6 +26,8 @@ type t = Unsafe_poly_variant_type
 
 val prerr_bs_ffi_warning : Location.t -> t -> unit
 
+val warn_deprecated_bs_suffix_flag : unit -> unit
+
 val warn_missing_primitive : Location.t -> string -> unit
 
 val warn_literal_overflow : Location.t -> unit

jscomp/common/js_config.mli

@@ -69,7 +69,6 @@ val syntax_only : bool ref
 val binary_ast : bool ref
 val simple_binary_ast : bool ref
 
-val bs_suffix : bool ref
 val debug : bool ref
 
 val cmi_only : bool ref

jscomp/core/js_cmj_format.ml

@@ -34,29 +34,27 @@ type effect = string option
 (* we don't force people to use package *)
 let single_na = Single Lam_arity.na
 
-type cmj_case = Ext_namespace.file_kind
-
 type keyed_cmj_values = (string * cmj_value) array
 
 type t = {
   values : keyed_cmj_values;
   pure : bool;
   package_info : Js_package_info.t;
-  cmj_case : cmj_case;
+  leading_case : Ext_namespace.leading_case;
 }
 
 let empty_values = [||]
 
-let mk ~values ~effect ~package_info ~cmj_case : t =
+let mk ~values ~effect ~package_info ~leading_case : t =
   {
     values = Map_string.to_sorted_array values;
     pure = effect = None;
     package_info;
-    cmj_case;
+    leading_case;
   }
 
 
-let cmj_magic_number = "BUCKLE20171012"
+let cmj_magic_number = "BUCKLE20200410"
 let cmj_magic_number_length = String.length cmj_magic_number
 
 let digest_length = 16 (*16 chars *)
@@ -176,24 +174,22 @@ let is_pure (cmj_table : t) = cmj_table.pure
 
 let get_package_info (cmj_table : t) = cmj_table.package_info
 
-let get_cmj_case (cmj_table : t) = cmj_table.cmj_case
+let get_leading_case (cmj_table : t) = cmj_table.leading_case
 
 (* start dumping *)
 
 let f fmt = Printf.fprintf stdout fmt
 
-let pp_cmj_case (cmj_case : cmj_case) : unit =
-  match cmj_case with
-  | Little_js -> f "case : little, .js\n"
-  | Little_bs -> f "case : little, .bs.js\n"
-  | Upper_js -> f "case: upper, .js\n"
-  | Upper_bs -> f "case: upper, .bs.js\n"
+let pp_leading_case (leading_case : Ext_namespace.leading_case) : unit =
+  match leading_case with
+  | Upper -> f "case: upper\n"
+  | Lower -> f "case: lower\n"
 
 
-let pp_cmj ({ values; pure; package_info; cmj_case } : t) =
+let pp_cmj ({ values; pure; package_info; leading_case } : t) =
   f "package info: %s\n"
     (Format.asprintf "%a" Js_package_info.dump_package_info package_info);
-  pp_cmj_case cmj_case;
+  pp_leading_case leading_case;
 
   f "effect: %s\n" (if pure then "pure" else "not pure");
   Ext_array.iter values (fun (k, { arity; persistent_closed_lambda }) ->

jscomp/core/js_cmj_format.mli

@@ -46,15 +46,13 @@ type cmj_value = {
 
 type effect = string option
 
-type cmj_case = Ext_namespace.file_kind
-
 type t
 
 val mk :
   values:cmj_value Map_string.t ->
   effect:effect ->
   package_info:Js_package_info.t ->
-  cmj_case:cmj_case ->
+  leading_case:Ext_namespace.leading_case ->
   t
 
 val query_by_name : t -> string -> arity * Lam.t option
@@ -63,7 +61,7 @@ val is_pure : t -> bool
 
 val get_package_info : t -> Js_package_info.t
 
-val get_cmj_case : t -> cmj_case
+val get_leading_case : t -> Ext_namespace.leading_case
 
 val single_na : arity
 

jscomp/core/js_dump_import_export.mli

@@ -39,4 +39,4 @@ val imports :
   Ext_pp_scope.t -> 
   Ext_pp.t -> 
   (Ident.t * string) list -> 
-  Ext_pp_scope.t
+  Ext_pp_scope.t

jscomp/core/js_dump_program.ml

@@ -53,24 +53,25 @@ let dump_program (x : J.program) oc =
   ignore (program (P.from_channel oc) Ext_pp_scope.empty x)
 
 
-let node_program ~output_dir f (x : J.deps_program) =
+let node_program ~output_dir ~ext f (x : J.deps_program) =
   P.string f L.strict_directive;
   P.newline f;
   let cxt =
     Js_dump_import_export.requires L.require Ext_pp_scope.empty f
       (Ext_list.map x.modules (fun x ->
            ( Lam_module_ident.id x,
-             Js_name_of_module_id.string_of_module_id x ~output_dir NodeJS )))
+             Js_name_of_module_id.string_of_module_id x ~output_dir ~ext NodeJS
+           )))
   in
   program f cxt x.program
 
 
-let es6_program ~output_dir fmt f (x : J.deps_program) =
+let es6_program ~output_dir ~ext fmt f (x : J.deps_program) =
   let cxt =
     Js_dump_import_export.imports Ext_pp_scope.empty f
       (Ext_list.map x.modules (fun x ->
            ( Lam_module_ident.id x,
-             Js_name_of_module_id.string_of_module_id x ~output_dir fmt )))
+             Js_name_of_module_id.string_of_module_id x ~output_dir ~ext fmt )))
   in
   let () = P.force_newline f in
   let cxt = Js_dump.statement_list true cxt f x.program.block in
@@ -85,7 +86,7 @@ let es6_program ~output_dir fmt f (x : J.deps_program) =
         Linguist::FileBlob.new('jscomp/test/test_u.js').generated?
     ]} *)
 
-let pp_deps_program ~output_prefix (kind : Js_package_info.module_system)
+let pp_deps_program ~output_prefix ~ext (kind : Js_package_info.module_system)
     (program : J.deps_program) (f : Ext_pp.t) =
   if not !Js_config.no_version_header then (
     P.string f Bs_version.header;
@@ -96,8 +97,8 @@ let pp_deps_program ~output_prefix (kind : Js_package_info.module_system)
     let output_dir = Filename.dirname output_prefix in
     ignore
       ( match kind with
-      | Es6 | Es6_global -> es6_program ~output_dir kind f program
-      | NodeJS -> node_program ~output_dir f program );
+      | Es6 | Es6_global -> es6_program ~output_dir ~ext kind f program
+      | NodeJS -> node_program ~output_dir ~ext f program );
     P.newline f;
     P.string f
       ( match program.side_effect with
@@ -107,5 +108,5 @@ let pp_deps_program ~output_prefix (kind : Js_package_info.module_system)
     P.flush f ()
 
 
-let dump_deps_program ~output_prefix kind x (oc : out_channel) =
-  pp_deps_program ~output_prefix kind x (P.from_channel oc)
+let dump_deps_program ~output_prefix ~ext kind x (oc : out_channel) =
+  pp_deps_program ~output_prefix ~ext kind x (P.from_channel oc)

jscomp/core/js_dump_program.mli

@@ -27,13 +27,15 @@ val dump_program : J.program -> out_channel -> unit
 
 val pp_deps_program :
   output_prefix:string ->
+  ext:string ->
   Js_package_info.module_system ->
   J.deps_program ->
   Ext_pp.t ->
   unit
 
 val dump_deps_program :
   output_prefix:string ->
+  ext:string ->
   Js_package_info.module_system ->
   J.deps_program ->
   out_channel ->

jscomp/core/js_name_of_module_id.ml

@@ -47,12 +47,12 @@ let get_runtime_module_path (dep_module_id : Lam_module_ident.t)
       module_system
   in
   let js_file =
-    Ext_namespace.js_name_of_modulename dep_module_id.id.name Little_js
+    Ext_namespace.js_filename_of_modulename ~name:dep_module_id.id.name
+      ~ext:".js" Lower
   in
   match loc with
   | Package_not_found -> assert false
-  | Package_script ->
-      Js_package_info.runtime_package_path module_system js_file
+  | Package_script -> Js_package_info.runtime_package_path module_system js_file
   | Package_found pkg -> (
       let dep_path =
         "lib" // Js_package_info.runtime_dir_of_module_system module_system
@@ -82,8 +82,8 @@ let get_runtime_module_path (dep_module_id : Lam_module_ident.t)
 
 (* [output_dir] is decided by the command line argument *)
 let string_of_module_id (dep_module_id : Lam_module_ident.t)
-    ~(output_dir : string) (module_system : Js_package_info.module_system) :
-    string =
+    ~(output_dir : string) ~(ext : string)
+    (module_system : Js_package_info.module_system) : string =
   let current_package_info = Js_current_package_info.get_packages_info () in
   fix_path_for_windows
     ( match dep_module_id.kind with
@@ -99,12 +99,12 @@ let string_of_module_id (dep_module_id : Lam_module_ident.t)
         get_runtime_module_path dep_module_id current_package_info module_system
     | Ml -> (
         let query = Js_package_info.query_package_location_by_module_system in
-        let current_loc = query current_package_info module_system
-        in
+        let current_loc = query current_package_info module_system in
         match Lam_compile_env.get_package_path_from_cmj dep_module_id with
-        | cmj_path, dep_package_info, little -> (
+        | cmj_path, dep_package_info, case -> (
             let js_file =
-              Ext_namespace.js_name_of_modulename dep_module_id.id.name little
+              Ext_namespace.js_filename_of_modulename
+                ~name:dep_module_id.id.name ~ext case
             in
             let dep_loc = query dep_package_info module_system in
             match (dep_loc, current_loc) with
@@ -179,6 +179,6 @@ let string_of_module_id_in_browser (x : Lam_module_ident.t) =
 
 
 let string_of_module_id (id : Lam_module_ident.t) ~output_dir:(_ : string)
-    (_module_system : Js_package_info.module_system) =
+    ~ext:(_ : string) (_module_system : Js_package_info.module_system) =
   string_of_module_id_in_browser id
 #end

jscomp/core/js_name_of_module_id.mli

@@ -25,6 +25,7 @@
 val string_of_module_id :
   Lam_module_ident.t ->
   output_dir:string ->
+  ext:string ->
   Js_package_info.module_system ->
   string
 (** generate the mdoule path so that it can be spliced here:

jscomp/core/js_package_info.ml

@@ -49,6 +49,8 @@ type location_descriptor = {
 
 type package_name = Pkg_empty | Pkg_runtime | Pkg_normal of string
 
+let deprecated_use_bs_extension = ref false
+
 let runtime_package_name = "bs-platform"
 
 let ( // ) = Filename.concat
@@ -105,6 +107,7 @@ let dump_location_descriptor (fmt : Format.formatter)
     (string_of_module_system ms)
     path extension
 
+
 let dump_package_name fmt (x : package_name) =
   match x with
   | Pkg_empty -> Format.fprintf fmt "@empty_pkg@"
@@ -168,17 +171,33 @@ let get_output_dir (info : t) ~package_dir module_system =
   Filename.concat package_dir (get_js_path info module_system)
 
 
+let deprecated_set_bs_extension () =
+  Bs_warnings.warn_deprecated_bs_suffix_flag ();
+  deprecated_use_bs_extension := true
+
+
+let deprecated_get_default_extension () =
+  if !deprecated_use_bs_extension then Literals.suffix_bs_js
+  else Literals.suffix_js
+
+
+(* FIXME: The deprecated -bs-suffix will only affect -bs-package-output flags
+   passed *after* it. *)
 let append_location_descriptor_of_string (packages_info : t) (s : string) : t =
-  let module_system, path, extension = match Ext_string.split ~keep_empty:false s ':' with
-  | [ module_system; path; extension ] -> module_system, path, extension
-  | [ module_system; path ] -> module_system, path, "js"
-  | [ path ] -> "NodeJS", path, "js"
-  | _ -> Ext_arg.bad_argf "invalid value for -bs-package-output: %s" s
+  let module_system, path, extension =
+    match Ext_string.split ~keep_empty:false s ':' with
+    | [ module_system; path; extension ] -> (module_system, path, extension)
+    | [ module_system; path ] ->
+        (module_system, path, deprecated_get_default_extension ())
+    | [ path ] -> ("NodeJS", path, deprecated_get_default_extension ())
+    | _ -> Ext_arg.bad_argf "invalid value for -bs-package-output: %s" s
   in
   let module_system =
-  match module_system_of_string module_system with
+    match module_system_of_string module_system with
     | Some x -> x
-    | None -> Ext_arg.bad_argf "invalid module system in -bs-package-output: %s" module_system
+    | None ->
+        Ext_arg.bad_argf "invalid module system in -bs-package-output: %s"
+          module_system
   in
   {
     packages_info with

jscomp/core/js_package_info.mli

@@ -48,6 +48,8 @@ val is_empty : t -> bool
 
 val dump_package_info : Format.formatter -> t -> unit
 
+val deprecated_set_bs_extension : unit -> unit
+
 val append_location_descriptor_of_string : t -> string -> t
 (** used by command line option e.g [-bs-package-output commonjs:xx/path:ext] *)
 

jscomp/core/lam_compile_env.ml

@@ -96,7 +96,7 @@ let get_package_path_from_cmj (id : Lam_module_ident.t) =
   | Some (Ml { cmj_table; cmj_path }) ->
       ( cmj_path,
         Js_cmj_format.get_package_info cmj_table,
-        Js_cmj_format.get_cmj_case cmj_table )
+        Js_cmj_format.get_leading_case cmj_table )
   | Some (External | Runtime _) ->
       assert false
       (* called by {!Js_name_of_module_id.string_of_module_id} can not be
@@ -112,7 +112,7 @@ let get_package_path_from_cmj (id : Lam_module_ident.t) =
           id +> Ml cmj_load_info;
           ( cmj_load_info.cmj_path,
             Js_cmj_format.get_package_info cmj_table,
-            Js_cmj_format.get_cmj_case cmj_table ) )
+            Js_cmj_format.get_leading_case cmj_table ) )
 
 
 let add = Lam_module_ident.Hash_set.add

jscomp/core/lam_compile_env.mli

@@ -63,12 +63,15 @@ val query_external_id_info : Ident.t -> string -> ident_info
 val is_pure_module : Lam_module_ident.t -> bool
 
 val get_package_path_from_cmj :
-  Lam_module_ident.t -> string * Js_package_info.t * Js_cmj_format.cmj_case
+  Lam_module_ident.t -> string * Js_package_info.t * Ext_namespace.leading_case
 
-(* The second argument is mostly from [runtime] modules will change the input
-   [hard_dependencies] [get_required_modules extra hard_dependencies] [extra]
-   maybe removed if it is pure and not in [hard_dependencies] *)
 val get_required_modules :
   Lam_module_ident.Hash_set.t ->
   Lam_module_ident.Hash_set.t ->
   Lam_module_ident.t list
+(** The second argument is mostly from [runtime] modules
+
+    will change the input [hard_dependencies]
+
+    [get_required_modules extra hard_dependencies] - [extra] maybe removed if it
+    is pure and not in [hard_dependencies] *)