More cleanup of async handling.

Author: cristianoc

CHANGELOG.md

@@ -21,7 +21,7 @@
 #### :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
 

compiler/ml/ast_async.ml

@@ -1,8 +1,5 @@
-let is_async : Parsetree.attribute -> bool = fun ({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 has_async_payload attrs =
+  Ext_list.exists attrs (fun ({Location.txt}, _) -> txt = "res.async")
 
 let add_async_attribute ~async (body : Parsetree.expression) =
   if async then
@@ -14,15 +11,6 @@ let add_async_attribute ~async (body : Parsetree.expression) =
     }
   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_v4.ml

@@ -955,10 +955,8 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
       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
+      Ast_async.has_async_payload binding.pvb_expr.pexp_attributes
     in
-    (* do stuff here! *)
     let named_arg_list, newtypes, _typeConstraints =
       recursively_transform_named_args_for_make
         (modified_binding_old binding)
@@ -1192,9 +1190,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.has_async_payload modified_binding.pvb_expr.pexp_attributes
     in
 
     let make_new_binding ~loc ~full_module_name binding =

compiler/syntax/src/res_core.ml

@@ -3303,12 +3303,8 @@ and parse_expr_block ?first p =
 and parse_async_arrow_expression ?(arrow_attrs = []) p =
   let start_pos = p.Parser.start_pos in
   Parser.expect (Lident "async") p;
-  let async_attr =
-    Ast_async.make_async_attr (mk_loc start_pos p.prev_end_pos)
-  in
-  parse_es6_arrow_expression
-    ~arrow_attrs:(async_attr :: arrow_attrs)
-    ~arrow_start_pos:(Some start_pos) p
+  Ast_async.add_async_attribute ~async:true
+    (parse_es6_arrow_expression ~arrow_attrs ~arrow_start_pos:(Some start_pos) p)
 
 and parse_await_expression p =
   let await_loc = mk_loc p.Parser.start_pos p.end_pos in

compiler/syntax/src/res_parens.ml

@@ -301,7 +301,7 @@ let ternary_operand expr =
       Nothing
     | {pexp_desc = Pexp_constraint _} -> Parenthesized
     | _ when Res_parsetree_viewer.is_fun_newtype expr -> (
-      let _parameters, return_expr = ParsetreeViewer.fun_expr expr in
+      let _, _parameters, return_expr = ParsetreeViewer.fun_expr expr in
       match return_expr.pexp_desc with
       | Pexp_constraint _ -> Parenthesized
       | _ -> Nothing)

compiler/syntax/src/res_parsetree_viewer.ml

@@ -165,7 +165,8 @@ type fun_param_kind =
     }
   | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list}
 
-let fun_expr expr =
+let fun_expr expr_ =
+  let async = Ast_async.has_async_payload expr_.pexp_attributes in
   let rec collect_params ~n_fun ~params expr =
     match expr with
     | {
@@ -182,10 +183,9 @@ let fun_expr expr =
     }
       when arity = None || n_fun = 0 ->
       let parameter = Parameter {attrs; lbl; default_expr; pat = pattern} in
-      collect_params ~n_fun:(n_fun + 1) ~params:(parameter :: params) return_expr
-    (* If a fun has an attribute, then it stops here and makes currying.
-       i.e attributes outside of (...), uncurried `(.)` and `async` make currying *)
-    | _ -> (List.rev params, expr)
+      collect_params ~n_fun:(n_fun + 1) ~params:(parameter :: params)
+        return_expr
+    | _ -> (async, List.rev params, expr)
   in
   (* Turns (type t, type u, type z) into "type t u z" *)
   let rec collect_new_types acc return_expr =
@@ -194,12 +194,12 @@ let fun_expr expr =
       collect_new_types (string_loc :: acc) return_expr
     | return_expr -> (List.rev acc, return_expr)
   in
-  match expr with
+  match expr_ with
   | {pexp_desc = Pexp_newtype (string_loc, rest)} ->
     let string_locs, return_expr = collect_new_types [string_loc] rest in
     let param = NewTypes {attrs = []; locs = string_locs} in
     collect_params ~n_fun:0 ~params:[param] return_expr
-  | _ -> collect_params ~n_fun:0 ~params:[] {expr with pexp_attributes = []}
+  | _ -> collect_params ~n_fun:0 ~params:[] {expr_ with pexp_attributes = []}
 
 let process_braces_attr expr =
   match expr.pexp_attributes with

compiler/syntax/src/res_parsetree_viewer.mli

@@ -53,7 +53,7 @@ type fun_param_kind =
   | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list}
 
 val fun_expr :
-  Parsetree.expression -> fun_param_kind list * Parsetree.expression
+  Parsetree.expression -> bool * fun_param_kind list * Parsetree.expression
 
 (* example:
    *  `makeCoordinate({

compiler/syntax/src/res_printer.ml

@@ -1980,7 +1980,7 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl
      };
    pvb_expr = {pexp_desc = Pexp_newtype _} as expr;
   } -> (
-    let parameters, return_expr = ParsetreeViewer.fun_expr expr in
+    let _, parameters, return_expr = ParsetreeViewer.fun_expr expr in
     let abstract_type =
       match parameters with
       | [NewTypes {locs = vars}] ->
@@ -2695,9 +2695,8 @@ and print_if_chain ~state pexp_attributes ifs else_expr cmt_tbl =
 
 and print_expression ~state (e : Parsetree.expression) cmt_tbl =
   let print_arrow e =
-    let parameters, return_expr = ParsetreeViewer.fun_expr e in
+    let async, parameters, return_expr = ParsetreeViewer.fun_expr e in
     let attrs_on_arrow = e.pexp_attributes in
-    let async, attrs = Ast_async.extract_async_attribute attrs_on_arrow in
     let return_expr, typ_constraint =
       match return_expr.pexp_desc with
       | Pexp_constraint (expr, typ) ->
@@ -2760,7 +2759,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
         Doc.concat [Doc.text ": "; typ_doc]
       | _ -> Doc.nil
     in
-    let attrs = print_attributes ~state attrs cmt_tbl in
+    let attrs = print_attributes ~state attrs_on_arrow cmt_tbl in
     Doc.group
       (Doc.concat
          [
@@ -3437,9 +3436,8 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
   | _ -> expr_with_await
 
 and print_pexp_fun ~state ~in_callback e cmt_tbl =
-  let parameters, return_expr = ParsetreeViewer.fun_expr e in
+  let async, parameters, return_expr = ParsetreeViewer.fun_expr e in
   let attrs_on_arrow = e.pexp_attributes in
-  let async, attrs = Ast_async.extract_async_attribute attrs_on_arrow in
   let return_expr, typ_constraint =
     match return_expr.pexp_desc with
     | Pexp_constraint (expr, typ) ->
@@ -3505,7 +3503,7 @@ and print_pexp_fun ~state ~in_callback e cmt_tbl =
   in
   Doc.concat
     [
-      print_attributes ~state attrs cmt_tbl;
+      print_attributes ~state attrs_on_arrow cmt_tbl;
       parameters_doc;
       typ_constraint_doc;
       Doc.text " =>";