Delete Bs_ast_mapper, keeping Ast_mapper at upstream shape

compiler/frontend/ast_core_type_class_type.ml

@@ -56,15 +56,27 @@ let process_getter_setter ~not_getter_setter
         pctf_attributes
       :: get_acc
 
-let default_typ_mapper = Bs_ast_mapper.default_mapper.typ
+let default_typ_mapper = Ast_mapper.default_mapper.typ
 (*
   Attributes are very hard to attribute
   (since ptyp_attributes could happen in so many places), 
   and write ppx extensions correctly, 
   we can only use it locally
 *)
 
-let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
+(* Turns [(t1, .., tn) => ret] with a method-callback attribute into
+   [Js.MethodCallback.arityN<full type>]. *)
+let to_method_callback_type loc (mapper : Ast_mapper.mapper) ~arity
+    (meth_type : Parsetree.core_type) =
+  let meth_type = Ast_mapper.default_mapper.typ mapper meth_type in
+  Ast_helper.Typ.constr
+    {
+      txt = Ldot (Ast_literal.Lid.method_callback, "arity" ^ string_of_int arity);
+      loc;
+    }
+    [meth_type]
+
+let typ_mapper (self : Ast_mapper.mapper) (ty : Parsetree.core_type) =
   let loc = ty.ptyp_loc in
   match ty.ptyp_desc with
   | Ptyp_arrow {params = _}
@@ -76,10 +88,9 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
     | Meth_callback _ -> (
       match ty.ptyp_desc with
       | Ptyp_arrow {params} ->
-        Ast_typ_uncurry.to_method_callback_type loc self
-          ~arity:(List.length params) ty
+        to_method_callback_type loc self ~arity:(List.length params) ty
       | _ -> assert false)
-    | Nothing -> Bs_ast_mapper.default_mapper.typ self ty)
+    | Nothing -> Ast_mapper.default_mapper.typ self ty)
   | Ptyp_object (methods, closed_flag) ->
     let ( +> ) attr (typ : Parsetree.core_type) =
       {typ with ptyp_attributes = attr :: typ.ptyp_attributes}

compiler/frontend/ast_core_type_class_type.mli

@@ -22,5 +22,4 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val typ_mapper :
-  Bs_ast_mapper.mapper -> Parsetree.core_type -> Parsetree.core_type
+val typ_mapper : Ast_mapper.mapper -> Parsetree.core_type -> Parsetree.core_type

compiler/frontend/ast_exp_apply.ml

@@ -42,7 +42,7 @@ let bound (e : exp) (cb : exp -> _) =
       [Vb.mk ~loc (Pat.var ~loc {txt = tuple_obj_id; loc}) e]
       (cb (Exp.ident ~loc {txt = Lident tuple_obj_id; loc}))
 
-let default_expr_mapper = Bs_ast_mapper.default_mapper.expr
+let default_expr_mapper = Ast_mapper.default_mapper.expr
 
 let check_and_discard (args : (Asttypes.arg_label * Parsetree.expression) list)
     =
@@ -72,7 +72,7 @@ let view_as_app (fn : exp) (s : string list) : app_pattern option =
 
 let infix_ops = ["->"; "#="; "##"]
 
-let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
+let app_exp_mapper (e : exp) (self : Ast_mapper.mapper) : exp =
   match view_as_app e infix_ops with
   | Some {op = "->"; args = [a_; f_]; loc} -> (
     (*

compiler/frontend/ast_exp_apply.mli

@@ -23,4 +23,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 val app_exp_mapper :
-  Parsetree.expression -> Bs_ast_mapper.mapper -> Parsetree.expression
+  Parsetree.expression -> Ast_mapper.mapper -> Parsetree.expression

compiler/frontend/ast_exp_extension.ml

@@ -23,7 +23,7 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 open Ast_helper
 
-let handle_extension e (self : Bs_ast_mapper.mapper)
+let handle_extension e (self : Ast_mapper.mapper)
     (({txt; loc}, payload) : Parsetree.extension) =
   match txt with
   | "todo" ->
@@ -81,4 +81,4 @@ let handle_extension e (self : Bs_ast_mapper.mapper)
 (* For an unknown extension, we don't really need to process further*)
 (* Exp.extension ~loc ~attrs:e.pexp_attributes (
     self.extension self extension) *)
-(* Bs_ast_mapper.default_mapper.expr self e   *)
+(* Ast_mapper.default_mapper.expr self e   *)

compiler/frontend/ast_exp_extension.mli

@@ -24,6 +24,6 @@
 
 val handle_extension :
   Parsetree.expression ->
-  Bs_ast_mapper.mapper ->
+  Ast_mapper.mapper ->
   Parsetree.extension ->
   Parsetree.expression

compiler/frontend/ast_external.ml

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-let handle_external_in_sig (self : Bs_ast_mapper.mapper)
+let handle_external_in_sig (self : Ast_mapper.mapper)
     (prim : Parsetree.value_description) (sigi : Parsetree.signature_item) :
     Parsetree.signature_item =
   let loc = prim.pval_loc in
@@ -51,7 +51,7 @@ let handle_external_in_sig (self : Bs_ast_mapper.mapper)
             };
       })
 
-let handle_external_in_stru (self : Bs_ast_mapper.mapper)
+let handle_external_in_stru (self : Ast_mapper.mapper)
     (prim : Parsetree.value_description) (str : Parsetree.structure_item) :
     Parsetree.structure_item =
   let loc = prim.pval_loc in

compiler/frontend/ast_external.mli

@@ -23,13 +23,13 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 val handle_external_in_sig :
-  Bs_ast_mapper.mapper ->
+  Ast_mapper.mapper ->
   Parsetree.value_description ->
   Parsetree.signature_item ->
   Parsetree.signature_item
 
 val handle_external_in_stru :
-  Bs_ast_mapper.mapper ->
+  Ast_mapper.mapper ->
   Parsetree.value_description ->
   Parsetree.structure_item ->
   Parsetree.structure_item

compiler/frontend/ast_external_mk.ml

@@ -28,70 +28,40 @@ let local_external_apply loc ?(pval_attributes = []) ~(pval_prim : string list)
     Parsetree.expression_desc =
   Pexp_letmodule
     ( {txt = local_module_name; loc},
-      {
-        pmod_desc =
-          Pmod_structure
-            [
-              {
-                pstr_desc =
-                  Pstr_primitive
-                    {
-                      pval_name = {txt = local_fun_name; loc};
-                      pval_type;
-                      pval_loc = loc;
-                      pval_prim;
-                      pval_attributes;
-                    };
-                pstr_loc = loc;
-              };
-            ];
-        pmod_loc = loc;
-        pmod_attributes = [];
-      },
+      Ast_helper.Mod.structure ~loc
+        [
+          Ast_helper.Str.primitive ~loc
+            {
+              pval_name = {txt = local_fun_name; loc};
+              pval_type;
+              pval_loc = loc;
+              pval_prim;
+              pval_attributes;
+            };
+        ],
       Ast_helper.Exp.apply ~loc
-        ({
-           pexp_desc =
-             Pexp_ident
-               {txt = Ldot (Lident local_module_name, local_fun_name); loc};
-           pexp_attributes = [];
-           pexp_loc = loc;
-         }
-          : Parsetree.expression)
+        (Ast_helper.Exp.ident ~loc
+           {txt = Ldot (Lident local_module_name, local_fun_name); loc})
         (Ext_list.map args (fun x -> (Asttypes.Nolabel, x))) )
 
 let local_external_obj loc ?(pval_attributes = []) ~pval_prim ~pval_type
     ?(local_module_name = "J") ?(local_fun_name = "unsafe_expr") args :
     Parsetree.expression_desc =
   Pexp_letmodule
     ( {txt = local_module_name; loc},
-      {
-        pmod_desc =
-          Pmod_structure
-            [
-              {
-                pstr_desc =
-                  Pstr_primitive
-                    {
-                      pval_name = {txt = local_fun_name; loc};
-                      pval_type;
-                      pval_loc = loc;
-                      pval_prim;
-                      pval_attributes;
-                    };
-                pstr_loc = loc;
-              };
-            ];
-        pmod_loc = loc;
-        pmod_attributes = [];
-      },
+      Ast_helper.Mod.structure ~loc
+        [
+          Ast_helper.Str.primitive ~loc
+            {
+              pval_name = {txt = local_fun_name; loc};
+              pval_type;
+              pval_loc = loc;
+              pval_prim;
+              pval_attributes;
+            };
+        ],
       Ast_helper.Exp.apply ~loc
-        ({
-           pexp_desc =
-             Pexp_ident
-               {txt = Ldot (Lident local_module_name, local_fun_name); loc};
-           pexp_attributes = [];
-           pexp_loc = loc;
-         }
-          : Parsetree.expression)
+        (Ast_helper.Exp.ident ~loc
+           {txt = Ldot (Lident local_module_name, local_fun_name); loc})
         (Ext_list.map args (fun (l, a) ->
              (Asttypes.Labelled {txt = l; loc = Location.none}, a))) )

compiler/frontend/ast_tdcls.ml

@@ -35,7 +35,7 @@ let new_tdcls (tdcls : Parsetree.type_declaration list)
     Ext_list.map_last tdcls (fun last x ->
         if last then {x with Parsetree.ptype_attributes = new_attrs} else x)
 
-let handle_tdcls_in_sigi (self : Bs_ast_mapper.mapper)
+let handle_tdcls_in_sigi (self : Ast_mapper.mapper)
     (sigi : Parsetree.signature_item) rf
     (tdcls : Parsetree.type_declaration list) : Ast_signature.item =
   match
@@ -46,7 +46,7 @@ let handle_tdcls_in_sigi (self : Bs_ast_mapper.mapper)
     let original_tdcls_new_attrs = new_tdcls tdcls new_attrs in
     (* remove the processed attr*)
     let new_tdcls_new_attrs =
-      self.type_declaration_list self original_tdcls_new_attrs
+      List.map (self.type_declaration self) original_tdcls_new_attrs
     in
     let kind = Ast_derive_abstract.is_abstract actions in
     if kind <> Not_abstract then
@@ -68,9 +68,9 @@ let handle_tdcls_in_sigi (self : Bs_ast_mapper.mapper)
         (Sig.type_ ~loc rf new_tdcls_new_attrs
         :: self.signature self (Ast_derive.gen_signature tdcls actions rf))
   | {bs_deriving = None}, _ ->
-    Bs_ast_mapper.default_mapper.signature_item self sigi
+    Ast_mapper.default_mapper.signature_item self sigi
 
-let handle_tdcls_in_stru (self : Bs_ast_mapper.mapper)
+let handle_tdcls_in_stru (self : Ast_mapper.mapper)
     (str : Parsetree.structure_item) rf
     (tdcls : Parsetree.type_declaration list) : Ast_structure.item =
   match
@@ -81,7 +81,7 @@ let handle_tdcls_in_stru (self : Bs_ast_mapper.mapper)
     let original_tdcls_new_attrs = new_tdcls tdcls new_attrs in
     let new_str : Parsetree.structure_item =
       Str.type_ ~loc rf
-        (self.type_declaration_list self original_tdcls_new_attrs)
+        (List.map (self.type_declaration self) original_tdcls_new_attrs)
     in
     let kind = Ast_derive_abstract.is_abstract actions in
     if kind <> Not_abstract then
@@ -102,5 +102,4 @@ let handle_tdcls_in_stru (self : Bs_ast_mapper.mapper)
                 (fun action ->
                   Ast_derive.gen_structure_signature loc tdcls action rf)
                 actions))
-  | {bs_deriving = None}, _ ->
-    Bs_ast_mapper.default_mapper.structure_item self str
+  | {bs_deriving = None}, _ -> Ast_mapper.default_mapper.structure_item self str

compiler/frontend/ast_tdcls.mli

@@ -23,14 +23,14 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 val handle_tdcls_in_sigi :
-  Bs_ast_mapper.mapper ->
+  Ast_mapper.mapper ->
   Parsetree.signature_item ->
   Asttypes.rec_flag ->
   Parsetree.type_declaration list ->
   Ast_signature.item
 
 val handle_tdcls_in_stru :
-  Bs_ast_mapper.mapper ->
+  Ast_mapper.mapper ->
   Parsetree.structure_item ->
   Asttypes.rec_flag ->
   Parsetree.type_declaration list ->

compiler/frontend/ast_tuple_pattern_flatten.ml

@@ -41,7 +41,7 @@ let rec is_simple_pattern (p : Parsetree.pattern) =
   [ let a = M.N.c
     and b = M.N.d ]
 *)
-let flattern_tuple_pattern_vb (self : Bs_ast_mapper.mapper)
+let flattern_tuple_pattern_vb (self : Ast_mapper.mapper)
     (vb : Parsetree.value_binding) (acc : Parsetree.value_binding list) :
     Parsetree.value_binding list =
   let pvb_pat = self.pat self vb.pvb_pat in
@@ -108,8 +108,8 @@ let flattern_tuple_pattern_vb (self : Bs_ast_mapper.mapper)
     {pvb_pat; pvb_expr; pvb_constraint; pvb_loc = vb.pvb_loc; pvb_attributes}
     :: acc
 
-let value_bindings_mapper (self : Bs_ast_mapper.mapper)
+let value_bindings_mapper (self : Ast_mapper.mapper)
     (vbs : Parsetree.value_binding list) =
-  (* Bs_ast_mapper.default_mapper.value_bindings self  vbs   *)
+  (* Ast_mapper.default_mapper.value_bindings self  vbs   *)
   Ext_list.fold_right vbs [] (fun vb acc ->
       flattern_tuple_pattern_vb self vb acc)

compiler/frontend/ast_tuple_pattern_flatten.mli

@@ -23,6 +23,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 val value_bindings_mapper :
-  Bs_ast_mapper.mapper ->
+  Ast_mapper.mapper ->
   Parsetree.value_binding list ->
   Parsetree.value_binding list