specialize Js.Dict.fromArray to compile to a direct JS object creation when possible

Author: zth

jscomp/ml/translcore.ml

@@ -721,6 +721,13 @@ let extract_directive_for_fn exp =
  exp.exp_attributes |> List.find_map (
  fun ({txt}, payload) -> if txt = "directive" then Ast_payload.is_single_string payload else None)
 
+let args_elgible_for_dict_inlining (args : expression list) =
+ args
+ |> List.find_opt (fun (arg : expression) ->
+ match arg.exp_desc with
+ | Texp_tuple [{exp_desc = Texp_constant (Const_string _)}; _] -> false
+ | _ -> true)
+ |> Option.is_none
 
 let rec transl_exp e =
  List.iter (Translattribute.check_attribute e) e.exp_attributes;
@@ -803,6 +810,28 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
  | _ ->
  wrap (Lprim (prim, argl, e.exp_loc))
  ))
+ | Texp_apply
+ ( {exp_desc = Texp_ident (p, _, _)},
+ [(_lbl, Some {exp_desc = Texp_array args})] )
+ when Path.name p = "Js.Dict.fromArray"
+ && args_elgible_for_dict_inlining args ->
+ let fields = Array.make (List.length args) "" in
+ let args =
+ args
+ |> List.mapi (fun index (arg : expression) ->
+ match arg.exp_desc with
+ | Texp_tuple
+ [{exp_desc = Texp_constant (Const_string (fieldName, _))}; exp]
+ ->
+ Array.set fields index fieldName;
+ exp |> transl_exp |> extract_constant
+ | _ -> assert false)
+ in
+ Lconst
+ (Const_block
+ ( Blk_record
+ {fields; mutable_flag = Mutable; record_repr = Record_regular},
+ args ))
  | Texp_apply (funct, oargs) ->
  let inlined, funct =
  Translattribute.get_and_remove_inlined_attribute funct

jscomp/test/DictTests.js

@@ -0,0 +1,9 @@
+let dictCreationCanBeInlined = Js.Dict.fromArray([
+ ("name", "hello"),
+ ("age", "what"),
+ ("more", "stuff"),
+])
+
+external imaginaryExternalArgs: array<(string, string)> = "imaginary"
+
+let dictCreationCanNotBeInlined = Js.Dict.fromArray(imaginaryExternalArgs)