remove magic when bs attribute applied on object

Author: Hongbo Zhang

jscomp/syntax/ppx_entry.ml

@@ -63,15 +63,14 @@ let record_as_js_object = ref false (* otherwise has an attribute *)
 
 
 let obj_type_as_js_obj_type = ref false
-let uncurry_type = ref false 
+
 
 let no_export = ref false 
 
 
 let reset () = 
   record_as_js_object := false ;
   obj_type_as_js_obj_type := false ;
-  uncurry_type := false ;
   no_export  :=  false
 
 
@@ -188,78 +187,46 @@ let handle_typ
       | `Method, ptyp_attributes ->
         Ast_util.to_method_type loc self label args body
       | `Nothing , _ -> 
-        if !uncurry_type then 
-          Ast_util.to_uncurry_type loc  self  label args body
-        else 
           Ast_mapper.default_mapper.typ self ty
     end
   | {
     ptyp_desc =  Ptyp_object ( methods, closed_flag) ;
-    ptyp_attributes ;
     ptyp_loc = loc 
     } -> 
 
     let check_auto_uncurry core_type = self.typ self core_type in 
-    let methods, ptyp_attributes  =
-      begin match Ext_list.exclude_with_fact
-                    (function 
-                      | {Location.txt = "bs"; _}, _ -> true
-                      | _ -> false)
-                    ptyp_attributes with 
-      | None, _  ->
-        List.map (fun (label, ptyp_attrs, core_type ) -> 
-            match Ast_attributes.process_attributes_rev ptyp_attrs with 
-            | `Nothing,  _ -> 
-              label, ptyp_attrs , check_auto_uncurry  core_type
-            |  `Uncurry, _  -> 
-              label , ptyp_attrs, 
-              check_auto_uncurry
-                { core_type with 
-                  ptyp_attributes = 
-                    Ast_attributes.bs :: core_type.ptyp_attributes}
-            | `Method, ptyp_attrs 
-              ->  
-              label , ptyp_attrs, 
-              check_auto_uncurry
-                { core_type with 
-                  ptyp_attributes = 
-                    Ast_attributes.bs_method :: core_type.ptyp_attributes}
-            | `Meth_callback, ptyp_attrs 
-              ->  
-              label , ptyp_attrs, 
-              check_auto_uncurry
-                { core_type with 
-                  ptyp_attributes = 
-                    Ast_attributes.bs_this :: core_type.ptyp_attributes}
-          ) methods , ptyp_attributes
-      |  Some _ ,  ptyp_attributes -> 
-        Ext_ref.non_exn_protect uncurry_type true begin fun _ -> 
-          List.map (fun (label, ptyp_attrs, core_type ) -> 
-              match Ast_attributes.process_attributes_rev ptyp_attrs with 
-              | `Nothing,  _ -> label, ptyp_attrs , self.typ self core_type
-              |  `Uncurry, ptyp_attrs -> 
-                label , ptyp_attrs, self.typ self 
-                  { core_type with 
-                    ptyp_attributes = 
-                      Ast_attributes.bs :: core_type.ptyp_attributes}
-              |  `Method, ptyp_attrs -> 
-                label , ptyp_attrs, self.typ self 
-                  { core_type with 
-                    ptyp_attributes = 
-                      Ast_attributes.bs_method :: core_type.ptyp_attributes}
-              |  `Meth_callback, ptyp_attrs -> 
-                label , ptyp_attrs, self.typ self 
-                  { core_type with 
-                    ptyp_attributes = 
-                      Ast_attributes.bs_this :: core_type.ptyp_attributes}
-            ) methods 
-        end, ptyp_attributes 
-      end
+    let methods  =
+      List.map (fun (label, ptyp_attrs, core_type ) -> 
+          match Ast_attributes.process_attributes_rev ptyp_attrs with 
+          | `Nothing,  _ -> 
+            label, ptyp_attrs , check_auto_uncurry  core_type
+          |  `Uncurry, _  -> 
+            label , ptyp_attrs, 
+            check_auto_uncurry
+              { core_type with 
+                ptyp_attributes = 
+                  Ast_attributes.bs :: core_type.ptyp_attributes}
+          | `Method, ptyp_attrs 
+            ->  
+            label , ptyp_attrs, 
+            check_auto_uncurry
+              { core_type with 
+                ptyp_attributes = 
+                  Ast_attributes.bs_method :: core_type.ptyp_attributes}
+          | `Meth_callback, ptyp_attrs 
+            ->  
+            label , ptyp_attrs, 
+            check_auto_uncurry
+              { core_type with 
+                ptyp_attributes = 
+                  Ast_attributes.bs_this :: core_type.ptyp_attributes}
+        ) methods
+
     in          
     let inner_type =
       { ty
         with ptyp_desc = Ptyp_object(methods, closed_flag);
-             ptyp_attributes } in 
+              } in 
     if !obj_type_as_js_obj_type then 
       Ast_comb.to_js_type loc inner_type          
     else inner_type

jscomp/test/test_index.ml

@@ -23,17 +23,18 @@ let ff (x : int case  Js.t)
 
 
 type 'a return = int -> 'a [@bs]
+
 let h (x : 
-         [%bs.obj:< cse : (int -> 'a return  ); .. >  [@bs] ]) = 
+         [%bs.obj:< cse : int -> 'a return [@bs] ; .. >   ]) = 
    (x#@cse 3) 2 [@bs]
 
 
 
 type x_obj =  
   [%bs.obj: < 
-    cse : int ->  int ; 
-    cse_st : int -> int -> unit ;
-  >  [@bs] ]
+    cse : int ->  int [@bs] ; 
+    cse_st : int -> int -> unit [@bs];
+  >   ]
 
 let f_ext 
     (x : x_obj)
@@ -44,8 +45,8 @@ let f_ext
 
 type 'a h_obj = 
   [%bs.obj: < 
-    cse : int ->  'a return 
-  > [@bs] ]
+    cse : int ->  'a return [@bs]
+  >  ]
 
 let h_ext  (x : 'a h_obj) = 
    (x #@cse 3) 2 [@bs]