Remove res partial (#7240)

* Add partial flag to untyped and typed AST node and prepare to remove `@res.partial`.

* Remove `@res.partial` entirely.

* Update CHANGELOG.md

Author: cristianoc

CHANGELOG.md

@@ -24,6 +24,7 @@
 - AST cleanup: Prepare for ast async cleanup: Refactor code for "@res.async" payload handling and clean up handling of type and term parameters, so that now each `=>` in a function definition corresponds to a function. https://github.com/rescript-lang/rescript/pull/7223
 - AST: always put type parameters first in function definitions. https://github.com/rescript-lang/rescript/pull/7233
 - AST cleanup: Remove `@res.async` attribute from the internal representation, and add a flag to untyped and typed ASTs instead. https://github.com/rescript-lang/rescript/pull/7234
+- AST cleanup: Remove `@res.partial` attribute from the internal representation, and add a flag to untyped and typed ASTs instead. https://github.com/rescript-lang/rescript/pull/7238 https://github.com/rescript-lang/rescript/pull/7240
 
 # 12.0.0-alpha.7
 

analysis/src/CompletionFrontEnd.ml

@@ -262,12 +262,14 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
             pexp_loc;
             pexp_attributes;
           };
-        args = [(_, lhs); (_, {pexp_desc = Pexp_apply {funct = d; args}})];
+        args =
+          [(_, lhs); (_, {pexp_desc = Pexp_apply {funct = d; args; partial}})];
       } ->
     (* Transform away pipe with apply call *)
     exprToContextPath
       {
-        pexp_desc = Pexp_apply {funct = d; args = (Nolabel, lhs) :: args};
+        pexp_desc =
+          Pexp_apply {funct = d; args = (Nolabel, lhs) :: args; partial};
         pexp_loc;
         pexp_attributes;
       }
@@ -278,6 +280,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
           [
             (_, lhs); (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes});
           ];
+        partial;
       } ->
     (* Transform away pipe with identifier *)
     exprToContextPath
@@ -287,6 +290,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
             {
               funct = {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes};
               args = [(Nolabel, lhs)];
+              partial;
             };
         pexp_loc;
         pexp_attributes;

compiler/frontend/ast_compatible.ml

@@ -40,22 +40,28 @@ let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression)
     pexp_attributes = attrs;
     pexp_desc =
       Pexp_apply
-        {funct = fn; args = Ext_list.map args (fun x -> (Asttypes.Nolabel, x))};
+        {
+          funct = fn;
+          args = Ext_list.map args (fun x -> (Asttypes.Nolabel, x));
+          partial = false;
+        };
   }
 
 let app1 ?(loc = default_loc) ?(attrs = []) fn arg1 : expression =
   {
     pexp_loc = loc;
     pexp_attributes = attrs;
-    pexp_desc = Pexp_apply {funct = fn; args = [(Nolabel, arg1)]};
+    pexp_desc =
+      Pexp_apply {funct = fn; args = [(Nolabel, arg1)]; partial = false};
   }
 
 let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression =
   {
     pexp_loc = loc;
     pexp_attributes = attrs;
     pexp_desc =
-      Pexp_apply {funct = fn; args = [(Nolabel, arg1); (Nolabel, arg2)]};
+      Pexp_apply
+        {funct = fn; args = [(Nolabel, arg1); (Nolabel, arg2)]; partial = false};
   }
 
 let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression =
@@ -64,7 +70,11 @@ let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression =
     pexp_attributes = attrs;
     pexp_desc =
       Pexp_apply
-        {funct = fn; args = [(Nolabel, arg1); (Nolabel, arg2); (Nolabel, arg3)]};
+        {
+          funct = fn;
+          args = [(Nolabel, arg1); (Nolabel, arg2); (Nolabel, arg3)];
+          partial = false;
+        };
   }
 
 let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp =
@@ -108,6 +118,7 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn
         {
           funct = fn;
           args = Ext_list.map args (fun (l, a) -> (Asttypes.Labelled l, a));
+          partial = false;
         };
   }
 

compiler/frontend/ast_exp_apply.ml

@@ -88,10 +88,11 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
       {f with pexp_desc = Pexp_variant (label, Some a); pexp_loc = e.pexp_loc}
     | Pexp_construct (ctor, None) ->
       {f with pexp_desc = Pexp_construct (ctor, Some a); pexp_loc = e.pexp_loc}
-    | Pexp_apply {funct = fn1; args} ->
+    | Pexp_apply {funct = fn1; args; partial} ->
       Bs_ast_invariant.warn_discarded_unused_attributes fn1.pexp_attributes;
       {
-        pexp_desc = Pexp_apply {funct = fn1; args = (Nolabel, a) :: args};
+        pexp_desc =
+          Pexp_apply {funct = fn1; args = (Nolabel, a) :: args; partial};
         pexp_loc = e.pexp_loc;
         pexp_attributes = e.pexp_attributes @ f.pexp_attributes;
       }
@@ -116,6 +117,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
                              {
                                funct = fn;
                                args = (Nolabel, bounded_obj_arg) :: args;
+                               partial = false;
                              };
                          pexp_attributes = [];
                          pexp_loc = fn.pexp_loc;

compiler/frontend/ast_uncurry_gen.ml

@@ -74,4 +74,5 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label
                  }
                  [Typ.any ~loc ()]) );
         ];
+      partial = false;
     }

compiler/frontend/bs_ast_mapper.ml

@@ -320,8 +320,9 @@ module E = struct
       fun_ ~loc ~attrs ~arity ~async lab
         (map_opt (sub.expr sub) def)
         (sub.pat sub p) (sub.expr sub e)
-    | Pexp_apply {funct = e; args = l} ->
-      apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l)
+    | Pexp_apply {funct = e; args = l; partial} ->
+      apply ~loc ~attrs ~partial (sub.expr sub e)
+        (List.map (map_snd (sub.expr sub)) l)
     | Pexp_match (e, pel) ->
       match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
     | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)

compiler/ml/ast_helper.ml

@@ -154,7 +154,8 @@ module Exp = struct
   let fun_ ?loc ?attrs ?(async = false) ~arity a b c d =
     mk ?loc ?attrs
       (Pexp_fun {arg_label = a; default = b; lhs = c; rhs = d; arity; async})
-  let apply ?loc ?attrs funct args = mk ?loc ?attrs (Pexp_apply {funct; args})
+  let apply ?loc ?attrs ?(partial = false) funct args =
+    mk ?loc ?attrs (Pexp_apply {funct; args; partial})
   let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))
   let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b))
   let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a)

compiler/ml/ast_helper.mli

@@ -148,6 +148,7 @@ module Exp : sig
   val apply :
     ?loc:loc ->
     ?attrs:attrs ->
+    ?partial:bool ->
     expression ->
     (arg_label * expression) list ->
     expression

compiler/ml/ast_mapper.ml

@@ -283,8 +283,9 @@ module E = struct
       fun_ ~loc ~attrs ~arity ~async lab
         (map_opt (sub.expr sub) def)
         (sub.pat sub p) (sub.expr sub e)
-    | Pexp_apply {funct = e; args = l} ->
-      apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l)
+    | Pexp_apply {funct = e; args = l; partial} ->
+      apply ~loc ~attrs ~partial (sub.expr sub e)
+        (List.map (map_snd (sub.expr sub)) l)
     | Pexp_match (e, pel) ->
       match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
     | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)

compiler/ml/ast_mapper_from0.ml

@@ -310,7 +310,18 @@ module E = struct
         (sub.pat sub p) (sub.expr sub e)
     | Pexp_function _ -> assert false
     | Pexp_apply (e, l) ->
-      apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l)
+      let process_partial_app_attribute attrs =
+        let rec process partial_app acc attrs =
+          match attrs with
+          | [] -> (partial_app, List.rev acc)
+          | ({Location.txt = "res.partial"}, _) :: rest -> process true acc rest
+          | attr :: rest -> process partial_app (attr :: acc) rest
+        in
+        process false [] attrs
+      in
+      let partial, attrs = process_partial_app_attribute attrs in
+      apply ~loc ~attrs ~partial (sub.expr sub e)
+        (List.map (map_snd (sub.expr sub)) l)
     | Pexp_match (e, pel) ->
       match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
     | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)

compiler/ml/ast_mapper_to0.ml

@@ -325,7 +325,11 @@ module E = struct
           ~attrs:(arity_to_attributes arity)
           (Location.mkloc (Longident.Lident "Function$") e.pexp_loc)
           (Some e))
-    | Pexp_apply {funct = e; args = l} ->
+    | Pexp_apply {funct = e; args = l; partial} ->
+      let attrs =
+        if partial then (Location.mknoloc "res.partial", Pt.PStr []) :: attrs
+        else []
+      in
       apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l)
     | Pexp_match (e, pel) ->
       match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)

compiler/ml/parsetree.ml

@@ -242,7 +242,11 @@ and expression_desc =
        - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun.
        - "let f P = E" is represented using Pexp_fun.
     *)
-  | Pexp_apply of {funct: expression; args: (arg_label * expression) list}
+  | Pexp_apply of {
+      funct: expression;
+      args: (arg_label * expression) list;
+      partial: bool;
+    }
     (* E0 ~l1:E1 ... ~ln:En
        li can be empty (non labeled argument) or start with '?'
        (optional argument).

compiler/ml/pprintast.ml

@@ -631,7 +631,7 @@ and expression ctxt f x =
       (*   rec_flag rf *)
       pp f "@[<2>%a in@;<1 -2>%a@]" (bindings reset_ctxt) (rf, l)
         (expression ctxt) e
-    | Pexp_apply {funct = e; args = l} -> (
+    | Pexp_apply {funct = e; args = l; partial} -> (
       if not (sugar_expr ctxt f x) then
         match view_fixity_of_exp e with
         | `Infix s -> (
@@ -667,14 +667,15 @@ and expression ctxt f x =
               (list (label_x_expression_param ctxt))
               l)
         | _ ->
-          pp f "@[<hov2>%a@]"
+          let partial_str = if partial then " ..." else "" in
+          pp f "@[<hov2>%a%s@]"
             (fun f (e, l) ->
               pp f "%a@ %a" (expression2 ctxt) e
                 (list (label_x_expression_param reset_ctxt))
                 l)
               (* reset here only because [function,match,try,sequence]
                  are lower priority *)
-            (e, l))
+            (e, l) partial_str)
     | Pexp_construct (li, Some eo) when not (is_simple_construct (view_expr x))
       -> (
       (* Not efficient FIXME*)

compiler/ml/printast.ml

@@ -250,8 +250,9 @@ and expression i ppf x =
     option i expression ppf eo;
     pattern i ppf p;
     expression i ppf e
-  | Pexp_apply {funct = e; args = l} ->
+  | Pexp_apply {funct = e; args = l; partial} ->
     line i ppf "Pexp_apply\n";
+    if partial then line i ppf "partial\n";
     expression i ppf e;
     list i label_x_expression ppf l
   | Pexp_match (e, l) ->

compiler/ml/printtyped.ml

@@ -295,7 +295,8 @@ and expression i ppf x =
     line i ppf "%a" Ident.print param;
     arg_label i ppf p;
     case i ppf case_
-  | Texp_apply {funct = e; args = l} ->
+  | Texp_apply {funct = e; args = l; partial} ->
+    if partial then line i ppf "partial\n";
     line i ppf "Texp_apply\n";
     expression i ppf e;
     list i label_x_expression ppf l

compiler/ml/tast_mapper.ml

@@ -202,11 +202,12 @@ let expr sub x =
     | Texp_function {arg_label; arity; param; case; partial; async} ->
       Texp_function
         {arg_label; arity; param; case = sub.case sub case; partial; async}
-    | Texp_apply {funct = exp; args = list} ->
+    | Texp_apply {funct = exp; args = list; partial} ->
       Texp_apply
         {
           funct = sub.expr sub exp;
           args = List.map (tuple2 id (opt (sub.expr sub))) list;
+          partial;
         }
     | Texp_match (exp, cases, exn_cases, p) ->
       Texp_match

compiler/ml/translcore.ml

@@ -760,17 +760,14 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
       | Plazyforce, [a] -> wrap (Matching.inline_lazy_force a e.exp_loc)
       | Plazyforce, _ -> assert false
       | _ -> wrap (Lprim (prim, argl, e.exp_loc))))
-  | Texp_apply {funct; args = oargs} ->
+  | Texp_apply {funct; args = oargs; partial} ->
     let inlined, funct =
       Translattribute.get_and_remove_inlined_attribute funct
     in
     let uncurried_partial_application =
       (* In case of partial application foo(args, ...) when some args are missing,
          get the arity *)
-      let uncurried_partial_app =
-        Ext_list.exists e.exp_attributes (fun ({txt}, _) -> txt = "res.partial")
-      in
-      if uncurried_partial_app then
+      if partial then
         let arity_opt = Ctype.get_arity funct.exp_env funct.exp_type in
         match arity_opt with
         | Some arity ->

compiler/ml/typecore.ml

@@ -2420,7 +2420,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
     type_function ?in_function ~arity ~async loc sexp.pexp_attributes env
       ty_expected l
       [Ast_helper.Exp.case spat sbody]
-  | Pexp_apply {funct = sfunct; args = sargs} ->
+  | Pexp_apply {funct = sfunct; args = sargs; partial} ->
     assert (sargs <> []);
     begin_def ();
     (* one more level for non-returning functions *)
@@ -2429,11 +2429,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
     end_def ();
     wrap_trace_gadt_instances env (lower_args env []) ty;
     begin_def ();
-    let total_app =
-      not
-      @@ Ext_list.exists sexp.pexp_attributes (fun ({txt}, _) ->
-             txt = "res.partial")
-    in
+    let total_app = not partial in
     let type_clash_context = type_clash_context_from_function sexp sfunct in
     let args, ty_res, fully_applied =
       match translate_unified_ops env funct sargs with
@@ -2446,7 +2442,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
     let mk_apply funct args =
       rue
         {
-          exp_desc = Texp_apply {funct; args};
+          exp_desc = Texp_apply {funct; args; partial};
           exp_loc = loc;
           exp_extra = [];
           exp_type = ty_res;

compiler/ml/typedtree.ml

@@ -87,6 +87,7 @@ and expression_desc =
   | Texp_apply of {
       funct: expression;
       args: (arg_label * expression option) list;
+      partial: bool;
     }
   | Texp_match of expression * case list * case list * partial
   | Texp_try of expression * case list

compiler/ml/typedtree.mli

@@ -151,6 +151,7 @@ and expression_desc =
   | Texp_apply of {
       funct: expression;
       args: (arg_label * expression option) list;
+      partial: bool;
     }
       (** E0 ~l1:E1 ... ~ln:En