clean up ffi handling

ideally, we should branch bs.obj and normal FFI as early as we can

Author: bobzhang

jscomp/core/js_of_lam_variant.ml

@@ -31,26 +31,23 @@ type arg_expression =
   | Splice2 of E.t * E.t
 
 (* we need destruct [undefined] when input is optional *)
-let eval (arg : J.expression) (dispatches : (Ast_compatible.hash_label * string) list option) : E.t =
-  match dispatches with 
-  | None -> arg 
-  | Some dispatches -> 
-    if arg == E.undefined then E.undefined 
-    else
-      match arg.expression_desc with
-      | Str (_,s) ->     
-        let s = 
-          (Ext_list.assoc_by_string  dispatches s None) in 
-        E.str s 
-      | _ -> 
-        E.of_block
-          [(S.string_switch arg
-              (Ext_list.map dispatches (fun (i,r) ->
-                   {J.switch_case = i ;
-                    switch_body = [S.return_stmt (E.str r)];
-                    should_break = false; (* FIXME: if true, still print break*)
-                    comment = None;
-                   })))]
+let eval (arg : J.expression) (dispatches : (Ast_compatible.hash_label * string) list ) : E.t =
+  if arg == E.undefined then E.undefined 
+  else
+    match arg.expression_desc with
+    | Str (_,s) ->     
+      let s = 
+        (Ext_list.assoc_by_string  dispatches s None) in 
+      E.str s 
+    | _ -> 
+      E.of_block
+        [(S.string_switch arg
+            (Ext_list.map dispatches (fun (i,r) ->
+                 {J.switch_case = i ;
+                  switch_body = [S.return_stmt (E.str r)];
+                  should_break = false; (* FIXME: if true, still print break*)
+                  comment = None;
+                 })))]
 
 (** invariant: optional is not allowed in this case *)
 (** arg is a polyvar *)

jscomp/core/js_of_lam_variant.mli

@@ -31,7 +31,7 @@ type arg_expression =
 
 val eval :
    J.expression -> 
-   (Ast_compatible.hash_label * string) list option
+   (Ast_compatible.hash_label * string) list
    -> J.expression
 
 val eval_as_event : 

jscomp/core/lam_compile_external_call.ml

@@ -118,10 +118,10 @@ let ocaml_to_js_eff
        []
      else 
        [arg])
-  | Poly_var {has_payload = false ; descr = dispatches} -> 
-    Splice1 (Js_of_lam_variant.eval arg dispatches),[]
-  | Poly_var {has_payload = true ; descr = dispatches} -> 
-    Js_of_lam_variant.eval_as_event arg dispatches,[]    
+  | Poly_var_string {descr } -> 
+    Splice1 (Js_of_lam_variant.eval arg descr),[]
+  | Poly_var {descr} -> 
+    Js_of_lam_variant.eval_as_event arg descr,[]    
     (* FIXME: encode invariant below in the signature*)
     (* length of 2
       - the poly var tag 

jscomp/main/builtin_cmi_datasets.ml

@@ -437,7 +437,7 @@ let process_obj
                    {obj_arg_label = External_arg_spec.obj_label s; obj_arg_type},
                    {param_type with ty = new_ty}::arg_types,
                    (({Asttypes.txt = name; loc}, [], Ast_literal.type_int ~loc ()) :: result_types)
-                 | Poly_var { has_payload = false ; _} ->
+                 | Poly_var_string _ ->
                    let s = Lam_methname.translate  name in
                    {obj_arg_label = External_arg_spec.obj_label s; obj_arg_type},
                    {param_type with ty = new_ty }::arg_types,
@@ -446,7 +446,7 @@ let process_obj
                    Location.raise_errorf ~loc
                      "The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
                  | Extern_unit -> assert false
-                 | Poly_var { has_payload = true ; _} 
+                 | Poly_var _ 
                    ->
                    Location.raise_errorf ~loc
                      "bs.obj label %s does not support such arg type" name
@@ -470,7 +470,7 @@ let process_obj
                    {obj_arg_label = External_arg_spec.optional s ; obj_arg_type },
                    param_type :: arg_types,
                    (({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types)
-                 | Poly_var {has_payload = false ; _} ->
+                 | Poly_var_string _ ->
                    let s = Lam_methname.translate  name in
                    {obj_arg_label = External_arg_spec.optional s ; obj_arg_type },
                    param_type::arg_types,
@@ -482,7 +482,7 @@ let process_obj
                    Location.raise_errorf ~loc
                      "The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
                  | Extern_unit   -> assert false
-                 | Poly_var {has_payload = true; _}
+                 | Poly_var _
                    ->
                    Location.raise_errorf ~loc
                      "bs.obj label %s does not support such arg type" name
@@ -896,7 +896,7 @@ let handle_attributes
              | Optional s  ->
                let arg_type = get_opt_arg_type ~nolabel:false ty in
                begin match arg_type with
-                 | Poly_var {has_payload = true; _} ->
+                 | Poly_var _ ->
                    (* ?x:([`x of int ] [@bs.string]) does not make sense *)
                    Location.raise_errorf
                      ~loc

jscomp/syntax/ast_external_process.ml

@@ -112,12 +112,15 @@ let map_row_fields_into_strings ptyp_loc
   | `NonNull -> 
     let has_payload = case = `NonNull in 
     let descr = if !has_bs_as then Some result else None in    
-    if not has_payload && descr = None then begin
-      Location.prerr_warning ptyp_loc (Bs_ffi_warning "bs.string is redundant here, you can safely remove it")   
-    end;
-    External_arg_spec.Poly_var 
-      {has_payload  ; 
-       descr  }
+    match has_payload, descr with 
+    | false, None ->    
+      Location.prerr_warning ptyp_loc (Bs_ffi_warning "bs.string is redundant here, you can safely remove it");
+      Nothing         
+    | false , Some descr -> 
+      External_arg_spec.Poly_var_string {descr } 
+    | true, _ ->             
+      External_arg_spec.Poly_var 
+        { descr  }
 
 let is_enum row_fields = 
   List.for_all (fun (x : Parsetree.row_field) -> 

jscomp/syntax/ast_polyvar.ml

@@ -46,14 +46,22 @@ type label =
   (* it will be ignored , side effect will be recorded *)
 
 
-
+(* This type is used to give some meta info on each argument *)
 type attr = 
-  | Poly_var of { 
-    has_payload : bool ; 
+  | Poly_var_string of { 
     descr :
     (Ast_compatible.hash_label * string) list
-    option
-  }  
+   (* introduced by attributes bs.string
+    and bs.as 
+   *)
+  } 
+  | Poly_var of {
+    descr : 
+    (Ast_compatible.hash_label * string) list option 
+      (* introduced by attributes bs.string
+         and bs.as 
+      *)
+  } 
    (* `a does not have any value*)
   | Int of (Ast_compatible.hash_label * int ) list (* ([`a | `b ] [@bs.int])*)
   | Arg_cst of cst

jscomp/syntax/external_arg_spec.ml

@@ -41,12 +41,14 @@ type label = private
 
 
 type attr = 
-  | Poly_var of  {
-      has_payload : bool ; 
-      descr :
-        (Ast_compatible.hash_label * string) 
-          list option
-    }  
+  | Poly_var_string of { 
+    descr :
+    (Ast_compatible.hash_label * string) list
+  } 
+  | Poly_var of {
+    descr : 
+    (Ast_compatible.hash_label * string) list option 
+  }   
   | Int of (Ast_compatible.hash_label * int ) list (* ([`a | `b ] [@bs.int])*)
   | Arg_cst of cst
   | Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*)