small cleanup refactor

Author: cristianoc

compiler/syntax/src/res_parens.ml

@@ -301,9 +301,7 @@ let ternary_operand expr =
       Nothing
     | {pexp_desc = Pexp_constraint _} -> Parenthesized
     | _ when Res_parsetree_viewer.is_fun_newtype expr -> (
-      let _attrsOnArrow, _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

@@ -86,6 +86,17 @@ let has_partial_attribute attrs =
       | _ -> false)
     attrs
 
+type function_attributes_info = {async: bool; attributes: Parsetree.attributes}
+
+let process_function_attributes attrs =
+  let rec process async acc attrs =
+    match attrs with
+    | [] -> {async; attributes = List.rev acc}
+    | ({Location.txt = "res.async"}, _) :: rest -> process true acc rest
+    | attr :: rest -> process async (attr :: acc) rest
+  in
+  process false [] attrs
+
 let has_await_attribute attrs =
   List.exists
     (function
@@ -174,7 +185,7 @@ let fun_expr expr =
       collect_new_types (string_loc :: acc) return_expr
     | return_expr -> (List.rev acc, return_expr)
   in
-  let rec collect ~n_fun attrs_before acc expr =
+  let rec collect ~n_fun ~params expr =
     match expr with
     | {
      pexp_desc =
@@ -186,12 +197,11 @@ let fun_expr expr =
            rhs = {pexp_desc = Pexp_apply _};
          };
     } ->
-      (attrs_before, List.rev acc, rewrite_underscore_apply expr)
-    | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs}
-      when n_fun = 0 ->
+      (List.rev params, rewrite_underscore_apply expr)
+    | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} ->
       let string_locs, return_expr = collect_new_types [string_loc] rest in
       let param = NewTypes {attrs; locs = string_locs} in
-      collect ~n_fun attrs_before (param :: acc) return_expr
+      collect ~n_fun ~params:(param :: params) return_expr
     | {
      pexp_desc =
        Pexp_fun
@@ -208,19 +218,17 @@ let fun_expr expr =
       let parameter =
         Parameter {attrs = []; lbl; default_expr; pat = pattern}
       in
-      collect ~n_fun:(n_fun + 1) attrs_before (parameter :: acc) return_expr
+      collect ~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 *)
-    | {pexp_desc = Pexp_fun _} -> (attrs_before, List.rev acc, expr)
+    | {pexp_desc = Pexp_fun _} -> (List.rev params, expr)
     | expr when n_fun = 0 && Ast_uncurried.expr_is_uncurried_fun expr ->
       let expr = Ast_uncurried.expr_extract_uncurried_fun expr in
-      collect ~n_fun attrs_before acc expr
-    | expr -> (attrs_before, List.rev acc, expr)
+      collect ~n_fun ~params expr
+    | expr -> (List.rev params, expr)
   in
   match expr with
-  | {pexp_desc = Pexp_fun _ | Pexp_newtype _} ->
-    collect ~n_fun:0 expr.pexp_attributes [] {expr with pexp_attributes = []}
-  | _ -> collect ~n_fun:0 [] [] expr
+  | _ -> collect ~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,8 +53,7 @@ type fun_param_kind =
   | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list}
 
 val fun_expr :
-  Parsetree.expression ->
-  Parsetree.attributes * fun_param_kind list * Parsetree.expression
+  Parsetree.expression -> 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 _attrs, 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,8 +2695,11 @@ 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 attrs_on_arrow, parameters, return_expr = ParsetreeViewer.fun_expr e in
-    let async, attrs = Ast_async.extract_async_attribute attrs_on_arrow in
+    let parameters, return_expr = ParsetreeViewer.fun_expr e in
+    let attrs_on_arrow = e.pexp_attributes in
+    let ParsetreeViewer.{async; attributes = attrs} =
+      ParsetreeViewer.process_function_attributes attrs_on_arrow
+    in
     let return_expr, typ_constraint =
       match return_expr.pexp_desc with
       | Pexp_constraint (expr, typ) ->
@@ -3436,8 +3439,11 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
   | _ -> expr_with_await
 
 and print_pexp_fun ~state ~in_callback e cmt_tbl =
-  let attrs_on_arrow, parameters, return_expr = ParsetreeViewer.fun_expr e in
-  let async, attrs = Ast_async.extract_async_attribute attrs_on_arrow in
+  let parameters, return_expr = ParsetreeViewer.fun_expr e in
+  let attrs_on_arrow = e.pexp_attributes in
+  let ParsetreeViewer.{async; attributes = attrs} =
+    ParsetreeViewer.process_function_attributes attrs_on_arrow
+  in
   let return_expr, typ_constraint =
     match return_expr.pexp_desc with
     | Pexp_constraint (expr, typ) ->