Fix arity of inner functions.

The parser gives arity to inner functions while it should only give it to the toplevel for a nested function.
E.g. (x,y) => x+y should give toplevel arity 2, and no inner arity 1

Author: cristianoc

compiler/syntax/src/res_core.ml

@@ -1596,8 +1596,8 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
             {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:(Some arity) lbl default_expr
-              pat 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,

tests/syntax_tests/data/parsing/errors/expressions/expected/arrow.res.txt

@@ -11,5 +11,4 @@
 ;;(Object.keys providers).reduce
     (Function$
        (fun [arity:2]elements ->
-          fun [arity:1]providerId -> ((let x = 1 in let b = 2 in x + b)
-            [@res.braces ])))
+          fun providerId -> ((let x = 1 in let b = 2 in x + b)[@res.braces ])))

tests/syntax_tests/data/parsing/errors/expressions/expected/block.res.txt

@@ -66,11 +66,11 @@
 let findThreadByIdLinearScan =
   Function$
     (fun [arity:2]~threads:((threads)[@res.namedArgLoc ]) ->
-       fun [arity:1]~id:((id)[@res.namedArgLoc ]) ->
+       fun ~id:((id)[@res.namedArgLoc ]) ->
          ((Js.Array2.findi ThreadsModel.threads
              (Function$
                 (fun [arity:2]thread ->
-                   fun [arity:1]i ->
+                   fun i ->
                      ((let thisId =
                          match thread with
                          | ServerData.OneToOne

tests/syntax_tests/data/parsing/errors/expressions/expected/consecutive.res.txt

@@ -44,9 +44,8 @@
 
   consecutive expressions on a line must be separated by ';' or a newline
 
-let f = Function$ (fun [arity:2]a -> fun [arity:1]b -> a + 3)
+let f = Function$ (fun [arity:2]a -> fun b -> a + 3)
 ;;b
-let f =
-  Function$ (fun [arity:2]g -> fun [arity:1]h -> ((a + 3; b)[@res.braces ]))
+let f = Function$ (fun [arity:2]g -> fun h -> ((a + 3; b)[@res.braces ]))
 let () = ((sideEffect1 (); sideEffect2 ())[@res.braces ])
 let () = ((let open Foo in let exception End  in x ())[@res.braces ])

tests/syntax_tests/data/parsing/errors/expressions/expected/emptyBlock.res.txt

@@ -1,2 +1,2 @@
 let x = {  }
-let f = Function$ (fun [arity:2]a -> fun [arity:1]b -> {  })
+let f = Function$ (fun [arity:2]a -> fun b -> {  })

tests/syntax_tests/data/parsing/errors/other/expected/labelledParameters.res.txt

@@ -31,12 +31,10 @@
 
   A labeled parameter starts with a `~`. Did you mean: `~x`?
 
-let f =
-  Function$
-    (fun [arity:3]x -> fun [arity:2]?(y= 2) -> fun [arity:1]z -> (x + y) + z)
+let f = Function$ (fun [arity:3]x -> fun ?(y= 2) -> fun z -> (x + y) + z)
 let g =
   Function$
     (fun [arity:3]~x:((x)[@res.namedArgLoc ]) ->
-       fun [arity:2]?y:(((y)[@res.namedArgLoc ])= 2) ->
-         fun [arity:1]~z:((z)[@res.namedArgLoc ]) -> (x + y) + z)
+       fun ?y:(((y)[@res.namedArgLoc ])= 2) ->
+         fun ~z:((z)[@res.namedArgLoc ]) -> (x + y) + z)
 type nonrec f = (x:int -> y:int -> int, [ `Has_arity2 ]) function$

tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt

@@ -35,7 +35,7 @@ module ClientSet =
                                  let cmp =
                                    Function$
                                      (fun [arity:2]a ->
-                                        fun [arity:1]b ->
+                                        fun b ->
                                           ((compare
                                               (a |.u Client.getUniqueId)
                                               (b |.u Client.getUniqueId))

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

@@ -1,7 +1,7 @@
 [@@@uncurried ]
-let foo = Function$ (fun [arity:2]x -> fun [arity:1]y -> x + y)
+let foo = Function$ (fun [arity:2]x -> fun y -> x + y)
 let z = foo 3 4
-let bar = Function$ (fun [arity:2]x -> fun [arity:1]y -> x + y)
+let bar = Function$ (fun [arity:2]x -> fun y -> x + y)
 let b = bar 3 4
 let w = 3 |.u (foo 4)
 let a = 3 |.u (foo 4)

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

@@ -5,17 +5,15 @@ let uFun = Function$ (fun [arity:1]x -> 3)
 let mixFun =
   Function$
     (fun [arity:3]a ->
-       fun [arity:2]b ->
-         fun [arity:1]c ->
+       fun b ->
+         fun c ->
            Function$
              (fun [arity:3]d ->
-                fun [arity:2]e ->
-                  fun [arity:1]f ->
-                    Function$ (fun [arity:2]g -> fun [arity:1]h -> 4)))
+                fun e -> fun f -> Function$ (fun [arity:2]g -> fun h -> 4)))
 let bracesFun =
   Function$ (fun [arity:1]x -> Function$ (fun [arity:1]y -> x + y))
-let cFun2 = Function$ (fun [arity:2]x -> fun [arity:1]y -> 3)
-let uFun2 = Function$ (fun [arity:2]x -> fun [arity:1]y -> 3)
+let cFun2 = Function$ (fun [arity:2]x -> fun y -> 3)
+let uFun2 = Function$ (fun [arity:2]x -> fun y -> 3)
 type nonrec cTyp = (string -> int, [ `Has_arity1 ]) function$
 type nonrec uTyp = (string -> int, [ `Has_arity1 ]) function$
 type nonrec mixTyp =
@@ -77,19 +75,19 @@ let _ = Function$ ((fun [arity:1]x -> 34)[@res.async ][@att ])
 let _ = preserveAttr (Function$ ((fun [arity:1]x -> 34)[@att ]))
 let _ = preserveAttr (Function$ ((fun [arity:1]x -> 34)[@res.async ][@att ]))
 let t0 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t1 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t2 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t3 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t4 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t5 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t6 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 type nonrec arrowPath1 = (int -> string, [ `Has_arity1 ]) function$
 type nonrec arrowPath2 = (I.t -> string, [ `Has_arity1 ]) function$
 type nonrec arrowPath3 = (int -> string, [ `Has_arity1 ]) function$
@@ -109,18 +107,18 @@ let mixFun =
     (fun [arity:1]a ->
        Function$
          (fun [arity:2]b ->
-            fun [arity:1]c ->
+            fun c ->
               Function$
                 (fun [arity:3]d ->
-                   fun [arity:2]e ->
-                     fun [arity:1]f ->
+                   fun e ->
+                     fun f ->
                        Function$
                          (fun [arity:1]g -> Function$ (fun [arity:1]h -> 4)))))
 let bracesFun =
   Function$ (fun [arity:1]x -> Function$ (fun [arity:1]y -> x + y))
-let cFun2 = Function$ (fun [arity:2]x -> fun [arity:1]y -> 3)
-let uFun2 = Function$ (fun [arity:2]x -> fun [arity:1]y -> 3)
-let cFun2Dots = Function$ (fun [arity:2]x -> fun [arity:1]y -> 3)
+let cFun2 = Function$ (fun [arity:2]x -> fun y -> 3)
+let uFun2 = Function$ (fun [arity:2]x -> fun y -> 3)
+let cFun2Dots = Function$ (fun [arity:2]x -> fun y -> 3)
 type nonrec cTyp = (string -> int, [ `Has_arity1 ]) function$
 type nonrec uTyp = (string -> int, [ `Has_arity1 ]) function$
 type nonrec mixTyp =
@@ -184,13 +182,13 @@ let _ = Function$ ((fun [arity:1]x -> 34)[@res.async ][@att ])
 let _ = preserveAttr (Function$ ((fun [arity:1]x -> 34)[@att ]))
 let _ = preserveAttr (Function$ ((fun [arity:1]x -> 34)[@res.async ][@att ]))
 let t0 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t1 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t2 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 let t3 (type a) (type b) =
-  Function$ (fun [arity:2](l : a list) -> fun [arity:1](x : a) -> x :: l)
+  Function$ (fun [arity:2](l : a list) -> fun (x : a) -> x :: l)
 type nonrec arrowPath1 = (int -> string, [ `Has_arity1 ]) function$
 type nonrec arrowPath2 = (I.t -> string, [ `Has_arity1 ]) function$
 type nonrec arrowPath3 = (int -> string, [ `Has_arity1 ]) function$

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

@@ -4,8 +4,7 @@
 ;;foo (Function$ (fun [arity:1]_ -> bla))
     (Function$ (fun [arity:1]_ -> blaz))
 ;;List.map (Function$ (fun [arity:1]x -> x + 1)) myList
-;;List.reduce
-    (Function$ (fun [arity:2]acc -> fun [arity:1]curr -> acc + curr)) 0
+;;List.reduce (Function$ (fun [arity:2]acc -> fun curr -> acc + curr)) 0
     myList
 let unitUncurried = apply ()
 ;;call ~a:(((((a)[@res.namedArgLoc ]) : int))[@res.namedArgLoc ])