Merge pull request #4188 from BuckleScript/optimize_ffi_encoding

a bunch optimizations around ffi encoding

Author: bobzhang

jscomp/bsb/bsb_ninja_file_groups.ml

@@ -96,7 +96,7 @@ let emit_module_build
     filename_sans_extension  ^ if is_re then Literals.suffix_reiast else Literals.suffix_mliast in
   let output_d = filename_sans_extension ^ Literals.suffix_d in
   let output_filename_sans_extension =  
-      Ext_namespace.make ?ns:namespace filename_sans_extension
+      Ext_namespace_encode.make ?ns:namespace filename_sans_extension
   in 
   let output_cmi =  output_filename_sans_extension ^ Literals.suffix_cmi in
   let output_cmj =  output_filename_sans_extension ^ Literals.suffix_cmj in

jscomp/bsb/bsb_world.ml

@@ -35,7 +35,7 @@ let install_targets cwd ({files_to_install; namespace; package_name = _} : Bsb_c
   let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
   let install_filename_sans_extension destdir namespace x = 
     let x = 
-      Ext_namespace.make ?ns:namespace x in 
+      Ext_namespace_encode.make ?ns:namespace x in 
     install ~destdir (cwd // x ^  Literals.suffix_ml) ;
     install ~destdir (cwd // x ^  Literals.suffix_re) ;
     install ~destdir (cwd // x ^ Literals.suffix_mli) ;

jscomp/bsb_helper/bsb_helper_depfile_gen.ml

@@ -91,7 +91,7 @@ type kind = Js | Bytecode | Native
 
 let output_file (buf : Ext_buffer.t) source namespace = 
   Ext_buffer.add_string buf 
-    (Ext_namespace.make ?ns:namespace source)
+    (Ext_namespace_encode.make ?ns:namespace source)
 
 (** for bucklescript artifacts 
     [lhs_suffix] is [.cmj]
@@ -144,11 +144,11 @@ let oc_impl
     output_file buf (Ext_filename.chop_extension_maybe mlast) namespace ; 
     Ext_buffer.add_string buf lhs_suffix; 
     Ext_buffer.add_string buf dep_lit ) in  
-  Ext_option.iter namespace (fun ns -> 
+  (match namespace with None -> () | Some ns -> 
       Lazy.force at_most_once;
       Ext_buffer.add_string buf ns;
       Ext_buffer.add_string buf Literals.suffix_cmi;
-    ) ; (* TODO: moved into static files*)
+  ) ; (* TODO: moved into static files*)
   let is_not_lib_dir = not (Bsb_dir_index.is_lib_dir index) in 
   let s = extract_dep_raw_string mlast in 
   let offset = ref 1 in 
@@ -206,11 +206,11 @@ let oc_intf
     output_file buf (Ext_filename.chop_all_extensions_maybe mliast) namespace ;   
     Ext_buffer.add_string buf Literals.suffix_cmi ; 
     Ext_buffer.add_string buf dep_lit) in 
-  Ext_option.iter namespace (fun ns -> 
+  (match namespace with None -> () | Some  ns -> 
       Lazy.force at_most_once;  
       Ext_buffer.add_string buf ns;
       Ext_buffer.add_string buf Literals.suffix_cmi;
-    ) ; 
+  ) ; 
   let cur_module_name = Ext_filename.module_name mliast in
   let is_not_lib_dir = not (Bsb_dir_index.is_lib_dir index)  in  
   let s = extract_dep_raw_string mliast in 

jscomp/core/bs_cmi_load.ml

@@ -38,8 +38,8 @@ let load_cmi ~unit_name : Env.Persistent_signature.t option =
         if Js_config.get_diagnose () then
           Format.fprintf Format.err_formatter ">Cmi: %s@." unit_name;
         let cmi : Cmi_format.cmi_infos = 
-            Marshal.from_string 
-            Builtin_cmi_datasets.module_data.(cmi) 0 in   
+            Ext_marshal.from_string_uncheck
+            Builtin_cmi_datasets.module_data.(cmi)  in   
         if Js_config.get_diagnose () then
           Format.fprintf Format.err_formatter "<Cmi: %s@." unit_name;
         Some {filename = Sys.executable_name ; 

jscomp/core/js_cmj_load.ml

@@ -42,7 +42,7 @@ then
     if Js_config.get_diagnose () then
       Format.fprintf Format.err_formatter ">Cmj: %s@." unit_name;
     let cmj_table : Js_cmj_format.t = 
-       let values, pure =  Marshal.from_string Builtin_cmj_datasets.module_data.(i) 0 in   
+       let values, pure =  Ext_marshal.from_string_uncheck Builtin_cmj_datasets.module_data.(i)  in   
        {values; pure; package_spec = Js_packages_info.runtime_package_specs;js_file_kind = Little_js} 
     in 
     if Js_config.get_diagnose () then

jscomp/core/js_implementation.ml

@@ -227,7 +227,7 @@ let make_structure_item ~ns cunit : Parsetree.structure_item =
     (Mb.mk {txt = cunit; loc  }
        (Mod.ident 
           {txt = Lident 
-               ( Ext_namespace.make ~ns cunit)
+               ( Ext_namespace_encode.make ~ns cunit)
           ; loc}))
 
 

jscomp/core/lam_compile_external_call.ml

@@ -97,16 +97,16 @@ let ocaml_to_js_eff
   : arg_expression * E.t list  =
   let arg =
     match arg_label with
-    | Optional  -> 
+    | Arg_optional  -> 
       Js_of_lam_option.get_default_undefined_from_optional raw_arg
-    | Label  | Empty -> raw_arg
+    | Arg_label  | Arg_empty -> raw_arg
   in 
   match arg_type with
   | Arg_cst _ -> assert false 
   | Fn_uncurry_arity _ -> assert false  
   (* has to be preprocessed by {!Lam} module first *)
   | Extern_unit ->  
-    (if arg_label = Empty then 
+    (if arg_label = Arg_empty then 
       Splice0 else Splice1 E.unit), 
     (if Js_analyzer.no_side_effect_expression arg then 
        []
@@ -132,7 +132,7 @@ let ocaml_to_js_eff
   | Unwrap ->
     let single_arg =
       match arg_label with
-      | Optional  ->
+      | Arg_optional  ->
         (**
            If this is an optional arg (like `?arg`), we have to potentially do
            2 levels of unwrapping:
@@ -174,8 +174,8 @@ let assemble_args_no_splice call_loc ffi
     match labels, args with 
     | [], _  
       -> assert (args = []) ; empty_pair
-    | { arg_label =  Empty | Label ; arg_type = Arg_cst cst } :: labels, args 
-      -> 
+    | { arg_type = Arg_cst cst ; _} :: labels, args 
+      -> (* can not be Optional *)
       let accs, eff = aux labels args in
       Lam_compile_const.translate_arg_cst cst :: accs, eff 
     | {arg_label  ; arg_type } ::labels,
@@ -201,7 +201,7 @@ let assemble_args_has_splice call_loc ffi (arg_types : specs) (args : exprs)
   let rec aux (labels : specs) (args : exprs) = 
     match labels, args with       
     | [] , _ -> assert (args = []); empty_pair
-    | { arg_label =  Empty | Label; arg_type = Arg_cst cst} :: labels  , args 
+    | { arg_type = Arg_cst cst; _} :: labels  , args 
       -> 
       let accs, eff = aux labels args in
       Lam_compile_const.translate_arg_cst cst :: accs, eff 

jscomp/core/lam_compile_external_obj.ml

@@ -40,47 +40,47 @@ module S = Js_stmt_make
 *)
 
 (* TODO: check stackoverflow *)
-let assemble_obj_args (labels : External_arg_spec.t list)  (args : J.expression list) 
+let assemble_obj_args (labels : External_arg_spec.obj_params)  (args : J.expression list) 
   : J.block * J.expression = 
-   let rec aux (labels : External_arg_spec.t list) args 
+   let rec aux (labels : External_arg_spec.obj_params) args 
     : (Js_op.property_name * E.t ) list  * J.expression list * _ = 
     match labels, args with 
     | [] , []  ->  [], [], []
-    | {arg_label = Label {name = label; cst = Some cst }} :: labels  , args -> 
+    | {obj_arg_label = Obj_label {name = label;  }; obj_arg_type = Arg_cst cst } :: labels  , args -> 
       let accs, eff, assign = aux labels args in 
       (label, Lam_compile_const.translate_arg_cst cst )::accs, eff, assign 
-    | {arg_label = EmptyCst _ } :: rest  , args -> assert false 
-    | {arg_label = Empty  }::labels, arg::args 
+    (* | {obj_arg_label = EmptyCst _ } :: rest  , args -> assert false  *)
+    | {obj_arg_label = Obj_empty  }::labels, arg::args 
       ->  (* unit type*)
       let (accs, eff, assign) as r  = aux labels args in 
       if Js_analyzer.no_side_effect_expression arg then r 
       else (accs, arg::eff, assign)
-    | ({arg_label = Label {name = label; cst = None}  } as arg_kind)::labels, arg::args 
+    | ({obj_arg_label = Obj_label {name = label;}  } as arg_kind)::labels, arg::args 
       -> 
       let accs, eff, assign = aux labels args in 
-      let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff ~arg_label:Label ~arg_type:arg_kind.arg_type arg in 
+      let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff ~arg_label:Arg_label ~arg_type:arg_kind.obj_arg_type arg in 
       begin match acc with 
         | Splice2 _ 
         | Splice0 -> assert false
         | Splice1 x ->
           (label, x) :: accs , Ext_list.append new_eff  eff , assign          
       end (* evaluation order is undefined *)
 
-    | ({arg_label = Optional {name = label}; arg_type } as arg_kind)::labels, arg::args 
+    | ({obj_arg_label = Obj_optional {name = label}; obj_arg_type } as arg_kind)::labels, arg::args 
       -> 
       let (accs, eff, assign) as r = aux labels args  in 
       Js_of_lam_option.destruct_optional arg 
         ~for_sure_none:r 
         ~for_sure_some:(fun x -> let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff 
-            ~arg_label:Label ~arg_type x in 
+            ~arg_label:Arg_label ~arg_type:obj_arg_type x in 
           begin match acc with 
           | Splice2 _
           | Splice0 -> assert false 
           | Splice1 x ->
             (label, x) :: accs , Ext_list.append new_eff  eff , assign
           end )
         ~not_sure:(fun _ -> accs, eff , (arg_kind,arg)::assign )
-    | {arg_label = Empty  | Label {cst = None;_} | Optional _  } :: _ , [] -> assert false 
+    | {obj_arg_label = Obj_empty  | Obj_label _ | Obj_optional _  } :: _ , [] -> assert false 
     | [],  _ :: _  -> assert false 
   in 
   let map, eff, assignment = aux labels args in 
@@ -101,9 +101,9 @@ let assemble_obj_args (labels : External_arg_spec.t list)  (args : J.expression
       | x::xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)     
     end) :: 
       (Ext_list.flat_map assignment (fun 
-        ((xlabel : External_arg_spec.t), (arg  : J.expression )) -> 
+        ((xlabel : External_arg_spec.obj_param), (arg  : J.expression )) -> 
       match xlabel with 
-      | {arg_label = Optional {name = label} } -> 
+      | {obj_arg_label = Obj_optional {name = label} } -> 
         (* Need make sure whether assignment is effectful or not
           to avoid code duplication
         *)
@@ -112,7 +112,7 @@ let assemble_obj_args (labels : External_arg_spec.t list)  (args : J.expression
           let acc,new_eff = 
             Lam_compile_external_call.ocaml_to_js_eff 
             ~arg_label:
-             Empty ~arg_type:xlabel.arg_type 
+             Arg_empty ~arg_type:xlabel.obj_arg_type 
               (Js_of_lam_option.val_from_option arg) in 
           begin match acc with 
           | Splice1 v  ->                         
@@ -131,8 +131,8 @@ let assemble_obj_args (labels : External_arg_spec.t list)  (args : J.expression
           let acc,new_eff = 
             Lam_compile_external_call.ocaml_to_js_eff 
             ~arg_label:
-             Empty
-             ~arg_type:xlabel.arg_type             
+             Arg_empty
+             ~arg_type:xlabel.obj_arg_type             
               (Js_of_lam_option.val_from_option arg) in 
           begin match acc with 
           | Splice1 v  ->        

jscomp/core/lam_compile_external_obj.mli

@@ -38,7 +38,7 @@
  *)
 
 val assemble_obj_args :
-  External_arg_spec.t list -> 
+  External_arg_spec.obj_params -> 
   J.expression list -> 
   J.block * J.expression 
 (* It returns a block in cases we need set the property dynamically: we need

jscomp/core/lam_convert.ml

@@ -456,6 +456,10 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
       let args = Ext_list.map args  convert_aux in
       prim ~primitive:(Pjs_object_create labels) ~args loc
     | Ffi_bs(arg_types, result_type, ffi) ->
+      let arg_types = 
+        match arg_types with 
+        | Params ls -> ls 
+        | Param_number i -> Ext_list.init i (fun _ -> External_arg_spec.dummy )   in 
       let args = Ext_list.map args convert_aux in
       Lam.handle_bs_non_obj_ffi arg_types result_type ffi args loc prim_name
     | Ffi_inline_const i -> Lam.const i