Ast types first

CHANGELOG.md

@@ -17,6 +17,11 @@
 - Editor: Fix issue where pipe completions would not trigger with generic type arguments. https://github.com/rescript-lang/rescript/pull/7231
 - Fix leftover assert false in code for `null != undefined`. https://github.com/rescript-lang/rescript/pull/7232
 
+#### :house: Internal
+
+- 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
+
 # 12.0.0-alpha.7
 
 #### :bug: Bug fix

compiler/frontend/bs_builtin_ppx.ml

@@ -111,8 +111,6 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
     {e with pexp_desc = Pexp_constant (Pconst_integer (s, None))}
   (* End rewriting *)
   | Pexp_newtype (s, body) ->
-    let async = Ast_async.has_async_payload e.pexp_attributes in
-    let body = Ast_async.add_async_attribute ~async body in
     let res = self.expr self body in
     {e with pexp_desc = Pexp_newtype (s, res)}
   | Pexp_fun {arg_label = label; lhs = pat; rhs = body} -> (

compiler/ml/ast_async.ml

@@ -1,28 +1,34 @@
-let is_async : Parsetree.attribute -> bool = fun ({txt}, _) -> txt = "res.async"
+let has_async_payload attrs =
+  Ext_list.exists attrs (fun ({Location.txt}, _) -> txt = "res.async")
 
-let has_async_payload attrs = Ext_list.exists attrs is_async
-
-let make_async_attr loc = (Location.mkloc "res.async" loc, Parsetree.PStr [])
+let rec dig_async_payload_from_function (expr : Parsetree.expression) =
+  match expr.pexp_desc with
+  | Pexp_fun _ -> has_async_payload expr.pexp_attributes
+  | Pexp_newtype (_, body) -> dig_async_payload_from_function body
+  | _ -> false
 
 let add_async_attribute ~async (body : Parsetree.expression) =
+  let add (exp : Parsetree.expression) =
+    if has_async_payload exp.pexp_attributes then exp
+    else
+      {
+        exp with
+        pexp_attributes =
+          ({txt = "res.async"; loc = Location.none}, PStr [])
+          :: exp.pexp_attributes;
+      }
+  in
   if async then
-    {
-      body with
-      pexp_attributes =
-        ({txt = "res.async"; loc = Location.none}, PStr [])
-        :: body.pexp_attributes;
-    }
+    let rec add_to_fun (exp : Parsetree.expression) =
+      match exp.pexp_desc with
+      | Pexp_newtype (txt, e) ->
+        {exp with pexp_desc = Pexp_newtype (txt, add_to_fun e)}
+      | Pexp_fun _ -> add exp
+      | _ -> exp
+    in
+    add_to_fun body
   else body
 
-let extract_async_attribute attrs =
-  let rec process async acc attrs =
-    match attrs with
-    | [] -> (async, List.rev acc)
-    | ({Location.txt = "res.async"}, _) :: rest -> process true acc rest
-    | attr :: rest -> process async (attr :: acc) rest
-  in
-  process false [] attrs
-
 let add_promise_type ?(loc = Location.none) ~async
     (result : Parsetree.expression) =
   if async then

compiler/syntax/src/jsx_common.ml

@@ -50,22 +50,6 @@ let raise_error_multiple_component ~loc =
     "Only one component definition is allowed for each module. Move to a \
      submodule or other file if necessary."
 
-let remove_arity binding =
-  let rec remove_arity_record expr =
-    match expr.pexp_desc with
-    | _ when Ast_uncurried.expr_is_uncurried_fun expr ->
-      Ast_uncurried.expr_extract_uncurried_fun expr
-    | Pexp_newtype (label, e) ->
-      {expr with pexp_desc = Pexp_newtype (label, remove_arity_record e)}
-    | Pexp_apply (forward_ref, [(label, e)]) ->
-      {
-        expr with
-        pexp_desc = Pexp_apply (forward_ref, [(label, remove_arity_record e)]);
-      }
-    | _ -> expr
-  in
-  {binding with pvb_expr = remove_arity_record binding.pvb_expr}
-
 let async_component ~async expr =
   if async then
     let open Ast_helper in

compiler/syntax/src/jsx_v4.ml

@@ -927,7 +927,6 @@ let vb_match_expr named_arg_list expr =
 let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
   if Jsx_common.has_attr_on_binding Jsx_common.has_attr binding then (
     check_multiple_components ~config ~loc:pstr_loc;
-    let binding = Jsx_common.remove_arity binding in
     let core_type_of_attr =
       Jsx_common.core_type_of_attrs binding.pvb_attributes
     in
@@ -954,11 +953,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
     let binding_wrapper, has_forward_ref, expression =
       modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding
     in
-    let is_async =
-      Ext_list.find_first binding.pvb_expr.pexp_attributes Ast_async.is_async
-      |> Option.is_some
-    in
-    (* do stuff here! *)
+    let is_async = Ast_async.dig_async_payload_from_function binding.pvb_expr in
     let named_arg_list, newtypes, _typeConstraints =
       recursively_transform_named_args_for_make
         (modified_binding_old binding)
@@ -1177,12 +1172,10 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
     (Some props_record_type, binding, new_binding))
   else if Jsx_common.has_attr_on_binding Jsx_common.has_attr_with_props binding
   then
-    let modified_binding = Jsx_common.remove_arity binding in
     let modified_binding =
       {
-        modified_binding with
-        pvb_attributes =
-          modified_binding.pvb_attributes |> List.filter other_attrs_pure;
+        binding with
+        pvb_attributes = binding.pvb_attributes |> List.filter other_attrs_pure;
       }
     in
     let fn_name = get_fn_name modified_binding.pvb_pat in
@@ -1192,9 +1185,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
     in
 
     let is_async =
-      Ext_list.find_first modified_binding.pvb_expr.pexp_attributes
-        Ast_async.is_async
-      |> Option.is_some
+      Ast_async.dig_async_payload_from_function modified_binding.pvb_expr
     in
 
     let make_new_binding ~loc ~full_module_name binding =