feat: wrap the melange stdlib extension, expose it as Melstd (#859)

bin/dune

@@ -4,7 +4,7 @@
  (flags :standard -open Melange_compiler_libs)
  (libraries
   js_parser
-  ext
+  melstd
   melange_compiler_libs
   melange_ffi
   melangelib

bin/jsoo_main.ml

@@ -22,6 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+open Melstd
 open Melangelib
 open Melange_compiler_libs
 module Js = Jsoo_common.Js
@@ -53,7 +54,7 @@ let playground_warning_reporter (loc : Location.t) w : Location.report option =
       let main = { Location.loc; txt = msg_of_str message } in
       let sub =
         List.map
-          (fun (loc, sub_message) ->
+          ~f:(fun (loc, sub_message) ->
             { Location.loc; txt = msg_of_str sub_message })
           sub_locs
       in
@@ -235,11 +236,8 @@ let compile =
         Js_dump_program.pp_deps_program ~output_prefix:""
           ~package_info:Js_packages_info.empty
           ~output_info:
-            {
-              Js_packages_info.module_system = Es6;
-              suffix = Ext_js_suffix.default;
-            }
-          (Ext_pp.from_buffer buffer)
+            { Js_packages_info.module_system = Es6; suffix = Js_suffix.default }
+          (Js_pp.from_buffer buffer)
           (Lam_compile_main.compile "" lam)
       in
       let v = Buffer.contents buffer in
@@ -249,7 +247,8 @@ let compile =
           [|
             ("js_code", Js.string v);
             ( "warnings",
-              List.rev_map Jsoo_common.warning_error_to_js !warnings_collected
+              List.rev_map ~f:Jsoo_common.warning_error_to_js
+                !warnings_collected
               |> Array.of_list |> Js.array );
             ("type_hints", type_hints);
           |])
@@ -270,7 +269,7 @@ let compile =
               | warnings ->
                   let type_ = "warning_errors" in
                   let jsErrors =
-                    List.rev_map Jsoo_common.warning_error_to_js warnings
+                    List.rev_map ~f:Jsoo_common.warning_error_to_js warnings
                     |> Array.of_list
                   in
                   Js.obj

bin/melc.ml

@@ -10,6 +10,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
+open Melstd
+
 #ifndef BS_RELEASE_BUILD
 let print_backtrace () =
   let raw_bt = Printexc.backtrace_slots (Printexc.get_raw_backtrace ()) in
@@ -26,15 +28,15 @@ let print_backtrace () =
             | [] -> acc := [ bt ]
             | hd :: _ -> if hd <> bt then acc := bt :: !acc)
       done;
-      List.iter (fun (bt: Printexc.location) ->
+      List.iter ~f:(fun (bt: Printexc.location) ->
           Printf.eprintf "File \"%s\", line %d, characters %d-%d\n" bt.filename
             bt.line_number bt.start_char bt.end_char) !acc
 #endif
 
 let set_abs_input_name sourcefile =
   let sourcefile =
     if !Clflags.absname && Filename.is_relative  sourcefile then
-      Ext_path.absolute_cwd_path sourcefile
+      Path.absolute_cwd_path sourcefile
     else sourcefile in
   Location.set_input_name sourcefile;
   sourcefile
@@ -48,7 +50,7 @@ let process_file sourcefile
   *)
   let kind =
     match kind with
-    | None -> Artifact_extension.Valid_input.classify (Ext_filename.get_extension_maybe sourcefile)
+    | None -> Artifact_extension.Valid_input.classify (Filename.get_extension_maybe sourcefile)
     | Some kind -> kind in
   match kind with
   | Ml ->
@@ -143,7 +145,7 @@ let anonymous =
       else
         begin
             if !Js_config.syntax_only then begin
-              Ext_list.rev_iter rev_args (fun filename ->
+              List.rev_iter rev_args (fun filename ->
                   begin
                     (* Clflags.reset_dump_state (); *)
                     (* Warnings.reset (); *)
@@ -186,7 +188,7 @@ let eval (s : string) =
   ret
 
 let print_standard_library () =
-  print_endline (String.concat ":" (Js_config.std_include_dirs ()));
+  print_endline (String.concat ~sep:":" (Js_config.std_include_dirs ()));
   exit 0
 
 let bs_version_string =
@@ -274,7 +276,7 @@ let main: Melc_cli.t -> _ Cmdliner.Term.ret
       (* The OCaml compiler expects include_dirs in reverse CLI order, but
          cmdliner returns it in CLI order. *)
       List.rev_append include_dirs !Clflags.include_dirs;
-    List.iter Warnings.parse_alert_option alerts;
+    List.iter ~f:Warnings.parse_alert_option alerts;
 
     begin match warnings with
     | [] -> ()
@@ -285,7 +287,7 @@ let main: Melc_cli.t -> _ Cmdliner.Term.ret
          "+20" (so we override it). *)
       Melc_warnings.parse_warnings ~warn_error:false first;
       Melc_warnings.parse_warnings ~warn_error:false "-20";
-      List.iter (Melc_warnings.parse_warnings ~warn_error:false) rest;
+      List.iter ~f:(Melc_warnings.parse_warnings ~warn_error:false) rest;
     end;
 
     Option.iter
@@ -307,17 +309,17 @@ let main: Melc_cli.t -> _ Cmdliner.Term.ret
     | Some bs_module_type, [] ->
       let suffix = match output_name with
         | Some output_name ->
-          (match Ext_filename.get_all_extensions_maybe output_name with
+          (match Filename.get_all_extensions_maybe output_name with
           | None ->
             raise (Arg.Bad "`-o FILENAME` needs to include a valid extension")
-          | Some ext -> Ext_js_suffix.of_string ext)
+          | Some ext -> Js_suffix.of_string ext)
         | None ->
           raise (Arg.Bad "`-o FILENAME` is required when passing `-bs-module-type`")
       in
       Js_packages_state.set_output_info ~suffix bs_module_type
     | None, bs_package_output ->
       List.iter
-        (Js_packages_state.update_npm_package_path ?module_name:bs_module_name)
+        ~f:(Js_packages_state.update_npm_package_path ?module_name:bs_module_name)
         bs_package_output;
     | Some _, _ :: _ ->
       raise (Arg.Bad ("Can't pass both `-bs-package-output` and `-bs-module-type`"))
@@ -365,7 +367,7 @@ let main: Melc_cli.t -> _ Cmdliner.Term.ret
     if short_paths then Clflags.real_paths := false;
     if unsafe then Clflags.unsafe := unsafe;
     if warn_help then Warnings.help_warnings ();
-    List.iter (Melc_warnings.parse_warnings ~warn_error:true) warn_error ;
+    List.iter ~f:(Melc_warnings.parse_warnings ~warn_error:true) warn_error ;
     if bs_stop_after_cmj then Js_config.cmj_only := bs_stop_after_cmj;
 
     Option.iter (fun s ->
@@ -407,7 +409,7 @@ let file_level_flags_handler (e : Parsetree.expression option) =
   | None -> ()
   | Some { pexp_desc = Pexp_array args; pexp_loc; _ } ->
     let args =
-      ( List.map (fun (e: Parsetree.expression) ->
+      ( List.map ~f:(fun (e: Parsetree.expression) ->
           match e.pexp_desc with
           | Pexp_constant (Pconst_string(name,_,_)) -> name
           | _ -> Location.raise_errorf ~loc:e.pexp_loc "string literal expected" ) args)

bin/melc_cli.ml

@@ -23,6 +23,7 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 open Cmdliner
+open Melstd
 
 type t = {
   include_dirs : string list;
@@ -32,7 +33,7 @@ type t = {
   ppx : string list;
   open_modules : string list;
   bs_package_output : string list;
-  bs_module_type : Ext_module_system.t option;
+  bs_module_type : Module_system.t option;
   bs_syntax_only : bool;
   bs_g : bool;
   bs_package_name : string option;
@@ -261,13 +262,11 @@ module Internal = struct
   let bs_module_type =
     let module_system_conv =
       let parse m =
-        match Ext_module_system.of_string m with
+        match Module_system.of_string m with
         | Some module_system -> Ok module_system
         | None -> Error (`Msg (Format.asprintf "Invalid module system %s" m))
       in
-      let print fmt ms =
-        Format.fprintf fmt "%s" (Ext_module_system.to_string ms)
-      in
+      let print fmt ms = Format.fprintf fmt "%s" (Module_system.to_string ms) in
       Arg.conv ~docv:"method" (parse, print)
     in
     let doc = "Specify the module type for JS imports" in
@@ -596,4 +595,4 @@ let normalize_argv argv =
       incr nidx);
     incr idx
   done;
-  if !nidx < len then Array.sub normalized 0 !nidx else normalized
+  if !nidx < len then Array.sub normalized ~pos:0 ~len:!nidx else normalized

jscomp/common/dune

@@ -3,7 +3,7 @@
  (package melange)
  (flags :standard -open Melange_compiler_libs)
  (modules_without_implementation js_raw_info lam_tag_info)
- (libraries ext melange_compiler_libs js_parser))
+ (libraries melstd melange_compiler_libs js_parser))
 
 (rule
  (target oprint_mel_primitive_name.ml)

jscomp/common/external_ffi_types.ml

@@ -22,6 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+open Import
 open External_ffi_types0
 
 module Literals = struct
@@ -104,7 +105,7 @@ type t =
 
 let valid_js_char =
   let a =
-    Array.init 256 (fun i ->
+    Array.init 256 ~f:(fun i ->
         let c = Char.chr i in
         (c >= 'a' && c <= 'z')
         || (c >= 'A' && c <= 'Z')
@@ -115,7 +116,7 @@ let valid_js_char =
 
 let valid_first_js_char =
   let a =
-    Array.init 256 (fun i ->
+    Array.init 256 ~f:(fun i ->
         let c = Char.chr i in
         (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '_' || c = '$')
   in
@@ -143,9 +144,9 @@ let is_package_relative_path (x : string) =
 
 let valid_global_name ?loc txt =
   if not (valid_ident txt) then
-    let v = Ext_string.split_by ~keep_empty:true (fun x -> x = '.') txt in
+    let v = String.split_by ~keep_empty:true (fun x -> x = '.') txt in
     List.iter
-      (fun s ->
+      ~f:(fun s ->
         if not (valid_ident s) then
           Location.raise_errorf ?loc "Not a valid global name %s" txt)
       v

jscomp/common/import.ml

@@ -0,0 +1 @@
+include Melstd

jscomp/common/lam_constant.ml

@@ -22,6 +22,8 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+open Import
+
 type constructor_tag = { name : string; const : int; non_const : int }
 
 type pointer_info =
@@ -75,11 +77,11 @@ let rec eq_approx (x : t) (y : t) =
   | Const_block (ix, _, ixs) -> (
       match y with
       | Const_block (iy, _, iys) ->
-          ix = iy && Ext_list.for_all2_no_exn ixs iys eq_approx
+          ix = iy && List.for_all2_no_exn ixs iys eq_approx
       | _ -> false)
   | Const_float_array ixs -> (
       match y with
-      | Const_float_array iys -> Ext_list.for_all2_no_exn ixs iys String.equal
+      | Const_float_array iys -> List.for_all2_no_exn ixs iys String.equal
       | _ -> false)
   | Const_some ix -> (
       match y with Const_some iy -> eq_approx ix iy | _ -> false)

jscomp/common/lam_methname.ml

@@ -22,6 +22,8 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+open Import
+
 (**
   {[
     _open -> open
@@ -59,7 +61,7 @@
 
 (* Copied from [ocaml/parsing/lexer.mll] *)
 let key_words =
-  Hash_set_string.of_array
+  String.Hash_set.of_array
     [|
       "and";
       "as";
@@ -132,17 +134,17 @@ let valid_start_char x = match x with '_' | 'a' .. 'z' -> true | _ -> false
 
 let translate name =
   assert (String.length name > 0);
-  let i = Ext_string.rfind ~sub:double_underscore name in
+  let i = String.rfind ~sub:double_underscore name in
   if i < 0 then
     let name_len = String.length name in
     if name.[0] = '_' then
-      let try_key_word = String.sub name 1 (name_len - 1) in
+      let try_key_word = String.sub name ~pos:1 ~len:(name_len - 1) in
       if
         name_len > 1
         && ((not (valid_start_char try_key_word.[0]))
-           || Hash_set_string.mem key_words try_key_word)
+           || String.Hash_set.mem key_words try_key_word)
       then try_key_word
       else name
     else name
   else if i = 0 then name
-  else String.sub name 0 i
+  else String.sub name ~pos:0 ~len:i

jscomp/core/ast_config.ml

@@ -22,21 +22,23 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type action_table = (Parsetree.expression option -> unit) Map_string.t
+open Import
+
+type action_table = (Parsetree.expression option -> unit) String.Map.t
 
 let structural_config_table : action_table ref =
   ref
-    (Map_string.singleton "no_export" (fun x ->
+    (String.Map.singleton "no_export" (fun x ->
          Js_config.no_export :=
            match x with Some e -> Ast_payload.assert_bool_lit e | None -> true))
 
 let add_structure k v =
-  structural_config_table := Map_string.add !structural_config_table k v
+  structural_config_table := String.Map.add !structural_config_table k v
 
-let signature_config_table : action_table ref = ref Map_string.empty
+let signature_config_table : action_table ref = ref String.Map.empty
 
 let add_signature k v =
-  signature_config_table := Map_string.add !signature_config_table k v
+  signature_config_table := String.Map.add !signature_config_table k v
 
 let rec iter_on_mel_config_stru (x : Parsetree.structure) =
   match x with
@@ -53,7 +55,7 @@ let rec iter_on_mel_config_stru (x : Parsetree.structure) =
     }
     :: _ ->
       List.iter
-        (fun x ->
+        ~f:(fun x ->
           Ast_payload.table_dispatch !structural_config_table x |> ignore)
         (Ast_payload.ident_or_record_as_config loc payload)
   (* [ppxlib] adds a wrapper like:
@@ -98,7 +100,7 @@ let rec iter_on_mel_config_sigi (x : Parsetree.signature) =
     }
     :: _ ->
       List.iter
-        (fun x ->
+        ~f:(fun x ->
           Ast_payload.table_dispatch !signature_config_table x |> ignore)
         (Ast_payload.ident_or_record_as_config loc payload)
   | { psig_desc = Psig_attribute _; _ } :: rest -> iter_on_mel_config_sigi rest