Delete Bs_ast_mapper, keeping Ast_mapper at upstream shape

Bs_ast_mapper was a 600-line mechanical fork of the vendored Ast_mapper
whose entire delta - still delimited by fossilized cppo (* #if *)
comments - was three group-level hooks: type_declaration_list,
value_bindings, and value_bindings_rec. Only value_bindings ever had a
client (tuple/module-record pattern flattening for non-recursive lets);
the other two were never overridden by anything. Meanwhile the fork had
drifted: it dropped ~loc/~attrs when rebuilding JSX fragments and did
not remap JSX element-name locations. Every parsetree change paid the
duplication tax twice.

Rather than folding hooks into Ast_mapper, keep it byte-identical to
its upstream shape and move the one real behavior into the client:
bs_builtin_ppx's default_expr_mapper is now a thin wrapper that
flattens non-recursive Pexp_let groups before delegating, so every
fallback in expr_mapper inherits the flattening uniformly (hello_res's
nested [let {length: l, add} = module(List)] reaches it only through a
fallback and pins this), and structure_item_mapper handles
Pstr_value(Nonrecursive) the same way. Recursive groups map per
binding - their patterns are restricted to variables, so group
rewrites do not apply.

Also: inline Ast_typ_uncurry's one function into its one consumer and
delete the module; replace ast_external_mk's hand-rolled expression,
structure, and module-expr records with Ast_helper constructors;
replace ast_tdcls's two dead-hook accessor calls with plain List.map.

Generated output is byte-identical across the test suite.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
Signed-off-by: Cristiano Calcagno <cristianoc@users.noreply.github.com>

Author: cristianoc

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