tweak, clean up

Author: bobzhang

jscomp/syntax/ast_external_process.ml

@@ -96,28 +96,29 @@ let spec_of_ptyp
 (* is_optional = false 
 *)
 let refine_arg_type ~(nolabel:bool) (ptyp : Ast_core_type.t) 
-  : Ast_core_type.t * External_arg_spec.attr = 
-  if ptyp.ptyp_desc = Ptyp_any then 
-    let ptyp_attrs = ptyp.ptyp_attributes in
-    let result = Ast_attributes.iter_process_bs_string_or_int_as ptyp_attrs in
-    (* when ppx start dropping attributes
-       we should warn, there is a trade off whether
-       we should warn dropped non bs attribute or not
-    *)
-    Bs_ast_invariant.warn_discarded_unused_attributes ptyp_attrs;
-    match result with
-    |  None ->
-      Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external
-    | Some (Int i) -> (* (_[@bs.as ])*)
-      (* This type is used in bs.obj only to construct obj type*)
-      Ast_literal.type_int ~loc:ptyp.ptyp_loc (), Arg_cst(External_arg_spec.cst_int i)
-    | Some (Str i)->
-      Ast_literal.type_string ~loc:ptyp.ptyp_loc (), Arg_cst (External_arg_spec.cst_string i)
-    | Some (Json_str s) ->
-      (* FIXME: This seems to be wrong in bs.obj, we should disable such payload in bs.obj *)
-      Ast_literal.type_string ~loc:ptyp.ptyp_loc (), Arg_cst (External_arg_spec.cst_json ptyp.ptyp_loc s)
-  else (* ([`a|`b] [@bs.string]) *)
-    ptyp, spec_of_ptyp nolabel ptyp   
+  :  External_arg_spec.attr = 
+  (if ptyp.ptyp_desc = Ptyp_any then 
+     let ptyp_attrs = ptyp.ptyp_attributes in
+     let result = Ast_attributes.iter_process_bs_string_or_int_as ptyp_attrs in
+     (* when ppx start dropping attributes
+        we should warn, there is a trade off whether
+        we should warn dropped non bs attribute or not
+     *)
+     Bs_ast_invariant.warn_discarded_unused_attributes ptyp_attrs;
+     match result with
+     |  None ->
+       Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external
+     | Some (Int i) -> (* (_[@bs.as ])*)
+       (* This type is used in bs.obj only to construct obj type*)
+       Arg_cst(External_arg_spec.cst_int i)
+     | Some (Str i)->
+       Arg_cst (External_arg_spec.cst_string i)
+     | Some (Json_str s) ->
+       (* FIXME: This seems to be wrong in bs.obj, we should disable such payload in bs.obj *)
+       Arg_cst (External_arg_spec.cst_json ptyp.ptyp_loc s)
+   else (* ([`a|`b] [@bs.string]) *)
+     spec_of_ptyp nolabel ptyp   
+  )
 
 let refine_obj_arg_type ~(nolabel:bool) (ptyp : Ast_core_type.t) 
   : Ast_core_type.t * External_arg_spec.attr = 
@@ -882,15 +883,15 @@ let handle_attributes
       let init : External_arg_spec.params * Ast_compatible.param_type list * int  = 
         match external_desc.val_send_pipe with
         | Some obj ->
-          let new_ty, arg_type = refine_arg_type ~nolabel:true obj in
+          let arg_type = refine_arg_type ~nolabel:true obj in
           begin match arg_type with
             | Arg_cst _ ->
               Location.raise_errorf ~loc:obj.ptyp_loc "[@bs.as] is not supported in bs.send type "
             | _ ->
               (* more error checking *)
               [{arg_label = Arg_empty; arg_type}],
               [{label = Nolabel;
-                ty = new_ty;
+                ty = obj;
                 attr =  [];
                 loc = obj.ptyp_loc} ],
               0           
@@ -929,20 +930,20 @@ let handle_attributes
                    Arg_optional, arg_type,
                    param_type :: arg_types end
              | Labelled _  ->
-               begin match refine_arg_type ~nolabel:false ty with
-                 | _, (Arg_cst _ as arg_type)  ->
-                   Arg_label , arg_type, arg_types
-                 | new_ty, arg_type ->
-                   Arg_label , arg_type, 
-                   {param_type with ty = new_ty} :: arg_types
-               end
+               let arg_type = refine_arg_type ~nolabel:false ty in
+               Arg_label , arg_type,
+               (match arg_type with
+                | Arg_cst _   ->
+                  arg_types
+                |  _ ->                   
+                  param_type :: arg_types)               
              | Nolabel ->
-               begin match refine_arg_type ~nolabel:true ty with
-                 | _ , (Arg_cst _ as arg_type) ->
-                   Arg_empty , arg_type,  arg_types
-                 | new_ty , arg_type ->
-                   Arg_empty, arg_type, {param_type with ty = new_ty} :: arg_types
-               end
+               let arg_type = refine_arg_type ~nolabel:true ty in 
+               Arg_empty , arg_type, (match arg_type with
+                   | Arg_cst _  ->
+                     arg_types
+                   | _ ->
+                     param_type :: arg_types)
            in
            ({ arg_label  ;
               arg_type