Remove support for @bs.send.pipe from the compiler.

cristianoc · cristianoc · commit f04aa3f93c50 · 2024-07-07T20:34:42.000+02:00
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -32,6 +32,7 @@
 - Remove ml parsing tests and conversion from `.ml` to `.res` via format. https://github.com/rescript-lang/rescript-compiler/pull/6848
 - Remove support for compiling `.ml` files, and general cleanup. https://github.com/rescript-lang/rescript-compiler/pull/6852
 - Remove `rescript convert` subcommand. https://github.com/rescript-lang/rescript-compiler/pull/6860
+- Remove support for `@bs.send.pipe`. https://github.com/rescript-lang/rescript-compiler/pull/6858
 
 #### :bug: Bug Fix
 
diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml
@@ -176,34 +176,6 @@ let process_derive_type (attrs : t) : derive_attr * t =
         | Some _ -> Bs_syntaxerr.err loc Duplicated_bs_deriving)
       | _ -> (st, attr :: acc))
 
-let process_send_pipe (attrs : t) : (Parsetree.core_type * t) option =
-  match attrs with
-  | [] -> None
-  | _ -> (
-    if not (Ext_list.exists_fst attrs (fun {txt} -> txt = "bs.send.pipe")) then
-      (* fast path *)
-      None
-    else
-      let ty = ref None in
-      let attrs =
-        Ext_list.fold_left attrs [] (fun acc (({txt; loc}, payload) as attr) ->
-            match txt with
-            | "bs.send.pipe" -> (
-              match !ty with
-              | None ->
-                Location.prerr_warning loc
-                  (Warnings.Bs_ffi_warning
-                     "This attribute is deprecated, use @send instead.");
-
-                ty := Some (Ast_payload.as_core_type loc payload);
-                ({Asttypes.txt = "send"; loc}, Parsetree.PStr []) :: acc
-              | Some _ -> Location.raise_errorf ~loc "Duplicated bs.send.pipe")
-            | _ -> attr :: acc)
-      in
-      match !ty with
-      | None -> assert false
-      | Some ty -> Some (ty, attrs))
-
 (* duplicated @uncurry @string not allowed,
    it is worse in @uncurry since it will introduce
    inconsistency in arity
diff --git a/jscomp/frontend/ast_attributes.mli b/jscomp/frontend/ast_attributes.mli
@@ -87,8 +87,6 @@ val internal_expansive : attr
 
 val rs_externals : t -> string list -> bool
 
-val process_send_pipe : t -> (Parsetree.core_type * t) option
-
 val is_gentype : attr -> bool
 
 val gentype : attr
diff --git a/jscomp/frontend/ast_core_type.ml b/jscomp/frontend/ast_core_type.ml
@@ -129,14 +129,6 @@ let get_curry_arity (ty : t) =
     let arity, _ = Ast_uncurried.core_type_extract_uncurried_fun ty in
     arity
   else get_uncurry_arity_aux ty 0
-
-(* add hoc for bs.send.pipe *)
-let rec get_curry_labels (ty : t) acc =
-  match ty.ptyp_desc with
-  | Ptyp_arrow (label, _, rest) -> get_curry_labels rest (label :: acc)
-  | _ -> acc
-
-let get_curry_labels ty = List.rev (get_curry_labels ty [])
 let is_arity_one ty = get_curry_arity ty = 1
 
 type param_type = {
diff --git a/jscomp/frontend/ast_core_type.mli b/jscomp/frontend/ast_core_type.mli
@@ -47,8 +47,6 @@ val get_uncurry_arity : t -> int option
    None -- means not a function
 *)
 
-val get_curry_labels : t -> Asttypes.arg_label list
-
 type param_type = {
   label: Asttypes.arg_label;
   ty: t;
diff --git a/jscomp/frontend/ast_external.ml b/jscomp/frontend/ast_external.ml
@@ -28,58 +28,35 @@ let handle_external_in_sig (self : Bs_ast_mapper.mapper)
   let loc = prim.pval_loc in
   let pval_type = self.typ self prim.pval_type in
   let pval_attributes = self.attributes self prim.pval_attributes in
-  match Ast_attributes.process_send_pipe pval_attributes with
-  | Some (obj, _) ->
-    (*has bs.send.pipe: best effort *)
-    {
-      sigi with
-      psig_desc =
-        Psig_value
-          {
-            prim with
-            pval_type = Ast_core_type.add_last_obj pval_type obj;
-            pval_prim = [];
-            pval_attributes = [];
-          };
-    }
-  | None -> (
-    match prim.pval_prim with
-    | [] -> Location.raise_errorf ~loc "empty primitive string"
-    | a :: b :: _ ->
-      Location.raise_errorf ~loc
-        "only a single string is allowed in bs external %S %S" a b
-    | [v] -> (
-      match
-        Ast_external_process.encode_attributes_as_string loc pval_type
-          pval_attributes v
-      with
-      | {pval_type; pval_prim; pval_attributes; no_inline_cross_module} ->
-        {
-          sigi with
-          psig_desc =
-            Psig_value
-              {
-                prim with
-                pval_type;
-                pval_prim = (if no_inline_cross_module then [] else pval_prim);
-                pval_attributes;
-              };
-        }))
+  match prim.pval_prim with
+  | [] -> Location.raise_errorf ~loc "empty primitive string"
+  | a :: b :: _ ->
+    Location.raise_errorf ~loc
+      "only a single string is allowed in bs external %S %S" a b
+  | [v] -> (
+    match
+      Ast_external_process.encode_attributes_as_string loc pval_type
+        pval_attributes v
+    with
+    | {pval_type; pval_prim; pval_attributes; no_inline_cross_module} ->
+      {
+        sigi with
+        psig_desc =
+          Psig_value
+            {
+              prim with
+              pval_type;
+              pval_prim = (if no_inline_cross_module then [] else pval_prim);
+              pval_attributes;
+            };
+      })
 
 let handle_external_in_stru (self : Bs_ast_mapper.mapper)
     (prim : Parsetree.value_description) (str : Parsetree.structure_item) :
     Parsetree.structure_item =
   let loc = prim.pval_loc in
   let pval_type = self.typ self prim.pval_type in
   let pval_attributes = self.attributes self prim.pval_attributes in
-  let send_pipe = ref false in
-  let pval_type, pval_attributes =
-    match Ast_attributes.process_send_pipe pval_attributes with
-    | Some (obj, attrs) ->
-      send_pipe := true;
-      (Ast_helper.Typ.arrow ~loc Nolabel obj pval_type, attrs)
-    | None -> (pval_type, pval_attributes)
-  in
   match prim.pval_prim with
   | [] -> Location.raise_errorf ~loc "empty primitive string"
   | a :: b :: _ ->
@@ -98,86 +75,24 @@ let handle_external_in_stru (self : Bs_ast_mapper.mapper)
             Pstr_primitive {prim with pval_type; pval_prim; pval_attributes};
         }
       in
-      let normal () =
-        if not no_inline_cross_module then external_result
-        else
-          let open Ast_helper in
-          Str.include_ ~loc
-            (Incl.mk ~loc
-               (Mod.constraint_ ~loc
-                  (Mod.structure ~loc [external_result])
-                  (Mty.signature ~loc
-                     [
-                       {
-                         psig_desc =
-                           Psig_value
-                             {
-                               prim with
-                               pval_type;
-                               pval_prim = [];
-                               pval_attributes;
-                             };
-                         psig_loc = loc;
-                       };
-                     ])))
-      in
-      if !send_pipe then
-        let[@warning "-8"] (_ :: params as args) =
-          Ast_core_type.get_curry_labels pval_type
-        in
-        let arity = List.length args in
-        if arity = 1 then normal ()
-        else
-          let open Ast_helper in
-          Str.include_ ~loc
-            (Incl.mk ~loc
-               (Mod.structure ~loc
-                  [
-                    external_result;
-                    Str.value ~loc Nonrecursive
-                      [
-                        Vb.mk ~loc
-                          (Pat.var ~loc prim.pval_name)
-                          (let body =
-                             Exp.apply ~loc
-                               (Exp.ident ~loc
-                                  {txt = Lident prim.pval_name.txt; loc})
-                               (( Asttypes.Nolabel,
-                                  Exp.ident ~loc {txt = Lident "obj"; loc} )
-                               :: Ext_list.mapi params (fun i x ->
-                                      ( x,
-                                        match x with
-                                        | Asttypes.Nolabel ->
-                                          Exp.ident
-                                            {
-                                              txt =
-                                                Lident
-                                                  ("arg" ^ string_of_int (i + 1));
-                                              loc;
-                                            }
-                                        | Labelled s | Optional s ->
-                                          Exp.ident {txt = Lident s; loc} )))
-                           in
-                           snd
-                           @@ Ext_list.fold_right params
-                                ( 0,
-                                  Exp.fun_ Nolabel None
-                                    (Pat.var ~loc {txt = "obj"; loc})
-                                    body )
-                                (fun arg (i, obj) ->
-                                  ( i + 1,
-                                    Exp.fun_ arg None
-                                      (Pat.var ~loc
-                                         {
-                                           txt =
-                                             (match arg with
-                                             | Labelled s | Optional s -> s
-                                             | Nolabel ->
-                                               "arg"
-                                               ^ string_of_int (arity - i - 1));
-                                           loc;
-                                         })
-                                      obj )));
-                      ];
-                  ]))
-      else normal ())
+      if not no_inline_cross_module then external_result
+      else
+        let open Ast_helper in
+        Str.include_ ~loc
+          (Incl.mk ~loc
+             (Mod.constraint_ ~loc
+                (Mod.structure ~loc [external_result])
+                (Mty.signature ~loc
+                   [
+                     {
+                       psig_desc =
+                         Psig_value
+                           {
+                             prim with
+                             pval_type;
+                             pval_prim = [];
+                             pval_attributes;
+                           };
+                       psig_loc = loc;
+                     };
+                   ]))))
diff --git a/jscomp/frontend/ast_external_process.ml b/jscomp/frontend/ast_external_process.ml
@@ -222,7 +222,6 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
     (prim_attributes : Ast_attributes.t) : Ast_attributes.t * external_desc =
   (* shared by `[@@val]`, `[@@send]`,
      `[@@set]`, `[@@get]` , `[@@new]`
-     `[@@bs.send.pipe]` does not use it
   *)
   let name_from_payload_or_prim ~loc (payload : Parsetree.payload) :
       bundle_source =
