Cleanup: remove tracking of uncurried state in parser/printer.

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/ext/config.ml

@@ -11,8 +11,6 @@ let bs_only = ref true
 
 let unsafe_empty_array = ref false
 
-type uncurried = Legacy | Uncurried
-
 let cmi_magic_number = "Caml1999I022"
 
 and ast_impl_magic_number = "Caml1999M022"

jscomp/ext/config.mli

@@ -41,5 +41,3 @@ val cmt_magic_number : string
 (* Magic number for compiled interface files *)
 
 val print_config : out_channel -> unit
-
-type uncurried = Legacy | Uncurried

jscomp/frontend/ast_attributes.ml

@@ -74,28 +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
-      | _, _ -> (st, attr :: acc))
-
-let process_bs (attrs : t) =
-  Ext_list.fold_left attrs (false, [])
-    (fun (st, acc) (({txt; loc = _}, _) as attr) ->
-      match (txt, st) with
-      | "bs", _ -> (true, acc)
+      | "this", _ -> Bs_syntaxerr.err loc Conflict_bs_bs_this_bs_meth
       | _, _ -> (st, attr :: acc))
 
 let external_attrs =
@@ -287,10 +274,6 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
   !st
 
 let locg = Location.none
-(* let bs : attr
-   =  {txt = "bs" ; loc = locg}, Ast_payload.empty *)
-
-let res_uapp : attr = ({txt = "res.uapp"; loc = locg}, Ast_payload.empty)
 
 let get : attr = ({txt = "get"; loc = locg}, Ast_payload.empty)
 

jscomp/frontend/ast_attributes.mli

@@ -29,16 +29,10 @@ 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
 
-val process_bs : t -> bool * t
-
 val has_inline_payload : t -> attr option
 
 val has_await_payload : t -> attr option
@@ -47,7 +41,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
 
@@ -60,9 +54,6 @@ val iter_process_bs_string_or_int_as : t -> as_const_payload option
 
 val process_derive_type : t -> derive_attr * t
 
-(* Attribute for uncurried application coming from the ReScript parser *)
-val res_uapp : attr
-
 val get : attr
 
 val get_index : attr

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_exp_apply.ml

@@ -73,19 +73,14 @@ let infix_ops = ["|."; "|.u"; "#="; "##"]
 
 let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
   match view_as_app e infix_ops with
-  | Some {op = ("|." | "|.u") as op; args = [a_; f_]; loc} -> (
+  | Some {op = "|." | "|.u"; args = [a_; f_]; loc} -> (
     (*
         a |. f
         a |. f b c [@bs]  --> f a b c [@bs]
         a |. (g |. b)
         a |. `Variant
         a |. (b |. f c [@bs])
       *)
-    let add_uncurried_attr attrs =
-      if op = "|.u" && not (List.mem Ast_attributes.res_uapp attrs) then
-        Ast_attributes.res_uapp :: attrs
-      else attrs
-    in
     let a = self.expr self a_ in
     let f = self.expr self f_ in
     match f.pexp_desc with
@@ -98,8 +93,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
       {
         pexp_desc = Pexp_apply (fn1, (Nolabel, a) :: args);
         pexp_loc = e.pexp_loc;
-        pexp_attributes =
-          add_uncurried_attr (e.pexp_attributes @ f.pexp_attributes);
+        pexp_attributes = e.pexp_attributes @ f.pexp_attributes;
       }
     | Pexp_tuple xs ->
       bound a (fun bounded_obj_arg ->
@@ -119,18 +113,15 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
                        {
                          Parsetree.pexp_desc =
                            Pexp_apply (fn, (Nolabel, bounded_obj_arg) :: args);
-                         pexp_attributes = add_uncurried_attr [];
+                         pexp_attributes = [];
                          pexp_loc = fn.pexp_loc;
                        }
                      | _ ->
-                       Ast_compatible.app1 ~loc:fn.pexp_loc
-                         ~attrs:(add_uncurried_attr []) fn bounded_obj_arg));
+                       Ast_compatible.app1 ~loc:fn.pexp_loc fn bounded_obj_arg));
             pexp_attributes = f.pexp_attributes;
             pexp_loc = f.pexp_loc;
           })
-    | _ ->
-      Ast_compatible.app1 ~loc ~attrs:(add_uncurried_attr e.pexp_attributes) f a
-    )
+    | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a)
   | Some {op = "##"; loc; args = [obj; rest]} -> (
     (* - obj##property
        - obj#(method a b )
@@ -173,7 +164,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
       let arg = self.expr self arg in
       let fn = Exp.send ~loc obj {txt = name ^ Literals.setter_suffix; loc} in
       Exp.constraint_ ~loc
-        (Exp.apply ~loc ~attrs:[Ast_attributes.res_uapp] fn [(Nolabel, arg)])
+        (Exp.apply ~loc fn [(Nolabel, arg)])
         (Ast_literal.type_unit ~loc ())
     in
     match obj.pexp_desc with

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_ast_invariant.ml

@@ -28,8 +28,8 @@
 *)
 let is_bs_attribute txt =
   match txt with
-  | "as" | "bs" | "config" | "ignore" | "int" | "optional" | "string"
-  | "uncurry" | "unwrap" ->
+  | "as" | "config" | "ignore" | "int" | "optional" | "string" | "uncurry"
+  | "unwrap" ->
     true
   | _ -> false
 

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"

jscomp/ml/typecore.ml

@@ -2146,8 +2146,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty
       wrap_trace_gadt_instances env (lower_args env []) ty;
       begin_def ();
       let uncurried =
-        Ext_list.exists sexp.pexp_attributes (fun ({txt },_) -> txt = "res.uapp")
-        && not @@ Ext_list.exists sexp.pexp_attributes (fun ({txt },_) -> txt = "res.partial")
+        not @@ Ext_list.exists sexp.pexp_attributes (fun ({txt },_) -> txt = "res.partial")
         && not @@ is_automatic_curried_application env funct in
       let type_clash_context = type_clash_context_from_function sexp sfunct in
       let (args, ty_res, fully_applied) = type_application ?type_clash_context uncurried env funct sargs in