refactor: external arg spec ffi representation

jscomp/common/external_arg_spec.ml

@@ -62,9 +62,7 @@ type attr =
   | Ignore
   | Unwrap
 
-type param = { arg_type : attr; arg_label : label_noname }
-type obj_param = { obj_arg_type : attr; obj_arg_label : label }
-type obj_params = obj_param list
+type 'a param = { arg_type : attr; arg_label : 'a }
 
 let cst_obj_literal s = Arg_js_literal s
 let cst_int i = Arg_int_lit i
@@ -75,5 +73,7 @@ let obj_label name = Obj_label { name }
 let optional for_sure_no_nested_option name =
   Obj_optional { name; for_sure_no_nested_option }
 
-let empty_kind obj_arg_type = { obj_arg_label = empty_label; obj_arg_type }
+let empty_kind obj_arg_type =
+  { arg_label = empty_label; arg_type = obj_arg_type }
+
 let dummy = { arg_type = Nothing; arg_label = Arg_empty }

jscomp/common/external_arg_spec.mli

@@ -47,17 +47,13 @@ type attr =
   | Unwrap
 
 type label_noname = Arg_label | Arg_empty | Arg_optional
-type obj_param = { obj_arg_type : attr; obj_arg_label : label }
-type param = { arg_type : attr; arg_label : label_noname }
-type obj_params = obj_param list
+type 'a param = { arg_type : attr; arg_label : 'a }
 
 val cst_obj_literal : string -> cst
 val cst_int : int -> cst
 val cst_string : string -> cst
 val empty_label : label
-
-(* val empty_lit : cst -> label  *)
 val obj_label : string -> label
 val optional : bool -> string -> label
-val empty_kind : attr -> obj_param
-val dummy : param
+val empty_kind : attr -> label param
+val dummy : label_noname param

jscomp/common/external_ffi_types.ml

@@ -93,14 +93,16 @@ type return_wrapper =
   | Return_null_undefined_to_opt
   | Return_replaced_with_unit
 
-type params = Params of External_arg_spec.param list | Param_number of int
+type params =
+  | Params of External_arg_spec.label_noname External_arg_spec.param list
+  | Param_number of int
 
 type t =
   | Ffi_mel of params * return_wrapper * external_spec
       (**  [Ffi_mel(args,return,attr) ]
        [return] means return value is unit or not,
         [true] means is [unit] *)
-  | Ffi_obj_create of External_arg_spec.obj_params
+  | Ffi_obj_create of External_arg_spec.label External_arg_spec.param list
   | Ffi_inline_const of Lam_constant.t
   | Ffi_normal
 (* When it's normal, it is handled as normal c functional ffi call *)
@@ -238,7 +240,8 @@ let inline_float_primitive (i : string) : string list =
   [ ""; to_string (Ffi_inline_const (Const_float i)) ]
 
 let ffi_mel =
-  let rec ffi_mel_aux acc (params : External_arg_spec.param list) =
+  let rec ffi_mel_aux acc
+      (params : External_arg_spec.label_noname External_arg_spec.param list) =
     match params with
     | { arg_type = Nothing; arg_label = Arg_empty }
         (* same as External_arg_spec.dummy*)
@@ -247,7 +250,8 @@ let ffi_mel =
     | _ :: _ -> -1
     | [] -> acc
   in
-  fun (params : External_arg_spec.param list) return attr ->
+  fun (params : External_arg_spec.label_noname External_arg_spec.param list)
+      return attr ->
     let n = ffi_mel_aux 0 params in
     if n < 0 then Ffi_mel (Params params, return, attr)
     else Ffi_mel (Param_number n, return, attr)

jscomp/common/external_ffi_types.mli

@@ -85,11 +85,13 @@ type return_wrapper =
   | Return_null_undefined_to_opt
   | Return_replaced_with_unit
 
-type params = Params of External_arg_spec.param list | Param_number of int
+type params =
+  | Params of External_arg_spec.label_noname External_arg_spec.param list
+  | Param_number of int
 
 type t = private
   | Ffi_mel of params * return_wrapper * external_spec
-  | Ffi_obj_create of External_arg_spec.obj_params
+  | Ffi_obj_create of External_arg_spec.label External_arg_spec.param list
   | Ffi_inline_const of Lam_constant.t
   | Ffi_normal
 (* When it's normal, it is handled as normal c functional ffi call *)
@@ -109,10 +111,18 @@ val inline_int64_primitive : int64 -> string list
 val inline_float_primitive : string -> string list
 
 val ffi_mel :
-  External_arg_spec.param list -> return_wrapper -> external_spec -> t
+  External_arg_spec.label_noname External_arg_spec.param list ->
+  return_wrapper ->
+  external_spec ->
+  t
 
 val ffi_mel_as_prims :
-  External_arg_spec.param list -> return_wrapper -> external_spec -> string list
+  External_arg_spec.label_noname External_arg_spec.param list ->
+  return_wrapper ->
+  external_spec ->
+  string list
 
-val ffi_obj_create : External_arg_spec.obj_params -> t
-val ffi_obj_as_prims : External_arg_spec.obj_params -> string list
+val ffi_obj_create : External_arg_spec.label External_arg_spec.param list -> t
+
+val ffi_obj_as_prims :
+  External_arg_spec.label External_arg_spec.param list -> string list

jscomp/core/lam_compile_external_call.ml

@@ -147,7 +147,10 @@ let ocaml_to_js_eff ~(arg_label : Melange_ffi.External_arg_spec.label_noname)
 let empty_pair = ([], [])
 let add_eff eff e = match eff with None -> e | Some v -> E.seq v e
 
-type specs = Melange_ffi.External_arg_spec.param list
+type specs =
+  Melange_ffi.External_arg_spec.label_noname Melange_ffi.External_arg_spec.param
+  list
+
 type exprs = E.t list
 
 (* TODO: fix splice,

jscomp/core/lam_compile_external_call.mli

@@ -31,7 +31,8 @@ val ocaml_to_js_eff :
 
 val translate_ffi :
   Lam_compile_context.t ->
-  Melange_ffi.External_arg_spec.param list ->
+  Melange_ffi.External_arg_spec.label_noname Melange_ffi.External_arg_spec.param
+  list ->
   Melange_ffi.External_ffi_types.external_spec ->
   J.expression list ->
   J.expression

jscomp/core/lam_compile_external_obj.ml

@@ -38,58 +38,57 @@ module S = Js_stmt_make
 *)
 
 (* TODO: check stackoverflow *)
-let assemble_obj_args (labels : Melange_ffi.External_arg_spec.obj_params)
-    (args : J.expression list) : J.block * J.expression =
-  let rec aux (labels : Melange_ffi.External_arg_spec.obj_params) args :
-      (Js_op.property_name * E.t) list * J.expression list * _ =
+let assemble_obj_args
+    (labels :
+      Melange_ffi.External_arg_spec.label Melange_ffi.External_arg_spec.param
+      list) (args : J.expression list) : J.block * J.expression =
+  let rec aux
+      (labels :
+        Melange_ffi.External_arg_spec.label Melange_ffi.External_arg_spec.param
+        list) args : (Js_op.property_name * E.t) list * J.expression list * _ =
     match (labels, args) with
     | [], [] -> ([], [], [])
-    | ( {
-          obj_arg_label = Obj_label { name = label };
-          obj_arg_type = Arg_cst cst;
-        }
+    | ( { arg_label = Obj_label { name = label }; arg_type = Arg_cst cst }
         :: labels,
         args ) ->
         let accs, eff, assign = aux labels args in
         ( (Js_op.Lit label, Lam_compile_const.translate_arg_cst cst) :: accs,
           eff,
           assign )
     (* | {obj_arg_label = EmptyCst _ } :: rest  , args -> assert false  *)
-    | { obj_arg_label = Obj_empty; _ } :: labels, arg :: args ->
+    | { 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)
-    | ( ({ obj_arg_label = Obj_label { name = label }; _ } as arg_kind) :: labels,
+    | ( ({ 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:Arg_label
-            ~arg_type:arg_kind.obj_arg_type arg
+            ~arg_type:arg_kind.arg_type arg
         in
         match acc with
         | Splice2 _ | Splice0 -> assert false
         | Splice1 x ->
             ((Js_op.Lit label, x) :: accs, List.append new_eff eff, assign)
         (* evaluation order is undefined *))
-    | ( ({ obj_arg_label = Obj_optional { name = label; _ }; obj_arg_type } as
-         arg_kind)
+    | ( ({ arg_label = Obj_optional { name = label; _ }; 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:Arg_label
-                ~arg_type:obj_arg_type x
+                ~arg_type x
             in
             match acc with
             | Splice2 _ | Splice0 -> assert false
             | Splice1 x ->
                 ((Js_op.Lit label, x) :: accs, List.append new_eff eff, assign))
           ~not_sure:(fun _ -> (accs, eff, (arg_kind, arg) :: assign))
-    | { obj_arg_label = Obj_empty | Obj_label _ | Obj_optional _; _ } :: _, []
-      ->
+    | { arg_label = Obj_empty | Obj_label _ | Obj_optional _; _ } :: _, [] ->
         assert false
     | [], _ :: _ -> assert false
   in
@@ -109,12 +108,14 @@ let assemble_obj_args (labels : Melange_ffi.External_arg_spec.obj_params)
           | x :: xs -> E.seq (E.fuse_to_seq x xs) (E.obj map))
         :: List.concat_map
              ~f:(fun
-                 ( (xlabel : Melange_ffi.External_arg_spec.obj_param),
+                 ( (xlabel :
+                     Melange_ffi.External_arg_spec.label
+                     Melange_ffi.External_arg_spec.param),
                    (arg : J.expression) )
                ->
                match xlabel with
                | {
-                obj_arg_label =
+                arg_label =
                   Obj_optional { name = label; for_sure_no_nested_option };
                 _;
                } -> (
@@ -125,7 +126,7 @@ let assemble_obj_args (labels : Melange_ffi.External_arg_spec.obj_params)
                    | None -> (
                        let acc, new_eff =
                          Lam_compile_external_call.ocaml_to_js_eff
-                           ~arg_label:Arg_empty ~arg_type:xlabel.obj_arg_type
+                           ~arg_label:Arg_empty ~arg_type:xlabel.arg_type
                            (if for_sure_no_nested_option then arg
                             else Js_of_lam_option.val_from_option arg)
                        in
@@ -148,7 +149,7 @@ let assemble_obj_args (labels : Melange_ffi.External_arg_spec.obj_params)
                        let arg = E.var id in
                        let acc, new_eff =
                          Lam_compile_external_call.ocaml_to_js_eff
-                           ~arg_label:Arg_empty ~arg_type:xlabel.obj_arg_type
+                           ~arg_label:Arg_empty ~arg_type:xlabel.arg_type
                            (if for_sure_no_nested_option then arg
                             else Js_of_lam_option.val_from_option arg)
                        in

jscomp/core/lam_compile_external_obj.mli

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

jscomp/core/lam_ffi.ml

@@ -30,14 +30,20 @@
    if it does not we wrap it in a normal way otherwise
 *)
 let rec no_auto_uncurried_arg_types
-    (xs : Melange_ffi.External_arg_spec.param list) =
+    (xs :
+      Melange_ffi.External_arg_spec.label_noname
+      Melange_ffi.External_arg_spec.param
+      list) =
   match xs with
   | [] -> true
   | { arg_type = Fn_uncurry_arity _; _ } :: _ -> false
   | _ :: xs -> no_auto_uncurried_arg_types xs
 
 let rec transform_uncurried_arg_type loc
-    (arg_types : Melange_ffi.External_arg_spec.param list) (args : Lam.t list) =
+    (arg_types :
+      Melange_ffi.External_arg_spec.label_noname
+      Melange_ffi.External_arg_spec.param
+      list) (args : Lam.t list) =
   match (arg_types, args) with
   | { arg_type = Fn_uncurry_arity n; arg_label } :: xs, y :: ys ->
       let o_arg_types, o_args = transform_uncurried_arg_type loc xs ys in
@@ -67,9 +73,11 @@ let handle_mel_non_obj_ffi =
         Lam.prim ~primitive:Pundefined_to_opt ~args:[ result ] loc
     | Return_unset | Return_identity -> result
   in
-  fun (arg_types : Melange_ffi.External_arg_spec.param list)
-      (result_type : Melange_ffi.External_ffi_types.return_wrapper) ffi args loc
-      prim_name ->
+  fun (arg_types :
+        Melange_ffi.External_arg_spec.label_noname
+        Melange_ffi.External_arg_spec.param
+        list) (result_type : Melange_ffi.External_ffi_types.return_wrapper) ffi
+      args loc prim_name ->
     if no_auto_uncurried_arg_types arg_types then
       result_wrap loc result_type
         (Lam.prim ~primitive:(Pjs_call { prim_name; arg_types; ffi }) ~args loc)

jscomp/core/lam_ffi.mli

@@ -23,7 +23,8 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 val handle_mel_non_obj_ffi :
-  Melange_ffi.External_arg_spec.param list ->
+  Melange_ffi.External_arg_spec.label_noname Melange_ffi.External_arg_spec.param
+  list ->
   Melange_ffi.External_ffi_types.return_wrapper ->
   Melange_ffi.External_ffi_types.external_spec ->
   Lam.t list ->

jscomp/core/lam_primitive.ml

@@ -48,10 +48,15 @@ type t =
   | Pccall of { prim_name : string }
   | Pjs_call of {
       prim_name : string;
-      arg_types : Melange_ffi.External_arg_spec.param list;
+      arg_types :
+        Melange_ffi.External_arg_spec.label_noname
+        Melange_ffi.External_arg_spec.param
+        list;
       ffi : Melange_ffi.External_ffi_types.external_spec;
     }
-  | Pjs_object_create of Melange_ffi.External_arg_spec.obj_params
+  | Pjs_object_create of
+      Melange_ffi.External_arg_spec.label Melange_ffi.External_arg_spec.param
+      list
   (* Exceptions *)
   | Praise
   (* Boolean operations *)

jscomp/core/lam_primitive.mli

@@ -45,10 +45,15 @@ type t =
   | Pjs_call of {
       (* Location.t *  [loc] is passed down *)
       prim_name : string;
-      arg_types : Melange_ffi.External_arg_spec.param list;
+      arg_types :
+        Melange_ffi.External_arg_spec.label_noname
+        Melange_ffi.External_arg_spec.param
+        list;
       ffi : Melange_ffi.External_ffi_types.external_spec;
     }
-  | Pjs_object_create of Melange_ffi.External_arg_spec.obj_params
+  | Pjs_object_create of
+      Melange_ffi.External_arg_spec.label Melange_ffi.External_arg_spec.param
+      list
   | Praise
   | Psequand
   | Psequor

ppx/ast_external_mk.ml

@@ -166,7 +166,10 @@ let pval_prim_of_labels (labels : string Asttypes.loc list) =
           Melange_ffi.External_arg_spec.obj_label
             (Melange_ffi.Lam_methname.translate p.txt)
         in
-        { Melange_ffi.External_arg_spec.obj_arg_type = Nothing; obj_arg_label }
+        {
+          Melange_ffi.External_arg_spec.arg_type = Nothing;
+          arg_label = obj_arg_label;
+        }
         :: arg_kinds)
       labels ~init:[]
   in
@@ -183,7 +186,10 @@ let pval_prim_of_option_labels (labels : (bool * string Asttypes.loc) list)
             Melange_ffi.External_arg_spec.optional false label_name
           else Melange_ffi.External_arg_spec.obj_label label_name
         in
-        { Melange_ffi.External_arg_spec.obj_arg_type = Nothing; obj_arg_label }
+        {
+          Melange_ffi.External_arg_spec.arg_type = Nothing;
+          arg_label = obj_arg_label;
+        }
         :: arg_kinds)
       labels
       ~init: