remove some intermediate allocation

Author: bobzhang

jscomp/syntax/ast_compatible.ml

@@ -28,7 +28,6 @@ open Parsetree
 let default_loc = Location.none
 
 
-type poly_var_label = Asttypes.label Asttypes.loc
 
 
 
@@ -37,8 +36,9 @@ type poly_var_label = Asttypes.label Asttypes.loc
 
 
 
-let arrow ?(loc=default_loc) ?(attrs = []) a b  =
-  Ast_helper.Typ.arrow ~loc ~attrs Nolabel a b  
+
+let arrow ?loc ?attrs a b  =
+  Ast_helper.Typ.arrow ?loc ?attrs Nolabel a b  
 
 let apply_simple
  ?(loc = default_loc) 
@@ -105,21 +105,6 @@ let fun_
     pexp_desc = Pexp_fun(Nolabel,None, pat, exp)
   }
 
-(* let opt_label s =
-  Asttypes.Optional s *)
-
-(* let label_fun
-  ?(loc = default_loc)
-  ?(attrs = [])
-  ~label
-  pat
-  exp =
-  {
-    pexp_loc = loc;
-    pexp_attributes = attrs;
-    pexp_desc = Pexp_fun(label, None, pat, exp)
-  } *)
-type hash_label = string 
 
 
 let const_exp_string 
@@ -133,15 +118,7 @@ let const_exp_string
     pexp_desc = Pexp_constant(Pconst_string(s,delimiter))
   }
 
-let const_hash_label 
-    ?(loc = default_loc)
-    ?(attrs = [])
-    (s : hash_label) : expression = 
-  {
-    pexp_loc = loc; 
-    pexp_attributes = attrs;
-    pexp_desc = Pexp_constant(Pconst_string(s,None))
-  }
+
 
 let const_exp_int 
   ?(loc = default_loc)
@@ -165,19 +142,6 @@ let apply_labels
         fn, 
         Ext_list.map args (fun (l,a) -> Asttypes.Labelled l, a)   ) }
 
-let object_ 
-  ?(loc= default_loc)
-  ?(attrs = [])
-  (fields : (Asttypes.label Asttypes.loc * attributes * core_type) list)
-  flg : core_type = 
-  {
-    ptyp_desc = 
-      Ptyp_object(
-        Ext_list.map fields (fun (a,b,c) -> 
-          Parsetree.Otag (a,b,c)),flg);
-    ptyp_loc = loc;
-    ptyp_attributes = attrs
-  }
 
 
 

jscomp/syntax/ast_compatible.mli

@@ -143,12 +143,6 @@ val opt_arrow:
   core_type ->
   core_type
 
-val object_: 
-  ?loc:loc -> 
-  ?attrs:attrs ->
-  (string Asttypes.loc * attributes * core_type) list -> 
-  Asttypes.closed_flag ->
-  core_type  
 
 
 (* val nonrec_type_str:  

jscomp/syntax/ast_core_type.ml

@@ -104,8 +104,9 @@ let from_labels ~loc arity labels
          Typ.var ~loc ("a" ^ string_of_int i)))) in
   let result_type =
     Ast_comb.to_js_type loc
-      (Ast_compatible.object_ ~loc
-         (Ext_list.map2 labels tyvars (fun x y -> x ,[], y)) Closed)
+      (Typ.object_ ~loc
+         (Ext_list.map2 labels tyvars 
+          (fun x y -> Parsetree.Otag (x ,[], y))) Closed)
   in
   Ext_list.fold_right2 labels tyvars  result_type
     (fun label (* {loc ; txt = label }*)
@@ -115,7 +116,7 @@ let from_labels ~loc arity labels
 
 let make_obj ~loc xs =
   Ast_comb.to_js_type loc
-    (Ast_compatible.object_  ~loc xs Closed)
+    (Typ.object_  ~loc xs Closed)
 
 
 

jscomp/syntax/ast_core_type.mli

@@ -47,7 +47,7 @@ val from_labels :
 
 val make_obj :
   loc:Location.t ->
-  (string Asttypes.loc * Parsetree.attributes * t) list ->
+  Parsetree.object_field list ->
   t
 
 val is_user_option : t -> bool

jscomp/syntax/ast_derive_js_mapper.ml

@@ -435,10 +435,10 @@ let init () =
 
                   let objType flag =                     
                     Ast_comb.to_js_type loc @@  
-                    Ast_compatible.object_
+                    Typ.object_
                       (Ext_list.map label_declarations
                          (fun {pld_name ; pld_type } -> 
-                            pld_name, [], pld_type)) 
+                            Parsetree.Otag(pld_name, [], pld_type))) 
                       flag in                   
                   newTypeStr +? 
                   [

jscomp/syntax/ast_external_process.ml

@@ -400,7 +400,7 @@ let process_obj
   } ->
     if String.length prim_name <> 0 then
       Location.raise_errorf ~loc "[@@bs.obj] expect external names to be empty string";
-    let arg_kinds, new_arg_types_ty, result_types =
+    let arg_kinds, new_arg_types_ty, (result_types : Parsetree.object_field list) =
       Ext_list.fold_right arg_types_ty ( [], [], [])
         (fun param_type ( arg_labels, (arg_types : Ast_compatible.param_type list), result_types) ->
            let arg_label = param_type.label in
@@ -426,22 +426,22 @@ let process_obj
                    {obj_arg_label = External_arg_spec.obj_label s;
                     obj_arg_type },
                    arg_types, (* ignored in [arg_types], reserved in [result_types] *)
-                   (({Asttypes.txt = name; loc} , [], new_ty) :: result_types)
+                   (Parsetree.Otag({Asttypes.txt = name; loc} , [], new_ty) :: result_types)
                  | Nothing  ->
                    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,
-                   (({Asttypes.txt = name; loc} , [], new_ty) :: result_types)
+                   (Otag ({Asttypes.txt = name; loc} , [], new_ty) :: result_types)
                  | Int _  ->
                    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,
-                   (({Asttypes.txt = name; loc}, [], Ast_literal.type_int ~loc ()) :: result_types)
+                   (Otag ({Asttypes.txt = name; loc}, [], Ast_literal.type_int ~loc ()) :: result_types)
                  | 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,
-                   (({Asttypes.txt = name; loc}, [], Ast_literal.type_string ~loc ()) :: result_types)
+                   (Otag({Asttypes.txt = name; loc}, [], Ast_literal.type_string ~loc ()) :: result_types)
                  | Fn_uncurry_arity _ ->
                    Location.raise_errorf ~loc
                      "The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
@@ -464,17 +464,17 @@ let process_obj
                    let s = (Lam_methname.translate  name) in
                    {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 ty) ::  result_types)
+                   ( Parsetree.Otag ({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc ty) ::  result_types)
                  | Int _  ->
                    let s = Lam_methname.translate  name in
                    {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)
+                   (Otag ({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types)
                  | 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,
-                   (({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc ()) :: result_types)
+                   (Otag ({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc ()) :: result_types)
                  | Arg_cst _
                    ->
                    Location.raise_errorf ~loc "bs.as is not supported with optional yet"

jscomp/syntax/ast_util.ml

@@ -66,10 +66,10 @@ let ocaml_obj_as_js_object
 
     let result = Typ.var ~loc val_name.txt in 
     result , 
-    ((val_name , [], result ) ::
+    (Parsetree.Otag (val_name , [], result ) ::
      (if is_mutable then 
-        [{val_name with txt = val_name.txt ^ Literals.setter_suffix},[],
-         Ast_typ_uncurry.to_method_type loc mapper Nolabel result (Ast_literal.type_unit ~loc ()) ]
+        [ Otag ({val_name with txt = val_name.txt ^ Literals.setter_suffix},[],
+         Ast_typ_uncurry.to_method_type loc mapper Nolabel result (Ast_literal.type_unit ~loc ())) ]
       else 
         []) )
   in 
@@ -84,7 +84,8 @@ let ocaml_obj_as_js_object
       for public object type its [@bs.meth] it does not depend on itself
       while for label argument it is [@bs.this] which depends internal object
   *)
-  let internal_label_attr_types, public_label_attr_types  = 
+  let (internal_label_attr_types : Parsetree.object_field list), 
+      (public_label_attr_types : Parsetree.object_field list) = 
     Ext_list.fold_right clfs ([], []) 
       (fun ({pcf_loc  = loc} as x  : Parsetree.class_field) 
         (label_attr_types, public_label_attr_types) ->
@@ -102,9 +103,9 @@ let ocaml_obj_as_js_object
               ->  
               let method_type =
                 Ast_typ_uncurry.generate_arg_type x.pcf_loc mapper label.txt lbl pat e in 
-              ((label, [], method_type) :: label_attr_types),
+              (Parsetree.Otag(label, [], method_type) :: label_attr_types),
               (if public_flag = Public then
-                 (label, [], method_type) :: public_label_attr_types
+                 Parsetree.Otag (label, [], method_type) :: public_label_attr_types
                else 
                  public_label_attr_types)