Adjustments to lambda translation.

Author: cristianoc

compiler/ml/translcore.ml

@@ -699,11 +699,9 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
     match arity with
     | Some arity ->
       let prim =
-        match
-          (Ast_uncurried.type_extract_uncurried_fun
-             (Ctype.expand_head e.exp_env e.exp_type))
-            .desc
-        with
+        let expanded = Ctype.expand_head e.exp_env e.exp_type in
+        let extracted = Ast_uncurried.type_extract_uncurried_fun expanded in
+        match (Btype.repr extracted).desc with
         | Tarrow (Nolabel, t, _, _) -> (
           match (Ctype.expand_head e.exp_env t).desc with
           | Tconstr (Pident {name = "unit"}, [], _) -> Pjs_fn_make_unit
@@ -1052,7 +1050,14 @@ and transl_function loc partial param case =
    c_rhs =
      {
        exp_desc =
-         Texp_function {arg_label = _; param = param'; case; partial = partial'};
+         Texp_function
+           {
+             arg_label = _;
+             arity = None;
+             param = param';
+             case;
+             partial = partial';
+           };
      } as exp;
   }
     when Parmatch.inactive ~partial pat && not (exp |> has_async_attribute) ->

tests/tests/src/class_type_ffi_test.res

@@ -30,5 +30,6 @@ let off2 = (o, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) =>
   o["huge_method"](a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12)
 
 /* Test [fn_mk] */
-let mk_f = () => (a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) =>
-  a0(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12)
+let mk_f = () =>
+  (a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) =>
+    a0(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12)

tests/tests/src/more_poly_variant_test.res

@@ -1,10 +1,11 @@
 type rec vlist<'a> = [#Nil | #Cons('a, vlist<'a>)]
 
-let rec map = (f): (vlist<'a> => vlist<'b>) => x =>
-  switch x {
-  | #Nil => #Nil
-  | #Cons(a, l) => #Cons(f(a), map(f)(l))
-  }
+let rec map = (f): (vlist<'a> => vlist<'b>) =>
+  x =>
+    switch x {
+    | #Nil => #Nil
+    | #Cons(a, l) => #Cons(f(a), map(f)(l))
+    }
 
 let split_cases = x =>
   switch x {

tests/tests/src/test_bs_this.res

@@ -2,11 +2,12 @@ let uux_this: @this ({"length": int}, int, int) => int = @this (o, x, y) => o["l
 
 let even = @this (o, x) => x + o
 
-let bark = () => @this
-(o: 'self, x, y) => {
-  Js.log((o["length"], o["x"], o["y"], x, y))
-  x + y
-}
+let bark = () =>
+  @this
+  (o: 'self, x, y) => {
+    Js.log((o["length"], o["x"], o["y"], x, y))
+    x + y
+  }
 
 let js_obj: 'self = {
   "bark": @this

tests/tests/src/uncurried_default.args.mjs

@@ -1,10 +1,10 @@
 // Generated by ReScript, PLEASE EDIT WITH CARE
 
 
-function withOpt(xOpt, y) {
-  let x = xOpt !== undefined ? xOpt : 1;
-  return (zOpt, w) => {
-    let z = zOpt !== undefined ? zOpt : 1;
+function withOpt($staropt$star, y) {
+  return ($staropt$star$1, w) => {
+    let x = $staropt$star !== undefined ? $staropt$star : 1;
+    let z = $staropt$star$1 !== undefined ? $staropt$star$1 : 1;
     return ((x + y | 0) + z | 0) + w | 0;
   };
 }
@@ -53,10 +53,10 @@ let StandardNotation = {
   r3: r3
 };
 
-function withOpt$1(xOpt, y) {
-  let x = xOpt !== undefined ? xOpt : 1;
-  return (zOpt, w) => {
-    let z = zOpt !== undefined ? zOpt : 1;
+function withOpt$1($staropt$star, y) {
+  return ($staropt$star$1, w) => {
+    let x = $staropt$star !== undefined ? $staropt$star : 1;
+    let z = $staropt$star$1 !== undefined ? $staropt$star$1 : 1;
     return ((x + y | 0) + z | 0) + w | 0;
   };
 }