Remove processing of @bs which is from ocaml.

Author: cristianoc

CHANGELOG.md

@@ -67,6 +67,7 @@
 - Remove `@@uncurried.swap`, which was used for internal tests. https://github.com/rescript-lang/rescript-compiler/pull/6875
 - Build the compiler libraries/tests in uncurried mode. https://github.com/rescript-lang/rescript-compiler/pull/6864
 - Ignore `-uncurried` command-line flag. https://github.com/rescript-lang/rescript-compiler/pull/6885
+- Cleanup: remove tracking of uncurried state in parser/printer. https://github.com/rescript-lang/rescript-compiler/pull/6888
 
 #### :nail_care: Polish
 

jscomp/frontend/ast_attributes.ml

@@ -74,21 +74,15 @@ let process_method_attributes_rev (attrs : t) =
         ({st with set = Some result}, acc)
       | _ -> (st, attr :: acc))
 
-type attr_kind =
-  | Nothing
-  | Meth_callback of attr
-  | Uncurry of attr
-  | Method of attr
+type attr_kind = Nothing | Meth_callback of attr | Method of attr
 
 let process_attributes_rev (attrs : t) : attr_kind * t =
   Ext_list.fold_left attrs (Nothing, [])
     (fun (st, acc) (({txt; loc}, _) as attr) ->
       match (txt, st) with
-      | "bs", (Nothing | Uncurry _) ->
-        (Uncurry attr, acc) (* TODO: warn unused/duplicated attribute *)
       | "this", (Nothing | Meth_callback _) -> (Meth_callback attr, acc)
       | "meth", (Nothing | Method _) -> (Method attr, acc)
-      | ("bs" | "this"), _ -> Bs_syntaxerr.err loc Conflict_bs_bs_this_bs_meth
+      | "this", _ -> Bs_syntaxerr.err loc Conflict_bs_bs_this_bs_meth
       | _, _ -> (st, attr :: acc))
 
 let process_bs (attrs : t) =

jscomp/frontend/ast_attributes.mli

@@ -29,11 +29,7 @@ type ('a, 'b) st = {get: 'a option; set: 'b option}
 
 val process_method_attributes_rev : t -> (bool * bool, [`Get | `No_get]) st * t
 
-type attr_kind =
-  | Nothing
-  | Meth_callback of attr
-  | Uncurry of attr
-  | Method of attr
+type attr_kind = Nothing | Meth_callback of attr | Method of attr
 
 val process_attributes_rev : t -> attr_kind * t
 
@@ -47,7 +43,7 @@ val has_async_payload : t -> attr option
 type derive_attr = {bs_deriving: Ast_payload.action list option} [@@unboxed]
 
 val iter_process_bs_string_int_unwrap_uncurry :
-  t -> [`Nothing | `String | `Int | `Ignore | `Unwrap | `Uncurry of int option]
+  t -> [`Nothing | `String | `Int | `Ignore | `Unwrap]
 
 val iter_process_bs_string_as : t -> string option
 

jscomp/frontend/ast_core_type_class_type.ml

@@ -80,7 +80,6 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
    ptyp_loc = loc;
   } -> (
     match fst (Ast_attributes.process_attributes_rev ptyp_attributes) with
-    | Uncurry _ -> Ast_typ_uncurry.to_uncurry_type loc self label args body
     | Meth_callback _ ->
       Ast_typ_uncurry.to_method_callback_type loc self label args body
     | Method _ ->
@@ -100,7 +99,6 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
               let attrs, core_type =
                 match Ast_attributes.process_attributes_rev attrs with
                 | Nothing, attrs -> (attrs, ty) (* #1678 *)
-                | Uncurry attr, attrs -> (attrs, attr +> ty)
                 | Method _, _ ->
                   Location.raise_errorf ~loc "%@get/set conflicts with %@meth"
                 | Meth_callback attr, attrs -> (attrs, attr +> ty)
@@ -111,7 +109,6 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
               let attrs, core_type =
                 match Ast_attributes.process_attributes_rev attrs with
                 | Nothing, attrs -> (attrs, ty)
-                | Uncurry attr, attrs -> (attrs, attr +> ty)
                 | Method _, _ ->
                   Location.raise_errorf ~loc "%@get/set conflicts with %@meth"
                 | Meth_callback attr, attrs -> (attrs, attr +> ty)
@@ -124,7 +121,6 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
               let attrs, core_type =
                 match Ast_attributes.process_attributes_rev ptyp_attrs with
                 | Nothing, attrs -> (attrs, ty)
-                | Uncurry attr, attrs -> (attrs, attr +> ty)
                 | Method attr, attrs -> (attrs, attr +> ty)
                 | Meth_callback attr, attrs -> (attrs, attr +> ty)
               in

jscomp/frontend/ast_external_process.ml

@@ -66,21 +66,6 @@ let spec_of_ptyp (nolabel : bool) (ptyp : Parsetree.core_type) :
       Unwrap
     (* Unwrap attribute can only be attached to things like `[a of a0 | b of b0]` *)
     | _ -> Bs_syntaxerr.err ptyp.ptyp_loc Invalid_bs_unwrap_type)
-  | `Uncurry opt_arity -> (
-    let real_arity =
-      if Ast_uncurried.core_type_is_uncurried_fun ptyp then
-        let arity, _ = Ast_uncurried.core_type_extract_uncurried_fun ptyp in
-        Some arity
-      else Ast_core_type.get_uncurry_arity ptyp
-    in
-    match (opt_arity, real_arity) with
-    | Some arity, None -> Fn_uncurry_arity arity
-    | None, None -> Bs_syntaxerr.err ptyp.ptyp_loc Canot_infer_arity_by_syntax
-    | None, Some arity -> Fn_uncurry_arity arity
-    | Some arity, Some n ->
-      if n <> arity then
-        Bs_syntaxerr.err ptyp.ptyp_loc (Inconsistent_arity (arity, n))
-      else Fn_uncurry_arity arity)
   | `Nothing -> (
     match ptyp_desc with
     | Ptyp_constr ({txt = Lident "unit"; _}, []) ->

jscomp/frontend/bs_builtin_ppx.ml

@@ -138,10 +138,6 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       async_context := (old_in_function_def && !async_context) || async;
       in_function_def := true;
       Ast_async.make_function_async ~async (default_expr_mapper self e)
-    | Uncurry _, pexp_attributes ->
-      async_context := async;
-      Ast_uncurry_gen.to_uncurry_fn {e with pexp_attributes} self label pat body
-        async
     | Method _, _ ->
       Location.raise_errorf ~loc:e.pexp_loc
         "%@meth is not supported in function expression"