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 =