Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove bs send pipe #6858

Merged
merged 3 commits into from
Jul 8, 2024
Merged

Remove bs send pipe #6858

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
7e04768
Remove `@bs.send.pipe`.
cristianoc Jul 5, 2024
54ca0bd
Remove uses of `@bs.send.pipe` in tests.
cristianoc Jul 5, 2024
47c0b70
Remove support for `@bs.send.pipe` from the compiler.
cristianoc Jul 5, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
28 changes: 0 additions & 28 deletions jscomp/frontend/ast_attributes.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 0 additions & 2 deletions jscomp/frontend/ast_attributes.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
8 changes: 0 additions & 8 deletions jscomp/frontend/ast_core_type.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 = {
Expand Down
2 changes: 0 additions & 2 deletions jscomp/frontend/ast_core_type.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
171 changes: 43 additions & 128 deletions jscomp/frontend/ast_external.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 :: _ ->
Expand All @@ -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;
};
]))))
1 change: 0 additions & 1 deletion jscomp/frontend/ast_external_process.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
Loading