Preserve the property of 1 function per => in function definition.

Before this diff `() => 3` would be a function but `(type a) => 3` would just be a number. Plus, `(type a) => (type b) => (x) => ...` would express a single function. Now, each `=>` represents a function (possibly adding a unit parameter when there are only types but no no term parameters).
rescript-lang · Jan 8, 2025 · 4982266 · 4982266
1 parent 5a83824
commit 4982266
Show file tree

Hide file tree

Showing 9 changed files with 59 additions and 80 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -63,7 +63,6 @@
 - AST cleanup: store arity in function type. https://github.com/rescript-lang/rescript/pull/7195
 - AST cleanup: remove explicit uses of `function$` in preparation for removing the type entirely. https://github.com/rescript-lang/rescript/pull/7206
 - AST cleanup: remove `function$` entirely. https://github.com/rescript-lang/rescript/pull/7208
-- AST cleanup: use inline record for Pexp_fun. https://github.com/rescript-lang/rescript/pull/7213
 
 # 12.0.0-alpha.5
 

diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml
@@ -1731,7 +1731,12 @@ and parse_parameter_list p =
       ~f:parse_parameter ~closing:Rparen p
   in
   Parser.expect Rparen p;
-  parameters
+  let has_term_parameter =
+    Ext_list.exists parameters (function
+      | TermParameter _ -> true
+      | _ -> false)
+  in
+  (has_term_parameter, parameters)
 
 (* parameters ::=
  *   | _
@@ -1742,6 +1747,22 @@ and parse_parameter_list p =
  *)
 and parse_parameters p =
   let start_pos = p.Parser.start_pos in
+  let unit_term_parameter () =
+    let loc = mk_loc start_pos p.Parser.prev_end_pos in
+    let unit_pattern =
+      Ast_helper.Pat.construct ~loc
+        (Location.mkloc (Longident.Lident "()") loc)
+        None
+    in
+    TermParameter
+      {
+        attrs = [];
+        label = Asttypes.Nolabel;
+        expr = None;
+        pat = unit_pattern;
+        pos = start_pos;
+      }
+  in
   match p.Parser.token with
   | Lident ident ->
     Parser.next p;
@@ -1769,56 +1790,12 @@ and parse_parameters p =
           pos = start_pos;
         };
     ]
-  | Lparen -> (
+  | Lparen ->
     Parser.next p;
-    match p.Parser.token with
-    | Rparen ->
-      Parser.next p;
-      let loc = mk_loc start_pos p.Parser.prev_end_pos in
-      let unit_pattern =
-        Ast_helper.Pat.construct ~loc
-          (Location.mkloc (Longident.Lident "()") loc)
-          None
-      in
-      [
-        TermParameter
-          {
-            attrs = [];
-            label = Asttypes.Nolabel;
-            expr = None;
-            pat = unit_pattern;
-            pos = start_pos;
-          };
-      ]
-    | Dot -> (
-      Parser.next p;
-      match p.token with
-      | Rparen ->
-        Parser.next p;
-        let loc = mk_loc start_pos p.Parser.prev_end_pos in
-        let unit_pattern =
-          Ast_helper.Pat.construct ~loc
-            (Location.mkloc (Longident.Lident "()") loc)
-            None
-        in
-        [
-          TermParameter
-            {
-              attrs = [];
-              label = Asttypes.Nolabel;
-              expr = None;
-              pat = unit_pattern;
-              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)
+    ignore (Parser.optional p Dot);
+    let has_term_parameter, parameters = parse_parameter_list p in
+    if has_term_parameter then parameters
+    else parameters @ [unit_term_parameter ()]
   | token ->
     Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
     []

diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml
@@ -187,7 +187,8 @@ let fun_expr expr =
          };
     } ->
       (attrs_before, List.rev acc, rewrite_underscore_apply expr)
-    | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} ->
+    | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs}
+      when n_fun = 0 ->
       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

diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt
@@ -44,9 +44,9 @@ let t0 (type a) (type b) [arity:2](l : a list) (x : a) = x :: l
 let t1 (type a) (type b) [arity:2](l : a list) (x : a) = x :: l
 let t2 (type a) (type b) [arity:2](l : a list) (x : a) = x :: l
 let t3 (type a) (type b) [arity:2](l : a list) (x : a) = x :: l
-let t4 (type a) (type b) [arity:2](l : a list) (x : a) = x :: l
-let t5 (type a) (type b) [arity:2](l : a list) (x : a) = x :: l
-let t6 (type a) (type b) [arity:2](l : a list) (x : a) = x :: l
+let t4 (type a) (type b) [arity:1]() [arity:2](l : a list) (x : a) = x :: l
+let t5 (type a) (type b) [arity:1]() [arity:2](l : a list) (x : a) = x :: l
+let t6 (type a) (type b) [arity:1]() [arity:2](l : a list) (x : a) = x :: l
 type nonrec arrowPath1 = int -> string (a:1)
 type nonrec arrowPath2 = I.t -> string (a:1)
 type nonrec arrowPath3 = int -> string (a:1)

diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt
@@ -33,11 +33,16 @@ let ex2 = ((3)[@res.await ]) ** ((4)[@res.await ])
 let ex3 = ((foo |.u (bar ~arg:((arg)[@res.namedArgLoc ])))[@res.await ])
 let ex4 = (((foo.bar).baz)[@res.await ])
 let attr1 = ((fun [arity:1]x -> x + 1)[@res.async ][@a ])
-let attr2 = ((fun (type a) -> fun (type b) -> fun (type c) ->
-  fun [arity:1]x -> 3)[@res.async ][@a ])
-let attr3 = ((fun (type a) -> ((fun (type b) -> fun (type c) ->
-  fun [arity:1]x -> 3)[@res.async ]))[@a ])
-let attr4 = ((fun (type a) -> ((fun (type b) -> fun (type c) ->
-  fun [arity:1]x -> 3)[@res.async ][@b ]))[@a ])
+let attr2 = ((fun (type a) ->
+  fun [arity:1]() -> fun (type b) -> fun (type c) -> fun [arity:1]x -> 3)
+  [@res.async ][@a ])
+let attr3 = ((fun (type a) ->
+  fun [arity:1]() -> ((fun (type b) -> fun (type c) -> fun [arity:1]x -> 3)
+    [@res.async ]))
+  [@a ])
+let attr4 = ((fun (type a) ->
+  fun [arity:1]() -> ((fun (type b) -> fun (type c) -> fun [arity:1]x -> 3)
+    [@res.async ][@b ]))
+  [@a ])
 let (attr5 : int) = ((fun (type a) -> fun (type b) -> fun (type c) ->
-  fun [arity:1](x : a) -> x)[@res.async ][@a ][@b ])
+  fun [arity:1]() -> fun [arity:1](x : a) -> x)[@res.async ][@a ][@b ])
diff --git a/tests/syntax_tests/data/printer/comments/expected/expr.res.txt b/tests/syntax_tests/data/printer/comments/expected/expr.res.txt
@@ -227,12 +227,8 @@ let f = (
 ) => /* c7 */ ()
 
 let multiply = (type /* c-2 */ t /* c-1 */, /* c0 */ m1 /* c1 */, /* c2 */ m2 /* c3 */) => ()
-let multiply = (
-  type /* c-4 */ t /* c-3 */,
-  /* c0 */ m1 /* c1 */,
-  type /* c-2 */ s /* c-1 */,
-  /* c2 */ m2 /* c3 */,
-) => ()
+let multiply = (type /* c-4 */ t /* c-3 */, /* c0 */ m1 /* c1 */) =>
+  (type /* c-2 */ s /* c-1 */, /* c2 */ m2 /* c3 */) => ()
 
 f(
   // a

diff --git a/tests/syntax_tests/data/printer/expr/expected/UncurriedByDefault.res.txt b/tests/syntax_tests/data/printer/expr/expected/UncurriedByDefault.res.txt
@@ -53,9 +53,9 @@ let t0 = (type a b, l: list<a>, x: a) => list{x, ...l}
 let t1 = (type a b, l: list<a>, x: a) => list{x, ...l}
 let t2 = (type a b, l: list<a>, x: a) => list{x, ...l}
 let t3 = (type a b, l: list<a>, x: a) => list{x, ...l}
-let t4 = (type a b, l: list<a>, x: a) => list{x, ...l}
-let t5 = (type a b, l: list<a>, x: a) => list{x, ...l}
-let t6 = (type a b, l: list<a>, x: a) => list{x, ...l}
+let t4 = (type a b, ()) => (l: list<a>, x: a) => list{x, ...l}
+let t5 = (type a b, ()) => (l: list<a>, x: a) => list{x, ...l}
+let t6 = (type a b, ()) => (l: list<a>, x: a) => list{x, ...l}
 
 let () = (x => ignore(x))(3)
 let () = (x => ignore(x))(3)

diff --git a/tests/syntax_tests/data/printer/expr/expected/asyncAwait.res.txt b/tests/syntax_tests/data/printer/expr/expected/asyncAwait.res.txt
@@ -146,7 +146,7 @@ let f = async (type a, ()) => {
 }
 
 let attr1 = @a async x => x + 1
-let attr2 = @a async (type a b c, x) => 3
-let attr3 = @a (type a, type b c, x) => 3
-let attr4 = @a (type a, @b type b c, x) => 3
-let attr5: int => promise<int> = @a @b async (type a b c, x: a) => x
+let attr2 = @a async (type a, ()) => (type b c, x) => 3
+let attr3 = @a (type a, ()) => async (type b c, x) => 3
+let attr4 = @a (type a, ()) => @b async (type b c, x) => 3
+let attr5: int => promise<int> = @a @b async (type a b c, ()) => (x: a) => x
diff --git a/tests/syntax_tests/data/printer/expr/expected/newtype.res.txt b/tests/syntax_tests/data/printer/expr/expected/newtype.res.txt
@@ -1,13 +1,14 @@
 let f = (type t, xs: list<t>) => ()
 let f = @attr (type t, xs: list<t>) => ()
-let f = (type t, xs: list<t>, type s, ys: list<s>) => ()
-let f = @attr (type t, xs: list<t>, @attr2 type s, ys: list<s>) => ()
+let f = (type t, xs: list<t>) => (type s, ys: list<s>) => ()
+let f = @attr (type t, xs: list<t>) => @attr2 (type s, ys: list<s>) => ()
 let f = (type t u v, xs: list<(t, u, v)>) => ()
 let f = @attr (type t u v, xs: list<(t, u, v)>) => ()
-let f = (type t u v, xs: list<(t, u, v)>, type s w z, ys: list<(s, w, z)>) => ()
-let f = @attr (type t u v, xs: list<(t, u, v)>, @attr2 type s w z, ys: list<(s, w, z)>) => ()
+let f = (type t u v, xs: list<(t, u, v)>) => (type s w z, ys: list<(s, w, z)>) => ()
+let f = @attr (type t u v, xs: list<(t, u, v)>) => @attr2 (type s w z, ys: list<(s, w, z)>) => ()
 let f = @attr
-(type t, @attr type s, xs: list<(t, s)>, @attr type u, @attr type v w, ys: list<(u, v, w)>) => ()
+(type t, @attr type s, xs: list<(t, s)>) =>
+  @attr (type u, @attr type v w, ys: list<(u, v, w)>) => ()
 
 let mk_formatting_gen:
   type a b c d e f. formatting_gen<a, b, c, d, e, f> => Parsetree.expression =