Remove Function$ entirely.

CHANGELOG.md

@@ -28,6 +28,8 @@
 - AST cleanup: Remove Pexp_function from the AST. https://github.com/rescript-lang/rescript/pull/7198
 - Remove unused code from Location and Rescript_cpp modules. https://github.com/rescript-lang/rescript/pull/7150
 - Build with OCaml 5.2.1. https://github.com/rescript-lang/rescript-compiler/pull/7201
+- AST cleanup: Remove `Function$` entirely for function definitions. https://github.com/rescript-lang/rescript/pull/7200
+
 
 # 12.0.0-alpha.5
 

analysis/reanalyze/src/Arnold.ml

@@ -545,7 +545,7 @@ module FindFunctionsCalled = struct
   let findCallees (expression : Typedtree.expression) =
     let isFunction =
       match expression.exp_desc with
-      | Texp_function _ -> true
+      | Texp_function {arity = None} -> true
       | _ -> false
     in
     let callees = ref StringSet.empty in

analysis/src/CompletionFrontEnd.ml

@@ -1093,7 +1093,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
           (* Ignore list expressions, used in JSX, unit, and more *) ()
         | Pexp_construct (lid, eOpt) -> (
           let lidPath = flattenLidCheckDot lid in
-          if debug && lid.txt <> Lident "Function$" then
+          if debug then
             Printf.printf "Pexp_construct %s:%s %s\n"
               (lidPath |> String.concat "\n")
               (Loc.toString lid.loc)

analysis/src/Hint.ml

@@ -60,7 +60,8 @@ let inlay ~path ~pos ~maxLength ~debug =
            ( Pexp_constant _ | Pexp_tuple _ | Pexp_record _ | Pexp_variant _
            | Pexp_apply _ | Pexp_match _ | Pexp_construct _ | Pexp_ifthenelse _
            | Pexp_array _ | Pexp_ident _ | Pexp_try _ | Pexp_lazy _
-           | Pexp_send _ | Pexp_field _ | Pexp_open _ );
+           | Pexp_send _ | Pexp_field _ | Pexp_open _
+           | Pexp_fun (_, _, _, _, Some _) );
        };
     } ->
       push vb.pvb_pat.ppat_loc Type
@@ -125,12 +126,7 @@ let codeLens ~path ~debug =
     (match vb with
     | {
      pvb_pat = {ppat_desc = Ppat_var _; ppat_loc};
-     pvb_expr =
-       {
-         pexp_desc =
-           Pexp_construct
-             ({txt = Lident "Function$"}, Some {pexp_desc = Pexp_fun _});
-       };
+     pvb_expr = {pexp_desc = Pexp_fun _};
     } ->
       push ppat_loc
     | _ -> ());

analysis/src/Xform.ml

@@ -303,10 +303,7 @@ module AddTypeAnnotation = struct
     in
     let rec processFunction ~argNum (e : Parsetree.expression) =
       match e.pexp_desc with
-      | Pexp_fun (argLabel, _, pat, e, _)
-      | Pexp_construct
-          ( {txt = Lident "Function$"},
-            Some {pexp_desc = Pexp_fun (argLabel, _, pat, e, _)} ) ->
+      | Pexp_fun (argLabel, _, pat, e, _) ->
         let isUnlabeledOnlyArg =
           argNum = 1 && argLabel = Nolabel
           &&

compiler/frontend/ast_derive_js_mapper.ml

@@ -169,7 +169,7 @@ let init () =
               in
               let to_js_body body =
                 Ast_comb.single_non_rec_value pat_to_js
-                  (Ast_uncurried.uncurried_fun ~loc:Location.none ~arity:1
+                  (Ast_uncurried.uncurried_fun ~arity:1
                      (Ast_compatible.fun_ ~arity:None
                         (Pat.constraint_ (Pat.var pat_param) core_type)
                         body))
@@ -214,7 +214,7 @@ let init () =
                 in
                 let from_js =
                   Ast_comb.single_non_rec_value pat_from_js
-                    (Ast_uncurried.uncurried_fun ~loc:Location.none ~arity:1
+                    (Ast_uncurried.uncurried_fun ~arity:1
                        (Ast_compatible.fun_ ~arity:(Some 1) (Pat.var pat_param)
                           (if create_type then
                              Exp.let_ Nonrecursive
@@ -260,7 +260,7 @@ let init () =
                            app2 unsafe_index_get_exp exp_map exp_param
                          else app1 erase_type_exp exp_param);
                       Ast_comb.single_non_rec_value pat_from_js
-                        (Ast_uncurried.uncurried_fun ~loc:Location.none ~arity:1
+                        (Ast_uncurried.uncurried_fun ~arity:1
                            (Ast_compatible.fun_ ~arity:(Some 1)
                               (Pat.var pat_param)
                               (let result =

compiler/frontend/ast_derive_projector.ml

@@ -20,9 +20,9 @@ let init () =
       {
         structure_gen =
           (fun (tdcls : tdcls) _explict_nonrec ->
-            let handle_uncurried_accessor_tranform ~loc ~arity accessor =
+            let handle_uncurried_accessor_tranform ~arity accessor =
               (* Accessors with no params (arity of 0) are simply values and not functions *)
-              if arity > 0 then Ast_uncurried.uncurried_fun ~loc ~arity accessor
+              if arity > 0 then Ast_uncurried.uncurried_fun ~arity accessor
               else accessor
             in
             let handle_tdcl tdcl =
@@ -52,7 +52,7 @@ let init () =
                             (Exp.ident {txt = Lident txt; loc})
                             {txt = Longident.Lident pld_label; loc})
                       (*arity will alwys be 1 since these are single param functions*)
-                      |> handle_uncurried_accessor_tranform ~arity:1 ~loc))
+                      |> handle_uncurried_accessor_tranform ~arity:1))
               | Ptype_variant constructor_declarations ->
                 Ext_list.map constructor_declarations
                   (fun
@@ -108,10 +108,10 @@ let init () =
                              annotate_type
                          in
                          Ext_list.fold_right vars exp (fun var b ->
-                             Ast_compatible.fun_ ~arity:(Some 1)
+                             Ast_compatible.fun_ ~arity:None
                                (Pat.var {loc; txt = var})
                                b)
-                         |> handle_uncurried_accessor_tranform ~loc ~arity))
+                         |> handle_uncurried_accessor_tranform ~arity))
               | Ptype_abstract | Ptype_open ->
                 Ast_derive_util.not_applicable tdcl.ptype_loc deriving_name;
                 []

compiler/frontend/bs_builtin_ppx.ml

@@ -110,18 +110,6 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
   | Pexp_constant (Pconst_integer (s, Some 'l')) ->
     {e with pexp_desc = Pexp_constant (Pconst_integer (s, None))}
   (* End rewriting *)
-  | _
-    when Ast_uncurried.expr_is_uncurried_fun e
-         &&
-         match
-           Ast_attributes.process_attributes_rev
-             (Ast_uncurried.expr_extract_uncurried_fun e).pexp_attributes
-         with
-         | Meth_callback _, _ -> true
-         | _ -> false ->
-    (* Treat @this (. x, y, z) => ... just like @this (x, y, z) => ... *)
-    let fun_expr = Ast_uncurried.expr_extract_uncurried_fun e in
-    self.expr self fun_expr
   | Pexp_newtype (s, body) ->
     let async = Ast_attributes.has_async_payload e.pexp_attributes <> None in
     let body = Ast_async.add_async_attribute ~async body in

compiler/gentype/TranslateStructure.ml

@@ -18,9 +18,6 @@ let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression)
       else a_name
     in
     {a_name; a_type} :: next_types1
-  | Texp_construct ({txt = Lident "Function$"}, _, [fun_expr]), _, _ ->
-    (* let uncurried1: function$<_, _> = Function$(x => x |> string_of_int, [`Has_arity1]) *)
-    addAnnotationsToTypes_ ~config ~expr:fun_expr arg_types
   | Texp_apply ({exp_desc = Texp_ident (path, _, _)}, [(_, Some expr1)]), _, _
     -> (
     match path |> TranslateTypeExprFromTypes.path_to_list |> List.rev with

compiler/ml/ast_mapper_from0.ml

@@ -321,14 +321,7 @@ module E = struct
         match arg1 with
         | Some ({pexp_desc = Pexp_fun (l, eo, p, e, _)} as e1) ->
           let arity = attributes_to_arity attrs in
-          {
-            e1 with
-            pexp_desc =
-              Pexp_construct
-                ( lid1,
-                  Some {e with pexp_desc = Pexp_fun (l, eo, p, e, Some arity)}
-                );
-          }
+          {e1 with pexp_desc = Pexp_fun (l, eo, p, e, Some arity)}
         | _ -> exp1)
       | _ -> exp1)
     | Pexp_variant (lab, eo) ->

compiler/ml/ast_mapper_to0.ml

@@ -283,41 +283,38 @@ module E = struct
     | Pexp_constant x -> constant ~loc ~attrs (map_constant x)
     | Pexp_let (r, vbs, e) ->
       let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
-    | Pexp_fun (lab, def, p, e, _) ->
-      fun_ ~loc ~attrs lab
-        (map_opt (sub.expr sub) def)
-        (sub.pat sub p) (sub.expr sub e)
+    | Pexp_fun (lab, def, p, e, arity) -> (
+      let e =
+        fun_ ~loc ~attrs lab
+          (map_opt (sub.expr sub) def)
+          (sub.pat sub p) (sub.expr sub e)
+      in
+      match arity with
+      | None -> e
+      | Some arity ->
+        let arity_to_attributes arity =
+          [
+            ( Location.mknoloc "res.arity",
+              Parsetree0.PStr
+                [
+                  Ast_helper0.Str.eval
+                    (Ast_helper0.Exp.constant
+                       (Pconst_integer (string_of_int arity, None)));
+                ] );
+          ]
+        in
+        Ast_helper0.Exp.construct
+          ~attrs:(arity_to_attributes arity)
+          (Location.mkloc (Longident.Lident "Function$") e.pexp_loc)
+          (Some e))
     | Pexp_apply (e, l) ->
       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)
     | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
     | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el)
-    | Pexp_construct (lid, arg) -> (
-      let exp0 =
-        construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
-      in
-      match lid.txt with
-      | Lident "Function$" -> (
-        match arg with
-        | Some {pexp_desc = Pexp_fun (_, _, _, _, Some arity)} ->
-          let arity_to_attributes arity =
-            [
-              ( Location.mknoloc "res.arity",
-                Parsetree0.PStr
-                  [
-                    Ast_helper0.Str.eval
-                      (Ast_helper0.Exp.constant
-                         (Pconst_integer (string_of_int arity, None)));
-                  ] );
-            ]
-          in
-          {
-            exp0 with
-            pexp_attributes = arity_to_attributes arity @ exp0.pexp_attributes;
-          }
-        | _ -> assert false)
-      | _ -> exp0)
+    | Pexp_construct (lid, arg) ->
+      construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
     | Pexp_variant (lab, eo) ->
       variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
     | Pexp_record (l, eo) ->

compiler/ml/ast_uncurried.ml

@@ -19,38 +19,25 @@ let uncurried_type ~loc ~arity t_arg =
   let t_arity = arity_type ~loc arity in
   Ast_helper.Typ.constr ~loc {txt = Lident "function$"; loc} [t_arg; t_arity]
 
-let uncurried_fun ~loc ~arity fun_expr =
+let uncurried_fun ~arity fun_expr =
   let fun_expr =
     match fun_expr.Parsetree.pexp_desc with
     | Pexp_fun (l, eo, p, e, _) ->
       {fun_expr with pexp_desc = Pexp_fun (l, eo, p, e, Some arity)}
     | _ -> assert false
   in
-  Ast_helper.Exp.construct ~loc
-    (Location.mknoloc (Longident.Lident "Function$"))
-    (Some fun_expr)
+  fun_expr
 
 let expr_is_uncurried_fun (expr : Parsetree.expression) =
   match expr.pexp_desc with
-  | Pexp_construct ({txt = Lident "Function$"}, Some _) -> true
+  | Pexp_fun (_, _, _, _, Some _) -> true
   | _ -> false
 
 let expr_extract_uncurried_fun (expr : Parsetree.expression) =
   match expr.pexp_desc with
-  | Pexp_construct ({txt = Lident "Function$"}, Some e) ->
-    let () =
-      match e.pexp_desc with
-      | Pexp_fun (_, _, _, _, Some _arity) -> ()
-      | _ -> assert false
-    in
-    e
+  | Pexp_fun (_, _, _, _, Some _) -> expr
   | _ -> assert false
 
-let remove_fun (expr : Parsetree.expression) =
-  match expr.pexp_desc with
-  | Pexp_construct ({txt = Lident "Function$"}, Some e) -> e
-  | _ -> expr
-
 let core_type_is_uncurried_fun (typ : Parsetree.core_type) =
   match typ.ptyp_desc with
   | Ptyp_constr ({txt = Lident "function$"}, [{ptyp_desc = Ptyp_arrow _}; _]) ->

compiler/ml/pprintast.ml

@@ -954,7 +954,7 @@ and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
       | Pexp_fun (label, eo, p, e, arity) ->
           let arity_str = match arity with
             | None -> ""
-            | Some arity -> "arity:" ^ string_of_int arity
+            | Some arity -> "[arity:" ^ string_of_int arity ^ "]"
           in
           if label=Nolabel then
             pp f "%s%a@ %a" arity_str (simple_pattern ctxt) p pp_print_pexp_function e

compiler/ml/printtyped.ml

@@ -285,8 +285,11 @@ and expression i ppf x =
     line i ppf "Texp_let %a\n" fmt_rec_flag rf;
     list i value_binding ppf l;
     expression i ppf e
-  | Texp_function {arg_label = p; param; case = case_; partial = _} ->
+  | Texp_function {arg_label = p; arity; param; case = case_; partial = _} ->
     line i ppf "Texp_function\n";
+    (match arity with
+    | Some arity -> line i ppf "arity: %d\n" arity
+    | None -> ());
     line i ppf "%a" Ident.print param;
     arg_label i ppf p;
     case i ppf case_

compiler/ml/translcore.ml

@@ -674,7 +674,7 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
   | Texp_constant cst -> Lconst (Const_base cst)
   | Texp_let (rec_flag, pat_expr_list, body) ->
     transl_let rec_flag pat_expr_list (transl_exp body)
-  | Texp_function {arg_label = _; param; case; partial} ->
+  | Texp_function {arg_label = _; arity; param; case; partial} -> (
     let async = has_async_attribute e in
     let directive =
       match extract_directive_for_fn e with
@@ -695,7 +695,24 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
       }
     in
     let loc = e.exp_loc in
-    Lfunction {params; body; attr; loc}
+    let lambda = Lfunction {params; body; attr; loc} in
+    match arity with
+    | Some arity ->
+      let prim =
+        let expanded = Ctype.expand_head e.exp_env e.exp_type in
+        let extracted = Ast_uncurried.type_extract_uncurried_fun expanded in
+        match (Btype.repr extracted).desc with
+        | Tarrow (Nolabel, t, _, _) -> (
+          match (Ctype.expand_head e.exp_env t).desc with
+          | Tconstr (Pident {name = "unit"}, [], _) -> Pjs_fn_make_unit
+          | _ -> Pjs_fn_make arity)
+        | _ -> Pjs_fn_make arity
+      in
+      Lprim
+        ( prim (* could be replaced with Opaque in the future except arity 0*),
+          [lambda],
+          loc )
+    | None -> lambda)
   | Texp_apply
       ( ({
            exp_desc = Texp_ident (_, _, {val_kind = Val_prim p});
@@ -781,27 +798,6 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
     with Not_constant -> Lprim (Pmakeblock Blk_tuple, ll, e.exp_loc))
   | Texp_construct ({txt = Lident "false"}, _, []) -> Lconst Const_false
   | Texp_construct ({txt = Lident "true"}, _, []) -> Lconst Const_true
-  | Texp_construct
-      ({txt = Lident "Function$"}, _, [({exp_desc = Texp_function _} as expr)])
-    ->
-    (* ReScript uncurried encoding *)
-    let loc = expr.exp_loc in
-    let lambda = transl_exp expr in
-    let arity =
-      Ast_uncurried.uncurried_type_get_arity ~env:e.exp_env e.exp_type
-    in
-    let prim =
-      match (Ctype.expand_head expr.exp_env expr.exp_type).desc with
-      | Tarrow (Nolabel, t, _, _) -> (
-        match (Ctype.expand_head expr.exp_env t).desc with
-        | Tconstr (Pident {name = "unit"}, [], _) -> Pjs_fn_make_unit
-        | _ -> Pjs_fn_make arity)
-      | _ -> Pjs_fn_make arity
-    in
-    Lprim
-      ( prim (* could be replaced with Opaque in the future except arity 0*),
-        [lambda],
-        loc )
   | Texp_construct (lid, cstr, args) -> (
     let ll = transl_list args in
     if cstr.cstr_inlined <> None then
@@ -1054,7 +1050,14 @@ and transl_function loc partial param case =
    c_rhs =
      {
        exp_desc =
-         Texp_function {arg_label = _; param = param'; case; partial = partial'};
+         Texp_function
+           {
+             arg_label = _;
+             arity = None;
+             param = param';
+             case;
+             partial = partial';
+           };
      } as exp;
   }
     when Parmatch.inactive ~partial pat && not (exp |> has_async_attribute) ->