AST: always put type parameters first in function definitions.

Normalize function definitions to be of the form `(type a b c, x, y) => ...`, moving all the types first if they are not already.

Author: cristianoc

compiler/syntax/src/res_core.ml

@@ -183,26 +183,53 @@ type typ_def_or_ext =
     }
   | TypeExt of Parsetree.type_extension
 
-type labelled_parameter =
-  | TermParameter of {
-      attrs: Parsetree.attributes;
-      label: Asttypes.arg_label;
-      expr: Parsetree.expression option;
-      pat: Parsetree.pattern;
-      pos: Lexing.position;
-    }
-  | TypeParameter of {
-      attrs: Parsetree.attributes;
-      locs: string Location.loc list;
-      pos: Lexing.position;
-    }
+type fundef_type_param = {
+  attrs: Parsetree.attributes;
+  locs: string Location.loc list;
+  p_pos: Lexing.position;
+}
+
+type fundef_term_param = {
+  attrs: Parsetree.attributes;
+  p_label: Asttypes.arg_label;
+  expr: Parsetree.expression option;
+  pat: Parsetree.pattern;
+  p_pos: Lexing.position;
+}
+
+(* Single parameter of a function definition  (type a b, x, ~y) *)
+type fundef_parameter =
+  | TermParameter of fundef_term_param
+  | TypeParameter of fundef_type_param
 
 type record_pattern_item =
   | PatUnderscore
   | PatField of (Ast_helper.lid * Parsetree.pattern * bool (* optional *))
 
 type context = OrdinaryExpr | TernaryTrueBranchExpr | WhenExpr
 
+(* Extracts type and term parameters from a list of function definition parameters, combining all type parameters into one *)
+let rec extract_fundef_params ~(type_acc : fundef_type_param option)
+    ~(term_acc : fundef_term_param list) (params : fundef_parameter list) :
+    fundef_type_param option * fundef_term_param list =
+  match params with
+  | TermParameter tp :: rest ->
+    extract_fundef_params ~type_acc ~term_acc:(tp :: term_acc) rest
+  | TypeParameter tp :: rest ->
+    let type_acc =
+      match type_acc with
+      | Some tpa ->
+        Some
+          {
+            attrs = tpa.attrs @ tp.attrs;
+            locs = tpa.locs @ tp.locs;
+            p_pos = tpa.p_pos;
+          }
+      | None -> Some tp
+    in
+    extract_fundef_params ~type_acc ~term_acc rest
+  | [] -> (type_acc, List.rev term_acc)
+
 let get_closing_token = function
   | Token.Lparen -> Token.Rparen
   | Lbrace -> Rbrace
@@ -1511,7 +1538,7 @@ and parse_ternary_expr left_operand p =
   | _ -> left_operand
 
 and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
-    ?context ?parameters p =
+    ?context ?term_parameters p =
   let start_pos = p.Parser.start_pos in
   Parser.leave_breadcrumb p Grammar.Es6ArrowExpr;
   (* Parsing function parameters and attributes:
@@ -1521,8 +1548,8 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
      2. Attributes inside `(...)` are added to the arguments regardless of whether
      labeled, optional or nolabeled *)
   let parameters =
-    match parameters with
-    | Some params -> params
+    match term_parameters with
+    | Some params -> (None, params)
     | None -> parse_parameters p
   in
   let parameters =
@@ -1533,15 +1560,23 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
       | None -> pos
     in
     match parameters with
-    | TermParameter p :: rest ->
-      TermParameter
-        {p with attrs = update_attrs p.attrs; pos = update_pos p.pos}
-      :: rest
-    | TypeParameter p :: rest ->
-      TypeParameter
-        {p with attrs = update_attrs p.attrs; pos = update_pos p.pos}
-      :: rest
-    | [] -> parameters
+    | None, termp :: rest ->
+      ( None,
+        {
+          termp with
+          attrs = update_attrs termp.attrs;
+          p_pos = update_pos termp.p_pos;
+        }
+        :: rest )
+    | Some (tpa : fundef_type_param), term_params ->
+      ( Some
+          {
+            tpa with
+            attrs = update_attrs tpa.attrs;
+            p_pos = update_pos tpa.p_pos;
+          },
+        term_params )
+    | _ -> parameters
   in
   let return_type =
     match p.Parser.token with
@@ -1562,32 +1597,32 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
   in
   Parser.eat_breadcrumb p;
   let end_pos = p.prev_end_pos in
-  let term_parameters =
-    parameters
-    |> List.filter (function
-         | TermParameter _ -> true
-         | TypeParameter _ -> false)
-  in
-  let _paramNum, arrow_expr, _arity =
+  let type_param_opt, term_parameters = parameters in
+  let _paramNum, arrow_expr =
     List.fold_right
-      (fun parameter (term_param_num, expr, arity) ->
-        match parameter with
-        | TermParameter
-            {attrs; label = lbl; expr = default_expr; pat; pos = start_pos} ->
-          let loc = mk_loc start_pos end_pos in
-          let fun_expr =
-            Ast_helper.Exp.fun_ ~loc ~attrs ~arity:None lbl default_expr pat
-              expr
-          in
-          if term_param_num = 1 then
-            (term_param_num - 1, Ast_uncurried.uncurried_fun ~arity fun_expr, 1)
-          else (term_param_num - 1, fun_expr, arity + 1)
-        | TypeParameter {attrs; locs = newtypes; pos = start_pos} ->
-          ( term_param_num,
-            make_newtypes ~attrs ~loc:(mk_loc start_pos end_pos) newtypes expr,
-            arity ))
-      parameters
-      (List.length term_parameters, body, 1)
+      (fun parameter (term_param_num, expr) ->
+        let {attrs; p_label = lbl; expr = default_expr; pat; p_pos = start_pos}
+            =
+          parameter
+        in
+        let loc = mk_loc start_pos end_pos in
+        let fun_expr =
+          Ast_helper.Exp.fun_ ~loc ~attrs ~arity:None lbl default_expr pat expr
+        in
+        if term_param_num = 1 then
+          ( term_param_num - 1,
+            Ast_uncurried.uncurried_fun
+              ~arity:(List.length term_parameters)
+              fun_expr )
+        else (term_param_num - 1, fun_expr))
+      term_parameters
+      (List.length term_parameters, body)
+  in
+  let arrow_expr =
+    match type_param_opt with
+    | None -> arrow_expr
+    | Some {attrs; locs = newtypes; p_pos = start_pos} ->
+      make_newtypes ~attrs ~loc:(mk_loc start_pos end_pos) newtypes arrow_expr
   in
   {arrow_expr with pexp_loc = {arrow_expr.pexp_loc with loc_start = start_pos}}
 
@@ -1621,7 +1656,7 @@ and parse_parameter p =
     if p.Parser.token = Typ then (
       Parser.next p;
       let lidents = parse_lident_list p in
-      Some (TypeParameter {attrs; locs = lidents; pos = start_pos}))
+      Some (TypeParameter {attrs; locs = lidents; p_pos = start_pos}))
     else
       let attrs, lbl, pat =
         match p.Parser.token with
@@ -1695,15 +1730,17 @@ and parse_parameter p =
           Parser.next p;
           Some
             (TermParameter
-               {attrs; label = lbl; expr = None; pat; pos = start_pos})
+               {attrs; p_label = lbl; expr = None; pat; p_pos = start_pos})
         | _ ->
           let expr = parse_constrained_or_coerced_expr p in
           Some
             (TermParameter
-               {attrs; label = lbl; expr = Some expr; pat; pos = start_pos}))
+               {attrs; p_label = lbl; expr = Some expr; pat; p_pos = start_pos})
+        )
       | _ ->
         Some
-          (TermParameter {attrs; label = lbl; expr = None; pat; pos = start_pos})
+          (TermParameter
+             {attrs; p_label = lbl; expr = None; pat; p_pos = start_pos})
   else None
 
 and parse_parameter_list p =
@@ -1712,7 +1749,7 @@ and parse_parameter_list p =
       ~f:parse_parameter ~closing:Rparen p
   in
   Parser.expect Rparen p;
-  parameters
+  extract_fundef_params ~type_acc:None ~term_acc:[] parameters
 
 (* parameters ::=
  *   | _
@@ -1721,35 +1758,35 @@ and parse_parameter_list p =
  *   | (.)
  *   | ( parameter {, parameter} [,] )
  *)
-and parse_parameters p =
+and parse_parameters p : fundef_type_param option * fundef_term_param list =
   let start_pos = p.Parser.start_pos in
   match p.Parser.token with
   | Lident ident ->
     Parser.next p;
     let loc = mk_loc start_pos p.Parser.prev_end_pos in
-    [
-      TermParameter
+    ( None,
+      [
         {
           attrs = [];
-          label = Asttypes.Nolabel;
+          p_label = Asttypes.Nolabel;
           expr = None;
           pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc);
-          pos = start_pos;
+          p_pos = start_pos;
         };
-    ]
+      ] )
   | Underscore ->
     Parser.next p;
     let loc = mk_loc start_pos p.Parser.prev_end_pos in
-    [
-      TermParameter
+    ( None,
+      [
         {
           attrs = [];
-          label = Asttypes.Nolabel;
+          p_label = Asttypes.Nolabel;
           expr = None;
           pat = Ast_helper.Pat.any ~loc ();
-          pos = start_pos;
+          p_pos = start_pos;
         };
-    ]
+      ] )
   | Lparen -> (
     Parser.next p;
     match p.Parser.token with
@@ -1761,16 +1798,16 @@ and parse_parameters p =
           (Location.mkloc (Longident.Lident "()") loc)
           None
       in
-      [
-        TermParameter
+      ( None,
+        [
           {
             attrs = [];
-            label = Asttypes.Nolabel;
+            p_label = Asttypes.Nolabel;
             expr = None;
             pat = unit_pattern;
-            pos = start_pos;
+            p_pos = start_pos;
           };
-      ]
+        ] )
     | Dot -> (
       Parser.next p;
       match p.token with
@@ -1782,27 +1819,21 @@ and parse_parameters p =
             (Location.mkloc (Longident.Lident "()") loc)
             None
         in
-        [
-          TermParameter
+        ( None,
+          [
             {
               attrs = [];
-              label = Asttypes.Nolabel;
+              p_label = Asttypes.Nolabel;
               expr = None;
               pat = unit_pattern;
-              pos = start_pos;
+              p_pos = start_pos;
             };
-        ]
-      | _ -> (
-        match parse_parameter_list p with
-        | TermParameter p :: rest ->
-          TermParameter {p with pos = start_pos} :: rest
-        | TypeParameter p :: rest ->
-          TypeParameter {p with pos = start_pos} :: rest
-        | parameters -> parameters))
+          ] )
+      | _ -> parse_parameter_list p)
     | _ -> parse_parameter_list p)
   | token ->
     Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
-    []
+    (None, [])
 
 and parse_coerced_expr ~(expr : Parsetree.expression) p =
   Parser.expect ColonGreaterThan p;
@@ -2998,16 +3029,15 @@ and parse_braced_or_record_expr p =
         let ident = Location.mkloc (Longident.last path_ident.txt) loc in
         let a =
           parse_es6_arrow_expression
-            ~parameters:
+            ~term_parameters:
               [
-                TermParameter
-                  {
-                    attrs = [];
-                    label = Asttypes.Nolabel;
-                    expr = None;
-                    pat = Ast_helper.Pat.var ~loc:ident.loc ident;
-                    pos = start_pos;
-                  };
+                {
+                  attrs = [];
+                  p_label = Asttypes.Nolabel;
+                  expr = None;
+                  pat = Ast_helper.Pat.var ~loc:ident.loc ident;
+                  p_pos = start_pos;
+                };
               ]
             p
         in

tests/syntax_tests/data/parsing/grammar/expressions/expected/locallyAbstractTypes.res.txt

@@ -1,16 +1,16 @@
 let f (type t) [arity:1](xs : t list) = ()
-let f (type t) [arity:2](xs : t list) (type s) (ys : s list) = ()
+let f (type t) (type s) [arity:2](xs : t list) (ys : s list) = ()
 let f (type t) (type u) (type v) [arity:1](xs : (t * u * v) list) = ()
-let f (type t) (type u) (type v) [arity:2](xs : (t * u * v) list) (type s)
-  (type w) (type z) (ys : (s * w * z) list) = ()
-let f = ((fun (type t) -> fun (type u) -> fun (type v) ->
-  fun [arity:2](xs : (t * u * v) list) -> ((fun (type s) -> fun (type w) ->
-    fun (type z) -> fun (ys : (s * w * z) list) -> ())[@attr2 ]))
-  [@attr ])
-let f = ((fun (type t) -> ((fun (type s) ->
-  fun [arity:2](xs : (t * s) list) -> ((fun (type u) -> ((fun (type v) -> fun
-    (type w) -> fun (ys : (u * v * w) list) -> ())[@attr ]))[@attr ]))
-  [@attr ]))[@attr ])
+let f (type t) (type u) (type v) (type s) (type w) (type z)
+  [arity:2](xs : (t * u * v) list) (ys : (s * w * z) list) = ()
+let f = ((fun (type t) -> fun (type u) -> fun (type v) -> fun (type s) -> fun
+  (type w) -> fun (type z) ->
+  fun [arity:2](xs : (t * u * v) list) -> fun (ys : (s * w * z) list) -> ())
+  [@attr ][@attr2 ])
+let f = ((fun (type t) -> fun (type s) -> fun (type u) -> fun (type v) -> fun
+  (type w) ->
+  fun [arity:2](xs : (t * s) list) -> fun (ys : (u * v * w) list) -> ())
+  [@attr ][@attr ][@attr ][@attr ])
 let cancel_and_collect_callbacks :
   'a 'u 'c .
     packed_callbacks list ->

tests/syntax_tests/data/printer/comments/expected/expr.res.txt

@@ -228,10 +228,9 @@ let f = (
 
 let multiply = (type /* c-2 */ t /* c-1 */, /* c0 */ m1 /* c1 */, /* c2 */ m2 /* c3 */) => ()
 let multiply = (
-  type /* c-4 */ t /* c-3 */,
+  type /* c-4 */ t /* c-3 */ s,
   /* c0 */ m1 /* c1 */,
-  type /* c-2 */ s /* c-1 */,
-  /* c2 */ m2 /* c3 */,
+  /* c-2 */ /* c-1 */ /* c2 */ m2 /* c3 */,
 ) => ()
 
 f(